File Coverage

blib/lib/Mojar/Cron.pm
Criterion Covered Total %
statement 105 105 100.0
branch 71 76 93.4
condition 41 47 87.2
subroutine 9 9 100.0
pod 4 4 100.0
total 230 241 95.4


line stmt bran cond sub pod time code
1             package Mojar::Cron;
2 5     5   927755 use Mojo::Base -base;
  5         59  
  5         40  
3              
4             our $VERSION = 0.501;
5              
6 5     5   1133 use Carp 'croak';
  5         8  
  5         222  
7 5     5   1907 use Mojar::Cron::Datetime;
  5         12  
  5         161  
8 5     5   28 use POSIX qw(mktime strftime setlocale LC_TIME);
  5         12  
  5         22  
9              
10             # Fields of a cron pattern
11             our @Fields = qw(sec min hour day month weekday);
12              
13             # Soft limits for defining ranges
14             my %Max; @Max{@Fields} = (59, 59, 23, 30, 11, 6);
15              
16             # Array indices of a datetime record
17             use constant {
18 5         8143 SEC => 0,
19             MIN => 1,
20             HOUR => 2,
21             DAY => 3,
22             MONTH => 4,
23             YEAR => 5,
24             WEEKDAY => 6
25 5     5   556 };
  5         9  
