X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXDb.pm;h=6a57dc7cc8db3003ce7338b3288aff94fb2b0656;hb=7b616aeabce92e3cb416a5fe6640a288adfe5410;hp=a7f31acca8ec1f4e07b59c187b910e252b77e812;hpb=0bd9d2811cc42417676a1b11b121681c2377d70a;p=spider.git diff --git a/perl/DXDb.pm b/perl/DXDb.pm index a7f31acc..6a57dc7c 100644 --- a/perl/DXDb.pm +++ b/perl/DXDb.pm @@ -48,6 +48,12 @@ $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 +82,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; } } @@ -255,18 +262,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; } @@ -338,16 +345,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;