Commit | Line | Data |
4536f655 |
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 ; |