3 # This file is part of Stem.
4 # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
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.
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.
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
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:
24 # Stem Systems, Inc. 781-643-7504
25 # 79 Everett St. info@stemsystems.com
35 use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
36 use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
38 Stem::Route::register_class( __PACKAGE__, 'cron' ) ;
45 my @set_names = qw( minutes hours month_days months week_days ) ;
51 my $delay = 59 - $t % 60 ;
53 if ( $Env{ 'cron_interval' } ) {
55 $interval = $Env{ 'cron_interval' } ;
59 # my $lt = localtime $t ;
60 # print "$t $lt ", $t % 60, "\n" ;
62 $cron_timer = Stem::Event::Timer->new(
63 'object' => __PACKAGE__,
64 'method' => 'cron_triggered',
65 'interval' => $interval,
72 die "Stem::Cron $cron_timer" unless ref $cron_timer ;
84 'class' => 'Stem::Msg',
103 'name' => 'month_days',
115 'name' => 'week_days',
124 'minutes' => [0, 59],
126 'month_days' => [1, 31],
128 'week_days' => [0, 6],
134 my( $class ) = shift ;
136 my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
137 return $self unless ref $self ;
139 $self->{'msg'}->from_cell( $self->{'reg_name'} || 'cron' ) ;
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.
144 foreach my $set_name ( @set_names ) {
146 $self->_make_cron_set( $set_name, @{$ranges{$set_name}} )
149 # keep track of all the active cron entries.
151 $cron_entries{ $self } = $self ;
153 TraceStatus Dumper($self) ;
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?
168 my( $self, $set_name, $min, $max ) = @_ ;
170 my $cron_list = $self->{$set_name} ;
172 return unless ref $cron_list eq 'ARRAY' ;
176 foreach my $cron_val ( @{$cron_list} ) {
178 if ( $cron_val =~ /^(\d+)$/ &&
179 $min <= $1 && $1 <= $max ) {
181 push @cron_vals, $1 ;
185 if ( $cron_val =~ /^(\d+)-(\d+)$/ &&
186 $min <= $1 && $1 <= $2 && $2 <= $max ) {
188 push @cron_vals, $1 .. $2 ;
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.
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.
206 # if ( $convert_to_num &&
207 # exists( $convert_to_num->{$cron_val} ) ) {
209 # push @cron_vals, $convert_to_num->{$cron_val} ;
213 TraceError "bad cron value '$cron_val'" ;
220 @cron_set[@cron_vals] = (1) x @cron_vals ;
222 $self->{"${set_name}_set"} = \@cron_set ;
229 my $this_time = time() ;
233 TraceStatus scalar localtime( $this_time ) ;
235 # get the current time part into a hash
237 @set_times{ @set_names } = (localtime( $this_time ))[ 1, 2, 3, 4, 6 ] ;
239 # one base the months
241 $set_times{'months'}++ ;
245 # loop over all the entries
248 foreach my $cron ( values %cron_entries ) {
250 # loop over all the possible time sets
252 foreach my $name ( @set_names ) {
254 # my $s = $cron->{"${name}_set"} || [] ;
255 # print "C $name $set_times{ $name } @$s\n" ;
257 # we don't trigger unless we have a set with data and the time slot
258 # for the current time is true
260 next CRON if $set = $cron->{"${name}_set"} and
261 ! $set->[$set_times{ $name }] ;
264 #print "C disp $cron\n" ;
266 # we must have passed all the time filters, so send the message
268 $cron->{'msg'}->dispatch() ;
274 Dumper(\%cron_entries) ;