package Date::Manip::Recur; # Copyright (c) 1998-2017 Sullivan Beck. All rights reserved. # This program is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. ######################################################################## # Any routine that starts with an underscore (_) is NOT intended for # public use. They are for internal use in the the Date::Manip # modules and are subject to change without warning or notice. # # ABSOLUTELY NO USER SUPPORT IS OFFERED FOR THESE ROUTINES! ######################################################################## use Date::Manip::Obj; @ISA = ('Date::Manip::Obj'); require 5.010000; use warnings; use strict; use integer; use utf8; use IO::File; #use re 'debug'; use Date::Manip::Base; use Date::Manip::TZ; our $VERSION; $VERSION='6.60'; END { undef $VERSION; } ######################################################################## # BASE METHODS ######################################################################## sub is_recur { return 1; } # Call this every time a new recur is put in to make sure everything is # correctly initialized. # sub _init { my($self) = @_; my $dmt = $$self{'tz'}; my $dmb = $$dmt{'base'}; $$self{'err'} = ''; $$self{'data'}{'freq'} = ''; # The frequency $$self{'data'}{'flags'} = []; # Modifiers $$self{'data'}{'base'} = undef; # The specified base date $$self{'data'}{'BASE'} = undef; # The actual base date $$self{'data'}{'start'} = undef; # Start and end date $$self{'data'}{'end'} = undef; $$self{'data'}{'unmod_range'} = 0; # If this is 1, the start/end range # refer to the unmodified dates, not the # final dates. $$self{'data'}{'interval'} = []; # (Y, M, ...) $$self{'data'}{'rtime'} = []; # ( [ VAL_OR_RANGE, VAL_OR_RANGE, ... ], # [ VAL_OR_RANGE, VAL_OR_RANGE, ... ], # ... ) $$self{'data'}{'slow'} = 0; # 1 if a range of the form 2--2 is # included. $$self{'data'}{'ev_per_d'} = 0; # The number of events per interval date. $$self{'data'}{'delta'} = undef; # The offset based on the interval. $$self{'data'}{'noint'} = 1; # 0 if an interval is present # 1 if no interval is present and dates # not done # 2 if no interval is present and dates # done $$self{'data'}{'idate'} = {}; # Non-slow: # { N => Nth interval date } # Slow: # { N => [Nth interval date,X,Y] } # [X,Y] are the first/last event indices # generated by this interval date. $$self{'data'}{'dates'} = {}; # { N => Nth recurring event } # N is relative to the base date and is # not affected by start/end $$self{'data'}{'curr'} = undef; # Iterator pointer $$self{'data'}{'first'} = undef; # N : the first date in a range $$self{'data'}{'last'} = undef; # N : the last date in a range # Get the default start/end dates my $range = $dmb->_config('recurrange'); if ($range eq 'none') { $$self{'data'}{'start'} = undef; $$self{'data'}{'end'} = undef; } elsif ($range eq 'year') { my $y = $dmt->_now('y',1); my $start = $self->new_date(); my $end = $self->new_date(); $start->set('date',[$y, 1, 1,00,00,00]); $end->set ('date',[$y,12,31,23,59,59]); $$self{'data'}{'start'} = $start; $$self{'data'}{'end'} = $end; } elsif ($range eq 'month') { my ($y,$m) = $dmt->_now('now',1); my $dim = $dmb->days_in_month($y,$m); my $start = $self->new_date(); my $end = $self->new_date(); $start->set('date',[$y,$m, 1,00,00,00]); $end->set ('date',[$y,$m,$dim,23,59,59]); $$self{'data'}{'start'} = $start; $$self{'data'}{'end'} = $end; } elsif ($range eq 'week') { my($y,$m,$d) = $dmt->_now('now',1); my $w; ($y,$w) = $dmb->week_of_year([$y,$m,$d]); ($y,$m,$d) = @{ $dmb->week_of_year($y,$w) }; my($yy,$mm,$dd) = @{ $dmb->_calc_date_ymwd([$y,$m,$d], [0,0,0,6], 0) }; my $start = $self->new_date(); my $end = $self->new_date(); $start->set('date',[$y, $m, $d, 00,00,00]); $end->set ('date',[$yy,$mm,$dd,23,59,59]); $$self{'data'}{'start'} = $start; $$self{'data'}{'end'} = $end; } elsif ($range eq 'day') { my($y,$m,$d) = $dmt->_now('now',1); my $start = $self->new_date(); my $end = $self->new_date(); $start->set('date',[$y,$m,$d,00,00,00]); $end->set ('date',[$y,$m,$d,23,59,59]); $$self{'data'}{'start'} = $start; $$self{'data'}{'end'} = $end; } elsif ($range eq 'all') { my $start = $self->new_date(); my $end = $self->new_date(); $start->set('date',[0001,02,01,00,00,00]); $end->set ('date',[9999,11,30,23,59,59]); $$self{'data'}{'start'} = $start; $$self{'data'}{'end'} = $end; } } # If $keep is 1, it will keep any existing base date and cached # dates, but it will reset other things. # sub _init_dates { my($self,$keep) = @_; if (! $keep) { $$self{'data'}{'base'} = undef; $$self{'data'}{'BASE'} = undef; $$self{'data'}{'idate'} = {}; $$self{'data'}{'dates'} = {}; } $$self{'data'}{'curr'} = undef; $$self{'data'}{'first'} = undef; $$self{'data'}{'last'} = undef; } sub _init_args { my($self) = @_; my @args = @{ $$self{'args'} }; $self->parse(@args); } ######################################################################## # METHODS ######################################################################## sub parse { my($self,$string,@args) = @_; $self->_init(); # Test if $string = FREQ my $err = $self->frequency($string); if (! $err) { $string = ''; } # Test if $string = "FREQ*..." and FREQ contains an '*'. if ($err) { $self->err(1); $string =~ s/\s*\*\s*/\*/g; if ($string =~ /^([^*]*\*[^*]*)\*/) { # Everything up to the 2nd '*' my $freq = $1; $err = $self->frequency($freq); if (! $err) { $string =~ s/^\Q$freq\E\*//; } } else { $err = 1; } } # Test if $string = "FREQ*..." and FREQ does NOT contains an '*'. if ($err) { $self->err(1); if ($string =~ s/^([^*]*)\*//) { # Everything up to he 1st '*' my $freq = $1; $err = $self->frequency($freq); if (! $err) { $string =~ s/^\Q$freq\E\*//; } } else { $err = 1; } } if ($err) { $$self{'err'} = "[parse] Invalid frequency string"; return 1; } # Handle MODIFIERS from string and arguments my @string = split(/\*/,$string); if (@string) { my $tmp = shift(@string); $err = $self->modifiers($tmp) if ($tmp); return 1 if ($err); } if (@args) { my $tmp = $args[0]; if ($tmp && ! ref($tmp)) { $err = $self->modifiers($tmp); shift(@args) if (! $err); } } # Handle BASE if (@string) { my $tmp = shift(@string); $err = $self->basedate($tmp) if (defined($tmp) && $tmp); return 1 if ($err); } if (@args) { my $tmp = shift(@args); $err = $self->basedate($tmp) if (defined($tmp) && $tmp); return 1 if ($err); } # Handle START, END, UNMOD if (@string) { my($start) = shift(@string); my($end) = shift(@string); my($unmod) = shift(@string); $err = $self->start($start,$unmod) if (defined($start) && $start); return 1 if ($err); $err = $self->end($end) if (defined($end) && $end); return 1 if ($err); } if (@args) { my($start) = shift(@args); my($end) = shift(@args); my($unmod) = shift(@args); $err = $self->start($start,$unmod) if (defined($start) && $start); return 1 if ($err); $err = $self->end($end) if (defined($end) && $end); return 1 if ($err); } # Remaining arguments are invalid. if (@string) { $$self{'err'} = "[parse] String contains invalid elements"; return 1; } if (@args) { $$self{'err'} = "[parse] Unknown arguments"; return 1; } return 0; } sub frequency { my($self,$string) = @_; return $$self{'data'}{'freq'} if (! defined $string); $self->_init(); my (@int,@rtime); PARSE: { # Standard frequency notation my $stdrx = $self->_rx('std'); if ($string =~ $stdrx) { my($l,$r) = @+{qw(l r)}; if (defined($l)) { $l =~ s/^\s*:/0:/; $l =~ s/:\s*$/:0/; $l =~ s/::/:0:/g; @int = split(/:/,$l); } if (defined($r)) { $r =~ s/^\s*:/0:/; $r =~ s/:\s*$/:0/; $r =~ s/::/:0:/g; @rtime = split(/:/,$r); } last PARSE; } # Other frequency strings # Strip out some words to ignore my $ignrx = $self->_rx('ignore'); $string =~ s/$ignrx/ /g; my $eachrx = $self->_rx('each'); my $each = 0; if ($string =~ s/$eachrx/ /g) { $each = 1; } $string =~ s/\s*$//; if (! $string) { $$self{'err'} = "[frequency] Invalid frequency string"; return 1; } my($l,$r); my $err = $self->_parse_lang($string); if ($err) { $$self{'err'} = "[frequency] Invalid frequency string"; return 1; } return 0; } # If the interval consists only of zeros, the last entry is changed # to 1. if (@int) { for my $i (@int) { $i += 0; } TEST_INT: { for my $i (@int) { last TEST_INT if ($i); } $int[$#int] = 1; } } # If @int contains 2 or 3 elements and ends in 0, move the trailing # 0 to the start of @rtime. # # Y:M:0 * D:H:MN:S => Y:M * 0:D:H:MN:S while (@int && ($#int == 1 || $#int == 2) && ($int[$#int] == 0)) { pop(@int); unshift(@rtime,0); } # We need to know what the valid values of M, W, and D are. # # Month can be: # moy : 1 to 12 (month of the year) # # Week can be: # woy : 1 to 53 or -1 to -53 (week of the year) # wom : 1 to 5 or -1 to -5 (week of the month) # # Day can be: # doy : 1 to 366 or -1 to -366 (day of the year) # dom : 1 to 31 or -1 to -31 (day of the month) # dow : 1 to 7 (day of the week) # # Other values must be zero or positive. my($mtype,$wtype,$dtype) = ('','',''); my @f = (@int,@rtime); my $m = $f[1]; my $w = $f[2]; my $d = $f[3]; if ($d && @int < 4) { if ($w) { $dtype = 'dow'; } elsif ($m) { $dtype = 'dom'; } else { $dtype = 'doy'; } } if ($w && @int < 3) { if ($m) { $wtype = 'wom'; } else { $wtype = 'woy'; } } if ($m && @int < 2) { $mtype = 'moy'; } # Test the format of @rtime. # # Turn it to: # @rtime = ( NUM|RANGE, NUM|RANGE, ...) # where # NUM is an integer # RANGE is [NUM1,NUM2] my $rfieldrx = $self->_rx('rfield'); my $rrangerx = $self->_rx('rrange'); my @type = qw(y m w d h mn s); while ($#type > $#rtime) { shift(@type); } foreach my $rfield (@rtime) { my $type = shift(@type); if ($rfield !~ $rfieldrx) { $$self{'err'} = "[frequency] Invalid rtime string"; return 1; } my @rfield = split(/,/,$rfield); my @val; foreach my $vals (@rfield) { if ($vals =~ $rrangerx) { my ($num1,$num2) = ($1+0,$2+0); my $err = $self->_frequency_values($num1,$type,$mtype,$wtype,$dtype); return $err if ($err); $err = $self->_frequency_values($num2,$type,$mtype,$wtype,$dtype); return $err if ($err); if ( ($num1 > 0 && $num2 > 0) || ($num1 < 0 && $num2 < 0) ) { if ($num1 > $num2) { $$self{'err'} = "[frequency] Invalid rtime range string"; return 1; } push(@val,$num1..$num2); } else { push(@val,[$num1,$num2]); } } else { $vals += 0; my $err = $self->_frequency_values($vals,$type,$mtype,$wtype,$dtype); return $err if ($err); push(@val,$vals); } } $rfield = [ @val ]; } # Store it $$self{'data'}{'interval'} = [ @int ]; $$self{'data'}{'rtime'} = [ @rtime ]; # Analyze the rtime to see if it's slow, and to get the number of # events per interval date. my $freq = join(':',@int); my $slow = 0; my $n = 1; if (@rtime) { $freq .= '*'; my (@tmp); foreach my $rtime (@rtime) { my @t2; foreach my $tmp (@$rtime) { if (ref($tmp)) { my($a,$b) = @$tmp; push(@t2,"$a-$b"); $slow = 1; } else { push(@t2,$tmp); } } my $tmp = join(',',@t2); push(@tmp,$tmp); my $nn = @t2; $n *= $nn; } $freq .= join(':',@tmp); } $$self{'data'}{'freq'} = $freq; $$self{'data'}{'slow'} = $slow; $$self{'data'}{'ev_per_d'} = $n if (! $slow); if (@int) { $$self{'data'}{'noint'} = 0; while (@int < 7) { push(@int,0); } my $delta = $self->new_delta(); $delta->set('delta',[@int]); $$self{'data'}{'delta'} = $delta; } else { $$self{'data'}{'noint'} = 1; } return 0; } sub _frequency_values { my($self,$num,$type,$mtype,$wtype,$dtype) = @_; my $err; if ($type eq 'm') { if ($mtype eq 'moy') { if ($num < 1) { $$self{'err'} = "[frequency] Month of year must be 1-12 (zero/negative not allowed)"; return 1; } elsif ($num > 12) { $$self{'err'} = "[frequency] Month of year must be 1-12"; return 1; } } return 0; } if ($type eq 'w') { if ($wtype eq 'woy') { if ($num == 0) { $$self{'err'} = "[frequency] Week of year must be nonzero"; return 1; } elsif ($num > 53 || $num < -53) { $$self{'err'} = "[frequency] Week of year must be 1-53 or -1 to -53"; return 1; } } elsif ($wtype eq 'wom') { if ($num == 0) { $$self{'err'} = "[frequency] Week of month must be nonzero"; return 1; } elsif ($num > 5 || $num < -5) { $$self{'err'} = "[frequency] Week of month must be 1-5 or -1 to -5"; return 1; } } return 0; } if ($type eq 'd') { if ($dtype eq 'dow') { if ($num < 1) { $$self{'err'} = "[frequency] Day of week must be 1-7 (zero/negative not allowed)"; return 1; } elsif ($num > 7) { $$self{'err'} = "[frequency] Day of week must be 1-7"; return 1; } } elsif ($dtype eq 'dom') { if ($num == 0) { $$self{'err'} = "[frequency] Day of month must be nonzero"; return 1; } elsif ($num > 31 || $num < -31) { $$self{'err'} = "[frequency] Day of month must be 1-31 or -1 to -31"; return 1; } } elsif ($dtype eq 'doy') { if ($num == 0) { $$self{'err'} = "[frequency] Day of year must be nonzero"; return 1; } elsif ($num > 366 || $num < -366) { $$self{'err'} = "[frequency] Day of year must be 1-366 or -1 to -366"; return 1; } } return 0; } if ($num < 0) { $$self{'err'} = "[frequency] Negative values only allowed for day/week"; return 1; } return 0; } sub _parse_lang { my($self,$string) = @_; my $dmt = $$self{'tz'}; my $dmb = $$dmt{'base'}; # Test the regular expression my $rx = $self->_rx('every'); return 1 if ($string !~ $rx); my($month,$week,$day,$last,$nth,$day_name,$day_abb,$mon_name,$mon_abb,$n,$y) = @+{qw(month week day last nth day_name day_abb mon_name mon_abb n y)}; # Convert wordlist values to calendar values my $dow; if (defined($day_name) || defined($day_abb)) { if (defined($day_name)) { $dow = $$dmb{'data'}{'wordmatch'}{'day_name'}{lc($day_name)}; } else { $dow = $$dmb{'data'}{'wordmatch'}{'day_abb'}{lc($day_abb)}; } } my $mmm; if (defined($mon_name) || defined($mon_abb)) { if (defined($mon_name)) { $mmm = $$dmb{'data'}{'wordmatch'}{'month_name'}{lc($mon_name)}; } else { $mmm = $$dmb{'data'}{'wordmatch'}{'month_abb'}{lc($mon_abb)}; } } if (defined($nth)) { $nth = $$dmb{'data'}{'wordmatch'}{'nth'}{lc($nth)}; } # Get the frequencies my($freq); if (defined($dow)) { if (defined($mmm)) { if (defined($last)) { # last DoW in MMM [YY] $freq = "1*$mmm:-1:$dow:0:0:0"; } elsif (defined($nth)) { # Nth DoW in MMM [YY] $freq = "1*$mmm:$nth:$dow:0:0:0"; } else { # every DoW in MMM [YY] $freq = "1*$mmm:1-5:$dow:0:0:0"; } } else { if (defined($last)) { # last DoW in every month [in YY] $freq = "0:1*-1:$dow:0:0:0"; } elsif (defined($nth)) { # Nth DoW in every month [in YY] $freq = "0:1*$nth:$dow:0:0:0"; } else { # every DoW in every month [in YY] $freq = "0:1*1-5:$dow:0:0:0"; } } } elsif (defined($day)) { if (defined($month)) { if (defined($nth)) { # Nth day of every month [YY] $freq = "0:1*0:$nth:0:0:0"; } elsif (defined($last)) { # last day of every month [YY] $freq = "0:1*0:-1:0:0:0"; } else { # every day of every month [YY] $freq = "0:0:0:1*0:0:0"; } } else { if (defined($nth)) { # every Nth day [YY] $freq = "0:0:0:$nth*0:0:0"; } elsif (defined($n)) { # every N days [YY] $freq = "0:0:0:$n*0:0:0"; } else { # every day [YY] $freq = "0:0:0:1*0:0:0"; } } } # Get the range (if YY is included) if (defined($y)) { $y = $dmt->_fix_year($y); my $start = "${y}010100:00:00"; my $end = "${y}123123:59:59"; return $self->parse($freq,undef,$start,$end); } return $self->frequency($freq) } sub _date { my($self,$op,$date_or_string) = @_; # Make sure the argument is a date if (ref($date_or_string) eq 'Date::Manip::Date') { $$self{'data'}{$op} = $date_or_string; } elsif (ref($date_or_string)) { $$self{'err'} = "[$op] Invalid date object"; return 1; } else { my $date = $self->new_date(); my $err = $date->parse($date_or_string); if ($err) { $$self{'err'} = "[$op] Invalid date string"; return 1; } $$self{'data'}{$op} = $date; } return 0; } sub start { my($self,$start,$unmod) = @_; return $$self{'data'}{'start'} if (! defined $start); $self->_init_dates(1); $$self{'data'}{'unmod_range'} = $unmod; $self->_date('start',$start); } sub end { my($self,$end) = @_; return $$self{'data'}{'end'} if (! defined $end); $self->_init_dates(1); $self->_date('end',$end); } sub basedate { my($self,$base) = @_; return ($$self{'data'}{'base'},$$self{'data'}{'BASE'}) if (! defined $base); $self->_init_dates(); $self->_date('base',$base); } sub modifiers { my($self,@flags) = @_; return @{ $$self{'data'}{'flags'} } if (! @flags); my $dmt = $$self{'tz'}; my $dmb = $$dmt{'base'}; if (@flags == 1) { @flags = split(/,/,lc($flags[0])); } # Add these flags to the list if (@flags && $flags[0] eq "+") { shift(@flags); my @tmp = @{ $$self{'data'}{'flags'} }; @flags = (@tmp,@flags) if (@tmp); } # Return an error if any modifier is unknown foreach my $flag (@flags) { next if ($flag =~ /^([pn][dt][1-7]|wd[1-7]|[fb][dw]\d+|cw[dnp]|[npd]wd|[in]bd|[in]w[1-7]|easter)$/); $$self{'err'} = "[modifiers] Invalid modifier: $flag"; return 1; } $$self{'data'}{'flags'} = [ @flags ]; $self->_init_dates(); return 0; } sub nth { my($self,$n) = @_; $n = 0 if (! $n); return ($$self{'data'}{'dates'}{$n},0) if (exists $$self{'data'}{'dates'}{$n}); my ($err) = $self->_error(); return (undef,$err) if ($err); return ($$self{'data'}{'dates'}{$n},0) if (exists $$self{'data'}{'dates'}{$n}); # If there is no interval, then we've found every date that # can be found. if ($$self{'data'}{'noint'}) { return (undef,0); } if ($$self{'data'}{'slow'}) { my $nn = 0; while (1) { $self->_nth_interval($nn); return ($$self{'data'}{'dates'}{$n},0) if (exists $$self{'data'}{'dates'}{$n}); if ($n >= 0) { $nn++; } else { $nn--; } } } else { my $nn; if ($n >= 0) { $nn = int($n/$$self{'data'}{'ev_per_d'}); } else { $nn = int(($n+1)/$$self{'data'}{'ev_per_d'}) -1; } $self->_nth_interval($nn); return ($$self{'data'}{'dates'}{$n},0); } } sub next { my($self) = @_; my ($err) = $self->_error(); return (undef,$err) if ($err); # If curr is not set, we have to get it. if (! defined $$self{'data'}{'curr'}) { CURR: while (1) { # If no interval then # return base date if ($$self{'data'}{'noint'}) { $$self{'data'}{'curr'} = -1; last CURR; } # If a range is defined # find first event in range and return it if (defined $$self{'data'}{'start'} && defined $$self{'data'}{'end'}) { my $n = $self->_locate_n('first'); $$self{'data'}{'curr'} = $n-1; } else { $$self{'data'}{'curr'} = -1; } last CURR; } } # With curr set, find the next defined one while (1) { $$self{'data'}{'curr'}++; if ($$self{'data'}{'noint'}) { return (undef,0) if (! exists $$self{'data'}{'dates'}{$$self{'data'}{'curr'}}); } my ($d,$e) = $self->nth($$self{'data'}{'curr'}); return (undef,$e) if ($e); return ($d,0) if (defined $d); } } sub prev { my($self) = @_; my ($err) = $self->_error(); return (undef,$err) if ($err); # If curr is not set, we have to get it. if (! defined $$self{'data'}{'curr'}) { CURR: while (1) { # If no interval then # return last one if ($$self{'data'}{'noint'}) { my @n = sort { $a <=> $b } keys %{ $$self{'data'}{'dates'} }; $$self{'data'}{'curr'} = pop(@n) + 1; last CURR; } # If a range is defined # find last event in range and return it if (defined $$self{'data'}{'start'} && defined $$self{'data'}{'end'}) { my $n = $self->_locate_n('last'); $$self{'data'}{'curr'} = $n+1; } else { $$self{'data'}{'curr'} = 0; } last CURR; } } # With curr set, find the previous defined one while (1) { $$self{'data'}{'curr'}--; if ($$self{'data'}{'noint'}) { return (undef,0) if (! exists $$self{'data'}{'dates'}{$$self{'data'}{'curr'}}); } my ($d,$e) = $self->nth($$self{'data'}{'curr'}); return (undef,$e) if ($e); return ($d,0) if (defined $d); } } sub dates { my($self,$start2,$end2,$unmod) = @_; $self->err(1); # If $start2 or $end2 are provided, make sure they are valid. # If either are provided, make a note of it ($tmp_limits). my $tmp_limits = 0; $tmp_limits = 1 if ($start2 || $end2); $unmod = 0 if (! $unmod); # Check the recurrence for errors. If both $start2 and $end2 are # provided, it's not necessary for a range to be in the recurrence. my $range_required; if (defined($start2) && defined($end2)) { $range_required = 0; } else { $range_required = 1; } my($err); ($err,$start2,$end2) = $self->_error($range_required,$start2,$end2); return () if ($err); # If $start2 or $end2 were provided, back up the data that applies # to the current date range, and store the new date range in it's place. my ($old_start, $old_end, $old_first, $old_last, $old_unmod); if ($tmp_limits) { $old_start = $$self{'data'}{'start'}; $old_end = $$self{'data'}{'end'}; $old_first = $$self{'data'}{'first'}; $old_last = $$self{'data'}{'last'}; $old_unmod = $$self{'data'}{'unmod_range'}; $$self{'data'}{'start'} = $start2; $$self{'data'}{'end'} = $end2; $$self{'data'}{'first'} = undef; $$self{'data'}{'last'} = undef; $$self{'data'}{'unmod_range'} = $unmod; } # Get all of the dates my($end,$first,$last,@dates); $first = $self->_locate_n('first'); $last = $self->_locate_n('last'); if (defined($first) && defined($last)) { for (my $n = $first; $n <= $last; $n++) { my($date,$err) = $self->nth($n); push(@dates,$date) if (defined $date); } } # Restore the original date range values. if ($tmp_limits) { $$self{'data'}{'start'} = $old_start; $$self{'data'}{'end'} = $old_end; $$self{'data'}{'first'} = $old_first; $$self{'data'}{'last'} = $old_last; $$self{'data'}{'unmod_range'} = $old_unmod; } return @dates; } ######################################################################## # MISC ######################################################################## # This checks a recurrence for errors and completeness prior to # extracting a date or dates from it. # sub _error { my($self,$range_required,$start2,$end2) = @_; return ('Invalid recurrence') if ($self->err()); # All dates entered must be valid. my($start,$end); if (defined $start2) { if (ref($start2) eq 'Date::Manip::Date') { $start = $start2; } elsif (! ref($start2)) { $start = $self->new_date(); $start->parse($start2); } else { return ('Invalid start argument'); } return ('Start invalid') if ($start->err()); } elsif (defined $$self{'data'}{'start'}) { $start = $$self{'data'}{'start'}; return ('Start invalid') if ($start->err()); } if (defined $end2) { if (ref($end2) eq 'Date::Manip::Date') { $end = $end2; } elsif (! ref($end2)) { $end = $self->new_date(); $end->parse($end2); } else { return ('Invalid end argument'); } return ('End invalid') if ($end->err()); } elsif (defined $$self{'data'}{'end'}) { $end = $$self{'data'}{'end'}; return ('End invalid') if ($end->err()); } if (defined $$self{'data'}{'base'}) { my $base = $$self{'data'}{'base'}; return ('Base invalid') if ($base->err()); } # *Y:M:W:D:H:MN:S is complete. if ($$self{'data'}{'noint'}) { if ($$self{'data'}{'noint'} == 1) { my @dates = $self->_apply_rtime_mods(); $$self{'data'}{'noint'} = 2; my $n = 0; foreach my $date (@dates) { next if (! defined $date); $$self{'data'}{'dates'}{$n++} = $date; } return (0,$start,$end) if ($n == 0); if (defined $start && defined $end) { my ($first,$last); for (my $i=0; $i<$n; $i++) { my $date = $$self{'data'}{'dates'}{$i}; if ($start->cmp($date) <= 0 && $end->cmp($date) >= 0) { $first = $i; last; } } for (my $i=$n-1; $i>=0; $i--) { my $date = $$self{'data'}{'dates'}{$i}; if ($start->cmp($date) <= 0 && $end->cmp($date) >= 0) { $last = $i; last; } } $$self{'data'}{'first'} = $first; $$self{'data'}{'last'} = $last; } else { $$self{'data'}{'first'} = 0; $$self{'data'}{'last'} = $n-1; } } return (0,$start,$end); } # If a range is entered, it must be valid. Also # a range is required if $range_required is given. if ($start && $end) { return ('Range invalid') if ($start->cmp($end) == 1); } elsif ($range_required) { return ('Incomplete recurrence'); } # Check that the base date is available. $self->_actual_base($start); if (defined $$self{'data'}{'BASE'}) { my $base = $$self{'data'}{'BASE'}; return ('Base invalid') if ($base->err()); return (0,$start,$end); } return ('Incomplete recurrence'); } # This determines the actual base date from a specified base date (or # start date). If a base date cannot be set, then # $$self{'data'}{'BASE'} is NOT defined. # sub _actual_base { my($self,$start2) = @_; # Is the actual base date already defined? return if (defined $$self{'data'}{'BASE'}); # Use the specified base date or start date. my $base = undef; if (defined $$self{'data'}{'base'}) { $base = $$self{'data'}{'base'}; } elsif (defined $start2) { $base = $start2; } elsif (defined $$self{'data'}{'start'}) { $base = $$self{'data'}{'start'}; } else { return; } # Determine the actual base date from the specified base date. my $dmt = $$self{'tz'}; my $dmb = $$dmt{'base'}; $dmt->_update_now(); # Update NOW my @int = @{ $$self{'data'}{'interval'} }; my @rtime = @{ $$self{'data'}{'rtime'} }; my ($yf,$mf,$wf,$df,$hf,$mnf,$sf) = (@int,@rtime); my ($y,$m,$d,$h,$mn,$s) = $base->value(); my $BASE = $self->new_date(); my $n = @int; if ($n == 0) { # *Y:M:W:D:H:MN:S return; } elsif ($n == 1) { # Y*M:W:D:H:MN:S $BASE->set('date',[$y,1,1,0,0,0]); } elsif ($n == 2) { # Y:M*W:D:H:MN:S $BASE->set('date',[$y,$m,1,0,0,0]); } elsif ($n == 3) { # Y:M:W*D:H:MN:S my($yy,$w) = $dmb->week_of_year([$y,$m,$d,$h,$mn,$s]); my($ymd) = $dmb->week_of_year($yy,$w); $BASE->set('date',[@$ymd,0,0,0]); } elsif ($n == 4) { # Y:M:W:D*H:MN:S $BASE->set('date',[$y,$m,$d,0,0,0]); } elsif ($n == 5) { # Y:M:W:D:H*MN:S $BASE->set('date',[$y,$m,$d,$h,0,0]); } elsif ($n == 6) { # Y:M:W:D:H:MN*S $BASE->set('date',[$y,$m,$d,$h,$mn,0]); } else { # Y:M:W:D:H:MN:S $BASE->set('date',[$y,$m,$d,$h,$mn,$s]); } $$self{'data'}{'BASE'} = $BASE; } sub _rx { my($self,$rx) = @_; my $dmt = $$self{'tz'}; my $dmb = $$dmt{'base'}; return $$dmb{'data'}{'rx'}{'recur'}{$rx} if (exists $$dmb{'data'}{'rx'}{'recur'}{$rx}); if ($rx eq 'std') { my $l = '[0-9]*'; my $r = '[-,0-9]*'; my $stdrx = "(?$l:$l:$l:$l:$l:$l:$l)(?)|" . "(?$l:$l:$l:$l:$l:$l)\\*(?$r)|" . "(?$l:$l:$l:$l:$l)\\*(?$r:$r)|" . "(?$l:$l:$l:$l)\\*(?$r:$r:$r)|" . "(?$l:$l:$l)\\*(?$r:$r:$r:$r)|" . "(?$l:$l)\\*(?$r:$r:$r:$r:$r)|" . "(?$l)\\*(?$r:$r:$r:$r:$r:$r)|" . "(?)\\*(?$r:$r:$r:$r:$r:$r:$r)"; $$dmb{'data'}{'rx'}{'recur'}{$rx} = qr/^\s*(?:$stdrx)\s*$/; } elsif ($rx eq 'rfield' || $rx eq 'rnum' || $rx eq 'rrange') { my $num = '[+-]?\d+'; my $range = "$num\-$num"; my $val = "(?:$range|$num)"; my $vals = "$val(?:,$val)*"; $$dmb{'data'}{'rx'}{'recur'}{'rfield'} = qr/^($vals)$/; $$dmb{'data'}{'rx'}{'recur'}{'rnum'} = qr/^($num)$/; $$dmb{'data'}{'rx'}{'recur'}{'rrange'} = qr/^($num)\-($num)$/; } elsif ($rx eq 'each') { my $each = $$dmb{'data'}{'rx'}{'each'}; my $eachrx = qr/(?:^|\s+)(?:$each)(\s+|$)/i; $$dmb{'data'}{'rx'}{'recur'}{$rx} = $eachrx; } elsif ($rx eq 'ignore') { my $of = $$dmb{'data'}{'rx'}{'of'}; my $on = $$dmb{'data'}{'rx'}{'on'}; my $ignrx = qr/(?:^|\s+)(?:$on|$of)(\s+|$)/i; $$dmb{'data'}{'rx'}{'recur'}{$rx} = $ignrx; } elsif ($rx eq 'every') { my $month = $$dmb{'data'}{'rx'}{'fields'}[2]; my $week = $$dmb{'data'}{'rx'}{'fields'}[3]; my $day = $$dmb{'data'}{'rx'}{'fields'}[4]; my $last = $$dmb{'data'}{'rx'}{'last'}; my $nth = $$dmb{'data'}{'rx'}{'nth'}[0]; my $nth_wom = $$dmb{'data'}{'rx'}{'nth_wom'}[0]; my $nth_dom = $$dmb{'data'}{'rx'}{'nth_dom'}[0]; my $day_abb = $$dmb{'data'}{'rx'}{'day_abb'}[0]; my $day_name = $$dmb{'data'}{'rx'}{'day_name'}[0]; my $mon_abb = $$dmb{'data'}{'rx'}{'month_abb'}[0]; my $mon_name = $$dmb{'data'}{'rx'}{'month_name'}[0]; my $beg = '(?:^|\s+)'; my $end = '(?:\s*$)'; $month = "$beg(?$month)"; # months $week = "$beg(?$week)"; # weeks $day = "$beg(?$day)"; # days $last = "$beg(?$last)"; # last $nth = "$beg(?$nth)"; # 1st,2nd,... $nth_wom = "$beg(?$nth_wom)"; # 1st - 5th $nth_dom = "$beg(?$nth_dom)"; # 1st - 31st my $n = "$beg(?\\d+)"; # 1,2,... my $dow = "$beg(?:(?$day_name)|(?$day_abb))"; # Sun|Sunday my $mmm = "$beg(?:(?$mon_name)|(?$mon_abb))"; # Jan|January my $y = "(?:$beg(?:(?\\d\\d\\d\\d)|(?\\d\\d)))?"; my $freqrx = "$nth_wom?$dow$mmm$y|" . # every DoW in MMM [YY] "$last$dow$mmm$y|" . # Nth DoW in MMM [YY] # last DoW in MMM [YY] # day_name|day_abb # mon_name|mon_abb # last*|nth* # y* "$nth_wom?$dow$month$y|" . # every DoW of every month [YY] "$last$dow$month$y|" . # Nth DoW of every month [YY] # last DoW of every month [YY] # day_name|day_abb # last*|nth* # y* "$nth_dom?$day$month$y|" . # every day of every month [YY] "$last$day$month$y|" . # Nth day of every month [YY] # last day of every month [YY] # day # month # nth*|last* # y* "$nth*$day$y|" . # every day [YY] "$n$day$y"; # every Nth day [YY] # every N days [YY] # day # nth*|n* # y* $freqrx = qr/^(?:$freqrx)\s*$/i; $$dmb{'data'}{'rx'}{'recur'}{$rx} = $freqrx; } return $$dmb{'data'}{'rx'}{'recur'}{$rx}; } # @dates = $self->_apply_rtime_mods(); # # Should only be called if there is no interval (*Y:M:W:D:H:MN:S). # # It will use rtime/modifiers to get a list of all events # specified by the recurrence. This only needs to be done once. # # @dates = $self->_apply_rtime_mods($date); # # For all other types of recurrences, this will take a single # date and apply all rtime/modifiers to it to get a list of # events. # sub _apply_rtime_mods { my($self,$date) = @_; my $dmt = $$self{'tz'}; my $dmb = $$dmt{'base'}; my @int = @{ $$self{'data'}{'interval'} }; my @rtime = @{ $$self{'data'}{'rtime'} }; my $n = @int; my ($yf,$mf,$wf,$df,$hf,$mnf,$sf) = (@int,@rtime); my $m_empty = $self->_field_empty($mf); my $w_empty = $self->_field_empty($wf); my $d_empty = $self->_field_empty($df); my ($err,$y,$m,$d,$h,$mn,$s,@y,@m,@w,@d,@h,@mn,@s,@doy,@woy,@dow,@n); ($y,$m,$d,$h,$mn,$s) = $date->value() if (defined $date); my(@date); if ($n <= 1) { # # *Y:M:W:D:H:MN:S # Y*M:W:D:H:MN:S # if (@int == 0) { ($err,@y) = $self->_rtime_values('y',$yf); return () if ($err); } else { @y = ($y); } if ( ($m_empty && $w_empty && $d_empty) || (! $m_empty && $w_empty) ) { # *0:0:0:0 Jan 1 of the current year # *1:0:0:0 Jan 1, 0001 # *0:2:0:0 Feb 1 of the current year # *1:2:0:0 Feb 1, 0001 # *0:2:0:4 Feb 4th of the current year # *1:2:0:4 Feb 4th, 0001 # 1*0:0:0 every year on Jan 1 # 1*2:0:0 every year on Feb 1 # 1*2:0:4 every year on Feb 4th $mf = [1] if ($m_empty); $df = [1] if ($d_empty); ($err,@m) = $self->_rtime_values('m',$mf); return () if ($err); foreach my $y (@y) { foreach my $m (@m) { ($err,@d) = $self->_rtime_values('day_of_month',$df,$y,$m); return () if ($err); foreach my $d (@d) { push(@date,[$y,$m,$d,0,0,0]); } } } } elsif ($m_empty) { if ($w_empty) { # *0:0:0:4 the 4th day of the current year # *1:0:0:4 the 4th day of 0001 # 1*0:0:4 every year on the 4th day of the year foreach my $y (@y) { ($err,@doy) = $self->_rtime_values('day_of_year',$df,$y); return () if ($err); foreach my $doy (@doy) { my($yy,$mm,$dd) = @{ $dmb->day_of_year($y,$doy) }; push(@date,[$yy,$mm,$dd,0,0,0]); } } } elsif ($d_empty) { # *0:0:3:0 the first day of the 3rd week of the curr year # *1:0:3:0 the first day of the 3rd week of 0001 # 1*0:3:0 every year on the first day of 3rd week of year foreach my $y (@y) { ($err,@woy) = $self->_rtime_values('week_of_year',$wf,$y); return () if ($err); foreach my $woy (@woy) { my ($yy,$mm,$dd) = @{ $dmb->week_of_year($y,$woy) }; push(@date,[$yy,$mm,$dd,0,0,0]); } } } else { # *1:0:3:4 in 0001 on the 3rd Thur of the year # *0:0:3:4 on the 3rd Thur of the current year # 1*0:3:4 every year on the 3rd Thur of the year ($err,@dow) = $self->_rtime_values('day_of_week',$df); return () if ($err); foreach my $y (@y) { foreach my $dow (@dow) { ($err,@n) = $self->_rtime_values('dow_of_year',$wf,$y,$dow); return () if ($err); foreach my $n (@n) { my $ymd = $dmb->nth_day_of_week($y,$n,$dow); my($yy,$mm,$dd) = @$ymd; push(@date,[$yy,$mm,$dd,0,0,0]); } } } } } else { # *1:2:3:4 in Feb 0001 on the 3rd Thur of the month # *0:2:3:4 on the 3rd Thur of Feb in the curr year # *1:2:3:0 the 3rd occurrence of FirstDay in Feb 0001 # *0:2:3:0 the 3rd occurrence of FirstDay in Feb of curr year # 1*2:3:4 every year in Feb on the 3rd Thur # 1*2:3:0 every year on the 3rd occurrence of FirstDay in Feb ($err,@m) = $self->_rtime_values('m',$mf); return () if ($err); if ($d_empty) { @dow = ($dmb->_config('firstday')); } else { ($err,@dow) = $self->_rtime_values('day_of_week',$df); return () if ($err); } foreach my $y (@y) { foreach my $m (@m) { foreach my $dow (@dow) { ($err,@n) = $self->_rtime_values('dow_of_month', $wf,$y,$m,$dow); return () if ($err); foreach my $n (@n) { my $ymd = $dmb->nth_day_of_week($y,$n,$dow,$m); my($yy,$mm,$dd) = @$ymd; push(@date,[$yy,$mm,$dd,0,0,0]); } } } } } } elsif ($n == 2) { # # Y:M*W:D:H:MN:S # if ($w_empty) { # 0:2*0:0 every 2 months on the first day of the month # 0:2*0:4 every 2 months on the 4th day of the month # 1:2*0:0 every 1 year, 2 months on the first day of the month # 1:2*0:4 every 1 year, 2 months on the 4th day of the month $df = [1] if ($d_empty); ($err,@d) = $self->_rtime_values('day_of_month',$df,$y,$m); return () if ($err); foreach my $d (@d) { push(@date,[$y,$m,$d,0,0,0]); } } else { # 0:2*3:0 every 2 months on the 3rd occurrence of FirstDay # 0:2*3:4 every 2 months on the 3rd Thur of the month # 1:2*3:0 every 1 year, 2 months on 3rd occurrence of FirstDay # 1:2*3:4 every 1 year, 2 months on the 3rd Thur of the month if ($d_empty) { @dow = ($dmb->_config('firstday')); } else { ($err,@dow) = $self->_rtime_values('day_of_week',$df); return () if ($err); } foreach my $dow (@dow) { ($err,@n) = $self->_rtime_values('dow_of_month', $wf,$y,$m,$dow); return () if ($err); foreach my $n (@n) { my $ymd = $dmb->nth_day_of_week($y,$n,$dow,$m); my($yy,$mm,$dd) = @$ymd; push(@date,[$yy,$mm,$dd,0,0,0]); } } } } elsif ($n == 3) { # # Y:M:W*D:H:MN:S # # 0:0:3*0 every 3 weeks on FirstDay # 0:0:3*4 every 3 weeks on Thur # 0:2:3*0 every 2 months, 3 weeks on FirstDay # 0:2:3*4 every 2 months, 3 weeks on Thur # 1:0:3*0 every 1 year, 3 weeks on FirstDay # 1:0:3*4 every 1 year, 3 weeks on Thur # 1:2:3*0 every 1 year, 2 months, 3 weeks on FirstDay # 1:2:3*4 every 1 year, 2 months, 3 weeks on Thur my $fdow = $dmb->_config('firstday'); if ($d_empty) { @dow = ($fdow); } else { ($err,@dow) = $self->_rtime_values('day_of_week',$df); return () if ($err); } my($mm,$dd); my($yy,$ww) = $dmb->week_of_year([$y,$m,$d]); ($yy,$mm,$dd) = @{ $dmb->week_of_year($yy,$ww) }; foreach my $dow (@dow) { $dow += 7 if ($dow < $fdow); my($yyy,$mmm,$ddd) = @{ $dmb->calc_date_days([$yy,$mm,$dd],$dow-$fdow) }; push(@date,[$yyy,$mmm,$ddd,0,0,0]); } } elsif ($n == 4) { # # Y:M:W:D*H:MN:S # push(@date,[$y,$m,$d,0,0,0]); } elsif ($n == 5) { # # Y:M:W:D:H*MN:S # push(@date,[$y,$m,$d,$h,0,0]); } elsif ($n == 6) { # # Y:M:W:D:H:MN*S # push(@date,[$y,$m,$d,$h,$mn,0]); } elsif ($n == 7) { # # Y:M:W:D:H:MN:S # push(@date,[$y,$m,$d,$h,$mn,$s]); } # # Handle the H/MN/S portion. # # Do hours if ($n <= 4 ) { ($err,@h) = $self->_rtime_values('h',$hf); return () if ($err); $self->_field_add_values(\@date,3,@h); } # Do minutes if ($n <= 5) { ($err,@mn) = $self->_rtime_values('mn',$mnf); return () if ($err); $self->_field_add_values(\@date,4,@mn); } # Do seconds if ($n <= 6) { ($err,@s) = $self->_rtime_values('s',$sf); return () if ($err); $self->_field_add_values(\@date,5,@s); } # Sort the dates... just to be sure. @date = sort { $dmb->cmp($a,$b) } @date if (@date); # # Apply modifiers # my @flags = @{ $$self{'data'}{'flags'} }; if (@flags) { my $obj = $self->new_date(); my @keep; foreach my $date (@date) { my ($y,$m,$d,$h,$mn,$s) = @$date; my $keep = 1; MODIFIER: foreach my $flag (@flags) { my(@wd,$today); if ($flag =~ /^([pn])([dt])([1-7])$/) { my($forw,$today,$dow) = ($1,$2,$3); $forw = ($forw eq 'p' ? 0 : 1); $today = ($today eq 'd' ? 0 : 1); ($y,$m,$d,$h,$mn,$s) = @{ $obj->__next_prev([$y,$m,$d,$h,$mn,$s],$forw,$dow,$today) }; } elsif ($flag =~ /^([fb])([dw])(\d+)$/) { my($prev,$business,$n) = ($1,$2,$3); $prev = ($prev eq 'b' ? 1 : 0); $business = ($business eq 'w' ? 1 : 0); if ($business) { ($y,$m,$d,$h,$mn,$s) = @{ $obj->__nextprev_business_day($prev,$n,0,[$y,$m,$d,$h,$mn,$s]) }; } else { ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],$n,$prev) }; } } elsif ($flag eq 'ibd' || $flag eq 'nbd') { my $bd = $obj->__is_business_day([$y,$m,$d,$h,$mn,$s],0); if ( ($flag eq 'ibd' && ! $bd) || ($flag eq 'nbd' && $bd) ) { $keep = 0; last MODIFIER; } } elsif ($flag =~ /^([in])w([1-7])$/) { my($is,$dow) = ($1,$2); $is = ($is eq 'i' ? 1 : 0); my $currdow = $dmb->day_of_week([$y,$m,$d]); # Current dow if ( ($is && $dow != $currdow) || (! $is && $dow == $currdow) ) { $keep = 0; last MODIFIER; } } elsif ($flag =~ /^wd([1-7])$/) { my $dow = $1; # Dow wanted my $currdow = $dmb->day_of_week([$y,$m,$d]); # Current dow if ($dow != $currdow) { my($yy,$ww) = $dmb->week_of_year([$y,$m,$d]); # What week is this my $tmp = $dmb->week_of_year($yy,$ww); # First day of week ($y,$m,$d) = @$tmp; $currdow = $dmb->_config('firstday'); if ($dow > $currdow) { $tmp = $dmb->calc_date_days([$y,$m,$d],$dow-$currdow); ($y,$m,$d) = @$tmp; } elsif ($dow < $currdow) { $tmp = $dmb->calc_date_days([$y,$m,$d],$dow-$currdow+7); ($y,$m,$d) = @$tmp; } } } elsif ($flag eq 'nwd') { if (! $obj->__is_business_day([$y,$m,$d,$h,$mn,$s],0)) { ($y,$m,$d,$h,$mn,$s) = @{ $obj->__nextprev_business_day(0,0,0,[$y,$m,$d,$h,$mn,$s]) }; } } elsif ($flag eq 'pwd') { if (! $obj->__is_business_day([$y,$m,$d,$h,$mn,$s],0)) { ($y,$m,$d,$h,$mn,$s) = @{ $obj->__nextprev_business_day(1,1,0,[$y,$m,$d,$h,$mn,$s]) }; } } elsif ($flag eq 'easter') { ($m,$d) = $self->_easter($y); } elsif ($flag eq 'dwd' && $obj->__is_business_day([$y,$m,$d,$h,$mn,$s],0)) { # nothing } else { if ($flag eq 'cwd' || $flag eq 'dwd') { if ($dmb->_config('tomorrowfirst')) { @wd = ([$y,$m,$d,$h,$mn,$s],+1, [$y,$m,$d,$h,$mn,$s],-1); } else { @wd = ([$y,$m,$d,$h,$mn,$s],-1, [$y,$m,$d,$h,$mn,$s],+1); } } elsif ($flag eq 'cwn') { @wd = ([$y,$m,$d,$h,$mn,$s],+1, [$y,$m,$d,$h,$mn,$s],-1); $today = 0; } elsif ($flag eq 'cwp') { @wd = ([$y,$m,$d,$h,$mn,$s],-1, [$y,$m,$d,$h,$mn,$s],+1); $today = 0; } while (1) { my(@d,$off); # Test in the first direction @d = @{ $wd[0] }; $off = $wd[1]; @d = @{ $dmb->calc_date_days(\@d,$off) }; if ($obj->__is_business_day(\@d,0)) { ($y,$m,$d,$h,$mn,$s) = @d; last; } $wd[0] = [@d]; # Test in the other direction @d = @{ $wd[2] }; $off = $wd[3]; @d = @{ $dmb->calc_date_days(\@d,$off) }; if ($obj->__is_business_day(\@d,0)) { ($y,$m,$d,$h,$mn,$s) = @d; last; } $wd[2] = [@d]; } } } if ($keep) { push(@keep,[$y,$m,$d,$h,$mn,$s]); } } @date = @keep; } # # Convert the dates to objects. # my(@ret); foreach my $date (@date) { my @d = @$date; my $obj = $self->new_date(); $obj->set('date',\@d); if ($obj->err()) { push(@ret,undef); } else { push(@ret,$obj); } } return @ret; } # This calculates the Nth interval date (0 is the base date) and then # calculates the recurring events produced by it. # sub _nth_interval { my($self,$n) = @_; return if (exists $$self{'data'}{'idate'}{$n}); my $base = $$self{'data'}{'BASE'}; my $date; # Get the interval date. if ($n == 0) { $date = $base; } else { my @delta = $$self{'data'}{'delta'}->value; my $absn = abs($n); @delta = map { $absn*$_ } @delta; my $delta = $self->new_delta; $delta->set('delta',[@delta]); $date = $base->calc($delta, ($n>0 ? 0 : 2)); } # For 'slow' recursion, we need to make sure we've got # the n-1 or n+1 interval as appropriate. if ($$self{'data'}{'slow'}) { if ($n > 0) { $self->_nth_interval($n-1); } elsif ($n < 0) { $self->_nth_interval($n+1); } } # Get the list of events associated with this interval date. my @date = $self->_apply_rtime_mods($date); # Determine the index of the earliest event associated with # this interval date. # # Events are numbered [$n0...$n1] my($n0,$n1); if ($$self{'data'}{'slow'}) { if (! @date) { $n0 = undef; $n1 = undef; } elsif ($n == 0) { $n0 = 0; $n1 = $#date; } elsif ($n > 0) { foreach (my $i = $n-1; $i >= 0; $i--) { next if (! defined $$self{'data'}{'idate'}{$i}[2]); $n0 = $$self{'data'}{'idate'}{$i}[2] + 1; last; } $n0 = 0 if (! defined $n0); $n1 = $n0 + $#date; } else { foreach (my $i = $n+1; $i <= 0; $i++) { next if (! defined $$self{'data'}{'idate'}{$i}[1]); $n1 = $$self{'data'}{'idate'}{$i}[1] - 1; last; } $n1 = -1 if (! defined $n1); $n0 = $n1 - $#date; } } else { # ev_per_d = 3 # idate = 0 1 2 # events = 0 1 2 3 4 5 6 7 8 # ev_per_d = 3 # idate = -1 -2 -3 # events = -3 -2 -1 -6 -5 -4 -9 -8 -7 $n0 = $n * $$self{'data'}{'ev_per_d'}; $n1 = $n0 + $$self{'data'}{'ev_per_d'} - 1; } # Store the dates. for (my $i=0; $i<=$#date; $i++) { $$self{'data'}{'dates'}{$n0+$i} = $date[$i]; } # Store the idate. if ($$self{'data'}{'slow'}) { $$self{'data'}{'idate'}{$n} = [$date,$n0,$n1]; } else { $$self{'data'}{'idate'}{$n} = $date; } } # This locates the first/last event in the range and returns $n. It # returns undef if there is no date in the range. # sub _locate_n { my($self,$op) = @_; return $$self{'data'}{$op} if (defined $$self{'data'}{$op}); my $start = $$self{'data'}{'start'}; my $end = $$self{'data'}{'end'}; my $unmod = $$self{'data'}{'unmod_range'}; if ($$self{'data'}{'noint'} == 2) { # If there is no interval, then we have calculated all the dates # possible. Work with them only. my($i,$first,$last); # Find the first date in the interval $i = 0; while (1) { last if (! exists $$self{'data'}{'dates'}{$i}); my $date = $$self{'data'}{'dates'}{$i}; if ($date->cmp($start) == -1) { # date < start : move to the next one $i++; next; } elsif ($date->cmp($end) == 1) { # date > end : we're done last; } else { # start <= date <= end : this is the first one $first = $i; last; } } # If we found one, find the last one if (defined($first)) { $i = $first; $last = $i; while (1) { last if (! exists $$self{'data'}{'dates'}{$i}); my $date = $$self{'data'}{'dates'}{$i}; if ($date->cmp($end) == 1) { # date > end : we're done last; } else { # date <= end : this might be the last one $last = $i; $i++; next; } } } $$self{'data'}{'first'} = $first; $$self{'data'}{'last'} = $last; return $$self{'data'}{$op} } # Given interval date Idate(n) produces event dates: Date(f)..Date(l) # # If we're looking at unmodified dates: # Find smallest n such that: # Idate(n) >= start # first=f # Then find largest n such that: # Idate(n) <= end # last=l # Otherwise # Find smallest n such that # Date(y) >= start # first=z (smallest z) # Where x <= z <= y and # Date(z) >= start # Then find largest n such that # Date(x) <= end # last=z (largest z) # Where x <= z <= y and # Date(z) <= end my($first_int,$last_int,$first,$last); if ($$self{'data'}{'slow'}) { # # For a 'slow' recurrence, we have to start at 0 and work forwards # or backwards. # # Move backwards until we're completely before start $first_int = 0; if ($unmod) { while (1) { $self->_nth_interval($first_int); my $date = $$self{'data'}{'idate'}{$first_int}[0]; last if (defined $date && $date->cmp($start) < 0); $first_int--; } } else { while (1) { $self->_nth_interval($first_int); my $ptr = $$self{'data'}{'idate'}{$first_int}[2]; if (defined $ptr) { my $date = $$self{'data'}{'dates'}{$ptr}; last if (defined $date && $date->cmp($start) < 0); } $first_int--; } } # Then move forwards until we're after start # i.e. Date(y) >= start for modified dates if ($unmod) { while (1) { $self->_nth_interval($first_int); my $date = $$self{'data'}{'idate'}{$first_int}[0]; last if (defined $date && $date->cmp($start) >= 0); $first_int++; } $first = $$self{'data'}{'idate'}{$first_int}[1]; } else { while (1) { $self->_nth_interval($first_int); my $ptr = $$self{'data'}{'idate'}{$first_int}[2]; if (defined $ptr) { my $date = $$self{'data'}{'dates'}{$ptr}; last if (defined $date && $date->cmp($start) >= 0); } $first_int++; } foreach my $i ($$self{'data'}{'idate'}{$first_int}[1] .. $$self{'data'}{'idate'}{$first_int}[2]) { my $date = $$self{'data'}{'dates'}{$i}; if (defined $date && $date->cmp($start) >= 0) { $first = $i; last; } } } # Then move forwards until we're after end # i.e. Date(x) > end for modified dates $last_int = $first_int; if ($unmod) { while (1) { $self->_nth_interval($last_int); my $date = $$self{'data'}{'idate'}{$last_int}[0]; last if (defined $date && $date->cmp($end) > 0); $last_int++; } $last_int--; for (my $i=$$self{'data'}{'idate'}{$last_int}[2]; $i >= $$self{'data'}{'idate'}{$last_int}[1]; $i--) { my $date = $$self{'data'}{'dates'}{$i}; if (defined $date) { $last = $i; last; } } } else { while (1) { $self->_nth_interval($last_int); my $ptr = $$self{'data'}{'idate'}{$last_int}[1]; if (defined $ptr) { my $date = $$self{'data'}{'dates'}{$ptr}; last if (defined $date && $date->cmp($end) > 0); } $last_int++; } $last_int--; $last = undef; my $i = $first; while (1) { last if (! exists $$self{'data'}{'dates'}{$i}); my $date = $$self{'data'}{'dates'}{$i}; next if (! defined $date); last if ($date->cmp($end) > 0); $last = $i; $i++; } } return undef if (! defined $last || $last < $first); $$self{'data'}{'first'} = $first; $$self{'data'}{'last'} = $last; return $$self{'data'}{$op} } # # For a normal recurrence, we can estimate which interval date we're # interested in and then move forward/backward from it. # # Calculate the interval date index ($nn) based on the length of # the delta. # # For the Nth interval, the dates produced are: # N*EV_PER_DAY to (N+1)EV_PER_DAY-1 # my $base = $$self{'data'}{'BASE'}; my $delta = $$self{'data'}{'delta'}; # $len = 0 is when a recur contains no delta (i.e. *Y:M:W:D:H:Mn:S) my $len = ($delta ? $delta->printf('%sys') : 0); my $targ = ($op eq 'first' ? $start : $end); my $diff = $base->calc($targ); my $tot = $diff->printf('%sys'); my $nn = ($len ? int($tot/$len) : 1); my $ev = $$self{'data'}{'ev_per_d'}; # Move backwards until we're completely before start $first_int = $nn; if ($unmod) { while (1) { $self->_nth_interval($first_int); my $date = $$self{'data'}{'idate'}{$first_int}; last if (defined $date && $date->cmp($start) < 0); $first_int--; } } else { LOOP: while (1) { $self->_nth_interval($first_int); for (my $i=($first_int+1)*$ev - 1; $i >= $first_int*$ev; $i--) { next if (! exists $$self{'data'}{'dates'}{$i}); my $date = $$self{'data'}{'dates'}{$i}; last LOOP if ($date->cmp($start) < 0); } $first_int--; } } # Then move forwards until we're after start # i.e. Date(y) >= start for modified dates if ($unmod) { while (1) { $self->_nth_interval($first_int); my $date = $$self{'data'}{'idate'}{$first_int}; last if (defined $date && $date->cmp($start) >= 0); $first_int++; } } else { LOOP: while (1) { $self->_nth_interval($first_int); for (my $i=($first_int+1)*$ev - 1; $i >= $first_int*$ev; $i--) { next if (! exists $$self{'data'}{'dates'}{$i}); my $date = $$self{'data'}{'dates'}{$i}; last LOOP if ($date->cmp($start) >= 0); } $first_int++; } } $first = $first_int*$ev; # Then move forwards until we're after end # i.e. Date(y) > end for modified dates $last_int = $first_int; if ($unmod) { while (1) { $self->_nth_interval($last_int); my $date = $$self{'data'}{'idate'}{$last_int}; last if (defined $date && $date->cmp($end) > 0); $last_int++; } $last_int--; } else { LOOP: while (1) { $self->_nth_interval($last_int); for (my $i=($last_int+1)*$ev - 1; $i >= $last_int*$ev; $i--) { next if (! exists $$self{'data'}{'dates'}{$i}); my $date = $$self{'data'}{'dates'}{$i}; last LOOP if ($date->cmp($end) >= 0); } $last_int++; } } $last = ($last_int+1)*$ev - 1; # Now get the actual first/last dates if ($unmod) { while (1) { last if (exists $$self{'data'}{'dates'}{$first} && defined $$self{'data'}{'dates'}{$first}); $first++; return undef if ($first > $last); } while (1) { last if (exists $$self{'data'}{'dates'}{$last} && defined $$self{'data'}{'dates'}{$last}); $last--; } } else { while (1) { last if (exists $$self{'data'}{'dates'}{$first} && defined $$self{'data'}{'dates'}{$first} && $$self{'data'}{'dates'}{$first}->cmp($start) >= 0); $first++; return undef if ($first > $last); } while (1) { last if (exists $$self{'data'}{'dates'}{$last} && defined $$self{'data'}{'dates'}{$last} && $$self{'data'}{'dates'}{$last}->cmp($end) <= 0); $last--; } } return undef if (! defined $last || $last < $first); $$self{'data'}{'first'} = $first; $$self{'data'}{'last'} = $last; return $$self{'data'}{$op} } # This returns the date easter occurs on for a given year as ($month,$day). # This is from the Calendar FAQ. # sub _easter { my($self,$y) = @_; my($c) = $y/100; my($g) = $y % 19; my($k) = ($c-17)/25; my($i) = ($c - $c/4 - ($c-$k)/3 + 19*$g + 15) % 30; $i = $i - ($i/28)*(1 - ($i/28)*(29/($i+1))*((21-$g)/11)); my($j) = ($y + $y/4 + $i + 2 - $c + $c/4) % 7; my($l) = $i-$j; my($m) = 3 + ($l+40)/44; my($d) = $l + 28 - 31*($m/4); return ($m,$d); } # This returns 1 if a field is empty. # sub _field_empty { my($self,$val) = @_; if (ref($val)) { my @tmp = @$val; return 1 if ($#tmp == -1 || ($#tmp == 0 && ! ref($tmp[0]) && ! $tmp[0])); return 0; } else { return $val; } } # This returns a list of values that appear in a field in the rtime. # # $val is a listref, with each element being a value or a range. # # Usage: # _rtime_values('y' ,$y); # _rtime_values('m' ,$m); # _rtime_values('week_of_year' ,$w ,$y); # _rtime_values('dow_of_year' ,$w ,$y,$dow); # _rtime_values('dow_of_month' ,$w ,$y,$m,$dow); # _rtime_values('day_of_year' ,$d ,$y); # _rtime_values('day_of_month' ,$d ,$y,$m); # _rtime_values('day_of_week' ,$d); # _rtime_values('h' ,$h); # _rtime_values('mn' ,$mn); # _rtime_values('s' ,$s); # # Returns ($err,@vals) # sub _rtime_values { my($self,$type,$val,@args) = @_; my $dmt = $$self{'tz'}; my $dmb = $$dmt{'base'}; if ($type eq 'h') { @args = (0,0,23,23); } elsif ($type eq 'mn') { @args = (0,0,59,59); } elsif ($type eq 's') { @args = (0,0,59,59); } elsif ($type eq 'y') { my $curry = $dmt->_now('y',1); foreach my $y (@$val) { $y = $curry if (! ref($y) && $y==0); } @args = (0,1,9999,9999); } elsif ($type eq 'm') { @args = (0,1,12,12); } elsif ($type eq 'week_of_year') { my($y) = @args; my $wiy = $dmb->weeks_in_year($y); @args = (1,1,$wiy,53); } elsif ($type eq 'dow_of_year') { my($y,$dow) = @args; # Get the 1st occurrence of $dow my $d0 = 1; my $dow0 = $dmb->day_of_week([$y,1,$d0]); if ($dow > $dow0) { $d0 += ($dow-$dow0); } elsif ($dow < $dow0) { $d0 += 7-($dow0-$dow); } # Get the last occurrence of $dow my $d1 = 31; my $dow1 = $dmb->day_of_week([$y,12,$d1]); if ($dow1 > $dow) { $d1 -= ($dow1-$dow); } elsif ($dow1 < $dow) { $d1 -= 7-($dow-$dow1); } # Find out the number of occurrenced of $dow my $doy1 = $dmb->day_of_year([$y,12,$d1]); my $n = ($doy1 - $d0)/7 + 1; # Get the list of @w @args = (1,1,$n,53); } elsif ($type eq 'dow_of_month') { my($y,$m,$dow) = @args; # Get the 1st occurrence of $dow in the month my $d0 = 1; my $dow0 = $dmb->day_of_week([$y,$m,$d0]); if ($dow > $dow0) { $d0 += ($dow-$dow0); } elsif ($dow < $dow0) { $d0 += 7-($dow0-$dow); } # Get the last occurrence of $dow my $d1 = $dmb->days_in_month($y,$m); my $dow1 = $dmb->day_of_week([$y,$m,$d1]); if ($dow1 > $dow) { $d1 -= ($dow1-$dow); } elsif ($dow1 < $dow) { $d1 -= 7-($dow-$dow1); } # Find out the number of occurrenced of $dow my $n = ($d1 - $d0)/7 + 1; # Get the list of @w @args = (1,1,$n,5); } elsif ($type eq 'day_of_year') { my($y) = @args; my $diy = $dmb->days_in_year($y); @args = (1,1,$diy,366); } elsif ($type eq 'day_of_month') { my($y,$m) = @args; my $dim = $dmb->days_in_month($y,$m); @args = (1,1,$dim,31); } elsif ($type eq 'day_of_week') { @args = (0,1,7,7); } my($err,@vals) = $self->__rtime_values($val,@args); if ($err) { $$self{'err'} = "[dates] $err [$type]"; return (1); } return(0,@vals); } # This returns the raw values for a list. # # If $allowneg is 0, only positive numbers are allowed, and they must be # in the range [$min,$absmax]. If $allowneg is 1, positive numbers in the # range [$min,$absmax] and negative numbers in the range [-$absmax,-$min] # are allowed. An error occurs if a value falls outside the range. # # Only values in the range of [$min,$max] are actually kept. This allows # a recurrence for day_of_month to be 1-31 and not fail for a month that # has fewer than 31 days. Any value outside the [$min,$max] are silently # discarded. # # Returns: # ($err,@vals) # sub __rtime_values { my($self,$vals,$allowneg,$min,$max,$absmax) = @_; my(@ret); foreach my $val (@$vals) { if (ref($val)) { my($val1,$val2) = @$val; if ($allowneg) { return ('Value outside range') if ( ($val1 >= 0 && ($val1 < $min || $val1 > $absmax) ) || ($val2 >= 0 && ($val2 < $min || $val2 > $absmax) ) ); return ('Negative value outside range') if ( ($val1 <= 0 && ($val1 < -$absmax || $val1 > -$min) ) || ($val2 <= 0 && ($val2 < -$absmax || $val2 > -$min) ) ); } else { return ('Value outside range') if ( ($val1 < $min || $val1 > $absmax) || ($val2 < $min || $val2 > $absmax) ); } return ('Range values reversed') if ( ($val1 <= 0 && $val2 <= 0 && $val1 > $val2) || ($val1 >= 0 && $val2 >= 0 && $val1 > $val2) ); # Use $max instead of $absmax when converting negative numbers to # positive ones. $val1 = $max + $val1 + 1 if ($val1 < 0); # day -10 $val2 = $max + $val2 + 1 if ($val2 < 0); $val1 = $min if ($val1 < $min); # day -31 in a 30 day month $val2 = $max if ($val2 > $max); next if ($val1 > $val2); push(@ret,$val1..$val2); } else { if ($allowneg) { return ('Value outside range') if ($val >= 0 && ($val < $min || $val > $absmax)); return ('Negative value outside range') if ($val <= 0 && ($val < -$absmax || $val > -$min)); } else { return ('Value outside range') if ($val < $min || $val > $absmax); } # Use $max instead of $absmax when converting negative numbers to # positive ones. my $ret; if ($val < 0 ) { $ret = $max + $val + 1; } else { $ret = $val; } next if ($ret > $max || $ret < $min); push(@ret,$ret); } } return ('',@ret); } # This takes a list of dates (each a listref of [y,m,d,h,mn,s]) and replaces # the Nth field with all of the possible values passed in, creating a new # list with all the dates. # sub _field_add_values { my($self,$datesref,$n,@val) = @_; my @dates = @$datesref; my @tmp; foreach my $date (@dates) { my @d = @$date; foreach my $val (@val) { $d[$n] = $val; push(@tmp,[@d]); } } @$datesref = @tmp; } 1; # Local Variables: # mode: cperl # indent-tabs-mode: nil # cperl-indent-level: 3 # cperl-continued-statement-offset: 2 # cperl-continued-brace-offset: 0 # cperl-brace-offset: 0 # cperl-brace-imaginary-offset: 0 # cperl-label-offset: 0 # End: