File Coverage

blib/lib/Time/Piece/Cron.pm
Criterion Covered Total %
statement 101 271 37.2
branch 29 132 21.9
condition 2 45 4.4
subroutine 11 17 64.7
pod 5 5 100.0
total 148 470 31.4


line stmt bran cond sub pod time code
1             package Time::Piece::Cron;
2              
3 2     2   44261 use 5.006;
  2         9  
  2         75  
4 2     2   11 use strict;
  2         5  
  2         64  
5 2     2   9 use warnings;
  2         8  
  2         55  
6 2     2   11 use Carp;
  2         2  
  2         153  
7 2     2   1122 use Time::Piece;
  2         14967  
  2         9  
8 2     2   119 use Time::Seconds;
  2         5  
  2         151  
9 2     2   11 use Time::Local;
  2         3  
  2         6062  
10              
11             =head1 NAME
12              
13             Time::Piece::Cron - Parse and evaluate times from crontab strings.
14              
15             =head1 VERSION
16              
17             Version 0.1
18              
19             =cut
20              
21             our $VERSION = '0.1';
22              
23             =head1 SYNOPSIS
24              
25             use Time::Piece;
26            
27             use Time::Piece::Cron;
28              
29             my $cron = Time::Piece::Cron->new();
30            
31             my $timepiece = $cron->next_time("30 08 * * Mon-Fri");
32            
33             my $time = $cron->next_timestamp("30 08 * * Mon-Fri");
34            
35             my $bool = $cron->is_now("*/15 * * * *");
36            
37             my $bool = $cron->parse_cron("30 08 * * Foo-Bar");
38              
39             =head1 DESCRIPTION
40              
41             Evaluate times from crontab type entries in a manner similar to the Vixie cron
42             standards, and the guidelines found in the "man 5 crontab" documentation.
43              
44             The cron time and date fields are:
45              
46             field allowed values
47             ----- --------------
48             minute 0-59
49             hour 0-23
50             day of month 1-31
51             month 1-12 (or names, see below)
52             day of week 0-7 (0 or 7 is Sun, or use names)
53              
54             A field may be an asterisk (*), which always stands for "first-last".
55              
56             Ranges of numbers are allowed. Ranges are two numbers separated with a
57             hyphen. The specified range is inclusive. For example, 8-11 for an
58             "hours" entry specifies execution at hours 8, 9, 10 and 11.
59              
60             Lists are allowed. A list is a set of numbers (or ranges) separated by
61             commas. Examples: "1,2,5,9", "0-4,8-12".
62              
63             Step values can be used in conjunction with ranges. Following a range
64             with "" specifies skips of the number's value through the
65             range. For example, "0-23/2" can be used in the hours field to specify
66             command execution every other hour. Steps are also permitted after
67             an asterisk, so if you want to say "every two hours", just use "*/2".
68              
69             Names can also be used for the "month" and "day of week" fields. Use
70             the first three letters of the particular day or month (case doesn't matter).
71              
72             Ranges and lists of names are allowed(**).
73             However, avoid Weekday and Month ranges that wrap from one week (or year) into
74             the next, as this will result in unexpected behavior once the lists are
75             expanded and sorted.
76             Such as:
77              
78             "30 08 * * Fri-Tue" or "30 08 * Dec-Mar *"
79              
80             If you must span into another week or year, use absolute lists instead.
81             Such as:
82              
83             "30 08 * * Fri,Sat,Sun,Mon,Tue" or "30 08 * Dec,Jan,Feb,Mar *"
84              
85             Note: The day of a command's execution can be specified by two fields --
86             day of month, and day of week. If both fields are restricted (ie, aren't *),
87             the command will be run when either field matches the current time.
88             For example,
89             "30 4 1,15 * 5" would cause a command to be run at 4:30 am on the 1st and 15th
90             of each month, PLUS every Friday.
91            
92             (**) = Deviates from Vixie cron standard.
93              
94             =head1 METHODS
95              
96             =head2 new
97              
98             Create a new Time::Piece::Cron instance;
99              
100             PARAMS
101              
102             none
103            
104             RETURNS
105              
106             an object
107              
108             $cron = Time::Piece::Cron->new();
109              
110             =cut
111              
112             sub new
113             {
114 1     1 1 731 my $class = shift;
115 1         28 my $self = {
116             cron_size => 5,
117             ranges => [ [ 0,59 ],
118             [ 0,23 ],
119             [ 1,31 ],
120             [ 1,12 ],
121             [ 0,6 ]
122             ],
123            
124             conversion => [ { 60 => 0 },
125             { 24 => 0 },
126             {},
127             {},
128             { 7 => 0}
129             ],
130            
131             alphamap => [ {},
132             {},
133             {},
134             { qw(jan 1 feb 2 mar 3 apr 4 may 5 jun 6 jul 7
135             aug 8 sep 9 oct 10 nov 11 dec 12) },
136             { qw(sun 0 mon 1 tue 2 wed 3 thu 4 fri 5 sat 6) }
137             ],
138            
139             indexmap => {
140             0 => 'min',
141             1 => 'hour',
142             2 => 'mday',
143             3 => 'mon',
144             4 => '_wday'
145             },
146            
147             };
148            
149 1         3 bless($self, $class);
150 1         3 return $self;
151             }
152              
153              
154             =head2 is_now
155              
156             Evaluate if a crontab string is true for the current time.
157              
158             PARAMS
159              
160             1. A string, like "05 * * * *"
161              
162             2. Optionally, a Time::Piece object for a reference start time.
163              
164             RETURNS
165              
166             1 if TRUE
167              
168             0 if FALSE
169              
170             $bool = $cron->is_now("30 08 * * Mon-Fri");
171              
172             =cut
173              
174             sub is_now
175             {
176 1     1 1 2 my $self = shift;
177 1         2 my $cron = shift;
178 1         2 my $timepiece = shift;
179            
180 1 50       3 if (defined $timepiece) {
181             # user passed a standard perl timestamp. wrong, but deal with it.
182 0 0 0     0 if (ref($timepiece) ne "Time::Piece" and $timepiece =~ /\b\d+\d/) {
183 0         0 $timepiece = Time::Piece->new($timepiece);
184             }
185             }
186 1 50       5 $timepiece = Time::Piece->new() if (! defined $timepiece);
187            
188            
189 1         59 my @atoms = $self->parse_cron($cron);
190 1         1 my $mday = 0;
191            
192 1 50       4 return 0 if (! scalar(@atoms));
193            
194 1         1 foreach my $index (sort keys %{$self->{indexmap}}) {
  1         6  
195 5         9 my $ref = $self->{indexmap}->{$index};
196 5         9 my $possibles = $atoms[$index];
197 5         6 my $found = 0;
198 5         19 my $val = $timepiece->$ref;
199            
200 5 50       134 if ( grep(/\b$val\b/, @{$possibles} ) ) {
  5         129  
201 5         5 $found = 1;
202 5 100       12 $mday = 1 if ($index == 2);
203             }
204            
205 5 100       8 if ($index == 2) {
206             # For some complex cases(like, "30 08 1 10 Tue"), a cron is valid
207             # in TWO situations:
208             # - 08:30am on October 1st.
209             # - 08:30am on EVERY Tuesday in October.
210             # So, do not be too hasty to abort if the MDAY field doesn't match,
211             # because WDAY needs to be given opportunity to match in some cases
212 1 50 33     5 next if (! $found and scalar(@{$atoms[4]}) < 7);
  0         0  
213             }
214            
215 5 100       10 if ($index == 4) {
216 1 50       24 return 1 if ($found); # wday was matched.
217 0 0 0     0 return 1 if (! $found and $mday); # wday not match, but mday did.
218             }
219            
220 4 50       10 return 0 if (! $found);
221             }
222            
223 0         0 return 0;
224             }
225              
226              
227             =head2 next_time
228              
229             Returns a Time::Piece object representing the next time a cron entry will run.
230              
231             If you just want to know if a cron entry will run right now, use instead the
232             faster is_now() method.
233              
234             PARAMS
235              
236             1. A valid crontab string. like ("05 * * * *")
237              
238             2. Optionally, a Time::Piece object for a reference start time.
239              
240             RETURNS
241              
242             A Time::Piece object
243              
244             UNDEF on error.
245              
246             $timepiece = $cron->next_time("30 08 * * *");
247              
248             =cut
249              
250             sub next_time
251             {
252 0     0 1 0 my $self = shift;
253 0         0 my $cron = shift;
254 0         0 my $master = shift;
255            
256 0 0       0 if (defined $master) {
257             # user passed a standard perl timestamp. wrong, but deal with it.
258 0 0 0     0 if (ref($master) ne "Time::Piece" and $master =~ /\b\d+\d/) {
259 0         0 $master= Time::Piece->new($master);
260             }
261             }
262 0 0       0 $master = Time::Piece->new() if (! defined $master);
263            
264            
265 0         0 my @atoms = $self->parse_cron($cron);
266 0 0       0 return undef if (! scalar(@atoms));
267            
268 0         0 my @results;
269 0         0 my $mode = $self->_timesearch_mode(@atoms);
270 0 0       0 my $pass = ($mode == 3) ? 2 : 1;
271 0         0 my $timepiece;
272            
273 0         0 do {
274            
275             # create a copy of starting Time::Piece object and zero out the seconds.
276 0         0 $timepiece = $master;
277 0         0 $timepiece = Time::Piece->new( timelocal(0, @{$timepiece}[1 .. 5] ) );
  0         0  
278 0         0 my $ymd_lock = 0;
279            
280             PARSEBLOCK:
281             {
282 0 0       0 if ($timepiece->year > ($master->year + 1)) {
  0         0  
283 0         0 carp "Cron parsing has gone out of range '$timepiece'";
284 0         0 $timepiece = undef;
285 0         0 last PARSEBLOCK;
286             }
287            
288             # iterate over cron sections in a specific order
289 0         0 foreach my $index (3, 4, 2, 1, 0) {
290 0         0 my $possibles = $atoms[$index];
291 0         0 my $ref = $self->{indexmap}->{$index};
292 0         0 my $max = ($self->{ranges}->[$index]->[-1] + 1) - $self->{ranges}->[$index]->[0];
293            
294             # skip sections depending on allowed range, or mode/pass values
295 0 0       0 next if (scalar(@{$possibles}) >= $max);
  0         0  
296 0 0 0     0 next if ($index == 4 and $mode == 0);
297 0 0 0     0 next if ($index == 4 and $pass == 2);
298 0 0 0     0 next if ($index == 2 and $mode == 3 and $pass == 1);
      0        
299            
300 0         0 my $val = $self->_next_possible($timepiece->$ref, $possibles);
301            
302 0 0       0 if ($index == 2) {
303             # reset max to equal number of days in this month
304 0         0 $max = $self->_last_day_of_month($timepiece->_mon, $timepiece->_year);
305             }
306            
307             # mon parsing
308 0 0       0 if ($index == 3) {
    0          
    0          
    0          
309 0 0       0 if ($val == $timepiece->$ref) {
    0          
310 0         0 next;
311             } elsif ($val > $timepiece->$ref) {
312 0         0 $timepiece += ONE_MONTH * ($val - $timepiece->$ref);
313             } else {
314 0         0 $timepiece += ONE_MONTH * (($max - $timepiece->$ref) + $val);
315             }
316 0         0 $timepiece = Time::Piece->new( timelocal(0,0,0,1,@{$timepiece}[4 .. 5]) );
  0         0  
317            
318             # mday parsing
319             } elsif ($index == 2) {
320 0 0       0 if ($val == $timepiece->$ref) {
    0          
321 0         0 next;
322             } elsif ($val > $timepiece->$ref) {
323             # make sure we are not exceeding max number of days
324             # valid for this month.
325 0 0       0 if ($val > $max) {
326 0         0 $timepiece += ONE_MONTH;
327 0         0 $timepiece = Time::Piece->new( timelocal(0,0,0,1,@{$timepiece}[4 .. 5]) );
  0         0  
328 0         0 redo PARSEBLOCK;
329             } else {
330 0         0 $timepiece += ONE_DAY * ($val - $timepiece->$ref);
331             }
332             } else {
333 0         0 $timepiece += ONE_DAY * (($max - $timepiece->$ref) + $val);
334 0         0 $timepiece = Time::Piece->new( timelocal(0,0,0,@{$timepiece}[3 .. 5]) );
  0         0  
335 0         0 redo PARSEBLOCK;
336             }
337            
338             # hour parsing
339             } elsif ($index == 1) {
340 0 0       0 if ($val == $timepiece->$ref) {
    0          
341 0         0 next;
342             } elsif ($val > $timepiece->$ref) {
343 0         0 $timepiece += ONE_HOUR * ($val - $timepiece->$ref);
344 0         0 $timepiece = Time::Piece->new( timelocal(0,0,@{$timepiece}[2 .. 5]) );
  0         0  
345             } else {
346 0         0 $timepiece += ONE_HOUR * (($max - $timepiece->$ref) + $val);
347 0         0 $timepiece = Time::Piece->new( timelocal(0,0,@{$timepiece}[2 .. 5]) );
  0         0  
348 0         0 redo PARSEBLOCK;
349             }
350            
351             # min parsing
352             } elsif ($index == 0) {
353 0 0       0 if ($val == $timepiece->$ref) {
    0          
354 0         0 next;
355             } elsif ($val > $timepiece->$ref) {
356 0         0 $timepiece += ONE_MINUTE * ($val - $timepiece->$ref);
357 0         0 $timepiece = Time::Piece->new( timelocal(0,@{$timepiece}[1 .. 5]) );
  0         0  
358             } else {
359 0         0 $timepiece += ONE_MINUTE * (($max - $timepiece->$ref) + $val);
360 0         0 $timepiece = Time::Piece->new( timelocal(0,@{$timepiece}[1 .. 5]) );
  0         0  
361 0         0 redo PARSEBLOCK;
362             }
363            
364             # the dreaded wday parsing!
365             } else {
366 0 0       0 if ($ymd_lock) {
367             # it is rare to end up in this loop a second time,
368             # but if it does happen... we have a bad DMY, and need
369             # to re-evaluate it from a later date.
370 0         0 $timepiece += ONE_DAY;
371             }
372            
373 0         0 my $temp = $self->_next_dow_time($val, $timepiece);
374            
375 0 0       0 if ($temp->mon == $timepiece->mon) {
376 0         0 $timepiece = $temp;
377 0         0 $ymd_lock = 1;
378             } else {
379             # next found day-of-week is beyond the range of the
380             # desired month. that won't do.
381 0         0 $timepiece += ONE_MONTH;
382 0         0 $timepiece = Time::Piece->new( timelocal(0,0,0,1,@{$timepiece}[4 .. 5]) );
  0         0  
383 0         0 $ymd_lock = 0;
384 0         0 redo PARSEBLOCK;
385             }
386             }
387             }
388             }
389            
390 0 0       0 push(@results, $timepiece) if (defined $timepiece);
391 0         0 $pass --;
392            
393             } while ($pass);
394            
395             # nothing was found? shouldn't happen, but you never know...
396 0 0       0 if (! scalar(@results)) {
397 0         0 carp "Unable to calculate next_time for '$cron'";
398 0         0 return undef;
399             }
400            
401             # if more than one result, return the earlier time
402 0 0       0 if (scalar(@results) == 2) {
403 0 0       0 if ($results[1]->epoch < $results[0]->epoch) {
404 0         0 return $results[1];
405             }
406             }
407 0         0 return $results[0];
408             }
409              
410              
411             =head2 next_timestamp
412              
413             Same as next_time(), but returns a regular perl timestamp (seconds since epoch)
414             instead of a Time::Piece object.
415              
416             PARAMS
417              
418             1. A valid crontab string. like ("05 * * * *")
419              
420             2. Optionally, a perl timestamp for a reference start time.
421              
422              
423             RETURNS
424              
425             A perl timestamp
426              
427             UNDEF on error.
428              
429             $time = $cron->next_timestamp("30 08 * * *");
430              
431             =cut
432              
433             sub next_timestamp
434             {
435 0     0 1 0 my $self = shift;
436 0         0 my $cron = shift;
437 0   0     0 my $time = shift || time();
438              
439 0         0 my $timepiece = Time::Piece->new($time);
440 0         0 $timepiece = $self->next_time($cron, $timepiece);
441              
442 0         0 return timelocal(@{$timepiece});
  0         0  
443             }
444              
445              
446             =head2 parse_cron
447              
448             Parse a crontab time string, and test for validity.
449             This method is mainly used internally, but may prove useful for other things.
450              
451             PARAMS
452            
453             A string, like "00,30 08 * * Mon-Fri"
454              
455             RETURNS
456              
457             In SCALAR context, returns whether or not it is a valid cron string.
458              
459             1 if TRUE
460             0 if FALSE
461              
462             In ARRAY context, returns an array of the possible values for each segment.
463              
464             ARRAY on success ([min 0-59],[hour 0-23],[mday 1-31],[mon 0-11],[wday 0-6])
465             UNDEF on Error
466              
467              
468             $bool = $cron->parse_cron("30 08 * * Mon-Fri");
469              
470             @atoms = $cron->parse_cron("30 08 * * Mon-Fri");
471              
472             =cut
473              
474             sub parse_cron
475             {
476 2     2 1 339 my $self = shift;
477 2         3 my $cron = shift;
478 2         2 my @results;
479            
480 2 50 33     13 if (! defined $cron or $cron eq "") {
481 0         0 carp "Must provide valid cron string";
482 0 0       0 return () if wantarray;
483 0         0 return 0;
484             }
485            
486 2         7 my @segments = split(/\s+/, $cron);
487            
488 2 50       11 if (scalar(@segments) != $self->{cron_size}) {
489 0         0 carp "Invalid number of elements in cron entry '$cron'";
490 0 0       0 return () if wantarray;
491 0         0 return 0;
492             }
493            
494             # decode and expand each segment into its range of valid numbers
495 2         6 for (my $index = 0; $index < scalar(@segments); $index ++) {
496 10         23 my @ary = $self->_expand_cron_index($segments[$index], $index);
497            
498 10 50       25 if (! scalar(@ary)) {
499 0         0 carp "Cron index $index resulted in no values.";
500 0 0       0 return () if wantarray;
501 0         0 return 0;
502             }
503            
504 10 50       88 if ( grep(/\D/, @ary) ) {
505 0         0 carp "Cron index $index contains invalid characters.";
506 0 0       0 return () if wantarray;
507 0         0 return 0;
508             }
509            
510 10         27 push(@results, \@ary);
511             }
512            
513 2 100       19 return @results if wantarray;
514 1         9 return 1;
515             }
516              
517              
518             # private method #
519             ##################
520             # _last_day_of_month
521             #
522             # Returns the last day number of a given month.
523             #
524             # PARAMS
525             # A month number (localtime compliant 0 - 11)
526             # A year number (localtime compliant -1900)
527             #
528             # RETURNS
529             # a number (28 thru 31)
530             #
531             sub _last_day_of_month
532             {
533 0     0   0 my $self = shift;
534 0         0 my $mon = shift;
535 0         0 my $year = shift;
536            
537 0         0 my $day;
538 0         0 my $t = Time::Piece->new ( timelocal(0,0,0,28,$mon,$year) );
539            
540 0         0 while ($t->_mon == $mon) {
541 0         0 $day = $t->mday;
542 0         0 $t += ONE_DAY;
543             }
544            
545 0         0 return $day;
546             }
547              
548              
549             # private method #
550             ##################
551             # _expand_cron_index()
552             #
553             # Parse a segment of a cron string. Convert all wildcards, ranges, etc., to
554             # a list of valid numbers.
555             #
556             # PARAMS:
557             # 1. A segment of cron text
558             # 2. The index number of the sent piece
559             #
560             # RETURNS:
561             # an array of numbers
562             #
563             sub _expand_cron_index
564             {
565 10     10   13 my $self = shift;
566 10         12 my $cron = shift;
567 10         10 my $index = shift;
568            
569 10         9 my @results;
570            
571 10         21 foreach my $piece ( split(/,/, $cron) ) {
572 10         9 my $step = 0;
573 10         12 my @atoms;
574            
575             # capture any defined steps (i.e., "*/15"), then remove.
576 10 50       19 if ($piece =~ /\/(\d+)$/) {
577 0         0 $step = $1;
578 0         0 $piece =~ s/\/\d+$//;
579             }
580            
581             # replace any text values with corresponding numbers.
582 10 50       23 if (defined $self->{alphamap}->[$index]) {
583 10         11 foreach my $key ( keys %{$self->{alphamap}->[$index]} ) {
  10         28  
584 38         67 my $replacement = $self->{alphamap}->[$index]->{$key};
585 38 50       262 next unless ($piece =~ /$key/i);
586 0         0 $piece =~ s/$key/$replacement/ig;
587             }
588             }
589            
590             # fix common out-of-range numbers
591 10 50       26 if (defined $self->{conversion}->[$index]) {
592 10         10 foreach my $num ( keys %{$self->{conversion}->[$index]} ) {
  10         21  
593 6         9 my $replacement = $self->{conversion}->[$index]->{$num};
594 6         52 $piece =~ s/\b$num\b/$replacement/g;
595             }
596             }
597            
598             # a simple, singular number?
599 10 100       30 if ($piece =~ /^\d+$/) {
600 2         3 push(@results, $piece);
601 2         4 next;
602             }
603            
604             # expand asterisks into a range of numbers
605 8 50       18 if ($piece =~ /\*/) {
606 8         6 my $replacement = join('-', @{$self->{ranges}->[$index]});
  8         22  
607 8         20 $piece =~ s/\*/$replacement/;
608             }
609            
610             # expand ranges and place into @atoms
611 8 50       28 if ($piece =~ /(\d+)-(\d+)/) {
612 8         63 push(@atoms, ($1 .. $2));
613             }
614            
615             # filter steps, or push all numbers into @range
616 8 50       19 if ($step) {
617 0         0 for (my $i = 0; $i < scalar(@atoms); $i++) {
618             # the first value in an step range always gets added,
619             # and so do numbers that divide evenly by the step.
620 0 0 0     0 if ( $i == 0 or (! ($atoms[$i] % $step)) ) {
621 0         0 push(@results, $atoms[$i]);
622             }
623             }
624             } else {
625 8         47 push(@results, @atoms);
626             }
627             }
628            
629             # clean the array. remove duplicates, convert all to INT, sort numeric asc
630             {
631 10         12 my $max = $self->{ranges}->[$index]->[-1];
  10         18  
632 10         16 my %hash = map { $_ => 1 } @results;
  186         310  
633 10         48 @results = ();
634 10         41 my @sorted = (sort {$a <=> $b} keys %hash);
  679         683  
635            
636 10         22 foreach my $val (@sorted) {
637 186 50       248 if (int($val) <= $max) {
638 186         254 push(@results, int($val));
639             }
640             }
641             }
642            
643 10         44 return @results;
644             }
645              
646              
647             # private method #
648             ##################
649             # _next_dow_time()
650             #
651             # Return Time::Piece object for the next occurence of the desired WDAY.
652             #
653             # PARAMS:
654             # 1. a DOW number.
655             # 2. A Time::Piece object representing a start time
656              
657             # RETURNS:
658             # A Time::Piece object
659             #
660             sub _next_dow_time
661             {
662 0     0     my $self = shift;
663 0           my $dow = shift;
664 0   0       my $tp = shift || Time::Piece->new();
665 0           my $copy = $tp;
666 0           my $tries = 7;
667            
668 0           while ($tries) {
669 0           $copy = Time::Piece->new( timelocal(0,0,0,@{$copy}[3 .. 5]) );
  0            
670 0 0         if ($copy->_wday == $dow) {
671 0           return $copy;
672             }
673 0           $copy += ONE_DAY;
674 0           $tries --;
675             }
676 0           carp "Unable to find next day-of-week";
677 0           return undef;
678             }
679              
680              
681             # private method #
682             ##################
683             # _timesearch_mode()
684             #
685             # Based on an expanded cron array, determine what mode of operation is needed.
686             #
687             # mode 0: WDAY field is wide open, so only focus on MDAY and MON fields.
688             # mode 1: WDAY field is limited, but MON and MDAY fields are wide open.
689             # mode 2: WDAY and MON fields are both limited, but MDAY is wide open.
690             # mode 3: WDAY, MON, and MDAY fields are all limited. This is the worst case.
691             #
692             # PARAMS:
693             # 1. An expanded crontab array
694             #
695             # RETURNS:
696             # a number (0-3)
697             #
698             sub _timesearch_mode
699             {
700 0     0     my $self = shift;
701 0           my @ary = @_;
702            
703 0           my $mode = 0;
704 0           my $dmax = ($self->{ranges}->[2]->[-1] + 1)- $self->{ranges}->[2]->[0];
705 0           my $mmax = ($self->{ranges}->[3]->[-1] + 1)- $self->{ranges}->[3]->[0];
706 0           my $wmax = ($self->{ranges}->[4]->[-1] + 1) - $self->{ranges}->[4]->[0];
707            
708 0 0 0       if ($wmax == scalar(@{$ary[4]})) {
  0 0 0        
  0 0 0        
709 0           $mode = 0;
710 0           } elsif ( $wmax != scalar(@{$ary[4]}) and
711 0           $mmax != scalar(@{$ary[3]}) and
712 0           $dmax != scalar(@{$ary[3]}) ) {
713 0           $mode = 3;
714 0           } elsif ( $wmax != scalar(@{$ary[4]}) and
715             $mmax != scalar(@{$ary[3]}) ) {
716 0           $mode = 2;
717             } else {
718 0           $mode = 1;
719             }
720              
721 0           return $mode;
722             }
723              
724              
725             # private method #
726             ##################
727             # _next_possible()
728             #
729             # Select the next higher (or same) value from an array, based on a
730             # starting number.
731             # If no suitable value found, selects the first lower value.
732             #
733             # PARAMS:
734             # 1. A starting number.
735             # 2. An array-reference to an array of numbers.
736             #
737             # RETURNS:
738             # a number
739             #
740             sub _next_possible
741             {
742 0     0     my $self = shift;
743 0           my $number = shift;
744 0           my $aref = shift;
745            
746 0           foreach my $i (@{$aref}) {
  0            
747 0 0         return $i if ($i >= $number);
748             }
749            
750             # couldn't find same or higher, so return lowest possible
751 0           return $aref->[0];
752             }
753              
754              
755             =head1 AUTHOR
756              
757             Jeffrey Leary, C<< >>
758              
759             =head1 BUGS
760              
761             Please report any bugs or feature requests to C, or through
762             the web interface at L. I will be notified, and then you'll
763             automatically be notified of progress on your bug as I make changes.
764              
765             =head1 TO DO
766              
767             Add a last_time() method.
768              
769             Test harness is very rudimentary. Could use better tests.
770              
771             Possibly add ability to handle special characters (L, W, ?, \#) found in some
772             non-standard implementations of cron.
773              
774             =head1 SUPPORT
775              
776             You can find documentation for this module with the perldoc command.
777              
778             perldoc Time::Piece::Cron
779              
780              
781             You can also look for information at:
782              
783             =over 4
784              
785             =item * RT: CPAN's request tracker (report bugs here)
786              
787             L
788              
789             =item * AnnoCPAN: Annotated CPAN documentation
790              
791             L
792              
793             =item * CPAN Ratings
794              
795             L
796              
797             =item * Search CPAN
798              
799             L
800              
801             =back
802              
803              
804             =head1 ACKNOWLEDGEMENTS
805              
806              
807             =head1 SEE ALSO
808              
809             Time::Piece
810             L
811              
812             Cron
813             L
814              
815             =head1 LICENSE AND COPYRIGHT
816              
817             Copyright 2013 Jeffrey Leary.
818              
819             This program is free software; you can redistribute it and/or modify it
820             under the terms of either: the GNU General Public License as published
821             by the Free Software Foundation; or the Artistic License.
822              
823             See http://dev.perl.org/licenses/ for more information.
824              
825              
826             =cut
827              
828             1; # End of Time::Piece::Cron