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 |