lib/Stem/Cron.pm

   1 #  File: Stem/Cron.pm
   2
   3 #  This file is part of Stem.
   4 #  Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
   5
   6 #  Stem is free software; you can redistribute it and/or modify
   7 #  it under the terms of the GNU General Public License as published by
   8 #  the Free Software Foundation; either version 2 of the License, or
   9 #  (at your option) any later version.
  10
  11 #  Stem is distributed in the hope that it will be useful,
  12 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 #  GNU General Public License for more details.
  15
  16 #  You should have received a copy of the GNU General Public License
  17 #  along with Stem; if not, write to the Free Software
  18 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19
  20 #  For a license to use the Stem under conditions other than those
  21 #  described here, to purchase support for this software, or to purchase a
  22 #  commercial warranty contract, please contact Stem Systems at:
  23
  24 #       Stem Systems, Inc.              781-643-7504
  25 #       79 Everett St.                  info@stemsystems.com
  26 #       Arlington, MA 02474
  27 #       USA
  28
  29 package Stem::Cron ;
  30
  31 use strict ;
  32 use Data::Dumper ;
  33
  34 use Stem::Vars ;
  35 use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
  36 use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
  37
  38 Stem::Route::register_class( __PACKAGE__, 'cron' ) ;
  39
  40 my %cron_entries ;
  41 my $cron_timer ;
  42 my $last_time ;
  43
  44
  45 my @set_names = qw( minutes hours month_days months week_days ) ;
  46
  47 {
  48         my $t = time ;
  49
  50         my $interval = 60 ;
  51         my $delay = 59 - $t % 60 ;
  52
  53         if ( $Env{ 'cron_interval' } ) {
  54
  55                 $interval = $Env{ 'cron_interval' } ;
  56                 $delay = 0 ;
  57         }
  58
  59 #       my $lt = localtime $t ;
  60 #       print "$t $lt ",  $t % 60, "\n" ;
  61
  62         $cron_timer = Stem::Event::Timer->new(
  63                 'object'        => __PACKAGE__,
  64                 'method'        => 'cron_triggered',
  65                 'interval'      => $interval,
  66                 'delay'         => $delay,
  67                 'repeat'        => 1,
  68                 'hard'          => 1,
  69         ) ;
  70 }
  71
  72 die "Stem::Cron $cron_timer" unless ref $cron_timer ;
  73
  74
  75 my $attr_spec = [
  76         {
  77                 'name'          => 'reg_name',
  78                 'help'          => <<HELP,
  79 HELP
  80         },
  81
  82         {
  83                 'name'          => 'msg',
  84                 'class'         => 'Stem::Msg',
  85                 'required'      => 1,
  86                 'help'          => <<HELP,
  87 HELP
  88         },
  89
  90         {
  91                 'name'          => 'minutes',
  92                 'help'          => <<HELP,
  93 HELP
  94         },
  95
  96         {
  97                 'name'          => 'hours',
  98                 'help'          => <<HELP,
  99 HELP
 100         },
 101
 102         {
 103                 'name'          => 'month_days',
 104                 'help'          => <<HELP,
 105 HELP
 106         },
 107
 108         {
 109                 'name'          => 'months',
 110                 'help'          => <<HELP,
 111 HELP
 112         },
 113
 114         {
 115                 'name'          => 'week_days',
 116                 'help'          => <<HELP,
 117 HELP
 118         },
 119
 120 ] ;
 121
 122 my %ranges = (
 123
 124         'minutes'       => [0, 59],
 125         'hours'         => [0, 23],
 126         'month_days'    => [1, 31],
 127         'months'        => [1, 12],
 128         'week_days'     => [0, 6],
 129 ) ;
 130
 131
 132 sub new {
 133
 134         my( $class ) = shift ;
 135
 136         my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
 137         return $self unless ref $self ;
 138
 139         $self->{'msg'}->from_cell( $self->{'reg_name'} || 'cron' ) ;
 140
 141 # make sets for each time part. if one isn't created because it is
 142 # empty, it is a wild card with behaves as if all the slots are set.
 143
 144         foreach my $set_name ( @set_names ) {
 145
 146                 $self->_make_cron_set( $set_name, @{$ranges{$set_name}} )
 147         }
 148
 149 # keep track of all the active cron entries.
 150
 151         $cron_entries{ $self } = $self ;
 152
 153         TraceStatus Dumper($self) ;
 154
 155 ####################
 156 ####################
 157 # why return cron entry? it should not be registered as you can't send
 158 # it messages.  do we need a way to cancel a cron entry? could we
 159 # register in internally to cron and not need external registration?
 160 ####################
 161 ####################
 162
 163         return $self ;
 164 }
 165
 166 sub _make_cron_set {
 167
 168         my( $self, $set_name, $min, $max ) = @_ ;
 169
 170         my $cron_list = $self->{$set_name} ;
 171
 172         return unless ref $cron_list eq 'ARRAY' ;
 173
 174         my( @cron_vals ) ;
 175
 176         foreach my $cron_val ( @{$cron_list} ) {
 177
 178                 if ( $cron_val =~ /^(\d+)$/ &&
 179                      $min <= $1 && $1 <= $max ) {
 180
 181                         push @cron_vals, $1 ;
 182                         next ;
 183                 }
 184
 185                 if ( $cron_val =~ /^(\d+)-(\d+)$/ &&
 186                      $min <= $1 && $1 <= $2 && $2 <= $max ) {
 187
 188                         push @cron_vals, $1 .. $2 ;
 189                         next ;
 190                 }
 191
 192 ##################
 193 ##################
 194 ##################
 195 # this is for normal cron entries with names like days of week and
 196 # months.  the name translation tables will be passed in or defaulted
 197 # to american names. it needs work.
 198 #
 199 # also to be done is fancy entries like first thursday of month or
 200 # weekend days, etc. it will be a filter to run when the numeric days
 201 # of week or month days filter is run.
 202 ##################
 203 ##################
 204 ##################
 205
 206 #               if ( $convert_to_num &&
 207 #                    exists( $convert_to_num->{$cron_val} ) ) {
 208
 209 #                       push @cron_vals, $convert_to_num->{$cron_val} ;
 210 #                       next ;
 211 #               }
 212
 213                 TraceError "bad cron value '$cron_val'" ;
 214         }
 215
 216         if ( @cron_vals ) {
 217
 218                 my @cron_set ;
 219
 220                 @cron_set[@cron_vals] = (1) x @cron_vals ;
 221
 222                 $self->{"${set_name}_set"} = \@cron_set ;
 223         }
 224 }
 225
 226
 227 sub cron_triggered {
 228
 229         my $this_time = time() ;
 230
 231         my %set_times ;
 232
 233         TraceStatus scalar localtime( $this_time ) ;
 234
 235 # get the current time part into a hash
 236
 237         @set_times{ @set_names } = (localtime( $this_time ))[ 1, 2, 3, 4, 6 ] ;
 238
 239 # one base the months
 240
 241         $set_times{'months'}++ ;
 242
 243         my( $set ) ;
 244
 245 # loop over all the entries
 246
 247         CRON:
 248         foreach my $cron ( values %cron_entries ) {
 249
 250 # loop over all the possible time sets
 251
 252                 foreach my $name ( @set_names ) {
 253
 254 #  my $s = $cron->{"${name}_set"} || [] ;
 255 #  print "C $name $set_times{ $name } @$s\n" ;
 256
 257 # we don't trigger unless we have a set with data and the time slot
 258 # for the current time is true
 259
 260                         next CRON if $set = $cron->{"${name}_set"} and
 261                                    ! $set->[$set_times{ $name }] ;
 262                 }
 263
 264 #print "C disp $cron\n" ;
 265
 266 # we must have passed all the time filters, so send the message
 267
 268                 $cron->{'msg'}->dispatch() ;
 269         }
 270 }
 271
 272 sub status_cmd {
 273
 274 Dumper(\%cron_entries) ;
 275
 276 }
 277
 278 1 ;