X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXDb.pm;h=9251bdfdaa8ed084567b54522caba2b35dedba65;hb=86e41a4301c772ec72b9e45ed6edd0dd4942fad2;hp=50148ee2a6d47c0c55a4a87d32707d13a7ba3ca5;hpb=6e210063f1ef4e5c36ad04ba029b59711cc1eb04;p=spider.git

diff --git a/perl/DXDb.pm b/perl/DXDb.pm
index 50148ee2..9251bdfd 100644
--- 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;