view release on metacpan or  search on metacpan

lib/Algorithm/Cron.pm  view on Meta::CPAN

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2012-2014 -- leonerd@leonerd.org.uk

package Algorithm::Cron;

use strict;
use warnings;

our $VERSION = '0.10';

my @FIELDS = qw( sec min hour mday mon year wday );
my @FIELDS_CTOR = grep { $_ ne "year" } @FIELDS;

use Carp;
use POSIX qw( mktime strftime setlocale LC_TIME );
use Time::timegm qw( timegm );

=head1 NAME

C<Algorithm::Cron> - abstract implementation of the F<cron(8)> scheduling
algorithm

=head1 SYNOPSIS

 use Algorithm::Cron;

 my $cron = Algorithm::Cron->new(
    base => 'local',
    crontab => "*/10 9-17 * * *",
 );

 my $time = time;
 while(1) {
    $time = $cron->next_time( $time );

    sleep( time - $time );

    print "Do something\n";
 }

=head1 DESCRIPTION

Objects in this class implement a time scheduling algorithm such as used by
F<cron(8)>. Objects are stateless once constructed, and represent a single
schedule as defined by a F<crontab(5)> entry. The object implements a method
C<next_time> which returns an epoch timestamp value to indicate the next time
included in the crontab schedule.

=head2 Crontabs

The schedule is provided as a set of acceptable values for each field of the
broken-down time (as returned by C<localtime> or C<gmtime>), either in a
single string called C<crontab> or by a set of named strings, each taking the
name of a F<crontab(5)> field.

 my $cron = Algorithm::Cron->new(
    base => 'local',
    crontab => '0 9 * * mon-fri',
 );

Z<>

 my $cron = Algorithm::Cron->new(
    base => 'local',
    min  => 0,
    hour => 9,
    wday => "mon-fri",
 );

A C<crontab> field containing a single asterisk (C<*>), or a missing named
field, indicates that any value here is included in the scheduled times. To
restrict the schedule, a value or set of values can be provided. This should
consist of one or more comma-separated numbers or ranges, where a range is
given as the start and end points, both inclusive.

 hour => "3-6"
 hour => "3,4,5,6"

Ranges can also be prefixed by a value to give the increment for values in
that range.

 min => "*/10"
 min => "0,10,20,30,40,50"

The C<mon> and C<wday> fields also allow symbolic month or weekday names in
place of numeric values. These names are always in the C locale, regardless of
the system's locale settings.

 mon => "mar-sep"

 wday => "mon,wed,fri"

Specifying C<sun> as the end of a C<wday> range, or giving the numeric value
of C<7> is also supported.

 wday => "fri-sun"
 wday => "5-7"
 # Both equivalent to: wday => "0,5,6"

As per F<cron(8)> behaviour, this algorithm looks for a match of the C<min>,
C<hour> and C<mon> fields, and at least one of the C<mday> or C<mday> fields.
If both C<mday> and C<wday> are specified, a match of either will be
sufficient.

As an extension, seconds may be provided either by passing six space-separated
fields in the C<crontab> string, or as an additional C<sec> field. If not
provided it will default to C<0>. If six fields are provided, the first gives
the seconds.

=head2 Time Base

C<Algorithm::Cron> supports using either UTC or the local timezone when
comparing against the given schedule.

=cut

# mday field starts at 1, others start at 0
my %MIN = (
   sec  => 0,
   min  => 0,
   hour => 0,
   mday => 1,
   mon  => 0
);

# These don't have to be real maxima, as the algorithm will cope. These are
# just the top end of the range expansions
my %MAX = (
   sec  => 59,
   min  => 59,
   hour => 23,
   mday => 31,
   mon  => 11,
   wday => 6,
);

my %MONTHS;
my %WDAYS;
# These always want to be in LC_TIME=C
{
   my $old_loc = setlocale( LC_TIME );
   setlocale( LC_TIME, "C" );

   %MONTHS = map { lc(strftime "%b", 0,0,0, 1, $_, 70), $_ } 0 .. 11;

   # 0 = Sun. 4th Jan 1970 was a Sunday
   %WDAYS  = map { lc(strftime "%a", 0,0,0, 4+$_, 0, 70), $_ } 0 .. 6;

   setlocale( LC_TIME, $old_loc );
}

sub _expand_set
{
   my ( $spec, $kind ) = @_;

   return undef if $spec eq "*";

   my @vals;
   foreach my $val ( split m/,/, $spec ) {
      my $step = 1;
      my $end;

      $val =~ s{/(\d+)$}{} and $step = $1;

      $val =~ m{^(.+)-(.+)$} and ( $val, $end ) = ( $1, $2 );
      if( $val eq "*" ) {
         ( $val, $end ) = ( $MIN{$kind}, $MAX{$kind} );
      }
      elsif( $kind eq "mon" ) {
         # Users specify 1-12 but we want 0-11
         defined and m/^\d+$/ and $_-- for $val, $end;
         # Convert symbolics
         defined and exists $MONTHS{lc $_} and $_ = $MONTHS{lc $_} for $val, $end;
      }
      elsif( $kind eq "wday" ) {
         # Convert symbolics
         defined and exists $WDAYS{lc $_} and $_ = $WDAYS{lc $_} for $val, $end;
         $end = 7 if defined $end and $end == 0 and $val > 0;
      }

      $val =~ m/^\d+$/ or croak "$val is unrecognised for $kind";
      $end =~ m/^\d+$/ or croak "$end is unrecognised for $kind" if defined $end;

      push @vals, $val;
      push @vals, $val while defined $end and ( $val += $step ) <= $end;

      if( $kind eq "wday" && $vals[-1] == 7 ) {
         unshift @vals, 0 unless $vals[0] == 0;
         pop @vals;
      }
   }

   return \@vals;
}

use constant { EXTRACT => 0, BUILD => 1, NORMALISE => 2 };
my %time_funcs = (
              # EXTRACT                BUILD     NORMALISE
   local => [ sub { localtime $_[0] }, \&mktime, sub { localtime mktime @_[0..5], -1, -1, -1 } ],
   utc   => [ sub { gmtime $_[0] },    \&timegm, sub { gmtime timegm @_[0..5], -1, -1, -1 } ],
);

# Indices in time array
use constant {
   TM_SEC  => 0,
   TM_MIN  => 1,
   TM_HOUR => 2,
   TM_MDAY => 3,
   TM_MON  => 4,