added chaining to databases

diff --git a/cmd/dbavail.pl b/cmd/dbavail.pl
index 9d898514f374a588daa363d39ffd8e3098fb312f..0974ee7feafa4f0d4eeb3b9da70b8cbc40bc3471 100644 (file)
--- a/cmd/dbavail.pl
+++ b/cmd/dbavail.pl
@@ -10,7 +10,7 @@ my @out;
 my $f;
 
 foreach $f (values %DXDb::avail) {
-       push @out, "DB Name          Location" unless @out;
-       push @out, sprintf "%-15s  %-s", $f->name, $f->remote ? $f->remote : "Local"; 
+       push @out, "DB Name          Location   Chain" unless @out;
+       push @out, sprintf "%-15s  %-10s %s", $f->name, $f->remote ? $f->remote : "Local", $f->chain ? parray($f->chain) : ""; 
 }
 return (1, @out);

diff --git a/cmd/dbcreate.pl b/cmd/dbcreate.pl
index 5ef4fe7d3890224aafc61f28d931b592292b5f76..8f47b63f6cc71fa063a6779e89990d8b4e100fdc 100644 (file)
--- a/cmd/dbcreate.pl
+++ b/cmd/dbcreate.pl
@@ -5,12 +5,28 @@
 # Copyright (c) 1999 Dirk Koopman G1TLH
 #
 my ($self, $line) = @_;
-my ($name, $remote) = split /\s+/, $line;
+my @f = split /\s+/, $line;
+my $name = shift @f if @f;
 my @out;
 
 return (1, $self->msg('e5')) if $self->priv < 9;
-
 return (1, $self->msg('db6', $name)) if DXDb::getdesc($name);
-DXDb::new($name, $remote);
+
+my $remote;
+my $chain;
+while (@f) {
+       my $f = lc shift @f;
+       if ($f eq 'remote') {
+               $remote = uc shift @f if @f;
+               next;
+       }
+       if ($f eq 'chain') {
+               if (@f) {
+                       $chain = [ @f ];
+                       last;
+               }
+       }
+}
+DXDb::new($name, $remote, $chain);
 push @out, $self->msg($remote ? 'db7' : 'db8', $name, $remote);
 return (1, @out);

diff --git a/cmd/dbshow.pl b/cmd/dbshow.pl
index 446531522f4172d17f9eca40b477dc496fd062f8..1c3b0139e2529017bc4909b104633914e4aebbdb 100644 (file)
--- a/cmd/dbshow.pl
+++ b/cmd/dbshow.pl
@@ -12,19 +12,49 @@ my $name = shift @f if @f;
 my $db = DXDb::getdesc($name);
 return (1, $self->msg('db3', $name)) unless $db;
 
-if ($db->remote) {
-       push @out, $self->msg('db11', $db->remote);
-       for (@f) {
-               my $n = DXDb::newstream($self->call);
-               DXProt::route(undef, $db->remote, DXProt::pc44($main::mycall, $db->remote, $n, uc $db->name,uc $_, $self->call));
-       }
-} else {
-       for (@f) {
-               my $value = $db->getkey($_);
-               if ($value) {
-                       push @out, split /\n/, $value;
-               } else {
-                       push @out, $self->msg('db2', $_, $db->{name});
+my @db; 
+push @db, $name;
+push @db, @{$db->chain} if $db->chain;
+
+my $n;
+foreach  $n (@db) {
+       $db = DXDb::getdesc($n);
+       return (1, $self->msg('db3', $n)) unless $db;
+       
+       if ($db->remote) {
+
+               # remote databases
+               unless (DXCluster->get_exact($db->remote) || DXChannel->get($db->remote)) {
+                       push @out, $self->msg('db4', uc $name, $db->remote);
+                       last;
+               }
+               
+               push @out, $self->msg('db11', $db->remote);
+               for (@f) {
+                       my $n = DXDb::newstream($self->call);
+                       DXProt::route(undef, $db->remote, DXProt::pc44($main::mycall, $db->remote, $n, uc $db->name,uc $_, $self->call));
+               }
+               last;
+       } else {
+
+               # local databases can chain to remote ones
+               my $count;
+               push @out, $db->print('pre');
+               push @out, "@f";
+               for (@f) {
+                       push @out, $db->name . " $_";
+                       my $value = $db->getkey($_);
+                       push @out, $db->name . ": $_ : $value";
+                       if ($value) {
+                               push @out, split /\n/, $value;
+                               $count++;
+                       } else {
+                               push @out, $self->msg('db2', uc $_, uc $db->{name});
+                       }
+               }
+               if ($count) {
+                       push @out, $db->print('post');
+                       last;
                }
        }
 }

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 5439fc4d21bcc8cfee490cb541ba19551e83f660..ca6c053e7d03cae21ba4376aff4b0eb102e5ef82 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -168,8 +168,7 @@ sub normal
                        $self->send($self->msg('page', scalar @ans));
                } else {
                        for (@ans) {
-                               s/\s+$//o;              # why ?????????
-                               $self->send($_);
+                               $self->send($_) if $_;
                        }
                } 
        } 

diff --git a/perl/DXDb.pm b/perl/DXDb.pm
index ab37f85291010d3ab951336a6a8d8b93dd1329af..bccfb6ddac951140481687ca9f36cad5e6f50541 100644 (file)
--- a/perl/DXDb.pm
+++ b/perl/DXDb.pm
@@ -27,6 +27,19 @@ $dbbase = "$main::root/db";          # where all the databases are kept;
                  name => '0,Name',
                  db => '9,DB Tied hash',
                  remote => '0,Remote Database',
+                 pre => '0,Heading text',
+                 post => '0,Tail text',
+                 chain => '0,Search these,parray',
+                 disable => '0,Disabled?,yesno',
+                 nf => '0,Not Found text',
+                 cal => '0,No Key text',
+                 allowread => '9,Allowed to read,parray',
+                 denyread => '9,Deny to read,parray',
+                 allowupd => '9,Allow to update,parray',
+                 denyupd => '9,Deny to update,parray',
+                 fwdupd => '9,Forward updates to,parray',
+                 template => '9,Upd Templates,parray',
+                 help => '0,Help txt,parray',
                 );
 
 $lastprocesstime = time;
