X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXDb.pm;h=81d21928334ea81e15848eed639f58b3225cb062;hb=b9dffeff7239952814342dad19db3a51def6fab7;hp=b7a886716df0181f76f4fe694179cde9340afee8;hpb=8178d787d7cc8040fa8958197582bba5c80e6f59;p=spider.git

diff --git a/perl/DXDb.pm b/perl/DXDb.pm
index b7a88671..81d21928 100644
--- a/perl/DXDb.pm
+++ b/perl/DXDb.pm
@@ -42,18 +42,13 @@ $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
 {
@@ -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;