26             # NB the distinction (YEAR) between this and @Fields
27              
28             # Canonical names
29             my (%Month, %Weekday);
30             {
31             my $old_locale = setlocale(LC_TIME);
32             setlocale(LC_TIME, 'C');
33              
34             %Month = map +(lc(strftime '%b', 0,0,0,1,$_,70) => $_), 0 .. 11;
35             %Weekday = map +(lc(strftime '%a', 0,0,0,$_,5,70) => $_), 0 .. 6;
36              
37             setlocale(LC_TIME, $old_locale);
38             }
39              
40             # Attributes
41              
42             # Object has these seven attributes
43             has \@Fields;
44             has 'is_local';
45              
46             # Public methods
47              
48             sub new {
49 25     25 1 24531 my ($class, %param) = @_;
50              
51             # Exclude is_local from expansion
52 25         52 my $is_local = delete $param{is_local};
53              
54             # Identify time pattern attributes
55 25         32 my @values;
56 25 100       55 if (exists $param{pattern}) {
    100          
57 23         192 @values = split /\s+/, delete $param{pattern};
58             }
59             elsif (exists $param{parts}) {
60 1         1 @values = @{ delete $param{parts} };
  1         3  
61             }
62             else {
63 1 50       3 my $given_sec = exists $param{sec} ? 1 : undef;
64 1         5 @values = map $param{$_}, @Fields;
65 1 50       3 $values[0] = 0 unless $given_sec; # Do not expand sec more than requested
66 1         3 delete @param{@Fields};
67             }
68             # Apply default 'sec'
69 25 100       82 unshift @values, '0' if @values < 6; # Vivify sec
70              
71 25 50       50 croak(sprintf 'Unrecognised parameter (%s)', join ',', keys %param) if %param;
72 25         35 %param = ();
73              
74             # Expand parameter values
75 25         78 $param{$Fields[$_]} = expand($Fields[$_] => $values[$_]) for 0 .. 5;
76            
77 25         131 return $class->SUPER::new(%param, is_local => $is_local);
78             }
79              
80             sub expand {
81             # Function; not method
82 174     174 1 1290 my ($field, $spec) = @_;
83              
84 174 100 100     536 return undef if not defined $spec or $spec eq '*';
85              
86 110         125 my @vals;
87 110         208 for my $val (split /,/, $spec) {
88 114         124 my $step = 1;
89 114         120 my $end;
90              
91 114 100       235 $val =~ s|/(\d+)$|| and $step = $1;
92              
93 114 100       254 $val =~ /^(.+)-(.+)$/ and ($val, $end) = ($1, $2);
94              
95 114 100       296 if ($val eq '*') {
    100          
    100          
    100          
96 8         30 ($val, $end) = (0, $Max{$field});
97             }
98             elsif ($field eq 'day') {
99             # Externally 1-31; internally 0-30
100 11   66     111 defined and /^\d+$/ and --$_ for $val, $end;
      66        
101             }
102             elsif ($field eq 'month') {
103             # Externally 1-12; internally 0-11
104 13   100     96 defined and /^\d+$/ and --$_ for $val, $end;
      66        
105             # Convert symbolics
106 13   100     94 defined and exists $Month{lc $_} and $_ = $Month{lc $_} for $val, $end;
      66        
107             }
108             elsif ($field eq 'weekday') {
109             # Convert symbolics
110             defined and exists $Weekday{lc $_} and $_ = $Weekday{lc $_}
111 20   100     125 for $val, $end;
      66        
112 20 100 100     60 $end = 7 if defined $end and $end == 0 and $val > 0;
      66        
113             }
114              
115 114         187 push @vals, $val;
116 114   100     302 push @vals, $val while defined $end and ($val += $step) <= $end;
117              
118 114 100 100     259 if ($field eq 'weekday' and $vals[-1] == 7) {
119 4 50       15 unshift @vals, 0 unless $vals[0] == 0;
120 4         8 pop @vals;
121             }
122             }
123 110         391 return [ sort {$a <=> $b} @vals ];
  99         203  
124             }
125              
126             sub next {
127 84     84 1 611 my ($self, $previous) = @_;
128             # Increment to the next possible time and convert to datetime
129 84         201 my $dt = Mojar::Cron::Datetime->from_timestamp(
130             $previous + 1, $self->is_local);
131              
132             {
133 84 100       110 redo unless $self->satisfiable(MONTH, $dt);
  271         455  
134              
135 266 100 100     764 if (defined $self->{day} and defined $self->{weekday}) {
    100          
    100          
136             # Both day and weekday are defined, so the cron entry should trigger as
137             # soon as _either_ of them is satisfied. Therefore need to determine
138             # which is satisfied sooner.
139              
140 34         63 my $weekday_dt = $dt->new;
141 34         54 my $weekday_restart = not $self->satisfiable(WEEKDAY, $weekday_dt);
142 34         63 my $next_by_weekday = $weekday_dt->to_timestamp($self->is_local);
143              
144 34         606 my $day_dt = $dt->new;
145 34         52 my $day_restart = not $self->satisfiable(DAY, $day_dt);
146 34         65 my $next_by_day = $day_dt->to_timestamp($self->is_local);
147              
148 34 100       653 if ($next_by_day <= $next_by_weekday) {
149 5         13 $dt->copy($day_dt);
150 5 50       11 redo if $day_restart;
151             }
152             else {
153 29         63 $dt->copy($weekday_dt);
154 29 100       67 redo if $weekday_restart;
155             }
156             }
157             elsif (defined $self->{day}) {
158 75 100       130 redo unless $self->satisfiable(DAY, $dt);
159             }
160             elsif (defined $self->{weekday}) {
161 114 100       160 redo unless $self->satisfiable(WEEKDAY, $dt);
162             }
163              
164 243 100       392 redo unless $self->satisfiable(HOUR, $dt);
165 195 100       290 redo unless $self->satisfiable(MIN, $dt);
166 146 100       232 redo unless $self->satisfiable(SEC, $dt);
167             }
168              
169 84         170 return $dt->to_timestamp($self->is_local);
170             }
171              
172             sub satisfiable {
173 1144     1144 1 4564 my ($self, $component, $dt) = @_;
174              
175             # The given $component of $self is a sequence of numeric slots. Test whether
176             # those slots can satisfy the corresponding component of $dt. Shortcircuit
177             # 'true' if slot is a wildcard.
178 1144 100       1664 my $field = ($component == WEEKDAY) ? 'weekday' : $Fields[$component];
179 1144   100     2096 my $slots = $self->{$field} // return 1;
180              
181             # $old : existing value; $new : same or next value satisfying cron
182 894 100       1234 my $old = ($component == WEEKDAY) ? $dt->weekday : $dt->[$component];
183 894         879 my $new;
184             # Grab first slot at least big enough
185 894 100       1131 for (@$slots) { $new = $_, last if $_ >= $old }
  1037         1747  
186              
187             # Can't manipulate WEEKDAY directly since it is tied to DAY. Instead
188             # manipulate DAY until goal is achieved.
189 894 100       1565 if ($component == WEEKDAY) {
    100          
    100          
190 154         165 $component = DAY;
191 154 100       270 $new = $dt->[DAY] + $new - $old if defined $new; # adjust by the same delta
192 154         200 $old = $dt->[DAY];
193              
194 154 100       304 if (not defined $new) {
    100          
195             # Rollover (into following week)
196 17         38 $dt->reset_parts(DAY - 1);
197             # Add more days till we hit next occurrance of $slots->[0]
198             # We know $dt->weekday is greater than all @$slots, so the following will
199             # add less than a week to $dt->[DAY].
200 17         35 $dt->[DAY] += $slots->[0] + 7 - $dt->weekday;
201              
202 17         38 $dt->normalise;
203 17         32 return undef;
204             }
205             elsif ($new > $old) {
206             # Component has moved up a slot
207 24         50 $dt->reset_parts($component - 1);
208             }
209             }
210             elsif (not defined $new) {
211             # Rollover
212 186         416 $dt->reset_parts($component - 1);
213 186         286 $dt->[$component] = $slots->[0];
214 186         241 $dt->[$component + 1]++;
215              
216 186         341 $dt->normalise;
217 186         384 return undef;
218             }
219             elsif ($new > $old) {
220             # Component has moved up a slot
221 119         246 $dt->reset_parts($component - 1);
222             }
223              
224 691         923 $dt->[$component] = $new;
225              
226             # Detect rollover of month and reset to next month
227 691         743 my $was_month = $dt->[MONTH];
228 691         1353 $dt->normalise;
229              
230 691 100 100     1370 if ($component == DAY and $was_month != $dt->[MONTH]) {
231 8         22 $dt->reset_parts(DAY);
232 8         20 return undef;
233             }
234              
235 683         1261 return 1;
236             }
237              
238             1;
239             __END__