modules/fallback/DateTime/Event/Cron.pm

   1 package DateTime::Event::Cron;
   2
   3 use 5.006;
   4 use strict;
   5 use warnings;
   6 use Carp;
   7
   8 use vars qw($VERSION);
   9
  10 $VERSION = '0.08';
  11
  12 use constant DEBUG => 0;
  13
  14 use DateTime;
  15 use DateTime::Set;
  16 use Set::Crontab;
  17
  18 my %Object_Attributes;
  19
  20 ###
  21
  22 sub from_cron {
  23   # Return cron as DateTime::Set
  24   my $class = shift;
  25   my %sparms = @_ == 1 ? (cron => shift) : @_;
  26   my %parms;
  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);
  32 }
  33
  34 sub from_crontab {
  35   # Return list of DateTime::Sets based on entries from
  36   # a crontab file.
  37   my $class = shift;
  38   my %sparms = @_ == 1 ? (file => shift) : @_;
  39   my $file = delete $sparms{file};
  40   delete $sparms{cron};
  41   my $fh = $class->_prepare_fh($file);
  42   my @cronsets;
  43   while (<$fh>) {
  44     chomp;
  45     my $set;
  46     eval { $set = $class->from_cron(%sparms, cron => $_) };
  47     push(@cronsets, $set) if ref $set && !$@;
  48   }
  49   @cronsets;
  50 }
  51
  52 sub as_set {
  53   # Return self as DateTime::Set
  54   my $self = shift;
  55   my %sparms = @_;
  56   Carp::cluck "Recurrence callbacks overriden by ". ref $self . "\n"
  57     if $sparms{next} || $sparms{recurrence} || $sparms{previous};
  58   delete $sparms{next};
  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);
  64 }
  65
  66 ###
  67
  68 sub new {
  69   my $class = shift;
  70   my $self = {};
  71   bless $self, $class;
  72   my %parms = @_ == 1 ? (cron => shift) : @_;
  73   my $crontab = $self->_make_cronset(%parms);
  74   $self->_cronset($crontab);
  75   $self;
  76 }
  77
  78 sub new_from_cron { new(@_) }
  79
  80 sub new_from_crontab {
  81   my $class = shift;
  82   my %parms = @_ == 1 ? (file => shift()) : @_;
  83   my $fh = $class->_prepare_fh($parms{file});
  84   delete $parms{file};
  85   my @dtcrons;
  86   while (<$fh>) {
  87     my $dtc;
  88     eval { $dtc = $class->new(%parms, cron => $_) };
  89     if (ref $dtc && !$@) {
  90       push(@dtcrons, $dtc);
  91       $parms{user_mode} = 1 if defined $dtc->user;
  92     }
  93   }
  94   @dtcrons;
  95 }
  96
  97 ###
  98
  99 sub _prepare_fh {
 100   my $class = shift;
 101   my $fh = shift;
 102   if (! ref $fh) {
 103     my $file = $fh;
 104     local(*FH);
 105     $fh = do { local *FH; *FH }; # doubled *FH avoids warning
 106     open($fh, "<$file")
 107       or croak "Error opening $file for reading\n";
 108   }
 109   $fh;
 110 }
 111
 112 ###
 113
 114 sub valid {
 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);
 122 }
 123
 124 sub match {
 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);
 132 }
 133
 134 ### Return adjacent dates without altering original date
 135
 136 sub next {
 137   my($self, $date) = @_;
 138   $date = DateTime->now unless $date;
 139   $self->increment($date->clone);
 140 }
 141
 142 sub previous {
 143   my($self, $date) = @_;
 144   $date = DateTime->now unless $date;
 145   $self->decrement($date->clone);
 146 }
 147
 148 ### Change given date to adjacent dates
 149
 150 sub increment {
 151   my($self, $date) = @_;
 152   $date = DateTime->now unless $date;
 153   return $date if $date->is_infinite;
 154   do {
 155     $self->_attempt_increment($date);
 156   } until $self->valid($date);
 157   $date;
 158 }
 159
 160 sub decrement {
 161   my($self, $date) = @_;
 162   $date = DateTime->now unless $date;
 163   return $date if $date->is_infinite;
 164   do {
 165     $self->_attempt_decrement($date);
 166   } until $self->valid($date);
 167   $date;
 168 }
 169
 170 ###
 171
 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);
 178 }
 179
 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);
 186 }
 187
 188 sub _valid_incr { shift->_minute_incr(@_) }
 189
 190 sub _valid_decr { shift->_minute_decr(@_) }
 191
 192 sub _invalid_incr {
 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";
 197
 198   print STDERR "\nI GOT: ", $date->datetime, "\n" if DEBUG;
 199
 200   $date->truncate(to => 'minute')->add(minutes => 1)
 201     if $date->second;
 202
 203   print STDERR "RND: ", $date->datetime, "\n" if DEBUG;
 204
 205   # Find our greatest invalid unit and clip
 206   if (!$self->month->contains($date->month)) {
 207     $date->truncate(to => 'month');
 208   }
 209   elsif (!$self->days_contain($date->day, $date->dow)) {
 210     $date->truncate(to => 'day');
 211   }
 212   elsif (!$self->hour->contains($date->hour)) {
 213     $date->truncate(to => 'hour');
 214   }
 215   else {
 216     $date->truncate(to => 'minute');
 217   }
 218
 219   print STDERR "BBT: ", $date->datetime, "\n" if DEBUG;
 220
 221   return $date if $self->valid($date);
 222
 223   print STDERR "ZZT: ", $date->datetime, "\n" if DEBUG;
 224
 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;
 229
 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;
 234
 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;
 239
 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;
 244   }
 245   print STDERR "SET: ", $date->datetime, "\n" if DEBUG;
 246   $date;
 247 }
 248
 249 sub _invalid_decr {
 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";
 254
 255   print STDERR "\nD GOT: ", $date->datetime, "\n" if DEBUG;
 256
 257   if (!$self->month->contains($date->month)) {
 258     $date->truncate(to => 'month');
 259   }
 260   elsif (!$self->days_contain($date->day, $date->dow)) {
 261     $date->truncate(to => 'day');
 262   }
 263   elsif (!$self->hour->contains($date->hour)) {
 264     $date->truncate(to => 'hour');
 265   }
 266   else {
 267     $date->truncate(to => 'minute');
 268   }
 269
 270   print STDERR "BBT: ", $date->datetime, "\n" if DEBUG;
 271
 272   return $date if $self->valid($date);
 273
 274   print STDERR "ZZT: ", $date->datetime, "\n" if DEBUG;
 275
 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;
 282     }
 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;
 290     }
 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;
 297     }
 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;
 304     }
 305   }
 306   print STDERR "SET: ", $date->datetime, "\n" if DEBUG;
 307   $date;
 308 }
 309
 310 ###
 311
 312 sub _unit_peak {
 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);
 318 }
 319
 320 ### Unit cascades
 321
 322 sub _minute_incr {
 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;
 329 }
 330
 331 sub _hour_incr {
 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;
 338 }
 339
 340 sub _day_incr {
 341   my($self, $date) = @_;
 342   croak "datetime object required\n" unless $date;
 343   $date->add(days => 1);
 344   $self->_invalid_incr($date);
 345 }
 346
 347 sub _minute_decr {
 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;
 354 }
 355
 356 sub _hour_decr {
 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;
 363 }
 364
 365 sub _day_decr {
 366   my($self, $date) = @_;
 367   croak "datetime object required\n" unless $date;
 368   $date->subtract(days => 1);
 369   $self->_invalid_decr($date);
 370 }
 371
 372 ### Factories
 373
 374 sub _make_cronset { shift; DateTime::Event::Cron::IntegratedSet->new(@_) }
 375
 376 ### Shortcuts
 377
 378 sub days_contain { shift->_cronset->days_contain(@_) }
 379
 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 }
 388
 389 ### Static acessors/mutators
 390
 391 sub _cronset { shift->_attr('cronset', @_) }
 392
 393 sub _attr {
 394   my $self = shift;
 395   my $name = shift;
 396   if (@_) {
 397     $Object_Attributes{$self}{$name} = shift;
 398   }
 399   $Object_Attributes{$self}{$name};
 400 }
 401
 402 ### debugging
 403
 404 sub _dump_sets {
 405   my($self, $date) = @_;
 406   foreach (qw(minute hour day month dow)) {
 407     print STDERR "$_: ", join(',',$self->$_->list), "\n";
 408   }
 409   if (ref $date) {
 410     $date = $date->clone;
 411     my @mod;
 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);
 417     }
 418     print STDERR "mod for month($mon): ", join(',', @mod), "\n";
 419   }
 420   print STDERR "day_squelch: ", $self->_cronset->day_squelch, " ",
 421                "dow_squelch: ", $self->_cronset->dow_squelch, "\n";
 422   $self;
 423 }
 424
 425 ###
 426
 427 sub DESTROY { delete $Object_Attributes{shift()} }
 428
 429 ##########
 430
 431 {
 432
 433 package DateTime::Event::Cron::IntegratedSet;
 434
 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.
 439 #
 440 # Also implements some merged field logic for day/dow
 441 # interactions.
 442
 443 use strict;
 444 use Carp;
 445
 446 my %Range = (
 447   minute => [0..59],
 448   hour   => [0..23],
 449   day    => [1..31],
 450   month  => [1..12],
 451   dow    => [1..7],
 452 );
 453
 454 my @Month_Max = qw( 31 29 31 30 31 30 31 31 30 31 30 31 );
 455
 456 my %Object_Attributes;
 457
 458 sub new {
 459   my $self = [];
 460   bless $self, shift;
 461   $self->_range(\%Range);
 462   $self->set_cron(@_);
 463   $self;
 464 }
 465
 466 sub set_cron {
 467   # Initialize
 468   my $self = shift;
 469   my %parms = @_;
 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);
 474   my @line;
 475   if (ref $cron) {
 476     @line = grep(!/^\s*$/, @$cron);
 477   }
 478   else {
 479     $cron =~ s/^\s+//;
 480     $cron =~ s/\s+$//;
 481     @line = split(/\s+/, $cron);
 482   }
 483   @line >= 5 or croak "At least five cron entry fields required.\n";
 484   my @entry = splice(@line, 0, 5);
 485   my($user, $command);
 486   unless (defined $user_mode) {
 487     # auto-detect
 488     if (@line > 1 && $line[0] =~ /^\w+$/) {
 489       $user_mode = 1;
 490     }
 491   }
 492   $user = shift @line if $user_mode;
 493   $command = join(' ', @line);
 494   $self->_attr('command', $command);
 495   $self->_attr('user', $user);
 496   my $i = 0;
 497   foreach my $name (qw( minute hour day month dow )) {
 498     $self->_attr($name, $self->make_valid_set($name, $entry[$i]));
 499     ++$i;
 500   }
 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;
 511     my $pass = 0;
 512     MONTH: foreach my $month ($self->month->list) {
 513       foreach (@days) {
 514         ++$pass && last MONTH if $_ <= $Month_Max[$month - 1];
 515       }
 516     }
 517     croak "Impossible last day for provided months.\n" unless $pass;
 518   }
 519   $self;
 520 }
 521
 522 # Field range queries
 523 sub range {
 524   my($self, $name) = @_;
 525   my $val = $self->_range->{$name} or croak "Unknown field '$name'\n";
 526   $val;
 527 }
 528
 529 # Perform sanity checks when setting up each field set.
 530 sub make_valid_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)) {
 539     shift(@list);
 540     push(@list, 7) unless $set->contains(7);
 541     $set = $self->make_set(join(',',@list), $range);
 542   }
 543   croak "Field value ($list[0]) out of range ($range->[0]-$range->[-1])\n"
 544     if $list[0] < $range->[0];
 545   $set;
 546 }
 547
 548 # No sanity checks
 549 sub make_set { shift; DateTime::Event::Cron::OrderedSet->new(@_) }
 550
 551 # Flags for when day/dow are applied.
 552 sub day_squelch { shift->_attr('day_squelch', @_ ) }
 553 sub dow_squelch { shift->_attr('dow_squelch', @_ ) }
 554
 555 # Merged logic for day/dow
 556 sub days_contain {
 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;
 564   $day_c || $dow_c;
 565 }
 566
 567 # Set Accessors
 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') }
 576
 577 # Accessors/mutators
 578 sub _range       { shift->_attr('range', @_) }
 579
 580 sub _attr {
 581   my $self = shift;
 582   my $name = shift;
 583   if (@_) {
 584     $Object_Attributes{$self}{$name} = shift;
 585   }
 586   $Object_Attributes{$self}{$name};
 587 }
 588
 589 sub DESTROY { delete $Object_Attributes{shift()} }
 590
 591 }
 592
 593 ##########
 594
 595 {
 596
 597 package DateTime::Event::Cron::OrderedSet;
 598
 599 # Extends Set::Crontab with some progression logic (next/prev)
 600
 601 use strict;
 602 use Carp;
 603 use base 'Set::Crontab';
 604
 605 my %Object_Attributes;
 606
 607 sub new {
 608   my $class = shift;
 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);
 613   bless $self, $class;
 614   my @list = $self->list;
 615   my(%next, %prev);
 616   foreach (0 .. $#list) {
 617     $next{$list[$_]} = $list[($_+1)%@list];
 618     $prev{$list[$_]} = $list[($_-1)%@list];
 619   }
 620   $self->_attr('next', \%next);
 621   $self->_attr('previous', \%prev);
 622   $self;
 623 }
 624
 625 sub next {
 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;
 631 }
 632
 633 sub previous {
 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;
 639 }
 640
 641 sub _attr {
 642   my $self = shift;
 643   my $name = shift;
 644   if (@_) {
 645     $Object_Attributes{$self}{$name} = shift;
 646   }
 647   $Object_Attributes{$self}{$name};
 648 }
 649
 650 sub DESTROY { delete $Object_Attributes{shift()} }
 651
 652 }
 653
 654 ###
 655
 656 1;
 657
 658 __END__
 659
 660 =head1 NAME
 661
 662 DateTime::Event::Cron - DateTime extension for generating recurrence
 663 sets from crontab lines and files.
 664
 665 =head1 SYNOPSIS
 666
 667   use DateTime::Event::Cron;
 668
 669   # check if a date matches (defaults to current time)
 670   my $c = DateTime::Event::Cron->new('* 2 * * *');
 671   if ($c->match) {
 672     # do stuff
 673   }
 674   if ($c->match($date)) {
 675     # do something else for datetime $date
 676   }
 677
 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);
 682   while (1) {
 683     my $next = $iter->next;
 684     my $now  = DateTime->now;
 685     sleep(($next->subtract_datetime_absolute($now))->seconds);
 686     # do stuff...
 687   }
 688
 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";
 693   foreach (@sets) {
 694     my $next = $_->next($now);
 695     print $next->datetime, "\n";
 696   }
 697
 698   # DateTime::Set parameters
 699   $crontab = '* * * * *';
 700
 701   $now = DateTime->now;
 702   %set_parms = ( after => $now );
 703   $set = DateTime::Event::Cron->from_cron(cron => $crontab, %set_parms);
 704   $dt = $set->next;
 705   print "Now: ", $now->datetime, " and next: ", $dt->datetime, "\n";
 706
 707   # Spans for DateTime::Set
 708   $crontab = '* * * * *';
 709   $now = DateTime->now;
 710   $now2 = $now->clone;
 711   $span = DateTime::Span->from_datetimes(
 712             start => $now->add(minutes => 1),
 713             end   => $now2->add(hours => 1),
 714           );
 715   %parms = (cron => $crontab, span => $span);
 716   $set = DateTime::Event::Cron->from_cron(%parms);
 717   # ...do things with the DateTime::Set
 718
 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);
 723
 724   # Rather than generating DateTime::Set objects, next/prev
 725   # calculations can be made directly:
 726
 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;
 733   ...
 734
 735   # List of DateTime::Event::Cron objects from
 736   # crontab file
 737   @dtc = DateTime::Event::Cron->new_from_crontab(file => '/etc/crontab');
 738
 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);
 743
 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;
 749
 750   # Unparsed original cron entry
 751   my $original = $dtc->original;
 752
 753 =head1 DESCRIPTION
 754
 755 DateTime::Event::Cron generated DateTime events or DateTime::Set objects
 756 based on crontab-style entries.
 757
 758 =head1 METHODS
 759
 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.
 764
 765 =head2 DateTime::Set Factories
 766
 767 See L<DateTime::Set> for methods provided by Set objects, such as
 768 C<next()> and C<previous()>.
 769
 770 =over 4
 771
 772 =item from_cron($cronline)
 773
 774 =item from_cron(cron => $cronline, %parms, %set_parms)
 775
 776 Generates a DateTime::Set recurrence for the cron line provided. See
 777 new() for details on %parms. Optionally takes parameters for
 778 DateTime::Set.
 779
 780 =item from_crontab(file => $crontab_fh, %parms, %set_parms)
 781
 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.
 786
 787 =item as_set(%set_parms)
 788
 789 Generates a DateTime::Set recurrence from an existing
 790 DateTime::Event::Cron object.
 791
 792 =back
 793
 794 =head2 Constructors
 795
 796 =over 4
 797
 798 =item new_from_cron(cron => $cronstring, %parms)
 799
 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.
 803
 804 =item new_from_crontab(file => $fh, %parms)
 805
 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.
 809
 810 =back
 811
 812 =head2 Other methods
 813
 814 =over 4
 815
 816 =item next()
 817
 818 =item next($date)
 819
 820 Returns the next valid datetime according to the cron specification.
 821 C<$date> defaults to DateTime->now unless provided.
 822
 823 =item previous()
 824
 825 =item previous($date)
 826
 827 Returns the previous valid datetime according to the cron specification.
 828 C<$date> defaults to DateTime->now unless provided.
 829
 830 =item increment($date)
 831
 832 =item decrement($date)
 833
 834 Same as C<next()> and C<previous()> except that the provided datetime is
 835 modified to the new datetime.
 836
 837 =item match($date)
 838
 839 Returns whether or not the given datetime (defaults to current time)
 840 matches the current cron specification. Dates are truncated to minute
 841 resolution.
 842
 843 =item valid($date)
 844
 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)
 851
 852 =item command()
 853
 854 Returns the command string, if any, from the original crontab entry.
 855 Currently no expansion is performed such as resolving environment
 856 variables, etc.
 857
 858 =item user()
 859
 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.
 862
 863 =item original()
 864
 865 Returns the original, unparsed cron string including any user or
 866 command fields.
 867
 868 =back
 869
 870 =head1 AUTHOR
 871
 872 Matthew P. Sisk E<lt>sisk@mojotoad.comE<gt>
 873
 874 =head1 COPYRIGHT
 875
 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.
 879
 880 =head1 SEE ALSO
 881
 882 DateTime(3), DateTime::Set(3), DateTime::Event::Recurrence(3),
 883 DateTime::Event::ICal(3), DateTime::Span(3), Set::Crontab(3), crontab(5)
 884
 885 =cut