X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXDb.pm;h=9251bdfdaa8ed084567b54522caba2b35dedba65;hb=25140d3e8633cbf9e25b6528248405ec8ed125e3;hp=db26d4aacf5b8329732e132e4ad7c303061cdc91;hpb=f7ad460466e7e783eda20d467146ef29fde1f4fa;p=spider.git

diff --git a/perl/DXDb.pm b/perl/DXDb.pm
index db26d4aa..9251bdfd 100644
--- a/perl/DXDb.pm
+++ b/perl/DXDb.pm
@@ -42,6 +42,7 @@ $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;
@@ -50,7 +51,7 @@ $nextstream = 0;
 
 use vars qw($VERSION $BRANCH);
 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
-$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
 $main::build += $VERSION;
 $main::branch += $BRANCH;
 
@@ -157,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;
 	}
@@ -187,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
@@ -259,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('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]));
-			}
+			my @in = DXCommandmode::run_cmd($dxchan, "dbshow $f[4] $f[5]");
+			sendremote($dxchan, $f[2], $f[3], @in);
 			last SWITCH;
 		}
 
@@ -345,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;