package Date::Manip::Recur;
# Copyright (c) 1998-2013 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.41';
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'}{'holiday'}  = 0;     # If this is 1, the start/end data
                                       # actually apply to the interval dates
                                       # instead of the final dates.  This is
                                       # only used in determining holidays
                                       # currently.
   $$self{'data'}{'saved'}    = {};    # I => 1  if date I is stored as a holiday

   $$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'}    = {};    # { N => Nth interval date } for non-slow
                                       # { N => [Nth interval date,X,Y] } for slow
                                       #   [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]);

   } 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]);

   } 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]);

   } 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]);

   } 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]);
   }
}

# 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'}{'saved'} = {};
   }
   $$self{'data'}{'curr'}     = undef;
   $$self{'data'}{'first'}    = undef;
   $$self{'data'}{'last'}     = undef;
}

sub _init_args {
   my($self) = @_;

   my @args = @{ $$self{'args'} };
   if (@args) {
      $self->parse(@args);
   }
}

sub _holiday {
   my($self,$val) = @_;
   if ($val) {
      $$self{'data'}{'holiday'} = $val;
   } else {
      $$self{'data'}{'holiday'} = 1;
   }
}

########################################################################
# METHODS
########################################################################

sub parse {
   my($self,$string,@args) = @_;

   # 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/^([^*]*)\*//) {
         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 == 1  ||  @args == 4) {
      my $tmp = shift(@args);
      if ($tmp  &&  ! ref($tmp)) {
         $err = $self->modifiers($tmp);
         return 1  if ($err);
      }
   }

   # Handle BASE

   if (@string) {
      my $tmp = shift(@string);
      $err = $self->basedate($tmp)  if (defined($tmp)  &&  $tmp);
      return 1  if ($err);
   }
   if (@args == 3) {
      my $tmp = $args[0];
      $err = $self->basedate($tmp)  if (defined($tmp)  &&  $tmp);
      return 1  if ($err);
   }

   # Handle START

   if (@string) {
      my $tmp = shift(@string);
      $err = $self->start($tmp)  if (defined($tmp)  &&  $tmp);
      return 1  if ($err);
   }
   if (@args == 3) {
      my $tmp = $args[1];
      $err = $self->start($tmp)  if (defined($tmp)  &&  $tmp);
      return 1  if ($err);
   }

   # END

   if (@string) {
      my $tmp = shift(@string);
      $err = $self->end($tmp)  if (defined($tmp)  &&  $tmp);
      return 1  if ($err);
   }
   if (@args == 3) {
      my $tmp = $args[2];
      @args   = ();
      $err = $self->end($tmp)  if (defined($tmp)  &&  $tmp);
      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) {
      TEST_INT: {
         for my $i (@int) {
            last TEST_INT if ($i);
         }
         $int[$#int] = 1;
      }
   }

   # If @int contains 2 or 3 elements, move a 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);
   }

   # 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,$2);

            if ( ($num1 < 0  ||  $num2 < 0)  &&
                 ($type ne 'w'  &&  $type ne 'd') ) {
               $$self{'err'} = "[frequency] Negative values allowed for day/week";
               return 1;
            }

            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 {
            if ($vals < 0  &&
                 ($type ne 'w'  &&  $type ne 'd') ) {
               $$self{'err'} = "[frequency] Negative values allowed for day/week";
               return 1;
            }
            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 _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) = @_;
   return $$self{'data'}{'start'}  if (! defined $start);

   $self->_init_dates(1);
   $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|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);

   if ($$self{'data'}{'noint'}) {
      return ($$self{'data'}{'dates'}{$n},0)
        if (exists $$self{'data'}{'dates'}{$n});
      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) = @_;
   $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);

   # 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);

   if ($tmp_limits) {
      $old_start              = $$self{'data'}{'start'};
      $old_end                = $$self{'data'}{'end'};
      $old_first              = $$self{'data'}{'first'};
      $old_last               = $$self{'data'}{'last'};

      $$self{'data'}{'start'} = $start2;
      $$self{'data'}{'end'}   = $end2;
      $$self{'data'}{'first'} = undef;
      $$self{'data'}{'last'}  = undef;
   }

   # 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;
   }

   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)(?<r>)|" .
                   "(?<l>$l:$l:$l:$l:$l:$l)\\*(?<r>$r)|" .
                   "(?<l>$l:$l:$l:$l:$l)\\*(?<r>$r:$r)|" .
                   "(?<l>$l:$l:$l:$l)\\*(?<r>$r:$r:$r)|" .
                   "(?<l>$l:$l:$l)\\*(?<r>$r:$r:$r:$r)|" .
                   "(?<l>$l:$l)\\*(?<r>$r:$r:$r:$r:$r)|" .
                   "(?<l>$l)\\*(?<r>$r:$r:$r:$r:$r:$r)|" .
                   "(?<l>)\\*(?<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>$month)";         # months
      $week        = "$beg(?<week>$week)";           # weeks
      $day         = "$beg(?<day>$day)";             # days

      $last        = "$beg(?<last>$last)";           # last
      $nth         = "$beg(?<nth>$nth)";             # 1st,2nd,...
      $nth_wom     = "$beg(?<nth>$nth_wom)";         # 1st - 5th
      $nth_dom     = "$beg(?<nth>$nth_dom)";         # 1st - 31st
      my $n        = "$beg(?<n>\\d+)";               # 1,2,...

      my $dow      = "$beg(?:(?<day_name>$day_name)|(?<day_abb>$day_abb))";  # Sun|Sunday
      my $mmm      = "$beg(?:(?<mon_name>$mon_name)|(?<mon_abb>$mon_abb))";  # Jan|January

      my $y        = "(?:$beg(?:(?<y>\\d\\d\\d\\d)|(?<y>\\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 occurence of FirstDay in Feb 0001
         #  *0:2:3:0       the 3rd occurence 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 occurence 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 occurence 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 occurence 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 =~ /^wd(\d)$/) {
               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      ($n == 0) {
         $n0 = 0;
         $n1 = $#date;

      } elsif ($n > 0) {
         $n0 = $$self{'data'}{'idate'}{$n-1}[2] + 1;
         $n1 = $n0 + $#date;

      } else {
         $n1 = $$self{'data'}{'idate'}{$n+1}[1] - 1;
         $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}  ||
                                   $$self{'data'}{'noint'} == 2);

   my ($first,$last);
   my $start = $$self{'data'}{'start'};
   my $end   = $$self{'data'}{'end'};

   #
   # For a 'slow' recurrence, we'll get both the start and the end at
   # once by starting at n=0 and working forwards or backwards.
   #

   if ($$self{'data'}{'slow'}) {

      if ($$self{'data'}{'holiday'}) {
         # Move backwards until date <= start
         # Then move forwards until date >= start
         #
         # Then move forwards until we have a date > end
         #
         # We want:
         # start <= date(first) <= date(last) <= end

         my($date,$first,$last);
         $first    = 0;
         while (1) {
            $self->_nth_interval($first);
            $date = $$self{'data'}{'idate'}{$first}[0];
            last  if (defined $date  &&  $date->cmp($start) <= 0);
            $first--;
         }
         while (1) {
            $self->_nth_interval($first);
            $date = $$self{'data'}{'idate'}{$first}[0];
            last  if (defined $date  &&  $date->cmp($start) >= 0);
            $first++;
         }

         return undef  if ($date->cmp($end) == 1);
         $last = $first;

         while (1) {
            $self->_nth_interval($last);
            $date = $$self{'data'}{'idate'}{$last}[0];
            last  if (defined $date  &&  $date->cmp($end) == 1);
            $last++;
         }
         $last--;

         $first = $$self{'data'}{'idate'}{$first}[1];
         $last  = $$self{'data'}{'idate'}{$last}[2];

      } else {
         # Move backwards until date <= start
         # Then move forwards until date >= start
         #
         # Then move forwards until we have date > end
         #
         # We want:
         # start <= date(first) <= date(last) <= end

         my($date,$err);
         $first    = 0;
         while (1) {
            ($date,$err)  = $self->nth($first);
            last  if (defined $date  &&  $date->cmp($start) <= 0);
            $first--;
         }
         while (1) {
            ($date,$err)  = $self->nth($first);
            last  if (defined $date  &&  $date->cmp($start) >= 0);
            $first++;
         }

         return undef  if ($date->cmp($end) == 1);
         $last = $first;

         while (1) {
            ($date,$err)  = $self->nth($last);
            last  if (defined $date  &&  $date->cmp($end) == 1);
            $last++;
         }
         $last--;
      }

      return undef  if ($last < $first);
      $$self{'data'}{'first'} = $first;
      $$self{'data'}{'last'}  = $last;
      return $$self{'data'}{$op}
   }

   #
   # For a regular 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.
   #

   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 $n     = $nn*$$self{'data'}{'ev_per_d'};

   #
   # For a holiday, find the NNth interval date.
   #

   my($date);

   if ($$self{'data'}{'holiday'}) {

      # Move backwards until we have date <= target
      # Move forward until we have date >= target  (after)
      # Move backarad again until we have date <= target  (before)

      my($beforenn,$afternn);
      $afternn = $nn;

      while (1) {
         $self->_nth_interval($afternn);
         $date = $$self{'data'}{'idate'}{$afternn}[0];
         last  if (defined $date  &&  $date->cmp($targ) <= 0);
         $afternn--;
      }
      while (1) {
         $self->_nth_interval($afternn);
         $date = $$self{'data'}{'idate'}{$afternn}[0];
         last  if (defined $date  &&  $date->cmp($targ) >= 0);
         $afternn++;
      }
      $beforenn = $afternn;
      while (1) {
         $self->_nth_interval($beforenn);
         $date = $$self{'data'}{'idate'}{$beforenn}[0];
         last  if (defined $date  &&  $date->cmp($targ) <= 0);
         $beforenn--;
      }
      return undef  if ($afternn < $beforenn);

      # If we're looking for the first date, it's the afternn
      # date. Otherwise, it's the beforenn one.

      if ($op eq 'first') {
         $n    = $afternn*$$self{'data'}{'ev_per_d'};
      } else {
         $n    = ($beforenn+1)*$$self{'data'}{'ev_per_d'}-1;
      }

      $$self{'data'}{$op}  = $n;
      return $$self{'data'}{$op}
   }

   #
   # For a regular recurrence, find the Nth date.
   #

   # Move backwards until we have date <= target
   # Move forward until we have date >= target  (after)
   # Move backarad again until we have date <= target  (before)

   my($beforen,$aftern,$before,$after,$err);
   $aftern = $n;

   while (1) {
      ($after,$err) = $self->nth($aftern);
      return undef   if ($err);
      last  if (defined $after  &&  $after->cmp($targ) <= 0);
      $aftern--;
   }
   while (1) {
      ($after,$err) = $self->nth($aftern);
      return undef   if ($err);
      last  if (defined $after  &&  $after->cmp($targ) >= 0);
      $aftern++;
   }
   $beforen = $aftern;
   while (1) {
      ($before,$err) = $self->nth($beforen);
      return undef   if ($err);
      last  if (defined $before  &&  $before->cmp($targ) <= 0);
      $beforen--;
   }
   return undef  if ($aftern < $beforen);

   if ($op eq 'first') {
      $$self{'data'}{$op} = $aftern;
      return $aftern;
   } else {
      $$self{'data'}{$op} = $beforen;
      return $beforen;
   }
}

# 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 occurence 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 occurence 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:
