From: djk <djk>
Date: Mon, 8 Nov 1999 21:29:40 +0000 (+0000)
Subject: added chaining to databases
X-Git-Tag: R_1_34~3
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=88c2b296ba903fdd356e351b83fcb844e2d6eacd;p=spider.git

added chaining to databases
---

diff --git a/cmd/dbavail.pl b/cmd/dbavail.pl
index 9d898514..0974ee7f 100644
--- 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 5ef4fe7d..8f47b63f 100644
--- 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 44653152..1c3b0139 100644
--- 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 5439fc4d..ca6c053e 100644
--- 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 ab37f852..bccfb6dd 100644
--- 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 d7ca5ed2..ac2b63e4 100644
--- 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 3d3f2b02..8e40b82c 100644
--- 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 8b45e2bd..1f011c55 100755
--- 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();