return $self->{$name};
}
+use strict;
+
#
# initialise the system
#
sub del_file
{
- my ($pkg, $fn, $mode) = @_;
+ my ($pkg, $fn) = @_;
confess "need a filename in User" if !$fn;
$fn .= ".v2";
unlink $fn;
}
-use strict;
-
#
# periodic processing
#
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);
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);
}
#
my $count = 0;
my $fh = new IO::File ">$fn" or return "cannot open $fn ($!)";
if ($fh) {
- my $ref;
- my $key;
+ my $ref = 0;
+ my $key = 0;
my $action;
my $t = scalar localtime;
- print $fh "#!/usr/bin/perl
+ print $fh q{#!/usr/bin/perl
#
# The exported userfile for a DXSpider System
#
# 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
+ if (-e $lockfn) {
+ open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!";
+ my $pid = <CLLOCK>;
+ chomp $pid;
+ die "Lockfile ($lockfn) and process $pid exists - cluster must be stopped first\n" if kill 0, $pid;
+ close CLLOCK;
+ }
+}
package DXUser;
+use DXVars;
+use DXUser;
+
+if (@ARGV) {
+ $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' => $ref,\n";
+ for ($action = R_FIRST; !$dbm->seq($key, $ref, $action); $action = R_NEXT) {
+ print $fh "'$key' => q{$ref},\n";
++$count;
}
- print $fh ");\n#\n# there were $count records\n#\n";
- $fh->close;
- }
+ print $fh ");\n#\nprint \"there were $count records\\n\";\n#\n";
+ print $fh "DXUser->sync; DXUser->finish;\n#\n";
+ $fh->close;
+ }
return $count;
}