view release on metacpan or  search on metacpan

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

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,
   TM_YEAR => 5,
   TM_WDAY => 6,
};

=head1 CONSTRUCTOR

=cut

=head2 $cron = Algorithm::Cron->new( %args )

Constructs a new C<Algorithm::Cron> object representing the given schedule
relative to the given time base. Takes the following named arguments:

=over 8

=item base => STRING

Gives the time base used for scheduling. Either C<utc> or C<local>.

=item crontab => STRING

Gives the crontab schedule in 5 or 6 space-separated fields.

=item sec => STRING, min => STRING, ... mon => STRING

Optional. Gives the schedule in a set of individual fields, if the C<crontab>
field is not specified.

=back

=cut

sub new
{
   my $class = shift;
   my %params = @_;

   my $base = delete $params{base};
   grep { $_ eq $base } qw( local utc ) or croak "Unrecognised base - should be 'local' or 'utc'";

   if( exists $params{crontab} ) {
      my $crontab = delete $params{crontab};
      s/^\s+//, s/\s+$// for $crontab;

      my @fields = split m/\s+/, $crontab;
      @fields >= 5 or croak "Expected at least 5 crontab fields";
      @fields <= 6 or croak "Expected no more than 6 crontab fields";

      @fields = ( "0", @fields ) if @fields < 6;
      @params{ @FIELDS_CTOR } = @fields;
   }

   $params{sec} = 0 unless exists $params{sec};

   my $self = bless {
      base => $base,
   }, $class;

   foreach ( @FIELDS_CTOR ) {
      next unless exists $params{$_};

      $self->{$_} = _expand_set( delete $params{$_}, $_ );
      !defined $self->{$_} or scalar @{ $self->{$_} } or
         croak "Require at least one value for '$_' field";
   }

   return $self;
}

=head1 METHODS

=cut

=head2 @seconds = $cron->sec

=head2 @minutes = $cron->min

=head2 @hours = $cron->hour

=head2 @mdays = $cron->mday

=head2 @months = $cron->mon

=head2 @wdays = $cron->wday

Accessors that return a list of the accepted values for each scheduling field.
These are returned in a plain list of numbers, regardless of the form they
were specified to the constructor.

Also note that the list of valid months will be 0-based (in the range 0 to 11)
rather than 1-based, to match the values used by C<localtime>, C<gmtime>,
C<mktime> and C<timegm>.

=cut

foreach my $field ( @FIELDS_CTOR ) {
   no strict 'refs';
   *$field = sub {
      my $self = shift;
      @{ $self->{$field} || [] };
   };
}

sub next_time_field
{