line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DateTime::Event::Cron; |
2
|
|
|
|
|
|
|
|
3
|
7
|
|
|
7
|
|
2141080
|
use 5.006; |
|
7
|
|
|
|
|
18
|
|
4
|
7
|
|
|
7
|
|
26
|
use strict; |
|
7
|
|
|
|
|
9
|
|
|
7
|
|
|
|
|
129
|
|
5
|
7
|
|
|
7
|
|
21
|
use warnings; |
|
7
|
|
|
|
|
11
|
|
|
7
|
|
|
|
|
187
|
|
6
|
7
|
|
|
7
|
|
21
|
use Carp; |
|
7
|
|
|
|
|
8
|
|
|
7
|
|
|
|
|
422
|
|
7
|
|
|
|
|
|
|
|
8
|
7
|
|
|
7
|
|
30
|
use vars qw($VERSION); |
|
7
|
|
|
|
|
7
|
|
|
7
|
|
|
|
|
337
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
$VERSION = '0.09'; |
11
|
|
|
|
|
|
|
|
12
|
7
|
|
|
7
|
|
24
|
use constant DEBUG => 0; |
|
7
|
|
|
|
|
9
|
|
|
7
|
|
|
|
|
473
|
|
13
|
|
|
|
|
|
|
|
14
|
7
|
|
|
7
|
|
754
|
use DateTime; |
|
7
|
|
|
|
|
308203
|
|
|
7
|
|
|
|
|
139
|
|
15
|
7
|
|
|
7
|
|
3361
|
use DateTime::Set; |
|
7
|
|
|
|
|
229703
|
|
|
7
|
|
|
|
|
178
|
|
16
|
7
|
|
|
7
|
|
51
|
use DateTime::Duration; |
|
7
|
|
|
|
|
11
|
|
|
7
|
|
|
|
|
123
|
|
17
|
7
|
|
|
7
|
|
2592
|
use Set::Crontab; |
|
7
|
|
|
|
|
4572
|
|
|
7
|
|
|
|
|
15709
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my %Object_Attributes; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
### |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub from_cron { |
24
|
|
|
|
|
|
|
# Return cron as DateTime::Set |
25
|
29
|
|
|
29
|
1
|
12712
|
my $class = shift; |
26
|
29
|
50
|
|
|
|
121
|
my %sparms = @_ == 1 ? (cron => shift) : @_; |
27
|
29
|
|
|
|
|
32
|
my %parms; |
28
|
29
|
|
|
|
|
50
|
$parms{cron} = delete $sparms{cron}; |
29
|
29
|
|
|
|
|
77
|
$parms{user_mode} = delete $sparms{user_mode}; |
30
|
29
|
100
|
|
|
|
307
|
$parms{cron} or croak "Cron string parameter required.\n"; |
31
|
27
|
|
|
|
|
83
|
my $dtc = $class->new(%parms); |
32
|
22
|
|
|
|
|
67
|
$dtc->as_set(%sparms); |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub from_crontab { |
36
|
|
|
|
|
|
|
# Return list of DateTime::Sets based on entries from |
37
|
|
|
|
|
|
|
# a crontab file. |
38
|
1
|
|
|
1
|
1
|
102
|
my $class = shift; |
39
|
1
|
50
|
|
|
|
7
|
my %sparms = @_ == 1 ? (file => shift) : @_; |
40
|
1
|
|
|
|
|
3
|
my $file = delete $sparms{file}; |
41
|
1
|
|
|
|
|
1
|
delete $sparms{cron}; |
42
|
1
|
|
|
|
|
20
|
my $fh = $class->_prepare_fh($file); |
43
|
1
|
|
|
|
|
1
|
my @cronsets; |
44
|
1
|
|
|
|
|
5
|
while (<$fh>) { |
45
|
11
|
|
|
|
|
14
|
chomp; |
46
|
11
|
|
|
|
|
8
|
my $set; |
47
|
11
|
|
|
|
|
8
|
eval { $set = $class->from_cron(%sparms, cron => $_) }; |
|
11
|
|
|
|
|
21
|
|
48
|
11
|
100
|
66
|
|
|
481
|
push(@cronsets, $set) if ref $set && !$@; |
49
|
|
|
|
|
|
|
} |
50
|
1
|
|
|
|
|
4
|
@cronsets; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub as_set { |
54
|
|
|
|
|
|
|
# Return self as DateTime::Set |
55
|
22
|
|
|
22
|
1
|
22
|
my $self = shift; |
56
|
22
|
|
|
|
|
29
|
my %sparms = @_; |
57
|
|
|
|
|
|
|
Carp::cluck "Recurrence callbacks overriden by ". ref $self . "\n" |
58
|
22
|
50
|
33
|
|
|
117
|
if $sparms{next} || $sparms{recurrence} || $sparms{previous}; |
|
|
|
33
|
|
|
|
|
59
|
22
|
|
|
|
|
24
|
delete $sparms{next}; |
60
|
22
|
|
|
|
|
36
|
delete $sparms{previous}; |
61
|
22
|
|
|
|
|
43
|
delete $sparms{recurrence}; |
62
|
22
|
|
|
83
|
|
88
|
$sparms{next} = sub { $self->next(@_) }; |
|
83
|
|
|
|
|
32941
|
|
63
|
22
|
|
|
65
|
|
59
|
$sparms{previous} = sub { $self->previous(@_) }; |
|
65
|
|
|
|
|
36199
|
|
64
|
22
|
|
|
|
|
109
|
DateTime::Set->from_recurrence(%sparms); |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
### |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub new { |
70
|
54
|
|
|
54
|
0
|
7945
|
my $class = shift; |
71
|
54
|
|
|
|
|
77
|
my $self = {}; |
72
|
54
|
|
|
|
|
79
|
bless $self, $class; |
73
|
54
|
100
|
|
|
|
176
|
my %parms = @_ == 1 ? (cron => shift) : @_; |
74
|
54
|
|
|
|
|
172
|
my $crontab = $self->_make_cronset(%parms); |
75
|
33
|
|
|
|
|
59
|
$self->_cronset($crontab); |
76
|
33
|
|
|
|
|
60
|
$self; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
7
|
|
|
7
|
1
|
4563
|
sub new_from_cron { new(@_) } |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub new_from_crontab { |
82
|
0
|
|
|
0
|
1
|
0
|
my $class = shift; |
83
|
0
|
0
|
|
|
|
0
|
my %parms = @_ == 1 ? (file => shift()) : @_; |
84
|
0
|
|
|
|
|
0
|
my $fh = $class->_prepare_fh($parms{file}); |
85
|
0
|
|
|
|
|
0
|
delete $parms{file}; |
86
|
0
|
|
|
|
|
0
|
my @dtcrons; |
87
|
0
|
|
|
|
|
0
|
while (<$fh>) { |
88
|
0
|
|
|
|
|
0
|
my $dtc; |
89
|
0
|
|
|
|
|
0
|
eval { $dtc = $class->new(%parms, cron => $_) }; |
|
0
|
|
|
|
|
0
|
|
90
|
0
|
0
|
0
|
|
|
0
|
if (ref $dtc && !$@) { |
91
|
0
|
|
|
|
|
0
|
push(@dtcrons, $dtc); |
92
|
0
|
0
|
|
|
|
0
|
$parms{user_mode} = 1 if defined $dtc->user; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
} |
95
|
0
|
|
|
|
|
0
|
@dtcrons; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
### |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub _prepare_fh { |
101
|
1
|
|
|
1
|
|
1
|
my $class = shift; |
102
|
1
|
|
|
|
|
2
|
my $fh = shift; |
103
|
1
|
50
|
|
|
|
3
|
if (! ref $fh) { |
104
|
0
|
|
|
|
|
0
|
my $file = $fh; |
105
|
0
|
|
|
|
|
0
|
local(*FH); |
106
|
0
|
|
|
|
|
0
|
$fh = do { local *FH; *FH }; # doubled *FH avoids warning |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
107
|
0
|
0
|
|
|
|
0
|
open($fh, "<$file") |
108
|
|
|
|
|
|
|
or croak "Error opening $file for reading\n"; |
109
|
|
|
|
|
|
|
} |
110
|
1
|
|
|
|
|
2
|
$fh; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
### |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub valid { |
116
|
|
|
|
|
|
|
# Is the given date valid according the current cron settings? |
117
|
444
|
|
|
444
|
1
|
20946
|
my($self, $date) = @_; |
118
|
444
|
100
|
66
|
|
|
889
|
return if !$date || $date->second; |
119
|
432
|
100
|
100
|
|
|
8439
|
$self->minute->contains($date->minute) && |
|
|
|
100
|
|
|
|
|
120
|
|
|
|
|
|
|
$self->hour->contains($date->hour) && |
121
|
|
|
|
|
|
|
$self->days_contain($date->day, $date->dow) && |
122
|
|
|
|
|
|
|
$self->month->contains($date->month); |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub match { |
126
|
|
|
|
|
|
|
# Does the given date match the cron spec? |
127
|
0
|
|
|
0
|
1
|
0
|
my($self, $date) = @_; |
128
|
0
|
0
|
|
|
|
0
|
$date = DateTime->now unless $date; |
129
|
0
|
0
|
0
|
|
|
0
|
$self->minute->contains($date->minute) && |
|
|
|
0
|
|
|
|
|
130
|
|
|
|
|
|
|
$self->hour->contains($date->hour) && |
131
|
|
|
|
|
|
|
$self->days_contain($date->day, $date->dow) && |
132
|
|
|
|
|
|
|
$self->month->contains($date->month); |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
### Return adjacent dates without altering original date |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub next { |
138
|
99
|
|
|
99
|
1
|
22870
|
my($self, $date) = @_; |
139
|
99
|
|
66
|
|
|
231
|
$self->increment($date || DateTime->now); |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub previous { |
143
|
81
|
|
|
81
|
1
|
14579
|
my($self, $date) = @_; |
144
|
81
|
|
66
|
|
|
227
|
$self->decrement($date || DateTime->now); |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
### Change given date to adjacent dates |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
sub increment { |
150
|
99
|
|
|
99
|
1
|
2257
|
my($self, $date) = @_; |
151
|
99
|
50
|
|
|
|
164
|
$date = $date ? $date->clone : DateTime->now; |
152
|
99
|
100
|
|
|
|
2207
|
return $date if $date->is_infinite; |
153
|
77
|
|
|
|
|
201
|
do { |
154
|
78
|
|
|
|
|
121
|
$self->_attempt_increment($date); |
155
|
|
|
|
|
|
|
} until $self->valid($date); |
156
|
77
|
|
|
|
|
838
|
$date; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub decrement { |
160
|
81
|
|
|
81
|
1
|
1911
|
my($self, $date) = @_; |
161
|
81
|
50
|
|
|
|
149
|
$date = $date ? $date->clone : DateTime->now; |
162
|
81
|
100
|
|
|
|
1914
|
return $date if $date->is_infinite; |
163
|
59
|
|
|
|
|
163
|
do { |
164
|
59
|
|
|
|
|
118
|
$self->_attempt_decrement($date); |
165
|
|
|
|
|
|
|
} until $self->valid($date); |
166
|
59
|
|
|
|
|
678
|
$date; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
### |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
sub _attempt_increment { |
172
|
78
|
|
|
78
|
|
128
|
my($self, $date) = @_; |
173
|
78
|
50
|
|
|
|
145
|
ref $date or croak "Reference to datetime object reqired\n"; |
174
|
78
|
100
|
|
|
|
115
|
$self->valid($date) ? |
175
|
|
|
|
|
|
|
$self->_valid_incr($date) : |
176
|
|
|
|
|
|
|
$self->_invalid_incr($date); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
sub _attempt_decrement { |
180
|
59
|
|
|
59
|
|
69
|
my($self, $date) = @_; |
181
|
59
|
50
|
|
|
|
146
|
ref $date or croak "Reference to datetime object reqired\n"; |
182
|
59
|
100
|
|
|
|
93
|
$self->valid($date) ? |
183
|
|
|
|
|
|
|
$self->_valid_decr($date) : |
184
|
|
|
|
|
|
|
$self->_invalid_decr($date); |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
50
|
|
|
50
|
|
466
|
sub _valid_incr { shift->_incr(@_) } |
188
|
|
|
|
|
|
|
|
189
|
36
|
|
|
36
|
|
354
|
sub _valid_decr { shift->_decr(@_) } |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
sub _invalid_incr { |
192
|
|
|
|
|
|
|
# If provided date is valid, return it. Otherwise return |
193
|
|
|
|
|
|
|
# nearest valid date after provided date. |
194
|
28
|
|
|
28
|
|
332
|
my($self, $date) = @_; |
195
|
28
|
50
|
|
|
|
61
|
ref $date or croak "Reference to datetime object reqired\n"; |
196
|
|
|
|
|
|
|
|
197
|
28
|
|
|
|
|
27
|
print STDERR "\nI GOT: ", $date->datetime, "\n" if DEBUG; |
198
|
|
|
|
|
|
|
|
199
|
28
|
100
|
|
|
|
54
|
$date->truncate(to => 'minute')->add(minutes => 1) |
200
|
|
|
|
|
|
|
if $date->second; |
201
|
|
|
|
|
|
|
|
202
|
28
|
|
|
|
|
6153
|
print STDERR "RND: ", $date->datetime, "\n" if DEBUG; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# Find our greatest invalid unit and clip |
205
|
28
|
100
|
|
|
|
56
|
if (!$self->month->contains($date->month)) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
206
|
3
|
|
|
|
|
27
|
$date->truncate(to => 'month'); |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
elsif (!$self->days_contain($date->day, $date->dow)) { |
209
|
12
|
|
|
|
|
44
|
$date->truncate(to => 'day'); |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
elsif (!$self->hour->contains($date->hour)) { |
212
|
5
|
|
|
|
|
43
|
$date->truncate(to => 'hour'); |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
else { |
215
|
8
|
|
|
|
|
80
|
$date->truncate(to => 'minute'); |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
28
|
|
|
|
|
4317
|
print STDERR "BBT: ", $date->datetime, "\n" if DEBUG; |
219
|
|
|
|
|
|
|
|
220
|
28
|
100
|
|
|
|
79
|
return $date if $self->valid($date); |
221
|
|
|
|
|
|
|
|
222
|
25
|
|
|
|
|
194
|
print STDERR "ZZT: ", $date->datetime, "\n" if DEBUG; |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
# Extraneous durations clipped. Start searching. |
225
|
25
|
|
|
|
|
42
|
while (!$self->valid($date)) { |
226
|
40
|
|
|
|
|
334
|
$date->add(months => 1) until $self->month->contains($date->month); |
227
|
40
|
|
|
|
|
270
|
print STDERR "MON: ", $date->datetime, "\n" if DEBUG; |
228
|
|
|
|
|
|
|
|
229
|
40
|
|
|
|
|
82
|
my $day_orig = $date->day; |
230
|
40
|
|
|
|
|
144
|
$date->add(days => 1) until $self->days_contain($date->day, $date->dow); |
231
|
40
|
100
|
50
|
|
|
88
|
$date->truncate(to => 'month') && next if $date->day < $day_orig; |
232
|
35
|
|
|
|
|
126
|
print STDERR "DAY: ", $date->datetime, "\n" if DEBUG; |
233
|
|
|
|
|
|
|
|
234
|
35
|
|
|
|
|
80
|
my $hour_orig = $date->hour; |
235
|
35
|
|
|
|
|
134
|
$date->add(hours => 1) until $self->hour->contains($date->hour); |
236
|
35
|
100
|
50
|
|
|
291
|
$date->truncate(to => 'day') && next if $date->hour < $hour_orig; |
237
|
30
|
|
|
|
|
103
|
print STDERR "HOR: ", $date->datetime, "\n" if DEBUG; |
238
|
|
|
|
|
|
|
|
239
|
30
|
|
|
|
|
60
|
my $min_orig = $date->minute; |
240
|
30
|
|
|
|
|
112
|
$date->add(minutes => 1) until $self->minute->contains($date->minute); |
241
|
30
|
100
|
50
|
|
|
261
|
$date->truncate(to => 'hour') && next if $date->minute < $min_orig; |
242
|
25
|
|
|
|
|
121
|
print STDERR "MIN: ", $date->datetime, "\n" if DEBUG; |
243
|
|
|
|
|
|
|
} |
244
|
25
|
|
|
|
|
215
|
print STDERR "SET: ", $date->datetime, "\n" if DEBUG; |
245
|
25
|
|
|
|
|
83
|
$date; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
sub _invalid_decr { |
249
|
|
|
|
|
|
|
# If provided date is valid, return it. Otherwise |
250
|
|
|
|
|
|
|
# return the nearest previous valid date. |
251
|
23
|
|
|
23
|
|
234
|
my($self, $date) = @_; |
252
|
23
|
50
|
|
|
|
57
|
ref $date or croak "Reference to datetime object reqired\n"; |
253
|
|
|
|
|
|
|
|
254
|
23
|
|
|
|
|
18
|
print STDERR "\nD GOT: ", $date->datetime, "\n" if DEBUG; |
255
|
|
|
|
|
|
|
|
256
|
23
|
100
|
|
|
|
45
|
if (!$self->month->contains($date->month)) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
257
|
3
|
|
|
|
|
27
|
$date->truncate(to => 'month'); |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
elsif (!$self->days_contain($date->day, $date->dow)) { |
260
|
10
|
|
|
|
|
33
|
$date->truncate(to => 'day'); |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
elsif (!$self->hour->contains($date->hour)) { |
263
|
3
|
|
|
|
|
26
|
$date->truncate(to => 'hour'); |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
else { |
266
|
7
|
|
|
|
|
68
|
$date->truncate(to => 'minute'); |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
23
|
|
|
|
|
3606
|
print STDERR "BBT: ", $date->datetime, "\n" if DEBUG; |
270
|
|
|
|
|
|
|
|
271
|
23
|
100
|
|
|
|
49
|
return $date if $self->valid($date); |
272
|
|
|
|
|
|
|
|
273
|
20
|
|
|
|
|
161
|
print STDERR "ZZT: ", $date->datetime, "\n" if DEBUG; |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
# Extraneous durations clipped. Start searching. |
276
|
20
|
|
|
|
|
30
|
while (!$self->valid($date)) { |
277
|
34
|
100
|
|
|
|
308
|
if (!$self->month->contains($date->month)) { |
278
|
9
|
|
|
|
|
65
|
$date->subtract(months => 1) until $self->month->contains($date->month); |
279
|
9
|
|
|
|
|
103
|
$self->_unit_peak($date, 'month'); |
280
|
9
|
|
|
|
|
11088
|
print STDERR "MON: ", $date->datetime, "\n" if DEBUG; |
281
|
|
|
|
|
|
|
} |
282
|
34
|
100
|
|
|
|
225
|
if (!$self->days_contain($date->day, $date->dow)) { |
283
|
22
|
|
|
|
|
47
|
my $day_orig = $date->day; |
284
|
22
|
|
|
|
|
86
|
$date->subtract(days => 1) |
285
|
|
|
|
|
|
|
until $self->days_contain($date->day, $date->dow); |
286
|
22
|
100
|
50
|
|
|
51
|
$self->_unit_peak($date, 'month') && next if ($date->day > $day_orig); |
287
|
13
|
|
|
|
|
71
|
$self->_unit_peak($date, 'day'); |
288
|
13
|
|
|
|
|
15996
|
print STDERR "DAY: ", $date->datetime, "\n" if DEBUG; |
289
|
|
|
|
|
|
|
} |
290
|
25
|
100
|
|
|
|
63
|
if (!$self->hour->contains($date->hour)) { |
291
|
21
|
|
|
|
|
182
|
my $hour_orig = $date->hour; |
292
|
21
|
|
|
|
|
72
|
$date->subtract(hours => 1) until $self->hour->contains($date->hour); |
293
|
21
|
100
|
50
|
|
|
189
|
$self->_unit_peak($date, 'day') && next if ($date->hour > $hour_orig); |
294
|
18
|
|
|
|
|
80
|
$self->_unit_peak($date, 'hour'); |
295
|
18
|
|
|
|
|
21898
|
print STDERR "HOR: ", $date->datetime, "\n" if DEBUG; |
296
|
|
|
|
|
|
|
} |
297
|
22
|
50
|
|
|
|
95
|
if (!$self->minute->contains($date->minute)) { |
298
|
22
|
|
|
|
|
194
|
my $min_orig = $date->minute; |
299
|
22
|
|
|
|
|
92
|
$date->subtract(minutes => 1) |
300
|
|
|
|
|
|
|
until $self->minute->contains($date->minute); |
301
|
22
|
100
|
50
|
|
|
200
|
$self->_unit_peak($date, 'hour') && next if ($date->minute > $min_orig); |
302
|
20
|
|
|
|
|
119
|
print STDERR "MIN: ", $date->datetime, "\n" if DEBUG; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
} |
305
|
20
|
|
|
|
|
195
|
print STDERR "SET: ", $date->datetime, "\n" if DEBUG; |
306
|
20
|
|
|
|
|
75
|
$date; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
### |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
sub _unit_peak { |
312
|
54
|
|
|
54
|
|
134
|
my($self, $date, $unit) = @_; |
313
|
54
|
50
|
33
|
|
|
140
|
$date && $unit or croak "DateTime ref and unit required.\n"; |
314
|
54
|
|
|
|
|
1743
|
$date->truncate(to => $unit) |
315
|
|
|
|
|
|
|
->add($unit . 's' => 1) |
316
|
|
|
|
|
|
|
->subtract(minutes => 1); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
sub _next_day { |
320
|
40
|
|
|
40
|
|
47
|
my($self, $year, $mon, $day) = @_; |
321
|
40
|
|
|
|
|
106
|
my $dt = DateTime->new(year => $year, month => $mon, day => $day); |
322
|
32
|
|
|
|
|
5819
|
my $dur = DateTime::Duration->new(days => 1); |
323
|
32
|
|
|
|
|
1881
|
$dt->add_duration($dur); |
324
|
32
|
|
|
|
|
15490
|
while (! $self->days_contain($dt->day, $dt->day_of_week)) { |
325
|
395
|
|
|
|
|
829
|
$dt->add_duration($dur); |
326
|
|
|
|
|
|
|
} |
327
|
32
|
|
|
|
|
73
|
$dt->day; |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub _prev_day { |
331
|
31
|
|
|
31
|
|
39
|
my($self, $year, $mon, $day) = @_; |
332
|
31
|
|
|
|
|
91
|
my $dt = DateTime->new(year => $year, month => $mon, day => $day); |
333
|
24
|
|
|
|
|
4423
|
my $dur = DateTime::Duration->new(days => 1); |
334
|
24
|
|
|
|
|
1306
|
$dt->subtract_duration($dur); |
335
|
24
|
|
|
|
|
13048
|
while (! $self->days_contain($dt->day, $dt->day_of_week)) { |
336
|
394
|
|
|
|
|
830
|
$dt->subtract_duration($dur); |
337
|
|
|
|
|
|
|
} |
338
|
24
|
|
|
|
|
64
|
$dt->day; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
### Unit cascades |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
sub _incr { |
344
|
50
|
|
|
50
|
|
54
|
my($self, $date) = @_; |
345
|
50
|
|
|
|
|
83
|
my $last_min = $date->minute; |
346
|
50
|
|
|
|
|
152
|
my $last_hour = $date->hour; |
347
|
50
|
|
|
|
|
178
|
my $last_day = $date->day; |
348
|
50
|
|
|
|
|
142
|
my $last_month = $date->month; |
349
|
50
|
|
|
|
|
145
|
my $year = $date->year; |
350
|
50
|
|
|
|
|
146
|
my($next_min, $next_hour, $next_day, $next_month) = |
351
|
|
|
|
|
|
|
($last_min, $last_hour, $last_day, $last_month); |
352
|
50
|
|
|
|
|
42
|
while (1) { |
353
|
72
|
|
|
|
|
93
|
$next_min = $self->minute->next($last_min); |
354
|
72
|
100
|
|
|
|
130
|
if ($next_min <= $last_min) { |
355
|
48
|
|
|
|
|
72
|
$next_hour = $self->hour->next($last_hour); |
356
|
48
|
100
|
|
|
|
85
|
if ($next_hour <= $last_hour) { |
357
|
40
|
|
|
|
|
40
|
eval { $next_day = $self->_next_day($year, $last_month, $last_day) }; |
|
40
|
|
|
|
|
68
|
|
358
|
40
|
100
|
66
|
|
|
1499
|
if ($next_day <= $last_day || $@) { |
359
|
19
|
|
|
|
|
45
|
$next_month = $self->month->next($last_month); |
360
|
19
|
100
|
|
|
|
39
|
if ($next_month <= $last_month) { |
361
|
9
|
|
|
|
|
8
|
$year += 1; |
362
|
|
|
|
|
|
|
} |
363
|
19
|
|
|
|
|
26
|
$last_month = $next_month; |
364
|
|
|
|
|
|
|
} |
365
|
40
|
|
|
|
|
37
|
$last_day = $next_day; |
366
|
|
|
|
|
|
|
} |
367
|
48
|
|
|
|
|
49
|
$last_hour = $next_hour; |
368
|
|
|
|
|
|
|
} |
369
|
72
|
|
|
|
|
62
|
$last_min = $next_min; |
370
|
72
|
|
|
|
|
67
|
eval { |
371
|
72
|
|
|
|
|
167
|
$date->set( |
372
|
|
|
|
|
|
|
minute => $next_min, |
373
|
|
|
|
|
|
|
hour => $next_hour, |
374
|
|
|
|
|
|
|
day => $next_day, |
375
|
|
|
|
|
|
|
month => $next_month, |
376
|
|
|
|
|
|
|
year => $year, |
377
|
|
|
|
|
|
|
); |
378
|
|
|
|
|
|
|
}; |
379
|
72
|
100
|
|
|
|
22814
|
last unless $@; |
380
|
|
|
|
|
|
|
} |
381
|
50
|
|
|
|
|
186
|
$date; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub _decr { |
385
|
36
|
|
|
36
|
|
49
|
my($self, $date) = @_; |
386
|
36
|
|
|
|
|
69
|
my $last_min = $date->minute; |
387
|
36
|
|
|
|
|
125
|
my $last_hour = $date->hour; |
388
|
36
|
|
|
|
|
118
|
my $last_day = $date->day; |
389
|
36
|
|
|
|
|
106
|
my $last_month = $date->month; |
390
|
36
|
|
|
|
|
111
|
my $year = $date->year; |
391
|
36
|
|
|
|
|
106
|
my($prev_min, $prev_hour, $prev_day, $prev_month) = |
392
|
|
|
|
|
|
|
($last_min, $last_hour, $last_day, $last_month); |
393
|
36
|
|
|
|
|
39
|
while (1) { |
394
|
68
|
|
|
|
|
101
|
$prev_min = $self->minute->previous($last_min); |
395
|
68
|
100
|
|
|
|
125
|
if ($prev_min >= $last_min) { |
396
|
43
|
|
|
|
|
62
|
$prev_hour = $self->hour->previous($last_hour); |
397
|
43
|
100
|
|
|
|
81
|
if ($prev_hour >= $last_hour) { |
398
|
31
|
|
|
|
|
33
|
eval { $prev_day = $self->_prev_day($year, $last_month, $last_day) }; |
|
31
|
|
|
|
|
63
|
|
399
|
31
|
100
|
66
|
|
|
1240
|
if ($prev_day >= $last_day || $@) { |
400
|
21
|
|
|
|
|
49
|
$prev_month = $self->month->previous($last_month); |
401
|
21
|
100
|
|
|
|
53
|
if ($prev_month >= $last_month) { |
402
|
12
|
|
|
|
|
13
|
$year -= 1; |
403
|
|
|
|
|
|
|
} |
404
|
21
|
|
|
|
|
24
|
$last_month = $prev_month; |
405
|
|
|
|
|
|
|
} |
406
|
31
|
|
|
|
|
29
|
$last_day = $prev_day; |
407
|
|
|
|
|
|
|
} |
408
|
43
|
|
|
|
|
59
|
$last_hour = $prev_hour; |
409
|
|
|
|
|
|
|
} |
410
|
68
|
|
|
|
|
57
|
$last_min = $prev_min; |
411
|
68
|
|
|
|
|
63
|
eval { |
412
|
68
|
|
|
|
|
190
|
$date->set( |
413
|
|
|
|
|
|
|
minute => $prev_min, |
414
|
|
|
|
|
|
|
hour => $prev_hour, |
415
|
|
|
|
|
|
|
day => $prev_day, |
416
|
|
|
|
|
|
|
month => $prev_month, |
417
|
|
|
|
|
|
|
year => $year, |
418
|
|
|
|
|
|
|
); |
419
|
|
|
|
|
|
|
}; |
420
|
68
|
100
|
|
|
|
21591
|
last unless $@; |
421
|
|
|
|
|
|
|
} |
422
|
36
|
|
|
|
|
137
|
$date; |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
### Factories |
426
|
|
|
|
|
|
|
|
427
|
54
|
|
|
54
|
|
45
|
sub _make_cronset { shift; DateTime::Event::Cron::IntegratedSet->new(@_) } |
|
54
|
|
|
|
|
144
|
|
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
### Shortcuts |
430
|
|
|
|
|
|
|
|
431
|
1832
|
|
|
1832
|
0
|
703098
|
sub days_contain { shift->_cronset->days_contain(@_) } |
432
|
|
|
|
|
|
|
|
433
|
2123
|
|
|
2123
|
0
|
811722
|
sub minute { shift->_cronset->minute } |
434
|
1074
|
|
|
1074
|
0
|
305657
|
sub hour { shift->_cronset->hour } |
435
|
0
|
|
|
0
|
0
|
0
|
sub dom { shift->_cronset->dom } |
436
|
544
|
|
|
544
|
0
|
53321
|
sub month { shift->_cronset->month } |
437
|
0
|
|
|
0
|
0
|
0
|
sub dow { shift->_cronset->dow } |
438
|
0
|
|
|
0
|
1
|
0
|
sub user { shift->_cronset->user } |
439
|
0
|
|
|
0
|
1
|
0
|
sub command { shift->_cronset->command } |
440
|
0
|
|
|
0
|
1
|
0
|
sub original { shift->_cronset->original } |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
### Static acessors/mutators |
443
|
|
|
|
|
|
|
|
444
|
5606
|
|
|
5606
|
|
7234
|
sub _cronset { shift->_attr('cronset', @_) } |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
sub _attr { |
447
|
5606
|
|
|
5606
|
|
4369
|
my $self = shift; |
448
|
5606
|
|
|
|
|
4201
|
my $name = shift; |
449
|
5606
|
100
|
|
|
|
8482
|
if (@_) { |
450
|
33
|
|
|
|
|
94
|
$Object_Attributes{$self}{$name} = shift; |
451
|
|
|
|
|
|
|
} |
452
|
5606
|
|
|
|
|
13163
|
$Object_Attributes{$self}{$name}; |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
### debugging |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
sub _dump_sets { |
458
|
0
|
|
|
0
|
|
0
|
my($self, $date) = @_; |
459
|
0
|
|
|
|
|
0
|
foreach (qw(minute hour dom month dow)) { |
460
|
0
|
|
|
|
|
0
|
print STDERR "$_: ", join(',',$self->$_->list), "\n"; |
461
|
|
|
|
|
|
|
} |
462
|
0
|
0
|
|
|
|
0
|
if (ref $date) { |
463
|
0
|
|
|
|
|
0
|
$date = $date->clone; |
464
|
0
|
|
|
|
|
0
|
my @mod; |
465
|
0
|
|
|
|
|
0
|
my $mon = $date->month; |
466
|
0
|
|
|
|
|
0
|
$date->truncate(to => 'month'); |
467
|
0
|
|
|
|
|
0
|
while ($date->month == $mon) { |
468
|
0
|
0
|
|
|
|
0
|
push(@mod, $date->day) if $self->days_contain($date->day, $date->dow); |
469
|
0
|
|
|
|
|
0
|
$date->add(days => 1); |
470
|
|
|
|
|
|
|
} |
471
|
0
|
|
|
|
|
0
|
print STDERR "mod for month($mon): ", join(',', @mod), "\n"; |
472
|
|
|
|
|
|
|
} |
473
|
0
|
|
|
|
|
0
|
print STDERR "day_squelch: ", $self->_cronset->day_squelch, " ", |
474
|
|
|
|
|
|
|
"dow_squelch: ", $self->_cronset->dow_squelch, "\n"; |
475
|
0
|
|
|
|
|
0
|
$self; |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
### |
479
|
|
|
|
|
|
|
|
480
|
54
|
|
|
54
|
|
6923
|
sub DESTROY { delete $Object_Attributes{shift()} } |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
########## |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
{ |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
package DateTime::Event::Cron::IntegratedSet; |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
# IntegratedSet manages the collection of field sets for |
489
|
|
|
|
|
|
|
# each cron entry, including sanity checks. Individual |
490
|
|
|
|
|
|
|
# field sets are accessed through their respective names, |
491
|
|
|
|
|
|
|
# i.e., minute hour dom month dow. |
492
|
|
|
|
|
|
|
# |
493
|
|
|
|
|
|
|
# Also implements some merged field logic for dom/dow |
494
|
|
|
|
|
|
|
# interactions. |
495
|
|
|
|
|
|
|
|
496
|
7
|
|
|
7
|
|
44
|
use strict; |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
132
|
|
497
|
7
|
|
|
7
|
|
24
|
use Carp; |
|
7
|
|
|
|
|
7
|
|
|
7
|
|
|
|
|
6934
|
|
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
my %Range = ( |
500
|
|
|
|
|
|
|
minute => [0..59], |
501
|
|
|
|
|
|
|
hour => [0..23], |
502
|
|
|
|
|
|
|
dom => [1..31], |
503
|
|
|
|
|
|
|
month => [1..12], |
504
|
|
|
|
|
|
|
dow => [1..7], |
505
|
|
|
|
|
|
|
); |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
my @Month_Max = qw( 31 29 31 30 31 30 31 31 30 31 30 31 ); |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
my %Object_Attributes; |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
sub new { |
512
|
54
|
|
|
54
|
|
61
|
my $self = []; |
513
|
54
|
|
|
|
|
68
|
bless $self, shift; |
514
|
54
|
|
|
|
|
116
|
$self->_range(\%Range); |
515
|
54
|
|
|
|
|
108
|
$self->set_cron(@_); |
516
|
33
|
|
|
|
|
39
|
$self; |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
sub set_cron { |
520
|
|
|
|
|
|
|
# Initialize |
521
|
54
|
|
|
54
|
|
54
|
my $self = shift; |
522
|
54
|
|
|
|
|
85
|
my %parms = @_; |
523
|
54
|
|
|
|
|
72
|
my $cron = $parms{cron}; |
524
|
54
|
|
|
|
|
55
|
my $user_mode = $parms{user_mode}; |
525
|
54
|
100
|
|
|
|
178
|
defined $cron or croak "Cron entry fields required\n"; |
526
|
53
|
|
|
|
|
78
|
$self->_attr('original', $cron); |
527
|
53
|
|
|
|
|
47
|
my @line; |
528
|
53
|
100
|
|
|
|
85
|
if (ref $cron) { |
529
|
1
|
|
|
|
|
7
|
@line = grep(!/^\s*$/, @$cron); |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
else { |
532
|
52
|
|
|
|
|
132
|
$cron =~ s/^\s+//; |
533
|
52
|
|
|
|
|
141
|
$cron =~ s/\s+$//; |
534
|
52
|
|
|
|
|
235
|
@line = split(/\s+/, $cron); |
535
|
|
|
|
|
|
|
} |
536
|
53
|
100
|
|
|
|
876
|
@line >= 5 or croak "At least five cron entry fields required.\n"; |
537
|
44
|
|
|
|
|
159
|
my @entry = splice(@line, 0, 5); |
538
|
44
|
|
|
|
|
56
|
my($user, $command); |
539
|
44
|
50
|
|
|
|
83
|
unless (defined $user_mode) { |
540
|
|
|
|
|
|
|
# auto-detect |
541
|
44
|
100
|
66
|
|
|
128
|
if (@line > 1 && $line[0] =~ /^\w+$/) { |
542
|
4
|
|
|
|
|
4
|
$user_mode = 1; |
543
|
|
|
|
|
|
|
} |
544
|
|
|
|
|
|
|
} |
545
|
44
|
100
|
|
|
|
81
|
$user = shift @line if $user_mode; |
546
|
44
|
|
|
|
|
83
|
$command = join(' ', @line); |
547
|
44
|
|
|
|
|
62
|
$self->_attr('command', $command); |
548
|
44
|
|
|
|
|
60
|
$self->_attr('user', $user); |
549
|
44
|
|
|
|
|
50
|
my $i = 0; |
550
|
44
|
|
|
|
|
65
|
foreach my $name (qw( minute hour dom month dow )) { |
551
|
199
|
|
|
|
|
287
|
$self->_attr($name, $self->make_valid_set($name, $entry[$i])); |
552
|
190
|
|
|
|
|
187
|
++$i; |
553
|
|
|
|
|
|
|
} |
554
|
35
|
|
|
|
|
69
|
my @dom_list = $self->dom->list; |
555
|
35
|
|
|
|
|
223
|
my @dow_list = $self->dow->list; |
556
|
35
|
|
|
|
|
143
|
my $dom_range = $self->range('dom'); |
557
|
35
|
|
|
|
|
53
|
my $dow_range = $self->range('dow'); |
558
|
35
|
100
|
100
|
|
|
184
|
$self->dom_squelch(scalar @dom_list == scalar @$dom_range && |
559
|
|
|
|
|
|
|
scalar @dow_list != scalar @$dow_range ? 1 : 0); |
560
|
35
|
100
|
100
|
|
|
165
|
$self->dow_squelch(scalar @dow_list == scalar @$dow_range && |
561
|
|
|
|
|
|
|
scalar @dom_list != scalar @$dom_range ? 1 : 0); |
562
|
35
|
100
|
|
|
|
50
|
unless ($self->dom_squelch) { |
563
|
29
|
|
|
|
|
44
|
my @doms = $self->dom->list; |
564
|
29
|
|
|
|
|
143
|
my $pass = 0; |
565
|
29
|
|
|
|
|
63
|
MONTH: foreach my $month ($self->month->list) { |
566
|
33
|
|
|
|
|
115
|
foreach (@doms) { |
567
|
33
|
100
|
50
|
|
|
138
|
++$pass && last MONTH if $_ <= $Month_Max[$month - 1]; |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
} |
570
|
29
|
100
|
|
|
|
234
|
croak "Impossible last day for provided months.\n" unless $pass; |
571
|
|
|
|
|
|
|
} |
572
|
33
|
|
|
|
|
90
|
$self; |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
# Field range queries |
576
|
|
|
|
|
|
|
sub range { |
577
|
269
|
|
|
269
|
|
201
|
my($self, $name) = @_; |
578
|
269
|
50
|
|
|
|
304
|
my $val = $self->_range->{$name} or croak "Unknown field '$name'\n"; |
579
|
269
|
|
|
|
|
254
|
$val; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
# Perform sanity checks when setting up each field set. |
583
|
|
|
|
|
|
|
sub make_valid_set { |
584
|
199
|
|
|
199
|
|
209
|
my($self, $name, $str) = @_; |
585
|
199
|
|
|
|
|
239
|
my $range = $self->range($name); |
586
|
199
|
|
|
|
|
265
|
my $set = $self->make_set($str, $range); |
587
|
199
|
|
|
|
|
305
|
my @list = $set->list; |
588
|
199
|
100
|
|
|
|
1146
|
croak "Malformed cron field '$str'\n" unless @list; |
589
|
197
|
100
|
|
|
|
782
|
croak "Field value ($list[-1]) out of range ($range->[0]-$range->[-1])\n" |
590
|
|
|
|
|
|
|
if $list[-1] > $range->[-1]; |
591
|
192
|
100
|
100
|
|
|
413
|
if ($name eq 'dow' && $set->contains(0)) { |
592
|
3
|
|
|
|
|
18
|
shift(@list); |
593
|
3
|
50
|
|
|
|
12
|
push(@list, 7) unless $set->contains(7); |
594
|
3
|
|
|
|
|
23
|
$set = $self->make_set(join(',',@list), $range); |
595
|
|
|
|
|
|
|
} |
596
|
192
|
100
|
|
|
|
616
|
croak "Field value ($list[0]) out of range ($range->[0]-$range->[-1])\n" |
597
|
|
|
|
|
|
|
if $list[0] < $range->[0]; |
598
|
190
|
|
|
|
|
341
|
$set; |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
# No sanity checks |
602
|
202
|
|
|
202
|
|
140
|
sub make_set { shift; DateTime::Event::Cron::OrderedSet->new(@_) } |
|
202
|
|
|
|
|
303
|
|
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
# Flags for when dom/dow are applied. |
605
|
1902
|
|
|
1902
|
|
2188
|
sub dom_squelch { shift->_attr('dom_squelch', @_ ) } |
606
|
1694
|
|
|
1694
|
|
1815
|
sub dow_squelch { shift->_attr('dow_squelch', @_ ) } |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
# Merged logic for dom/dow |
609
|
|
|
|
|
|
|
sub days_contain { |
610
|
1832
|
|
|
1832
|
|
1839
|
my($self, $dom, $dow) = @_; |
611
|
1832
|
50
|
33
|
|
|
6110
|
defined $dom && defined $dow |
612
|
|
|
|
|
|
|
or croak "Day of month and day of week required.\n"; |
613
|
1832
|
|
|
|
|
2210
|
my $dom_c = $self->dom->contains($dom); |
614
|
1832
|
|
|
|
|
8083
|
my $dow_c = $self->dow->contains($dow); |
615
|
1832
|
100
|
|
|
|
6906
|
return $dow_c if $self->dom_squelch; |
616
|
1659
|
100
|
|
|
|
1811
|
return $dom_c if $self->dow_squelch; |
617
|
269
|
100
|
|
|
|
1118
|
$dom_c || $dow_c; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
# Set Accessors |
621
|
2123
|
|
|
2123
|
|
2760
|
sub minute { shift->_attr('minute' ) } |
622
|
1074
|
|
|
1074
|
|
1374
|
sub hour { shift->_attr('hour' ) } |
623
|
1896
|
|
|
1896
|
|
2207
|
sub dom { shift->_attr('dom' ) } |
624
|
573
|
|
|
573
|
|
761
|
sub month { shift->_attr('month' ) } |
625
|
1867
|
|
|
1867
|
|
2007
|
sub dow { shift->_attr('dow' ) } |
626
|
0
|
|
|
0
|
|
0
|
sub user { shift->_attr('user' ) } |
627
|
0
|
|
|
0
|
|
0
|
sub command { shift->_attr('command') } |
628
|
0
|
|
|
0
|
|
0
|
sub original { shift->_attr('original') } |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
# Accessors/mutators |
631
|
323
|
|
|
323
|
|
395
|
sub _range { shift->_attr('range', @_) } |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
sub _attr { |
634
|
11783
|
|
|
11783
|
|
7635
|
my $self = shift; |
635
|
11783
|
|
|
|
|
7735
|
my $name = shift; |
636
|
11783
|
100
|
|
|
|
14189
|
if (@_) { |
637
|
455
|
|
|
|
|
832
|
$Object_Attributes{$self}{$name} = shift; |
638
|
|
|
|
|
|
|
} |
639
|
11783
|
|
|
|
|
29079
|
$Object_Attributes{$self}{$name}; |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
|
642
|
54
|
|
|
54
|
|
181
|
sub DESTROY { delete $Object_Attributes{shift()} } |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
} |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
########## |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
{ |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
package DateTime::Event::Cron::OrderedSet; |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
# Extends Set::Crontab with some progression logic (next/prev) |
653
|
|
|
|
|
|
|
|
654
|
7
|
|
|
7
|
|
36
|
use strict; |
|
7
|
|
|
|
|
8
|
|
|
7
|
|
|
|
|
129
|
|
655
|
7
|
|
|
7
|
|
27
|
use Carp; |
|
7
|
|
|
|
|
7
|
|
|
7
|
|
|
|
|
311
|
|
656
|
7
|
|
|
7
|
|
25
|
use base 'Set::Crontab'; |
|
7
|
|
|
|
|
8
|
|
|
7
|
|
|
|
|
2611
|
|
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
my %Object_Attributes; |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
sub new { |
661
|
202
|
|
|
202
|
|
152
|
my $class = shift; |
662
|
202
|
|
|
|
|
171
|
my($string, $range) = @_; |
663
|
202
|
50
|
33
|
|
|
666
|
defined $string && ref $range |
664
|
|
|
|
|
|
|
or croak "Cron field and range ref required.\n"; |
665
|
202
|
|
|
|
|
431
|
my $self = Set::Crontab->new($string, $range); |
666
|
202
|
|
|
|
|
8437
|
bless $self, $class; |
667
|
202
|
|
|
|
|
377
|
my @list = $self->list; |
668
|
202
|
|
|
|
|
852
|
my(%next, %prev); |
669
|
202
|
|
|
|
|
321
|
foreach (0 .. $#list) { |
670
|
2498
|
|
|
|
|
2577
|
$next{$list[$_]} = $list[($_+1)%@list]; |
671
|
2498
|
|
|
|
|
2782
|
$prev{$list[$_]} = $list[($_-1)%@list]; |
672
|
|
|
|
|
|
|
} |
673
|
202
|
|
|
|
|
302
|
$self->_attr('next', \%next); |
674
|
202
|
|
|
|
|
265
|
$self->_attr('previous', \%prev); |
675
|
202
|
|
|
|
|
413
|
$self; |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
sub next { |
679
|
139
|
|
|
139
|
|
129
|
my($self, $entry) = @_; |
680
|
139
|
|
|
|
|
180
|
my $hash = $self->_attr('next'); |
681
|
139
|
50
|
|
|
|
243
|
croak "Missing entry($entry) in set\n" unless exists $hash->{$entry}; |
682
|
139
|
|
|
|
|
130
|
my $next = $hash->{$entry}; |
683
|
139
|
50
|
|
|
|
260
|
wantarray ? ($next, $next <= $entry) : $next; |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
sub previous { |
687
|
132
|
|
|
132
|
|
132
|
my($self, $entry) = @_; |
688
|
132
|
|
|
|
|
187
|
my $hash = $self->_attr('previous'); |
689
|
132
|
50
|
|
|
|
239
|
croak "Missing entry($entry) in set\n" unless exists $hash->{$entry}; |
690
|
132
|
|
|
|
|
133
|
my $prev = $hash->{$entry}; |
691
|
132
|
50
|
|
|
|
241
|
wantarray ? ($prev, $prev >= $entry) : $prev; |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
sub _attr { |
695
|
675
|
|
|
675
|
|
486
|
my $self = shift; |
696
|
675
|
|
|
|
|
517
|
my $name = shift; |
697
|
675
|
100
|
|
|
|
902
|
if (@_) { |
698
|
404
|
|
|
|
|
730
|
$Object_Attributes{$self}{$name} = shift; |
699
|
|
|
|
|
|
|
} |
700
|
675
|
|
|
|
|
907
|
$Object_Attributes{$self}{$name}; |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
|
703
|
202
|
|
|
202
|
|
1626
|
sub DESTROY { delete $Object_Attributes{shift()} } |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
### |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
1; |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
__END__ |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
=head1 NAME |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
DateTime::Event::Cron - DateTime extension for generating recurrence |
716
|
|
|
|
|
|
|
sets from crontab lines and files. |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=head1 SYNOPSIS |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
use DateTime::Event::Cron; |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
# check if a date matches (defaults to current time) |
723
|
|
|
|
|
|
|
my $c = DateTime::Event::Cron->new('* 2 * * *'); |
724
|
|
|
|
|
|
|
if ($c->match) { |
725
|
|
|
|
|
|
|
# do stuff |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
if ($c->match($date)) { |
728
|
|
|
|
|
|
|
# do something else for datetime $date |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
# DateTime::Set construction from crontab line |
732
|
|
|
|
|
|
|
$crontab = '*/3 15 1-10 3,4,5 */2'; |
733
|
|
|
|
|
|
|
$set = DateTime::Event::Cron->from_cron($crontab); |
734
|
|
|
|
|
|
|
$iter = $set->iterator(after => DateTime->now); |
735
|
|
|
|
|
|
|
while (1) { |
736
|
|
|
|
|
|
|
my $next = $iter->next; |
737
|
|
|
|
|
|
|
my $now = DateTime->now; |
738
|
|
|
|
|
|
|
sleep(($next->subtract_datetime_absolute($now))->seconds); |
739
|
|
|
|
|
|
|
# do stuff... |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
# List of DateTime::Set objects from crontab file |
743
|
|
|
|
|
|
|
@sets = DateTime::Event::Cron->from_crontab(file => '/etc/crontab'); |
744
|
|
|
|
|
|
|
$now = DateTime->now; |
745
|
|
|
|
|
|
|
print "Now: ", $now->datetime, "\n"; |
746
|
|
|
|
|
|
|
foreach (@sets) { |
747
|
|
|
|
|
|
|
my $next = $_->next($now); |
748
|
|
|
|
|
|
|
print $next->datetime, "\n"; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
# DateTime::Set parameters |
752
|
|
|
|
|
|
|
$crontab = '* * * * *'; |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
$now = DateTime->now; |
755
|
|
|
|
|
|
|
%set_parms = ( after => $now ); |
756
|
|
|
|
|
|
|
$set = DateTime::Event::Cron->from_cron(cron => $crontab, %set_parms); |
757
|
|
|
|
|
|
|
$dt = $set->next; |
758
|
|
|
|
|
|
|
print "Now: ", $now->datetime, " and next: ", $dt->datetime, "\n"; |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
# Spans for DateTime::Set |
761
|
|
|
|
|
|
|
$crontab = '* * * * *'; |
762
|
|
|
|
|
|
|
$now = DateTime->now; |
763
|
|
|
|
|
|
|
$now2 = $now->clone; |
764
|
|
|
|
|
|
|
$span = DateTime::Span->from_datetimes( |
765
|
|
|
|
|
|
|
start => $now->add(minutes => 1), |
766
|
|
|
|
|
|
|
end => $now2->add(hours => 1), |
767
|
|
|
|
|
|
|
); |
768
|
|
|
|
|
|
|
%parms = (cron => $crontab, span => $span); |
769
|
|
|
|
|
|
|
$set = DateTime::Event::Cron->from_cron(%parms); |
770
|
|
|
|
|
|
|
# ...do things with the DateTime::Set |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
# Every RTFCT relative to 12am Jan 1st this year |
773
|
|
|
|
|
|
|
$crontab = '7-10 6,12-15 10-28/2 */3 3,4,5'; |
774
|
|
|
|
|
|
|
$date = DateTime->now->truncate(to => 'year'); |
775
|
|
|
|
|
|
|
$set = DateTime::Event::Cron->from_cron(cron => $crontab, after => $date); |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
# Rather than generating DateTime::Set objects, next/prev |
778
|
|
|
|
|
|
|
# calculations can be made directly: |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
# Every day at 10am, 2pm, and 6pm. Reference date |
781
|
|
|
|
|
|
|
# defaults to DateTime->now. |
782
|
|
|
|
|
|
|
$crontab = '10,14,18 * * * *'; |
783
|
|
|
|
|
|
|
$dtc = DateTime::Event::Cron->new_from_cron(cron => $crontab); |
784
|
|
|
|
|
|
|
$next_datetime = $dtc->next; |
785
|
|
|
|
|
|
|
$last_datetime = $dtc->previous; |
786
|
|
|
|
|
|
|
... |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
# List of DateTime::Event::Cron objects from |
789
|
|
|
|
|
|
|
# crontab file |
790
|
|
|
|
|
|
|
@dtc = DateTime::Event::Cron->new_from_crontab(file => '/etc/crontab'); |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
# Full cron lines with user, such as from /etc/crontab |
793
|
|
|
|
|
|
|
# or files in /etc/cron.d, are supported and auto-detected: |
794
|
|
|
|
|
|
|
$crontab = '* * * * * gump /bin/date'; |
795
|
|
|
|
|
|
|
$dtc = DateTime::Event::Cron->new(cron => $crontab); |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
# Auto-detection of users is disabled if you explicitly |
798
|
|
|
|
|
|
|
# enable/disable via the user_mode parameter: |
799
|
|
|
|
|
|
|
$dtc = DateTime::Event::Cron->new(cron => $crontab, user_mode => 1); |
800
|
|
|
|
|
|
|
my $user = $dtc->user; |
801
|
|
|
|
|
|
|
my $command = $dtc->command; |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
# Unparsed original cron entry |
804
|
|
|
|
|
|
|
my $original = $dtc->original; |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
=head1 DESCRIPTION |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
DateTime::Event::Cron generated DateTime events or DateTime::Set objects |
809
|
|
|
|
|
|
|
based on crontab-style entries. |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
=head1 METHODS |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
The cron fields are typical crontab-style entries. For more information, |
814
|
|
|
|
|
|
|
see L<crontab(5)> and extensions described in L<Set::Crontab>. The |
815
|
|
|
|
|
|
|
fields can be passed as a single string or as a reference to an array |
816
|
|
|
|
|
|
|
containing each field. Only the first five fields are retained. |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
=head2 DateTime::Set Factories |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
See L<DateTime::Set> for methods provided by Set objects, such as |
821
|
|
|
|
|
|
|
C<next()> and C<previous()>. |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=over 4 |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
=item from_cron($cronline) |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=item from_cron(cron => $cronline, %parms, %set_parms) |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
Generates a DateTime::Set recurrence for the cron line provided. See |
830
|
|
|
|
|
|
|
new() for details on %parms. Optionally takes parameters for |
831
|
|
|
|
|
|
|
DateTime::Set. |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=item from_crontab(file => $crontab_fh, %parms, %set_parms) |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
Returns a list of DateTime::Set recurrences based on lines from a |
836
|
|
|
|
|
|
|
crontab file. C<$crontab_fh> can be either a filename or filehandle |
837
|
|
|
|
|
|
|
reference. See new() for details on %parm. Optionally takes parameters |
838
|
|
|
|
|
|
|
for DateTime::Set which will be passed along to each set for each line. |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
=item as_set(%set_parms) |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
Generates a DateTime::Set recurrence from an existing |
843
|
|
|
|
|
|
|
DateTime::Event::Cron object. |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=back |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=head2 Constructors |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
=over 4 |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
=item new_from_cron(cron => $cronstring, %parms) |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
Returns a DateTime::Event::Cron object based on the cron specification. |
854
|
|
|
|
|
|
|
Optional parameters include the boolean 'user_mode' which indicates that |
855
|
|
|
|
|
|
|
the crontab entry includes a username column before the command. |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=item new_from_crontab(file => $fh, %parms) |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
Returns a list of DateTime::Event::Cron objects based on the lines of a |
860
|
|
|
|
|
|
|
crontab file. C<$fh> can be either a filename or a filehandle reference. |
861
|
|
|
|
|
|
|
Optional parameters include the boolean 'user_mode' as mentioned above. |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
=back |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
=head2 Other methods |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=over 4 |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=item next() |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=item next($date) |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
Returns the next valid datetime according to the cron specification. |
874
|
|
|
|
|
|
|
C<$date> defaults to DateTime->now unless provided. |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
=item previous() |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
=item previous($date) |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
Returns the previous valid datetime according to the cron specification. |
881
|
|
|
|
|
|
|
C<$date> defaults to DateTime->now unless provided. |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
=item increment($date) |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=item decrement($date) |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
Same as C<next()> and C<previous()> except that the provided datetime is |
888
|
|
|
|
|
|
|
modified to the new datetime. |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
=item match($date) |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
Returns whether or not the given datetime (defaults to current time) |
893
|
|
|
|
|
|
|
matches the current cron specification. Dates are truncated to minute |
894
|
|
|
|
|
|
|
resolution. |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
=item valid($date) |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
A more strict version of match(). Returns whether the given datetime is |
899
|
|
|
|
|
|
|
valid under the current cron specification. Cron dates are only accurate |
900
|
|
|
|
|
|
|
to the minute -- datetimes with seconds greater than 0 are invalid by |
901
|
|
|
|
|
|
|
default. (note: never fear, all methods accepting dates will accept |
902
|
|
|
|
|
|
|
invalid dates -- they will simply be rounded to the next nearest valid |
903
|
|
|
|
|
|
|
date in all cases except this particular method) |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
=item command() |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
Returns the command string, if any, from the original crontab entry. |
908
|
|
|
|
|
|
|
Currently no expansion is performed such as resolving environment |
909
|
|
|
|
|
|
|
variables, etc. |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
=item user() |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
Returns the username under which this cron command was to be executed, |
914
|
|
|
|
|
|
|
assuming such a field was present in the original cron entry. |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
=item original() |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
Returns the original, unparsed cron string including any user or |
919
|
|
|
|
|
|
|
command fields. |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
=back |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
=head1 AUTHOR |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
Matthew P. Sisk E<lt>sisk@mojotoad.comE<gt> |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
=head1 COPYRIGHT |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
Copyright (c) 2003 Matthew P. Sisk. All rights reserved. All wrongs |
930
|
|
|
|
|
|
|
revenged. This program is free software; you can distribute it and/or |
931
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
=head1 SEE ALSO |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
DateTime(3), DateTime::Set(3), DateTime::Event::Recurrence(3), |
936
|
|
|
|
|
|
|
DateTime::Event::ICal(3), DateTime::Span(3), Set::Crontab(3), crontab(5) |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
=cut |