X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXDb.pm;h=5d96e6cf2029db4ad798a699b350ff1f877ef392;hb=48f0cb90d0cfbe3037f353fc25adfc33561634fa;hp=b7a886716df0181f76f4fe694179cde9340afee8;hpb=8178d787d7cc8040fa8958197582bba5c80e6f59;p=spider.git diff --git a/perl/DXDb.pm b/perl/DXDb.pm index b7a88671..5d96e6cf 100644 --- a/perl/DXDb.pm +++ b/perl/DXDb.pm @@ -21,39 +21,34 @@ $dbbase = "$main::root/db"; # where all the databases are kept; %avail = (); # The hash contains a list of all the databases %valid = ( accesst => '9,Last Accs Time,atime', + allowread => '9,Allowed read,parray', + allowupd => '9,Allow upd,parray', + atemplate => '9,App Templates,parray', + cal => '0,No Key txt', + chain => '0,Search these,parray', createt => '9,Create Time,atime', - lastt => '9,Last Upd Time,atime', - name => '0,Name', db => '9,DB Tied hash', - remote => '0,Remote Database', - pre => '0,Heading txt', - post => '0,Tail txt', - chain => '0,Search these,parray', - disable => '0,Disabled?,yesno', - nf => '0,Not Found txt', - cal => '0,No Key txt', - allowread => '9,Allowed read,parray', denyread => '9,Deny read,parray', - allowupd => '9,Allow upd,parray', denyupd => '9,Deny upd,parray', + disable => '0,Disabled?,yesno', fwdupd => '9,Forw upd to,parray', - template => '9,Upd Templates,parray', - te => '9,End Upd txt', - tae => '9,End App txt', - atemplate => '9,App Templates,parray', help => '0,Help txt,parray', + lastt => '9,Last Upd Time,atime', + localcmd => '0,Local Command', + name => '0,Name', + nf => '0,Not Found txt', + post => '0,Tail txt', + pre => '0,Heading txt', + remote => '0,Remote Database', + tae => '9,End App txt', + te => '9,End Upd txt', + template => '9,Upd Templates,parray', ); $lastprocesstime = time; $nextstream = 0; %stream = (); -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - # allocate a new stream for this request sub newstream { @@ -155,9 +150,22 @@ sub getkey my $key = uc shift; my $value; + # massage the key + $key =~ s/[\@\$\&\%\*]+//g; + $key =~ s/^[\.\/]+//g; + # make sure we are open $self->open; - if ($self->{db}) { + if ($self->{localcmd}) { + my $dxchan = $main::me; + $dxchan->{remotecmd} = 1; # for the benefit of any command that needs to know + my $oldpriv = $dxchan->{priv}; + $dxchan->{priv} = 0; + my @in = (DXCommandmode::run_cmd($dxchan, "$self->{localcmd} $key")); + $dxchan->{priv} = $oldpriv; + delete $dxchan->{remotecmd}; + return @in ? join("\n", @in) : undef; + } elsif ($self->{db}) { my $s = $self->{db}->get($key, $value); return $s ? undef : $value; } @@ -187,13 +195,18 @@ sub new my $name = shift; my $remote = shift; my $chain = shift; + my $cmd = 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; + $self->{localcmd} = lc $cmd if $cmd; + $avail{$self->{name}} = $self; mkdir $dbbase, 02775 unless -e $dbbase; save(); + return $self; } # delete a database @@ -225,81 +238,58 @@ sub normal # sub process { - my ($dxchan, $line) = @_; - - # this is periodic processing - if (!$dxchan || !$line) { - if ($main::systime - $lastprocesstime >= 60) { - if (%avail) { - for (values %avail) { - if ($main::systime - $_->{accesst} > $opentime) { - $_->close; - } + if ($main::systime - $lastprocesstime >= 60) { + if (%avail) { + for (values %avail) { + if ($main::systime - $_->{accesst} > $opentime) { + $_->close; } } - $lastprocesstime = $main::systime; } - return; + $lastprocesstime = $main::systime; } +} - my @f = split /\^/, $line; - my ($pcno) = $f[0] =~ /^PC(\d\d)/; # just get the number +sub handle_37 +{ - # route out ones that are not for us - if ($f[1] eq $main::mycall) { - ; - } else { - $dxchan->route($f[1], $line); - return; - } +} - SWITCH: { - if ($pcno == 37) { # probably obsolete - last SWITCH; - } +sub handle_44 +{ + my $self = shift; - if ($pcno == 44) { # incoming DB Request - my $db = getdesc($f[4]); - if ($db) { - if ($db->{remote}) { - sendremote($dxchan, $f[2], $f[3], $dxchan->msg('db1', $db->{remote})); - } else { - my $value = $db->getkey($f[5]); - if ($value) { - my @out = split /\n/, $value; - sendremote($dxchan, $f[2], $f[3], @out); - } else { - sendremote($dxchan, $f[2], $f[3], $dxchan->msg('db2', $f[5], $db->{name})); - } - } - } else { - sendremote($dxchan, $f[2], $f[3], $dxchan->msg('db3', $f[4])); - } - last SWITCH; - } + # incoming DB Request + my @in = DXCommandmode::run_cmd($self, "dbshow $_[4] $_[5]"); + sendremote($self, $_[2], $_[3], @in); +} - if ($pcno == 45) { # incoming DB Information - my $n = getstream($f[3]); - if ($n) { - my $mchan = DXChannel->get($n->{call}); - $mchan->send($f[2] . ":$f[4]") if $mchan; - } - last SWITCH; - } +sub handle_45 +{ + my $self = shift; - if ($pcno == 46) { # incoming DB Complete - delstream($f[3]); - last SWITCH; - } + # incoming DB Information + my $n = getstream($_[3]); + if ($n) { + my $mchan = DXChannel::get($n->{call}); + $mchan->send($_[2] . ":$_[4]") if $mchan; + } +} - if ($pcno == 47) { # incoming DB Update request - last SWITCH; - } +sub handle_46 +{ + my $self = shift; - if ($pcno == 48) { # incoming DB Update request - last SWITCH; - } - } + # incoming DB Complete + delstream($_[3]); +} + +sub handle_47 +{ +} + +sub handle_48 +{ } # send back a trache of data to the remote @@ -348,7 +338,6 @@ sub field_prompt #no strict; sub AUTOLOAD { - my $self = shift; no strict; my $name = $AUTOLOAD; return if $name =~ /::DESTROY$/; @@ -358,9 +347,7 @@ sub AUTOLOAD # this clever line of code creates a subroutine which takes over from autoload # from OO Perl - Conway *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}}; - &$AUTOLOAD($self, @_); -# *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ; -# @_ ? $self->{$name} = shift : $self->{$name} ; + goto &$AUTOLOAD; } 1;