1 package DateTime::Event::Cron;
12 use constant DEBUG => 0;
18 my %Object_Attributes;
23 # Return cron as DateTime::Set
25 my %sparms = @_ == 1 ? (cron => shift) : @_;
27 $parms{cron} = delete $sparms{cron};
28 $parms{user_mode} = delete $sparms{user_mode};
29 $parms{cron} or croak "Cron string parameter required.\n";
30 my $dtc = $class->new(%parms);
31 $dtc->as_set(%sparms);
35 # Return list of DateTime::Sets based on entries from
38 my %sparms = @_ == 1 ? (file => shift) : @_;
39 my $file = delete $sparms{file};
41 my $fh = $class->_prepare_fh($file);
46 eval { $set = $class->from_cron(%sparms, cron => $_) };
47 push(@cronsets, $set) if ref $set && !$@;
53 # Return self as DateTime::Set
56 Carp::cluck "Recurrence callbacks overriden by ". ref $self . "\n"
57 if $sparms{next} || $sparms{recurrence} || $sparms{previous};
59 delete $sparms{previous};
60 delete $sparms{recurrence};
61 $sparms{next} = sub { $self->next(@_) };
62 $sparms{previous} = sub { $self->previous(@_) };
63 DateTime::Set->from_recurrence(%sparms);
72 my %parms = @_ == 1 ? (cron => shift) : @_;
73 my $crontab = $self->_make_cronset(%parms);
74 $self->_cronset($crontab);
78 sub new_from_cron { new(@_) }
80 sub new_from_crontab {
82 my %parms = @_ == 1 ? (file => shift()) : @_;
83 my $fh = $class->_prepare_fh($parms{file});
88 eval { $dtc = $class->new(%parms, cron => $_) };
89 if (ref $dtc && !$@) {
91 $parms{user_mode} = 1 if defined $dtc->user;
105 $fh = do { local *FH; *FH }; # doubled *FH avoids warning
107 or croak "Error opening $file for reading\n";
115 # Is the given date valid according the current cron settings?
116 my($self, $date) = @_;
117 return if !$date || $date->second;
118 $self->minute->contains($date->minute) &&
119 $self->hour->contains($date->hour) &&
120 $self->days_contain($date->day, $date->dow) &&
121 $self->month->contains($date->month);
125 # Does the given date match the cron spec?
126 my($self, $date) = @_;
127 $date = DateTime->now unless $date;
128 $self->minute->contains($date->minute) &&
129 $self->hour->contains($date->hour) &&
130 $self->days_contain($date->day, $date->dow) &&
131 $self->month->contains($date->month);
134 ### Return adjacent dates without altering original date
137 my($self, $date) = @_;
138 $date = DateTime->now unless $date;
139 $self->increment($date->clone);
143 my($self, $date) = @_;
144 $date = DateTime->now unless $date;
145 $self->decrement($date->clone);
148 ### Change given date to adjacent dates
151 my($self, $date) = @_;
152 $date = DateTime->now unless $date;
153 return $date if $date->is_infinite;
155 $self->_attempt_increment($date);
156 } until $self->valid($date);
161 my($self, $date) = @_;
162 $date = DateTime->now unless $date;
163 return $date if $date->is_infinite;
165 $self->_attempt_decrement($date);
166 } until $self->valid($date);
172 sub _attempt_increment {
173 my($self, $date) = @_;
174 ref $date or croak "Reference to datetime object reqired\n";
175 $self->valid($date) ?
176 $self->_valid_incr($date) :
177 $self->_invalid_incr($date);
180 sub _attempt_decrement {
181 my($self, $date) = @_;
182 ref $date or croak "Reference to datetime object reqired\n";
183 $self->valid($date) ?
184 $self->_valid_decr($date) :
185 $self->_invalid_decr($date);
188 sub _valid_incr { shift->_minute_incr(@_) }
190 sub _valid_decr { shift->_minute_decr(@_) }
193 # If provided date is valid, return it. Otherwise return
194 # nearest valid date after provided date.
195 my($self, $date) = @_;
196 ref $date or croak "Reference to datetime object reqired\n";
198 print STDERR "\nI GOT: ", $date->datetime, "\n" if DEBUG;
200 $date->truncate(to => 'minute')->add(minutes => 1)
203 print STDERR "RND: ", $date->datetime, "\n" if DEBUG;
205 # Find our greatest invalid unit and clip
206 if (!$self->month->contains($date->month)) {
207 $date->truncate(to => 'month');
209 elsif (!$self->days_contain($date->day, $date->dow)) {
210 $date->truncate(to => 'day');
212 elsif (!$self->hour->contains($date->hour)) {
213 $date->truncate(to => 'hour');
216 $date->truncate(to => 'minute');
219 print STDERR "BBT: ", $date->datetime, "\n" if DEBUG;
221 return $date if $self->valid($date);
223 print STDERR "ZZT: ", $date->datetime, "\n" if DEBUG;
225 # Extraneous durations clipped. Start searching.
226 while (!$self->valid($date)) {
227 $date->add(months => 1) until $self->month->contains($date->month);
228 print STDERR "MON: ", $date->datetime, "\n" if DEBUG;
230 my $day_orig = $date->day;
231 $date->add(days => 1) until $self->days_contain($date->day, $date->dow);
232 $date->truncate(to => 'month') && next if $date->day < $day_orig;
233 print STDERR "DAY: ", $date->datetime, "\n" if DEBUG;
235 my $hour_orig = $date->hour;
236 $date->add(hours => 1) until $self->hour->contains($date->hour);
237 $date->truncate(to => 'day') && next if $date->hour < $hour_orig;
238 print STDERR "HOR: ", $date->datetime, "\n" if DEBUG;
240 my $min_orig = $date->minute;
241 $date->add(minutes => 1) until $self->minute->contains($date->minute);
242 $date->truncate(to => 'hour') && next if $date->minute < $min_orig;
243 print STDERR "MIN: ", $date->datetime, "\n" if DEBUG;
245 print STDERR "SET: ", $date->datetime, "\n" if DEBUG;
250 # If provided date is valid, return it. Otherwise
251 # return the nearest previous valid date.
252 my($self, $date) = @_;
253 ref $date or croak "Reference to datetime object reqired\n";
255 print STDERR "\nD GOT: ", $date->datetime, "\n" if DEBUG;
257 if (!$self->month->contains($date->month)) {
258 $date->truncate(to => 'month');
260 elsif (!$self->days_contain($date->day, $date->dow)) {
261 $date->truncate(to => 'day');
263 elsif (!$self->hour->contains($date->hour)) {
264 $date->truncate(to => 'hour');
267 $date->truncate(to => 'minute');
270 print STDERR "BBT: ", $date->datetime, "\n" if DEBUG;
272 return $date if $self->valid($date);
274 print STDERR "ZZT: ", $date->datetime, "\n" if DEBUG;
276 # Extraneous durations clipped. Start searching.
277 while (!$self->valid($date)) {
278 if (!$self->month->contains($date->month)) {
279 $date->subtract(months => 1) until $self->month->contains($date->month);
280 $self->_unit_peak($date, 'month');
281 print STDERR "MON: ", $date->datetime, "\n" if DEBUG;
283 if (!$self->days_contain($date->day, $date->dow)) {
284 my $day_orig = $date->day;
285 $date->subtract(days => 1)
286 until $self->days_contain($date->day, $date->dow);
287 $self->_unit_peak($date, 'month') && next if ($date->day > $day_orig);
288 $self->_unit_peak($date, 'day');
289 print STDERR "DAY: ", $date->datetime, "\n" if DEBUG;
291 if (!$self->hour->contains($date->hour)) {
292 my $hour_orig = $date->hour;
293 $date->subtract(hours => 1) until $self->hour->contains($date->hour);
294 $self->_unit_peak($date, 'day') && next if ($date->hour > $hour_orig);
295 $self->_unit_peak($date, 'hour');
296 print STDERR "HOR: ", $date->datetime, "\n" if DEBUG;
298 if (!$self->minute->contains($date->minute)) {
299 my $min_orig = $date->minute;
300 $date->subtract(minutes => 1)
301 until $self->minute->contains($date->minute);
302 $self->_unit_peak($date, 'hour') && next if ($date->minute > $min_orig);
303 print STDERR "MIN: ", $date->datetime, "\n" if DEBUG;
306 print STDERR "SET: ", $date->datetime, "\n" if DEBUG;
313 my($self, $date, $unit) = @_;
314 $date && $unit or croak "DateTime ref and unit required.\n";
315 $date->truncate(to => $unit)
316 ->add($unit . 's' => 1)
317 ->subtract(minutes => 1);
323 my($self, $date) = @_;
324 croak "datetime object required\n" unless $date;
325 my $cur = $date->minute;
326 my $next = $self->minute->next($cur);
327 $date->set(minute => $next);
328 $next <= $cur ? $self->_hour_incr($date) : $date;
332 my($self, $date) = @_;
333 croak "datetime object required\n" unless $date;
334 my $cur = $date->hour;
335 my $next = $self->hour->next($cur);
336 $date->set(hour => $next);
337 $next <= $cur ? $self->_day_incr($date) : $date;
341 my($self, $date) = @_;
342 croak "datetime object required\n" unless $date;
343 $date->add(days => 1);
344 $self->_invalid_incr($date);
348 my($self, $date) = @_;
349 croak "datetime object required\n" unless $date;
350 my $cur = $date->minute;
351 my $next = $self->minute->previous($cur);
352 $date->set(minute => $next);
353 $next >= $cur ? $self->_hour_decr($date) : $date;
357 my($self, $date) = @_;
358 croak "datetime object required\n" unless $date;
359 my $cur = $date->hour;
360 my $next = $self->hour->previous($cur);
361 $date->set(hour => $next);
362 $next >= $cur ? $self->_day_decr($date) : $date;
366 my($self, $date) = @_;
367 croak "datetime object required\n" unless $date;
368 $date->subtract(days => 1);
369 $self->_invalid_decr($date);
374 sub _make_cronset { shift; DateTime::Event::Cron::IntegratedSet->new(@_) }
378 sub days_contain { shift->_cronset->days_contain(@_) }
380 sub minute { shift->_cronset->minute }
381 sub hour { shift->_cronset->hour }
382 sub day { shift->_cronset->day }
383 sub month { shift->_cronset->month }
384 sub dow { shift->_cronset->dow }
385 sub user { shift->_cronset->user }
386 sub command { shift->_cronset->command }
387 sub original { shift->_cronset->original }
389 ### Static acessors/mutators
391 sub _cronset { shift->_attr('cronset', @_) }
397 $Object_Attributes{$self}{$name} = shift;
399 $Object_Attributes{$self}{$name};
405 my($self, $date) = @_;
406 foreach (qw(minute hour day month dow)) {
407 print STDERR "$_: ", join(',',$self->$_->list), "\n";
410 $date = $date->clone;
412 my $mon = $date->month;
413 $date->truncate(to => 'month');
414 while ($date->month == $mon) {
415 push(@mod, $date->day) if $self->days_contain($date->day, $date->dow);
416 $date->add(days => 1);
418 print STDERR "mod for month($mon): ", join(',', @mod), "\n";
420 print STDERR "day_squelch: ", $self->_cronset->day_squelch, " ",
421 "dow_squelch: ", $self->_cronset->dow_squelch, "\n";
427 sub DESTROY { delete $Object_Attributes{shift()} }
433 package DateTime::Event::Cron::IntegratedSet;
435 # IntegratedSet manages the collection of field sets for
436 # each cron entry, including sanity checks. Individual
437 # field sets are accessed through their respective names,
438 # i.e., minute hour day month dow.
440 # Also implements some merged field logic for day/dow
454 my @Month_Max = qw( 31 29 31 30 31 30 31 31 30 31 30 31 );
456 my %Object_Attributes;
461 $self->_range(\%Range);
470 my $cron = $parms{cron};
471 my $user_mode = $parms{user_mode};
472 defined $cron or croak "Cron entry fields required\n";
473 $self->_attr('original', $cron);
476 @line = grep(!/^\s*$/, @$cron);
481 @line = split(/\s+/, $cron);
483 @line >= 5 or croak "At least five cron entry fields required.\n";
484 my @entry = splice(@line, 0, 5);
486 unless (defined $user_mode) {
488 if (@line > 1 && $line[0] =~ /^\w+$/) {
492 $user = shift @line if $user_mode;
493 $command = join(' ', @line);
494 $self->_attr('command', $command);
495 $self->_attr('user', $user);
497 foreach my $name (qw( minute hour day month dow )) {
498 $self->_attr($name, $self->make_valid_set($name, $entry[$i]));
501 my @day_list = $self->day->list;
502 my @dow_list = $self->dow->list;
503 my $day_range = $self->range('day');
504 my $dow_range = $self->range('dow');
505 $self->day_squelch(scalar @day_list == scalar @$day_range &&
506 scalar @dow_list != scalar @$dow_range ? 1 : 0);
507 $self->dow_squelch(scalar @dow_list == scalar @$dow_range &&
508 scalar @day_list != scalar @$day_range ? 1 : 0);
509 unless ($self->day_squelch) {
510 my @days = $self->day->list;
512 MONTH: foreach my $month ($self->month->list) {
514 ++$pass && last MONTH if $_ <= $Month_Max[$month - 1];
517 croak "Impossible last day for provided months.\n" unless $pass;
522 # Field range queries
524 my($self, $name) = @_;
525 my $val = $self->_range->{$name} or croak "Unknown field '$name'\n";
529 # Perform sanity checks when setting up each field set.
531 my($self, $name, $str) = @_;
532 my $range = $self->range($name);
533 my $set = $self->make_set($str, $range);
534 my @list = $set->list;
535 croak "Malformed cron field '$str'\n" unless @list;
536 croak "Field value ($list[-1]) out of range ($range->[0]-$range->[-1])\n"
537 if $list[-1] > $range->[-1];
538 if ($name eq 'dow' && $set->contains(0)) {
540 push(@list, 7) unless $set->contains(7);
541 $set = $self->make_set(join(',',@list), $range);
543 croak "Field value ($list[0]) out of range ($range->[0]-$range->[-1])\n"
544 if $list[0] < $range->[0];
549 sub make_set { shift; DateTime::Event::Cron::OrderedSet->new(@_) }
551 # Flags for when day/dow are applied.
552 sub day_squelch { shift->_attr('day_squelch', @_ ) }
553 sub dow_squelch { shift->_attr('dow_squelch', @_ ) }
555 # Merged logic for day/dow
557 my($self, $day, $dow) = @_;
558 defined $day && defined $dow
559 or croak "Day of month and day of week required.\n";
560 my $day_c = $self->day->contains($day);
561 my $dow_c = $self->dow->contains($dow);
562 return $dow_c if $self->day_squelch;
563 return $day_c if $self->dow_squelch;
568 sub minute { shift->_attr('minute' ) }
569 sub hour { shift->_attr('hour' ) }
570 sub day { shift->_attr('day' ) }
571 sub month { shift->_attr('month' ) }
572 sub dow { shift->_attr('dow' ) }
573 sub user { shift->_attr('user' ) }
574 sub command { shift->_attr('command') }
575 sub original { shift->_attr('original') }
578 sub _range { shift->_attr('range', @_) }
584 $Object_Attributes{$self}{$name} = shift;
586 $Object_Attributes{$self}{$name};
589 sub DESTROY { delete $Object_Attributes{shift()} }
597 package DateTime::Event::Cron::OrderedSet;
599 # Extends Set::Crontab with some progression logic (next/prev)
603 use base 'Set::Crontab';
605 my %Object_Attributes;
609 my($string, $range) = @_;
610 defined $string && ref $range
611 or croak "Cron field and range ref required.\n";
612 my $self = Set::Crontab->new($string, $range);
614 my @list = $self->list;
616 foreach (0 .. $#list) {
617 $next{$list[$_]} = $list[($_+1)%@list];
618 $prev{$list[$_]} = $list[($_-1)%@list];
620 $self->_attr('next', \%next);
621 $self->_attr('previous', \%prev);
626 my($self, $entry) = @_;
627 my $hash = $self->_attr('next');
628 croak "Missing entry($entry) in set\n" unless exists $hash->{$entry};
629 my $next = $hash->{$entry};
630 wantarray ? ($next, $next <= $entry) : $next;
634 my($self, $entry) = @_;
635 my $hash = $self->_attr('previous');
636 croak "Missing entry($entry) in set\n" unless exists $hash->{$entry};
637 my $prev = $hash->{$entry};
638 wantarray ? ($prev, $prev >= $entry) : $prev;
645 $Object_Attributes{$self}{$name} = shift;
647 $Object_Attributes{$self}{$name};
650 sub DESTROY { delete $Object_Attributes{shift()} }
662 DateTime::Event::Cron - DateTime extension for generating recurrence
663 sets from crontab lines and files.
667 use DateTime::Event::Cron;
669 # check if a date matches (defaults to current time)
670 my $c = DateTime::Event::Cron->new('* 2 * * *');
674 if ($c->match($date)) {
675 # do something else for datetime $date
678 # DateTime::Set construction from crontab line
679 $crontab = '*/3 15 1-10 3,4,5 */2';
680 $set = DateTime::Event::Cron->from_cron($crontab);
681 $iter = $set->iterator(after => DateTime->now);
683 my $next = $iter->next;
684 my $now = DateTime->now;
685 sleep(($next->subtract_datetime_absolute($now))->seconds);
689 # List of DateTime::Set objects from crontab file
690 @sets = DateTime::Event::Cron->from_crontab(file => '/etc/crontab');
691 $now = DateTime->now;
692 print "Now: ", $now->datetime, "\n";
694 my $next = $_->next($now);
695 print $next->datetime, "\n";
698 # DateTime::Set parameters
699 $crontab = '* * * * *';
701 $now = DateTime->now;
702 %set_parms = ( after => $now );
703 $set = DateTime::Event::Cron->from_cron(cron => $crontab, %set_parms);
705 print "Now: ", $now->datetime, " and next: ", $dt->datetime, "\n";
707 # Spans for DateTime::Set
708 $crontab = '* * * * *';
709 $now = DateTime->now;
711 $span = DateTime::Span->from_datetimes(
712 start => $now->add(minutes => 1),
713 end => $now2->add(hours => 1),
715 %parms = (cron => $crontab, span => $span);
716 $set = DateTime::Event::Cron->from_cron(%parms);
717 # ...do things with the DateTime::Set
719 # Every RTFCT relative to 12am Jan 1st this year
720 $crontab = '7-10 6,12-15 10-28/2 */3 3,4,5';
721 $date = DateTime->now->truncate(to => 'year');
722 $set = DateTime::Event::Cron->from_cron(cron => $crontab, after => $date);
724 # Rather than generating DateTime::Set objects, next/prev
725 # calculations can be made directly:
727 # Every day at 10am, 2pm, and 6pm. Reference date
728 # defaults to DateTime->now.
729 $crontab = '10,14,18 * * * *';
730 $dtc = DateTime::Event::Cron->new_from_cron(cron => $crontab);
731 $next_datetime = $dtc->next;
732 $last_datetime = $dtc->previous;
735 # List of DateTime::Event::Cron objects from
737 @dtc = DateTime::Event::Cron->new_from_crontab(file => '/etc/crontab');
739 # Full cron lines with user, such as from /etc/crontab
740 # or files in /etc/cron.d, are supported and auto-detected:
741 $crontab = '* * * * * gump /bin/date';
742 $dtc = DateTime::Event::Cron->new(cron => $crontab);
744 # Auto-detection of users is disabled if you explicitly
745 # enable/disable via the user_mode parameter:
746 $dtc = DateTime::Event::Cron->new(cron => $crontab, user_mode => 1);
747 my $user = $dtc->user;
748 my $command = $dtc->command;
750 # Unparsed original cron entry
751 my $original = $dtc->original;
755 DateTime::Event::Cron generated DateTime events or DateTime::Set objects
756 based on crontab-style entries.
760 The cron fields are typical crontab-style entries. For more information,
761 see L<crontab(5)> and extensions described in L<Set::Crontab>. The
762 fields can be passed as a single string or as a reference to an array
763 containing each field. Only the first five fields are retained.
765 =head2 DateTime::Set Factories
767 See L<DateTime::Set> for methods provided by Set objects, such as
768 C<next()> and C<previous()>.
772 =item from_cron($cronline)
774 =item from_cron(cron => $cronline, %parms, %set_parms)
776 Generates a DateTime::Set recurrence for the cron line provided. See
777 new() for details on %parms. Optionally takes parameters for
780 =item from_crontab(file => $crontab_fh, %parms, %set_parms)
782 Returns a list of DateTime::Set recurrences based on lines from a
783 crontab file. C<$crontab_fh> can be either a filename or filehandle
784 reference. See new() for details on %parm. Optionally takes parameters
785 for DateTime::Set which will be passed along to each set for each line.
787 =item as_set(%set_parms)
789 Generates a DateTime::Set recurrence from an existing
790 DateTime::Event::Cron object.
798 =item new_from_cron(cron => $cronstring, %parms)
800 Returns a DateTime::Event::Cron object based on the cron specification.
801 Optional parameters include the boolean 'user_mode' which indicates that
802 the crontab entry includes a username column before the command.
804 =item new_from_crontab(file => $fh, %parms)
806 Returns a list of DateTime::Event::Cron objects based on the lines of a
807 crontab file. C<$fh> can be either a filename or a filehandle reference.
808 Optional parameters include the boolean 'user_mode' as mentioned above.
820 Returns the next valid datetime according to the cron specification.
821 C<$date> defaults to DateTime->now unless provided.
825 =item previous($date)
827 Returns the previous valid datetime according to the cron specification.
828 C<$date> defaults to DateTime->now unless provided.
830 =item increment($date)
832 =item decrement($date)
834 Same as C<next()> and C<previous()> except that the provided datetime is
835 modified to the new datetime.
839 Returns whether or not the given datetime (defaults to current time)
840 matches the current cron specification. Dates are truncated to minute
845 A more strict version of match(). Returns whether the given datetime is
846 valid under the current cron specification. Cron dates are only accurate
847 to the minute -- datetimes with seconds greater than 0 are invalid by
848 default. (note: never fear, all methods accepting dates will accept
849 invalid dates -- they will simply be rounded to the next nearest valid
850 date in all cases except this particular method)
854 Returns the command string, if any, from the original crontab entry.
855 Currently no expansion is performed such as resolving environment
860 Returns the username under which this cron command was to be executed,
861 assuming such a field was present in the original cron entry.
865 Returns the original, unparsed cron string including any user or
872 Matthew P. Sisk E<lt>sisk@mojotoad.comE<gt>
876 Copyright (c) 2003 Matthew P. Sisk. All rights reserved. All wrongs
877 revenged. This program is free software; you can distribute it and/or
878 modify it under the same terms as Perl itself.
882 DateTime(3), DateTime::Set(3), DateTime::Event::Recurrence(3),
883 DateTime::Event::ICal(3), DateTime::Span(3), Set::Crontab(3), crontab(5)