perl/DXCron.pm

   1 #
   2 # module to timed tasks
   3 #
   4 # Copyright (c) 1998 - Dirk Koopman G1TLH
   5 #
   6 # $Id$
   7 #
   8
   9 package DXCron;
  10
  11 use DXVars;
  12 use DXUtil;
  13 use DXM;
  14 use DXDebug;
  15 use FileHandle;
  16 use Carp;
  17
  18 use strict;
  19
  20 use vars qw{@crontab $mtime $lasttime $lastmin};
  21
  22 @crontab = ();
  23 $mtime = 1;
  24 $lasttime = 0;
  25 $lastmin = 0;
  26
  27
  28 my $fn = "$main::cmd/crontab";
  29 my $localfn = "$main::localcmd/crontab";
  30
  31 # cron initialisation / reading in cronjobs
  32 sub init
  33 {
  34         if ((-e $localfn && -M $localfn < $mtime) || (-e $fn && -M $fn < $mtime) || $mtime == 0) {
  35                 my $t;
  36
  37                 @crontab = ();
  38
  39                 # first read in the standard one
  40                 if (-e $fn) {
  41                         $t = -M $fn;
  42
  43                         cread($fn);
  44                         $mtime = $t if  $t <= $mtime;
  45                 }
  46
  47                 # then read in any local ones
  48                 if (-e $localfn) {
  49                         $t = -M $localfn;
  50
  51                         cread($localfn);
  52                         $mtime = $t if $t <= $mtime;
  53                 }
  54         }
  55 }
  56
  57 # read in a cron file
  58 sub cread
  59 {
  60         my $fn = shift;
  61         my $fh = new FileHandle;
  62         my $line = 0;
  63
  64         dbg('cron', "cron: reading $fn\n");
  65         open($fh, $fn) or confess("cron: can't open $fn $!");
  66         while (<$fh>) {
  67                 $line++;
  68                 chomp;
  69                 next if /^\s*#/o or /^\s*$/o;
  70                 my ($min, $hour, $mday, $month, $wday, $cmd) = /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.+)$/o;
  71                 next if !$min;
  72                 my $ref = bless {};
  73                 my $err;
  74
  75                 $err |= parse($ref, 'min', $min, 0, 60);
  76                 $err |= parse($ref, 'hour', $hour, 0, 23);
  77                 $err |= parse($ref, 'mday', $mday, 1, 31);
  78                 $err |= parse($ref, 'month', $month, 1, 12, "jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec");
  79                 $err |= parse($ref, 'wday', $wday, 0, 6, "sun", "mon", "tue", "wed", "thu", "fri", "sat");
  80                 if (!$err) {
  81                         $ref->{cmd} = $cmd;
  82                         push @crontab, $ref;
  83                         dbg('cron', "cron: adding $_\n");
  84                 } else {
  85                         dbg('cron', "cron: error on line $line '$_'\n");
  86                 }
  87         }
  88         close($fh);
  89 }
  90
  91 sub parse
  92 {
  93         my $ref = shift;
  94         my $sort = shift;
  95         my $val = shift;
  96         my $low = shift;
  97         my $high = shift;
  98         my @req;
  99
 100         # handle '*' values
 101         if ($val eq '*') {
 102                 $ref->{$sort} = 0;
 103                 return 0;
 104         }
 105
 106         # handle comma delimited values
 107         my @comma = split /,/o, $val;
 108         for (@comma) {
 109                 my @minus = split /-/o;
 110                 if (@minus == 2) {
 111                         return 1 if $minus[0] < $low || $minus[0] > $high;
 112                         return 1 if $minus[1] < $low || $minus[1] > $high;
 113                         my $i;
 114                         for ($i = $minus[0]; $i <= $minus[1]; ++$i) {
 115                                 push @req, 0 + $i;
 116                         }
 117                 } else {
 118                         return 1 if $_ < $low || $_ > $high;
 119                         push @req, 0 + $_;
 120                 }
 121         }
 122         $ref->{$sort} = \@req;
 123
 124         return 0;
 125 }
 126
 127 # process the cronjobs
 128 sub process
 129 {
 130         my $now = $main::systime;
 131         return if $now-$lasttime < 1;
 132
 133         my ($sec, $min, $hour, $mday, $mon, $wday) = (gmtime($now))[0,1,2,3,4,6];
 134
 135         # are we at a minute boundary?
 136         if ($min != $lastmin) {
 137
 138                 # read in any changes if the modification time has changed
 139                 init();
 140
 141                 $mon += 1;       # months otherwise go 0-11
 142                 my $cron;
 143                 foreach $cron (@crontab) {
 144                         if ((!$cron->{min} || grep $_ eq $min, @{$cron->{min}}) &&
 145                                 (!$cron->{hour} || grep $_ eq $hour, @{$cron->{hour}}) &&
 146                                 (!$cron->{mday} || grep $_ eq $mday, @{$cron->{mday}}) &&
 147                                 (!$cron->{mon} || grep $_ eq $mon, @{$cron->{mon}}) &&
 148                                 (!$cron->{wday} || grep $_ eq $wday, @{$cron->{wday}})  ){
 149
 150                                 if ($cron->{cmd}) {
 151                                         dbg('cron', "cron: $min $hour $mday $mon $wday -> doing '$cron->{cmd}'");
 152                                         eval "$cron->{cmd}";
 153                                         dbg('cron', "cron: cmd error $@") if $@;
 154                                 }
 155                         }
 156                 }
 157         }
 158
 159         # remember when we are now
 160         $lasttime = $now;
 161         $lastmin = $min;
 162 }
 163
 164 #
 165 # these are simple stub functions to make connecting easy in DXCron contexts
 166 #
 167
 168 sub connected
 169 {
 170         my $call = uc shift;
 171         return DXChannel->get($call);
 172 }
 173
 174 sub start_connect
 175 {
 176         my $call = uc shift;
 177         my $lccall = lc $call;
 178
 179         my $prog = "$main::root/local/client.pl";
 180         $prog = "$main::root/perl/client.pl" if ! -e $prog;
 181
 182         my $pid = fork();
 183         if (defined $pid) {
 184                 if (!$pid) {
 185                         # in child, unset warnings, disable debugging and general clean up from us
 186                         $^W = 0;
 187                         eval "{ package DB; sub DB {} }";
 188                         $SIG{HUP} = 'IGNORE';
 189                         alarm(0);
 190                         DXChannel::closeall();
 191                         $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT';
 192                         exec $prog, $call, 'connect';
 193                         dbg('cron', "exec '$prog' failed $!");
 194                 }
 195                 dbg('cron', "connect to $call started");
 196         } else {
 197                 dbg('cron', "can't fork for $prog $!");
 198         }
 199
 200         # coordinate
 201         sleep(1);
 202 }
 203
 204 sub spawn
 205 {
 206         my $line = shift;
 207
 208         my $pid = fork();
 209         if (defined $pid) {
 210                 if (!$pid) {
 211                         # in child, unset warnings, disable debugging and general clean up from us
 212                         $^W = 0;
 213                         eval "{ package DB; sub DB {} }";
 214                         $SIG{HUP} = 'IGNORE';
 215                         alarm(0);
 216                         DXChannel::closeall();
 217                         $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT';
 218                         exec "$line";
 219                         dbg('cron', "exec '$line' failed $!");
 220                 }
 221                 dbg('cron', "spawn of $line started");
 222         } else {
 223                 dbg('cron', "can't fork for $line $!");
 224         }
 225
 226         # coordinate
 227         sleep(1);
 228 }
 229 1;
 230 __END__