X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXDb.pm;h=e399545d0616798c6cd832276d16b6c6c80a659f;hb=51fc2b9134d2e3bf91daf970c36bb8a80590e34f;hp=49da69c9804b729aad3cd04c87e7a4165397c395;hpb=9e2fbafcfdab1ee45e581524311f1a97ac41f6ad;p=spider.git

diff --git a/perl/DXDb.pm b/perl/DXDb.pm
index 49da69c9..e399545d 100644
--- a/perl/DXDb.pm
+++ b/perl/DXDb.pm
@@ -12,8 +12,7 @@ use DXVars;
 use DXLog;
 use DXUtil;
 use DB_File;
-
-use Carp;
+use DXDebug;
 
 use vars qw($opentime $dbbase %avail %valid $lastprocesstime $nextstream %stream);
 
@@ -21,18 +20,41 @@ $opentime = 5*60;				# length of time a database stays open after last access
 $dbbase = "$main::root/db";		# where all the databases are kept;
 %avail = ();					# The hash contains a list of all the databases
 %valid = (
-		  accesst => '9,Last Access Time,atime',
+		  accesst => '9,Last Accs Time,atime',
 		  createt => '9,Create Time,atime',
-		  lastt => '9,Last Update 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',
+		  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',
+		  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
 {
@@ -61,18 +83,18 @@ 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;
 	}
 }
 
 # save all the database descriptors
 sub save
 {
-	my $date = cldatetime($main::systime);
-	
-	writefilestr($dbbase, "dbs", "pl", \%avail, "#\n# database descriptor file\n# Don't alter this by hand unless you know what you are doing\n# last modified $date\n#\n");
+	closeall();
+	writefilestr($dbbase, "dbs", "pl", \%avail);
 }
 
 # get the descriptor of the database you want.
@@ -85,7 +107,7 @@ sub getdesc
 
 	# search for a partial if not found direct
 	unless ($r) {
-		for (values %avail) {
+		for (sort { $a->{name} cmp $b->{name} }values %avail) {
 			if ($_->{name} =~ /^$name/) {
 				$r = $_;
 				last;
@@ -112,7 +134,8 @@ sub close
 {
 	my $self = shift;
 	if ($self->{db}) {
-		untie $self->{db};
+		undef $self->{db};
+		delete $self->{db};
 	}
 }
 
@@ -135,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;
 	}
@@ -164,12 +196,19 @@ sub new
 	my $self = bless {};
 	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
@@ -238,18 +277,18 @@ sub process
 			my $db = getdesc($f[4]);
 			if ($db) {
 				if ($db->{remote}) {
-					sendremote($dxchan, $f[2], $f[3], $dxchan->msg('dx1', $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('dx2', $f[5], $db->{name}));
+						sendremote($dxchan, $f[2], $f[3], $dxchan->msg('db2', $f[5], $db->{name}));
 					}
 				}
 			} else {
-				sendremote($dxchan, $f[2], $f[3], $dxchan->msg('dx3', $f[4]));
+				sendremote($dxchan, $f[2], $f[3], $dxchan->msg('db3', $f[4]));
 			}
 			last SWITCH;
 		}
@@ -258,7 +297,7 @@ sub process
 			my $n = getstream($f[3]);
 			if ($n) {
 				my $mchan = DXChannel->get($n->{call});
-				$mchan->send($f[2] . ":$f[4]");
+				$mchan->send($f[2] . ":$f[4]") if $mchan;
 			}
 			last SWITCH;
 		}
@@ -292,6 +331,14 @@ sub sendremote
 	$dxchan->send(DXProt::pc46($main::mycall, $tonode, $stream));
 }
 
+# print a value from the db reference
+sub print
+{
+	my $self = shift;
+	my $s = shift;
+	return $self->{$s} ? $self->{$s} : undef; 
+} 
+
 # various access routines
 
 #
@@ -313,16 +360,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};
-	@_ ? $self->{$name} = shift : $self->{$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}};
+        goto &$AUTOLOAD;
 }
 
 1;