X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCron.pm;h=9e4bde71e9083c5b5c7e9c45a4522c98251ebb3f;hb=f3adc82a0299652d929b73c718127fa38571eec5;hp=961fa3a60df61c6aab1a096c16ef8412ba8e2806;hpb=69003f56e5249357c746999c2feec5f44c258472;p=spider.git diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 961fa3a6..9e4bde71 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -17,11 +17,12 @@ use Carp; use strict; -use vars qw{@crontab $mtime $lasttime}; +use vars qw{@crontab $mtime $lasttime $lastmin}; @crontab = (); -$mtime = 0; +$mtime = 1; $lasttime = 0; +$lastmin = 0; my $fn = "$main::cmd/crontab"; @@ -30,18 +31,26 @@ my $localfn = "$main::localcmd/crontab"; # cron initialisation / reading in cronjobs sub init { - my $t; - - if (-e $localfn) { - if (-e $localfn && ($t = -M $localfn) != $mtime) { + if ((-e $localfn && -M $localfn < $mtime) || (-e $fn && -M $fn < $mtime) || $mtime == 0) { + my $t; + + @crontab = (); + + # first read in the standard one + if (-e $fn) { + $t = -M $fn; + + cread($fn); + $mtime = $t if $t <= $mtime; + } + + # then read in any local ones + if (-e $localfn) { + $t = -M $localfn; + cread($localfn); - $mtime = $t; + $mtime = $t if $t <= $mtime; } - return; - } - if (($t = -M $fn) != $mtime) { - cread($fn); - $mtime = $t; } } @@ -52,14 +61,13 @@ sub cread my $fh = new FileHandle; my $line = 0; - dbg('cron', "reading $fn\n"); - open($fh, $fn) or confess("can't open $fn $!"); - @crontab = (); # clear out the old stuff + dbg('cron', "cron: reading $fn\n"); + open($fh, $fn) or confess("cron: can't open $fn $!"); while (<$fh>) { $line++; - + chomp; next if /^\s*#/o or /^\s*$/o; - my ($min, $hour, $mday, $month, $wday, $cmd) = /^\s*(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(.+)$/o; + my ($min, $hour, $mday, $month, $wday, $cmd) = /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.+)$/o; next if !$min; my $ref = bless {}; my $err; @@ -72,9 +80,9 @@ sub cread if (!$err) { $ref->{cmd} = $cmd; push @crontab, $ref; - dbg('cron', "adding $_\n"); + dbg('cron', "cron: adding $_\n"); } else { - dbg('cron', "error on line $line '$_'\n"); + dbg('cron', "cron: error on line $line '$_'\n"); } } close($fh); @@ -111,6 +119,8 @@ sub parse push @req, 0 + $_; } } + $ref->{$sort} = \@req; + return 0; } @@ -118,13 +128,95 @@ sub parse sub process { my $now = $main::systime; + return if $now-$lasttime < 1; - if ($now - $lasttime >= 60) { - my ($sec, $min, $hour, $mday, $mon, $wday) = (gmtime($main::systime))[0-4,6]; + my ($sec, $min, $hour, $mday, $mon, $wday) = (gmtime($now))[0,1,2,3,4,6]; + + # are we at a minute boundary? + if ($min != $lastmin) { - $lasttime = $now; + # read in any changes if the modification time has changed + init(); + + $mon += 1; # months otherwise go 0-11 + my $cron; + foreach $cron (@crontab) { + if ((!$cron->{min} || grep $_ eq $min, @{$cron->{min}}) && + (!$cron->{hour} || grep $_ eq $hour, @{$cron->{hour}}) && + (!$cron->{mday} || grep $_ eq $mday, @{$cron->{mday}}) && + (!$cron->{mon} || grep $_ eq $mon, @{$cron->{mon}}) && + (!$cron->{wday} || grep $_ eq $wday, @{$cron->{wday}}) ){ + + if ($cron->{cmd}) { + dbg('cron', "cron: $min $hour $mday $mon $wday -> doing '$cron->{cmd}'"); + eval "$cron->{cmd}"; + dbg('cron', "cron: cmd error $@") if $@; + } + } + } + } + + # remember when we are now + $lasttime = $now; + $lastmin = $min; +} + +# +# these are simple stub functions to make connecting easy in DXCron contexts +# + +sub connected +{ + my $call = uc shift; + return DXChannel->get($call); +} + +sub start_connect +{ + my $call = uc shift; + my $lccall = lc $call; + + my $prog = "$main::root/local/client.pl"; + $prog = "$main::root/perl/client.pl" if ! -e $prog; + + my $pid = fork(); + if (defined $pid) { + if (!$pid) { + # in child, unset warnings, disable debugging and general clean up from us + $^W = 0; +# do "$main::root/perl/Disable_debug.pl"; + eval "{ package DB; sub DB {} }"; + alarm(0); + $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; + exec $prog, $call, 'connect'; + dbg('cron', "exec '$prog' failed $!"); + } + dbg('cron', "connect to $call started"); + } else { + dbg('cron', "can't fork for $prog $!"); } } +sub spawn +{ + my $line = shift; + + my $pid = fork(); + if (defined $pid) { + if (!$pid) { + # in child, unset warnings, disable debugging and general clean up from us + $^W = 0; +# do "$main::root/perl/Disable_debug.pl"; + eval "{ package DB; sub DB {} }"; + alarm(0); + $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; + exec "$line"; + dbg('cron', "exec '$line' failed $!"); + } + dbg('cron', "spawn of $line started"); + } else { + dbg('cron', "can't fork for $line $!"); + } +} 1; __END__