From 88c2b296ba903fdd356e351b83fcb844e2d6eacd Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 8 Nov 1999 21:29:40 +0000 Subject: [PATCH] added chaining to databases --- cmd/dbavail.pl | 4 ++-- cmd/dbcreate.pl | 22 ++++++++++++++--- cmd/dbshow.pl | 56 +++++++++++++++++++++++++++++++++---------- perl/DXCommandmode.pm | 3 +-- perl/DXDb.pm | 31 ++++++++++++++++++++---- perl/DXUtil.pm | 16 +++++++------ perl/Messages | 2 +- perl/cluster.pl | 7 +++--- 8 files changed, 106 insertions(+), 35 deletions(-) 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(); -- 2.34.1