@@ -70,9 +83,8 @@ sub load
 # save all the database descriptors
 sub save
 {
-       my $date = cldatetime($main::systime);
-       
-       writefilestr($dbbase, "dbs", "pl", \%avail, "#\n# database descriptor file\n# Don't alter this by hand unless you know what you are doing\n# last modified $date\n#\n");
+       closeall();
+       writefilestr($dbbase, "dbs", "pl", \%avail);
 }
 
 # get the descriptor of the database you want.
@@ -112,7 +124,8 @@ sub close
 {
        my $self = shift;
        if ($self->{db}) {
-               untie $self->{db};
+               undef $self->{db};
+               delete $self->{db};
        }
 }
 
@@ -164,8 +177,10 @@ sub new
        my $self = bless {};
        my $name = shift;
        my $remote = shift;
+       my $chain = shift;
        $self->{name} = lc $name;
        $self->{remote} = uc $remote if $remote;
+       $self->{chain} = $chain if $chain && ref $chain;
        $self->{accesst} = $self->{createt} = $self->{lastt} = $main::systime;
        $avail{$self->{name}} = $self;
        mkdir $dbbase, 02775 unless -e $dbbase;
@@ -292,6 +307,14 @@ sub sendremote
        $dxchan->send(DXProt::pc46($main::mycall, $tonode, $stream));
 }
 
+# print a value from the db reference
+sub print
+{
+       my $self = shift;
+       my $s = shift;
+       return $self->{$s} ? $self->{$s} : undef; 
+} 
+
 # various access routines
 
 #

diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index d7ca5ed218e2b6e8e1671091e9c2cb043a3bf4c8..ac2b63e42a282212f79a8627e04468dca957f115 100644 (file)
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -268,11 +268,13 @@ sub writefilestr
        }
 
        my $fh = new IO::File ">$fn";
-       my $dd = new Data::Dumper([ $obj ]);
-       $dd->Indent(1);
-       $dd->Terse(1);
-    $dd->Quotekeys(0);
-#      $fh->print(@_) if @_ > 0;     # any header comments, lines etc
-       $fh->print($dd->Dumpxs);
-       $fh->close;
+       if ($fh) {
+               my $dd = new Data::Dumper([ $obj ]);
+               $dd->Indent(1);
+               $dd->Terse(1);
+               $dd->Quotekeys(0);
+               #       $fh->print(@_) if @_ > 0;     # any header comments, lines etc
+               $fh->print($dd->Dumpxs);
+               $fh->close;
+       }
 }

diff --git a/perl/Messages b/perl/Messages
index 3d3f2b022ec34ea3dbd312dcfb773256dd8e68f4..8e40b82ceeda1a7d82bd6ac418b8e502443ca549 100644 (file)
--- a/perl/Messages
+++ b/perl/Messages
@@ -26,7 +26,7 @@ package DXM;
                                disc1 => 'Disconnected by $_[0]',
                                disc2 => '$_[0] disconnected',
                                db1 => 'This database is hosted at $_[0]',
-                               db2 => 'Key: $_[0] not found in $_[1]',
+                               db2 => 'Sorry, but key: $_[0] was not found in $_[1]',
                                db3 => 'Sorry, database $_[0] doesn\'t exist here',
                                db4 => 'Sorry, database $_[0] located at $_[1] isn\'t currently online',
                                db5 => 'Accessing remote database on $_[0]...standby...',

diff --git a/perl/cluster.pl b/perl/cluster.pl
index 8b45e2bd65d805d7fc411650b387a586199d103f..1f011c55584971360363523d3c332d3e8c6f5766 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -178,9 +178,6 @@ sub cease
        };
        dbg('local', "Local::finish error $@") if $@;
 
-       # close all databases
-       DXDb::closeall;
-       
        # disconnect users
        foreach $dxchan (DXChannel->get_all()) {
                next if $dxchan->is_ak1a;
@@ -211,6 +208,10 @@ sub cease
        Msg->event_loop(1, 0.05);
        Msg->event_loop(1, 0.05);
        DXUser::finish();
+
+       # close all databases
+       DXDb::closeall;
+       
        dbg('chan', "DXSpider version $version ended");
        Log('cluster', "DXSpider V$version stopped");
        dbgclose();