X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=52b7819d4ace901067280cd6396f164281621c7e;hb=b91254375e95e7931312c4177ee390866f82c648;hp=ce26c291c7919a1b0874c709b09f1f53ddc918f2;hpb=79f4593964c44fb39faf9d070a418125e90e1333;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index ce26c291..52b7819d 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -63,8 +63,9 @@ $lasttime = 0; pingint => '9,Node Ping interval', nopings => '9,Ping Obs Count', wantlogininfo => '9,Login info req,yesno', - wantgrid => '0,DX Grid Info,yesno', + wantgrid => '0,DX Grid Info,yesno', lastoper => '9,Last for/oper,cldatetime', + nothere => '0,Not Here Text', ); no strict; @@ -77,12 +78,17 @@ sub AUTOLOAD $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}} ; if (@_) { $self->{$name} = shift; } return $self->{$name}; } +use strict; + # # initialise the system # @@ -110,8 +116,6 @@ sub del_file unlink $fn; } -use strict; - # # periodic processing # @@ -209,9 +213,10 @@ sub put confess "Trying to put nothing!" unless $self && ref $self; my $call = $self->{call}; # delete all instances of this - for ($dbm->get_dup($call)) { - $dbm->del_dup($call, $_); - } +# for ($dbm->get_dup($call)) { +# $dbm->del_dup($call, $_); +# } + $dbm->del($call); delete $self->{annok} if $self->{annok}; delete $self->{dxok} if $self->{dxok}; $dbm->put($call, $self->encode); @@ -239,8 +244,8 @@ sub decode my $ref; eval '$ref = ' . $s; if ($@) { - dbg('err', $@) if $@; - Log('err', $@) if $@; + dbg($@); + Log('err', $@); $ref = undef; } return $ref; @@ -255,9 +260,10 @@ sub del my $self = shift; my $call = $self->{call}; # delete all instances of this - for ($dbm->get_dup($call)) { - $dbm->del_dup($call, $_); - } +# for ($dbm->get_dup($call)) { +# $dbm->del_dup($call, $_); +# } + $dbm->del($call); } # @@ -319,23 +325,23 @@ sub export # Input file: $filename # Time: $t # - + package main; - + # search local then perl directories BEGIN { umask 002; - + # root of directory tree for this system $root = "/spider"; $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; unshift @INC, "$root/perl"; # this IS the right way round! unshift @INC, "$root/local"; - + # try to detect a lockfile (this isn't atomic but # should do for now - $lockfn = "$root/perl/cluster.lock"; # lock file name + $lockfn = "$root/perl/cluster.lck"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; @@ -351,25 +357,25 @@ use DXVars; use DXUser; if (@ARGV) { - $main::userfn = shift @ARGV; - print "user filename now $userfn\n"; + $main::userfn = shift @ARGV; + print "user filename now $userfn\n"; } DXUser->del_file($main::userfn); DXUser->init($main::userfn, 1); %u = ( - }; - -for ($action = R_FIRST; !$dbm->seq($key, $ref, $action); $action = R_NEXT) { - print $fh "'$key' => q{$ref},\n"; - ++$count; -} -print $fh ");\n#\nprint \"there were $count records\\n\";\n#\n"; -print $fh "DXUser->sync; DXUser->finish;\n#\n"; -$fh->close; -} - return $count; + }; + + for ($action = R_FIRST; !$dbm->seq($key, $ref, $action); $action = R_NEXT) { + print $fh "'$key' => q{$ref},\n"; + ++$count; + } + print $fh ");\n#\nprint \"there were $count records\\n\";\n#\n"; + print $fh "DXUser->sync; DXUser->finish;\n#\n"; + $fh->close; + } + return $count; } #