src/PVE/CalendarEvent.pm

   1 package PVE::CalendarEvent;
   2
   3 use strict;
   4 use warnings;
   5 use Data::Dumper;
   6 use Time::Local;
   7 use PVE::JSONSchema;
   8 use PVE::Tools qw(trim);
   9
  10 # Note: This class implements a parser/utils for systemd like calendar exents
  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
  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;
  30         die "invalid calendar event '$text' - $err\n";
  31     }
  32     return $text;
  33 }
  34
  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
  40     $event = trim($event);
  41
  42     if ($event eq '') {
  43         die "unable to parse calendar event - event is empty\n";
  44     }
  45
  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);
  65                     die "value '$start' out of range\n" if $start >= $max;
  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);
 111     my $utc = (@parts && uc($parts[-1]) eq 'UTC');
 112     pop @parts if $utc;
 113
 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);
 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         }
 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 {
 155         $h = [ sort { $a <=> $b } keys %$hours_hash ];
 156     }
 157
 158     if ($matchall_minutes) {
 159         $m = '*';
 160     } else {
 161         $m = [ sort { $a <=> $b } keys %$minutes_hash ];
 162     }
 163
 164     return { h => $h, m => $m, dow => [ sort keys %$dow_hash ], utc => $utc };
 165 }
 166
 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
 232 sub compute_next_event {
 233     my ($calspec, $last) = @_;
 234
 235     my $hspec = $calspec->{h};
 236     my $mspec = $calspec->{m};
 237     my $dowspec = $calspec->{dow};
 238     my $utc = $calspec->{utc};
 239
 240     $last += 60; # at least one minute later
 241
 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;
 254             }
 255         }
 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;
 270             }
 271         }
 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;
 286             }
 287         }
 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);
 296     }
 297
 298     die "unable to compute next calendar event\n";
 299 }
 300
 301 1;