use run_cmd for remote db enquiries

[spider.git] / perl / DXDb.pm

diff --git a/perl/DXDb.pm b/perl/DXDb.pm
index 50148ee2a6d47c0c55a4a87d32707d13a7ba3ca5..9251bdfdaa8ed084567b54522caba2b35dedba65 100644 (file)
--- a/perl/DXDb.pm
+++ b/perl/DXDb.pm
@@ -42,12 +42,19 @@ $dbbase = "$main::root/db";         # where all the databases are kept;
                  tae => '9,End App txt',
                  atemplate => '9,App Templates,parray',
                  help => '0,Help txt,parray',
+                 localcmd => '0,Local Command',
                 );
 
 $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
 {
@@ -76,9 +83,10 @@ sub load
 {
        my $s = readfilestr($dbbase, "dbs", "pl");
        if ($s) {
-               my $a = eval $s;
+               my $a;
+               eval "\$a = $s";
                confess $@ if $@;
-               %avail = %{$a} if $a
+               %avail = ( %$a ) if ref $a;
        }
 }
 
@@ -150,7 +158,16 @@ sub getkey
 
        # 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;
        }
@@ -180,13 +197,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
@@ -252,22 +274,8 @@ sub process
                }
 
                if ($pcno == 44) {              # incoming DB Request
-                       my $db = getdesc($f[4]);
-                       if ($db) {
-                               if ($db->{remote}) {
-                                       sendremote($dxchan, $f[2], $f[3], $dxchan->msg('dx1', $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('dx2', $f[5], $db->{name}));
-                                       }
-                               }
-                       } else {
-                               sendremote($dxchan, $f[2], $f[3], $dxchan->msg('dx3', $f[4]));
-                       }
+                       my @in = DXCommandmode::run_cmd($dxchan, "dbshow $f[4] $f[5]");
+                       sendremote($dxchan, $f[2], $f[3], @in);
                        last SWITCH;
                }
 
@@ -338,19 +346,19 @@ sub field_prompt
        return $valid{$ele};
 }
 
-no strict;
+#no strict;
 sub AUTOLOAD
 {
-       my $self = shift;
+       no strict;
        my $name = $AUTOLOAD;
        return if $name =~ /::DESTROY$/;
-       $name =~ s/.*:://o;
+       $name =~ s/^.*:://o;
   
        confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
        # 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}} ;
-       @_ ? $self->{$name} = shift : $self->{$name} ;
+       *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
+        goto &$AUTOLOAD;
 }
 
 1;