]>
Commit | Line | Data |
---|---|---|
2244b271 DM |
1 | package PVE::CalendarEvent; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | use Data::Dumper; | |
6 | use Time::Local; | |
55c6e2cd | 7 | use PVE::JSONSchema; |
a5ffa49f | 8 | use PVE::Tools qw(trim); |
2244b271 | 9 | |
fb3a1b29 | 10 | # Note: This class implements a parser/utils for systemd like calendar exents |
2244b271 DM |
11 | # Date specification is currently not implemented |
12 | ||
13 | my $dow_names = { | |
14 | sun => 0, | |
15 | mon => 1, | |
16 | tue => 2, | |
17 | wed => 3, | |
18 | thu => 4, | |
19 | fri => 5, | |
20 | sat => 6, | |
21 | }; | |
22 | ||
55c6e2cd DM |
23 | PVE::JSONSchema::register_format('pve-calendar-event', \&pve_verify_calendar_event); |
24 | sub pve_verify_calendar_event { | |
25 | my ($text, $noerr) = @_; | |
26 | ||
27 | eval { parse_calendar_event($text); }; | |
28 | if (my $err = $@) { | |
29 | return undef if $noerr; | |
05477bfe | 30 | die "invalid calendar event '$text' - $err\n"; |
55c6e2cd DM |
31 | } |
32 | return $text; | |
33 | } | |
34 | ||
2244b271 DM |
35 | # The parser. |
36 | # returns a $calspec hash which can be passed to compute_next_event() | |
37 | sub parse_calendar_event { | |
38 | my ($event) = @_; | |
39 | ||
a5ffa49f DC |
40 | $event = trim($event); |
41 | ||
42 | if ($event eq '') { | |
43 | die "unable to parse calendar event - event is empty\n"; | |
44 | } | |
45 | ||
2244b271 DM |
46 | my $parse_single_timespec = sub { |
47 | my ($p, $max, $matchall_ref, $res_hash) = @_; | |
48 | ||
49 | if ($p =~ m/^((?:\*|[0-9]+))(?:\/([1-9][0-9]*))?$/) { | |
50 | my ($start, $repetition) = ($1, $2); | |
51 | if (defined($repetition)) { | |
52 | $repetition = int($repetition); | |
53 | $start = $start eq '*' ? 0 : int($start); | |
54 | die "value '$start' out of range\n" if $start >= $max; | |
55 | die "repetition '$repetition' out of range\n" if $repetition >= $max; | |
56 | while ($start < $max) { | |
57 | $res_hash->{$start} = 1; | |
58 | $start += $repetition; | |
59 | } | |
60 | } else { | |
61 | if ($start eq '*') { | |
62 | $$matchall_ref = 1; | |
63 | } else { | |
64 | $start = int($start); | |
057c619a | 65 | die "value '$start' out of range\n" if $start >= $max; |
2244b271 DM |
66 | $res_hash->{$start} = 1; |
67 | } | |
68 | } | |
69 | } elsif ($p =~ m/^([0-9]+)\.\.([1-9][0-9]*)$/) { | |
70 | my ($start, $end) = (int($1), int($2)); | |
71 | die "range start '$start' out of range\n" if $start >= $max; | |
72 | die "range end '$end' out of range\n" if $end >= $max || $end < $start; | |
73 | for (my $i = $start; $i <= $end; $i++) { | |
74 | $res_hash->{$i} = 1; | |
75 | } | |
76 | } else { | |
77 | die "unable to parse calendar event '$p'\n"; | |
78 | } | |
79 | }; | |
80 | ||
81 | my $h = undef; | |
82 | my $m = undef; | |
83 | ||
84 | my $matchall_minutes = 0; | |
85 | my $matchall_hours = 0; | |
86 | my $minutes_hash = {}; | |
87 | my $hours_hash = {}; | |
88 | ||
89 | my $dowsel = join('|', keys %$dow_names); | |
90 | ||
91 | my $dow_hash; | |
92 | ||
93 | my $parse_dowspec = sub { | |
94 | my ($p) = @_; | |
95 | ||
96 | if ($p =~ m/^($dowsel)$/i) { | |
97 | $dow_hash->{$dow_names->{lc($1)}} = 1; | |
98 | } elsif ($p =~ m/^($dowsel)\.\.($dowsel)$/i) { | |
99 | my $start = $dow_names->{lc($1)}; | |
100 | my $end = $dow_names->{lc($2)} || 7; | |
101 | die "wrong order in range '$p'\n" if $end < $start; | |
102 | for (my $i = $start; $i <= $end; $i++) { | |
103 | $dow_hash->{($i % 7)} = 1; | |
104 | } | |
105 | } else { | |
106 | die "unable to parse weekday specification '$p'\n"; | |
107 | } | |
108 | }; | |
109 | ||
110 | my @parts = split(/\s+/, $event); | |
0b7ba044 WB |
111 | my $utc = (@parts && uc($parts[-1]) eq 'UTC'); |
112 | pop @parts if $utc; | |
113 | ||
2244b271 DM |
114 | |
115 | if ($parts[0] =~ m/$dowsel/i) { | |
116 | my $dow_spec = shift @parts; | |
117 | foreach my $p (split(',', $dow_spec)) { | |
118 | $parse_dowspec->($p); | |
119 | } | |
120 | } else { | |
121 | $dow_hash = { 0 => 1, 1 => 1, 2 => 1, 3 => 1, 4 => 1, 5=> 1, 6 => 1 }; | |
122 | } | |
123 | ||
124 | if (scalar(@parts) && $parts[0] =~ m/\-/) { | |
125 | my $date_spec = shift @parts; | |
126 | die "date specification not implemented"; | |
127 | } | |
128 | ||
129 | my $time_spec = shift(@parts) // "00:00"; | |
130 | my $chars = '[0-9*/.,]'; | |
131 | ||
132 | if ($time_spec =~ m/^($chars+):($chars+)$/) { | |
133 | my ($p1, $p2) = ($1, $2); | |
e2c29de7 DC |
134 | foreach my $p (split(',', $p1)) { |
135 | $parse_single_timespec->($p, 24, \$matchall_hours, $hours_hash); | |
136 | } | |
137 | foreach my $p (split(',', $p2)) { | |
138 | $parse_single_timespec->($p, 60, \$matchall_minutes, $minutes_hash); | |
139 | } | |
2244b271 DM |
140 | } elsif ($time_spec =~ m/^($chars)+$/) { # minutes only |
141 | $matchall_hours = 1; | |
142 | foreach my $p (split(',', $time_spec)) { | |
143 | $parse_single_timespec->($p, 60, \$matchall_minutes, $minutes_hash); | |
144 | } | |
145 | ||
146 | } else { | |
147 | die "unable to parse calendar event\n"; | |
148 | } | |
149 | ||
150 | die "unable to parse calendar event - unused parts\n" if scalar(@parts); | |
151 | ||
152 | if ($matchall_hours) { | |
153 | $h = '*'; | |
154 | } else { | |
a4200306 | 155 | $h = [ sort { $a <=> $b } keys %$hours_hash ]; |
2244b271 DM |
156 | } |
157 | ||
158 | if ($matchall_minutes) { | |
159 | $m = '*'; | |
160 | } else { | |
a4200306 | 161 | $m = [ sort { $a <=> $b } keys %$minutes_hash ]; |
2244b271 DM |
162 | } |
163 | ||
0b7ba044 | 164 | return { h => $h, m => $m, dow => [ sort keys %$dow_hash ], utc => $utc }; |
2244b271 DM |
165 | } |
166 | ||
1457ffef WB |
167 | sub is_leap_year($) { |
168 | return 0 if $_[0] % 4; | |
169 | return 1 if $_[0] % 100; | |
170 | return 0 if $_[0] % 400; | |
171 | return 1; | |
172 | } | |
173 | ||
174 | # mon = 0.. (Jan = 0) | |
175 | sub days_in_month($$) { | |
176 | my ($mon, $year) = @_; | |
177 | return 28 + is_leap_year($year) if $mon == 1; | |
178 | return (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)[$mon]; | |
179 | } | |
180 | ||
181 | # day = 1.. | |
182 | # mon = 0.. (Jan = 0) | |
183 | sub wrap_time($) { | |
184 | my ($time) = @_; | |
185 | my ($sec, $min, $hour, $day, $mon, $year, $wday) = @$time; | |
186 | ||
187 | use integer; | |
188 | if ($sec >= 60) { | |
189 | $min += $sec / 60; | |
190 | $sec %= 60; | |
191 | } | |
192 | ||
193 | if ($min >= 60) { | |
194 | $hour += $min / 60; | |
195 | $min %= 60; | |
196 | } | |
197 | ||
198 | if ($hour >= 24) { | |
199 | $day += $hour / 24; | |
200 | $wday += $hour / 24; | |
201 | $hour %= 24; | |
202 | } | |
203 | ||
204 | # Translate to 0..($days_in_mon-1) | |
205 | --$day; | |
206 | while (1) { | |
207 | my $days_in_mon = days_in_month($mon % 12, $year); | |
208 | last if $day < $days_in_mon; | |
209 | # Wrap one month | |
210 | $day -= $days_in_mon; | |
211 | ++$mon; | |
212 | } | |
213 | # Translate back to 1..$days_in_mon | |
214 | ++$day; | |
215 | ||
216 | if ($mon >= 12) { | |
217 | $year += $mon / 12; | |
218 | $mon %= 12; | |
219 | } | |
220 | ||
221 | $wday %= 7; | |
222 | return [$sec, $min, $hour, $day, $mon, $year, $wday]; | |
223 | } | |
224 | ||
225 | # helper as we need to keep weekdays in sync | |
226 | sub time_add_days($$) { | |
227 | my ($time, $inc) = @_; | |
228 | my ($sec, $min, $hour, $day, $mon, $year, $wday) = @$time; | |
229 | return wrap_time([$sec, $min, $hour, $day + $inc, $mon, $year, $wday + $inc]); | |
230 | } | |
231 | ||
2244b271 | 232 | sub compute_next_event { |
0b7ba044 | 233 | my ($calspec, $last) = @_; |
2244b271 DM |
234 | |
235 | my $hspec = $calspec->{h}; | |
236 | my $mspec = $calspec->{m}; | |
237 | my $dowspec = $calspec->{dow}; | |
0b7ba044 | 238 | my $utc = $calspec->{utc}; |
2244b271 DM |
239 | |
240 | $last += 60; # at least one minute later | |
241 | ||
1457ffef WB |
242 | my $t = [$utc ? gmtime($last) : localtime($last)]; |
243 | $t->[0] = 0; # we're not interested in seconds, actually | |
244 | $t->[5] += 1900; # real years for clarity | |
245 | ||
246 | outer: for (my $i = 0; $i < 1000; ++$i) { | |
247 | my $wday = $t->[6]; | |
248 | foreach my $d (@$dowspec) { | |
249 | goto this_wday if $d == $wday; | |
250 | if ($d > $wday) { | |
251 | $t->[0] = $t->[1] = $t->[2] = 0; # sec = min = hour = 0 | |
252 | $t = time_add_days($t, $d - $wday); | |
253 | next outer; | |
2244b271 | 254 | } |
2244b271 | 255 | } |
1457ffef WB |
256 | # Test next week: |
257 | $t->[0] = $t->[1] = $t->[2] = 0; # sec = min = hour = 0 | |
258 | $t = time_add_days($t, 7 - $wday); | |
259 | next outer; | |
260 | this_wday: | |
261 | ||
262 | goto this_hour if $hspec eq '*'; | |
263 | my $hour = $t->[2]; | |
264 | foreach my $h (@$hspec) { | |
265 | goto this_hour if $h == $hour; | |
266 | if ($h > $hour) { | |
267 | $t->[0] = $t->[1] = 0; # sec = min = 0 | |
268 | $t->[2] = $h; # hour = $h | |
269 | next outer; | |
2244b271 | 270 | } |
2244b271 | 271 | } |
1457ffef WB |
272 | # Test next day: |
273 | $t->[0] = $t->[1] = $t->[2] = 0; # sec = min = hour = 0 | |
274 | $t = time_add_days($t, 1); | |
275 | next outer; | |
276 | this_hour: | |
277 | ||
278 | goto this_min if $mspec eq '*'; | |
279 | my $min = $t->[1]; | |
280 | foreach my $m (@$mspec) { | |
281 | goto this_min if $m == $min; | |
282 | if ($m > $min) { | |
283 | $t->[0] = 0; # sec = 0 | |
284 | $t->[1] = $m; # min = $m | |
285 | next outer; | |
2244b271 | 286 | } |
2244b271 | 287 | } |
1457ffef WB |
288 | # Test next hour: |
289 | $t->[0] = $t->[1] = 0; # sec = min = hour = 0 | |
290 | $t->[2]++; | |
291 | $t = wrap_time($t); | |
292 | next outer; | |
293 | this_min: | |
294 | ||
295 | return $utc ? timegm(@$t) : timelocal(@$t); | |
2244b271 DM |
296 | } |
297 | ||
298 | die "unable to compute next calendar event\n"; | |
299 | } | |
300 | ||
301 | 1; |