1#  You may distribute under the terms of either the GNU General Public License
2#  or the Artistic License (the same terms as Perl itself)
3#
4#  (C) Paul Evans, 2012-2014 -- leonerd@leonerd.org.uk
5
6package Algorithm::Cron;
7
8use strict;
9use warnings;
10
11our $VERSION = '0.10';
12
13my @FIELDS = qw( sec min hour mday mon year wday );
14my @FIELDS_CTOR = grep { $_ ne "year" } @FIELDS;
15
16use Carp;
17use POSIX qw( mktime strftime setlocale LC_TIME );
18use Time::timegm qw( timegm );
19
20=head1 NAME
21
22C<Algorithm::Cron> - abstract implementation of the F<cron(8)> scheduling
23algorithm
24
25=head1 SYNOPSIS
26
27 use Algorithm::Cron;
28
29 my $cron = Algorithm::Cron->new(
30    base => 'local',
31    crontab => "*/10 9-17 * * *",
32 );
33
34 my $time = time;
35 while(1) {
36    $time = $cron->next_time( $time );
37
38    sleep( time - $time );
39
40    print "Do something\n";
41 }
42
43=head1 DESCRIPTION
44
45Objects in this class implement a time scheduling algorithm such as used by
46F<cron(8)>. Objects are stateless once constructed, and represent a single
47schedule as defined by a F<crontab(5)> entry. The object implements a method
48C<next_time> which returns an epoch timestamp value to indicate the next time
49included in the crontab schedule.
50
51=head2 Crontabs
52
53The schedule is provided as a set of acceptable values for each field of the
54broken-down time (as returned by C<localtime> or C<gmtime>), either in a
55single string called C<crontab> or by a set of named strings, each taking the
56name of a F<crontab(5)> field.
57
58 my $cron = Algorithm::Cron->new(
59    base => 'local',
60    crontab => '0 9 * * mon-fri',
61 );
62
63Z<>
64
65 my $cron = Algorithm::Cron->new(
66    base => 'local',
67    min  => 0,
68    hour => 9,
69    wday => "mon-fri",
70 );
71
72A C<crontab> field containing a single asterisk (C<*>), or a missing named
73field, indicates that any value here is included in the scheduled times. To
74restrict the schedule, a value or set of values can be provided. This should
75consist of one or more comma-separated numbers or ranges, where a range is
76given as the start and end points, both inclusive.
77
78 hour => "3-6"
79 hour => "3,4,5,6"
80
81Ranges can also be prefixed by a value to give the increment for values in
82that range.
83
84 min => "*/10"
85 min => "0,10,20,30,40,50"
86
87The C<mon> and C<wday> fields also allow symbolic month or weekday names in
88place of numeric values. These names are always in the C locale, regardless of
89the system's locale settings.
90
91 mon => "mar-sep"
92
93 wday => "mon,wed,fri"
94
95Specifying C<sun> as the end of a C<wday> range, or giving the numeric value
96of C<7> is also supported.
97
98 wday => "fri-sun"
99 wday => "5-7"
100 # Both equivalent to: wday => "0,5,6"
101
102As per F<cron(8)> behaviour, this algorithm looks for a match of the C<min>,
103C<hour> and C<mon> fields, and at least one of the C<mday> or C<mday> fields.
104If both C<mday> and C<wday> are specified, a match of either will be
105sufficient.
106
107As an extension, seconds may be provided either by passing six space-separated
108fields in the C<crontab> string, or as an additional C<sec> field. If not
109provided it will default to C<0>. If six fields are provided, the first gives
110the seconds.
111
112=head2 Time Base
113
114C<Algorithm::Cron> supports using either UTC or the local timezone when
115comparing against the given schedule.
116
117=cut
118
119# mday field starts at 1, others start at 0
120my %MIN = (
121   sec  => 0,
122   min  => 0,
123   hour => 0,
124   mday => 1,
125   mon  => 0
126);
127
128# These don't have to be real maxima, as the algorithm will cope. These are
129# just the top end of the range expansions
130my %MAX = (
131   sec  => 59,
132   min  => 59,
133   hour => 23,
134   mday => 31,
135   mon  => 11,
136   wday => 6,
137);
138
139my %MONTHS;
140my %WDAYS;
141# These always want to be in LC_TIME=C
142{
143   my $old_loc = setlocale( LC_TIME );
144   setlocale( LC_TIME, "C" );
145
146   %MONTHS = map { lc(strftime "%b", 0,0,0, 1, $_, 70), $_ } 0 .. 11;
147
148   # 0 = Sun. 4th Jan 1970 was a Sunday
149   %WDAYS  = map { lc(strftime "%a", 0,0,0, 4+$_, 0, 70), $_ } 0 .. 6;
150
151   setlocale( LC_TIME, $old_loc );
152}
153
154sub _expand_set
155{
156   my ( $spec, $kind ) = @_;
157
158   return undef if $spec eq "*";
159
160   my @vals;
161   foreach my $val ( split m/,/, $spec ) {
162      my $step = 1;
163      my $end;
164
165      $val =~ s{/(\d+)$}{} and $step = $1;
166
167      $val =~ m{^(.+)-(.+)$} and ( $val, $end ) = ( $1, $2 );
168      if( $val eq "*" ) {
169         ( $val, $end ) = ( $MIN{$kind}, $MAX{$kind} );
170      }
171      elsif( $kind eq "mon" ) {
172         # Users specify 1-12 but we want 0-11
173         defined and m/^\d+$/ and $_-- for $val, $end;
174         # Convert symbolics
175         defined and exists $MONTHS{lc $_} and $_ = $MONTHS{lc $_} for $val, $end;
176      }
177      elsif( $kind eq "wday" ) {
178         # Convert symbolics
179         defined and exists $WDAYS{lc $_} and $_ = $WDAYS{lc $_} for $val, $end;
180         $end = 7 if defined $end and $end == 0 and $val > 0;
181      }
182
183      $val =~ m/^\d+$/ or croak "$val is unrecognised for $kind";
184      $end =~ m/^\d+$/ or croak "$end is unrecognised for $kind" if defined $end;
185
186      push @vals, $val;
187      push @vals, $val while defined $end and ( $val += $step ) <= $end;
188
189      if( $kind eq "wday" && $vals[-1] == 7 ) {
190         unshift @vals, 0 unless $vals[0] == 0;
191         pop @vals;
192      }
193   }
194
195   return \@vals;
196}
197
198use constant { EXTRACT => 0, BUILD => 1, NORMALISE => 2 };
199my %time_funcs = (
200              # EXTRACT                BUILD     NORMALISE
201   local => [ sub { localtime $_[0] }, \&mktime, sub { localtime mktime @_[0..5], -1, -1, -1 } ],
202   utc   => [ sub { gmtime $_[0] },    \&timegm, sub { gmtime timegm @_[0..5], -1, -1, -1 } ],
203);
204
205# Indices in time array
206use constant {
207   TM_SEC  => 0,
208   TM_MIN  => 1,
209   TM_HOUR => 2,
210   TM_MDAY => 3,
211   TM_MON  => 4,
212   TM_YEAR => 5,
213   TM_WDAY => 6,
214};
215
216=head1 CONSTRUCTOR
217
218=cut
219
220=head2 $cron = Algorithm::Cron->new( %args )
221
222Constructs a new C<Algorithm::Cron> object representing the given schedule
223relative to the given time base. Takes the following named arguments:
224
225=over 8
226
227=item base => STRING
228
229Gives the time base used for scheduling. Either C<utc> or C<local>.
230
231=item crontab => STRING
232
233Gives the crontab schedule in 5 or 6 space-separated fields.
234
235=item sec => STRING, min => STRING, ... mon => STRING
236
237Optional. Gives the schedule in a set of individual fields, if the C<crontab>
238field is not specified.
239
240=back
241
242=cut
243
244sub new
245{
246   my $class = shift;
247   my %params = @_;
248
249   my $base = delete $params{base};
250   grep { $_ eq $base } qw( local utc ) or croak "Unrecognised base - should be 'local' or 'utc'";
251
252   if( exists $params{crontab} ) {
253      my $crontab = delete $params{crontab};
254      s/^\s+//, s/\s+$// for $crontab;
255
256      my @fields = split m/\s+/, $crontab;
257      @fields >= 5 or croak "Expected at least 5 crontab fields";
258      @fields <= 6 or croak "Expected no more than 6 crontab fields";
259
260      @fields = ( "0", @fields ) if @fields < 6;
261      @params{ @FIELDS_CTOR } = @fields;
262   }
263
264   $params{sec} = 0 unless exists $params{sec};
265
266   my $self = bless {
267      base => $base,
268   }, $class;
269
270   foreach ( @FIELDS_CTOR ) {
271      next unless exists $params{$_};
272
273      $self->{$_} = _expand_set( delete $params{$_}, $_ );
274      !defined $self->{$_} or scalar @{ $self->{$_} } or
275         croak "Require at least one value for '$_' field";
276   }
277
278   return $self;
279}
280
281=head1 METHODS
282
283=cut
284
285=head2 @seconds = $cron->sec
286
287=head2 @minutes = $cron->min
288
289=head2 @hours = $cron->hour
290
291=head2 @mdays = $cron->mday
292
293=head2 @months = $cron->mon
294
295=head2 @wdays = $cron->wday
296
297Accessors that return a list of the accepted values for each scheduling field.
298These are returned in a plain list of numbers, regardless of the form they
299were specified to the constructor.
300
301Also note that the list of valid months will be 0-based (in the range 0 to 11)
302rather than 1-based, to match the values used by C<localtime>, C<gmtime>,
303C<mktime> and C<timegm>.
304
305=cut
306
307foreach my $field ( @FIELDS_CTOR ) {
308   no strict 'refs';
309   *$field = sub {
310      my $self = shift;
311      @{ $self->{$field} || [] };
312   };
313}
314
315sub next_time_field
316{
317   my $self = shift;
318   my ( $t, $idx ) = @_;
319
320   my $funcs = $time_funcs{$self->{base}};
321
322   my $spec = $self->{ $FIELDS[$idx] } or return 1;
323
324   my $old = $t->[$idx];
325   my $new;
326
327   $_ >= $old and $new = $_, last for @$spec;
328
329   # wday field is special. We can't alter it directly; any changes to it have
330   # to happen via mday
331   if( $idx == TM_WDAY ) {
332      $idx = TM_MDAY;
333      # Adjust $new by the same delta
334      $new = $t->[TM_MDAY] + $new - $old if defined $new;
335      $old = $t->[TM_MDAY];
336
337      if( !defined $new ) {
338         # Next week
339         $t->[$_] = $MIN{$FIELDS[$_]} for TM_SEC .. TM_HOUR;
340         # Add more days, such that we hit the next occurance of $spec->[0]
341         $t->[TM_MDAY] += $spec->[0] + 7 - $t->[TM_WDAY];
342
343         @$t = $funcs->[NORMALISE]->( @$t );
344
345         return 0;
346      }
347      elsif( $new > $old ) {
348         $t->[$_] = $MIN{$FIELDS[$_]} for TM_SEC .. $idx-1;
349      }
350   }
351   else {
352      if( !defined $new ) {
353         # Rollover
354         $t->[$_] = $MIN{$FIELDS[$_]} for TM_SEC .. $idx-1;
355         $t->[$idx] = $spec->[0];
356         $t->[$idx+1]++;
357
358         @$t = $funcs->[NORMALISE]->( @$t );
359
360         return 0;
361      }
362      elsif( $new > $old ) {
363         # Next field; reset
364         $t->[$_] = $MIN{$FIELDS[$_]} for TM_SEC .. $idx-1;
365      }
366   }
367
368   $t->[$idx] = $new;
369
370   # Detect rollover of month and reset to next month
371   my $was_mon = $t->[TM_MON];
372
373   @$t = $funcs->[NORMALISE]->( @$t );
374
375   if( $idx == TM_MDAY and $was_mon != $t->[TM_MON] ) {
376      $t->[$_] = 0 for TM_SEC .. TM_HOUR;
377      $t->[TM_MDAY] = 1;
378
379      @$t = $funcs->[NORMALISE]->( @$t );
380
381      return 0;
382   }
383
384   return 1;
385}
386
387=head2 $time = $cron->next_time( $start_time )
388
389Returns the next scheduled time, as an epoch timestamp, after the given
390timestamp. This is a stateless operation; it does not change any state stored
391by the C<$cron> object.
392
393=cut
394
395sub next_time
396{
397   my $self = shift;
398   my ( $time ) = @_;
399
400   my $funcs = $time_funcs{$self->{base}};
401
402   # Always need to add at least 1 second
403   my @t = $funcs->[EXTRACT]->( $time + 1 );
404
405RESTART:
406   $self->next_time_field( \@t, TM_MON ) or goto RESTART;
407
408   if( defined $self->{mday} and defined $self->{wday} ) {
409      # Now it gets tricky because cron allows a match of -either- mday or wday
410      # rather than requiring both. So we'll work out which of the two is sooner
411      my $next_time_by_wday;
412      my @wday_t = @t;
413      my $wday_restart = 0;
414      $self->next_time_field( \@wday_t, TM_WDAY ) or $wday_restart = 1;
415      $next_time_by_wday = $funcs->[BUILD]->( @wday_t );
416
417      my $next_time_by_mday;
418      my @mday_t = @t;
419      my $mday_restart = 0;
420      $self->next_time_field( \@mday_t, TM_MDAY ) or $mday_restart = 1;
421      $next_time_by_mday = $funcs->[BUILD]->( @mday_t );
422
423      if( $next_time_by_wday > $next_time_by_mday ) {
424         @t = @mday_t;
425         goto RESTART if $mday_restart;
426      }
427      else {
428         @t = @wday_t;
429         goto RESTART if $wday_restart;
430      }
431   }
432   elsif( defined $self->{mday} ) {
433      $self->next_time_field( \@t, TM_MDAY ) or goto RESTART;
434   }
435   elsif( defined $self->{wday} ) {
436      $self->next_time_field( \@t, TM_WDAY ) or goto RESTART;
437   }
438
439   foreach my $idx ( TM_HOUR, TM_MIN, TM_SEC ) {
440      $self->next_time_field( \@t, $idx ) or goto RESTART;
441   }
442
443   return $funcs->[BUILD]->( @t );
444}
445
446=head1 AUTHOR
447
448Paul Evans <leonerd@leonerd.org.uk>
449
450=cut
451
4520x55AA;
453