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