# File: Stem/Cron.pm
# This file is part of Stem.
# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
# Stem is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# Stem is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with Stem; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
# For a license to use the Stem under conditions other than those
# described here, to purchase support for this software, or to purchase a
# commercial warranty contract, please contact Stem Systems at:
# Stem Systems, Inc. 781-643-7504
# 79 Everett St. info@stemsystems.com
# Arlington, MA 02474
# USA
package Stem::Cron ;
use strict ;
use Data::Dumper ;
use Stem::Vars ;
use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
Stem::Route::register_class( __PACKAGE__, 'cron' ) ;
my %cron_entries ;
my $cron_timer ;
my $last_time ;
my @set_names = qw( minutes hours month_days months week_days ) ;
{
my $t = time ;
my $interval = 60 ;
my $delay = 59 - $t % 60 ;
if ( $Env{ 'cron_interval' } ) {
$interval = $Env{ 'cron_interval' } ;
$delay = 0 ;
}
# my $lt = localtime $t ;
# print "$t $lt ", $t % 60, "\n" ;
$cron_timer = Stem::Event::Timer->new(
'object' => __PACKAGE__,
'method' => 'cron_triggered',
'interval' => $interval,
'delay' => $delay,
'repeat' => 1,
'hard' => 1,
) ;
}
die "Stem::Cron $cron_timer" unless ref $cron_timer ;
my $attr_spec = [
{
'name' => 'reg_name',
'help' => <<HELP,
HELP
},
{
'name' => 'msg',
'class' => 'Stem::Msg',
'required' => 1,
'help' => <<HELP,
HELP
},
{
'name' => 'minutes',
'help' => <<HELP,
HELP
},
{
'name' => 'hours',
'help' => <<HELP,
HELP
},
{
'name' => 'month_days',
'help' => <<HELP,
HELP
},
{
'name' => 'months',
'help' => <<HELP,
HELP
},
{
'name' => 'week_days',
'help' => <<HELP,
HELP
},
] ;
my %ranges = (
'minutes' => [0, 59],
'hours' => [0, 23],
'month_days' => [1, 31],
'months' => [1, 12],
'week_days' => [0, 6],
) ;
sub new {
my( $class ) = shift ;
my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
return $self unless ref $self ;
$self->{'msg'}->from_cell( $self->{'reg_name'} || 'cron' ) ;
# make sets for each time part. if one isn't created because it is
# empty, it is a wild card with behaves as if all the slots are set.
foreach my $set_name ( @set_names ) {
$self->_make_cron_set( $set_name, @{$ranges{$set_name}} )
}
# keep track of all the active cron entries.
$cron_entries{ $self } = $self ;
TraceStatus Dumper($self) ;
####################
####################
# why return cron entry? it should not be registered as you can't send
# it messages. do we need a way to cancel a cron entry? could we
# register in internally to cron and not need external registration?
####################
####################
return $self ;
}
sub _make_cron_set {
my( $self, $set_name, $min, $max ) = @_ ;
my $cron_list = $self->{$set_name} ;
return unless ref $cron_list eq 'ARRAY' ;
my( @cron_vals ) ;
foreach my $cron_val ( @{$cron_list} ) {
if ( $cron_val =~ /^(\d+)$/ &&
$min <= $1 && $1 <= $max ) {
push @cron_vals, $1 ;
next ;
}
if ( $cron_val =~ /^(\d+)-(\d+)$/ &&
$min <= $1 && $1 <= $2 && $2 <= $max ) {
push @cron_vals, $1 .. $2 ;
next ;
}
##################
##################
##################
# this is for normal cron entries with names like days of week and
# months. the name translation tables will be passed in or defaulted
# to american names. it needs work.
#
# also to be done is fancy entries like first thursday of month or
# weekend days, etc. it will be a filter to run when the numeric days
# of week or month days filter is run.
##################
##################
##################
# if ( $convert_to_num &&
# exists( $convert_to_num->{$cron_val} ) ) {
# push @cron_vals, $convert_to_num->{$cron_val} ;
# next ;
# }
TraceError "bad cron value '$cron_val'" ;
}
if ( @cron_vals ) {
my @cron_set ;
@cron_set[@cron_vals] = (1) x @cron_vals ;
$self->{"${set_name}_set"} = \@cron_set ;
}
}
sub cron_triggered {
my $this_time = time() ;
my %set_times ;
TraceStatus scalar localtime( $this_time ) ;
# get the current time part into a hash
@set_times{ @set_names } = (localtime( $this_time ))[ 1, 2, 3, 4, 6 ] ;
# one base the months
$set_times{'months'}++ ;
my( $set ) ;
# loop over all the entries
CRON:
foreach my $cron ( values %cron_entries ) {
# loop over all the possible time sets
foreach my $name ( @set_names ) {
# my $s = $cron->{"${name}_set"} || [] ;
# print "C $name $set_times{ $name } @$s\n" ;
# we don't trigger unless we have a set with data and the time slot
# for the current time is true
next CRON if $set = $cron->{"${name}_set"} and
! $set->[$set_times{ $name }] ;
}
#print "C disp $cron\n" ;
# we must have passed all the time filters, so send the message
$cron->{'msg'}->dispatch() ;
}
}
sub status_cmd {
Dumper(\%cron_entries) ;
}
1 ;