Net::ICal::Recurrence - Represent a single recurrence rule


Net-ICal documentation Contained in the Net-ICal distribution.

Index


Code Index:

NAME

Top

Net::ICal::Recurrence -- Represent a single recurrence rule

SYNOPSIS

Top

  use Net::ICal::Recurrence;
  $rrule = new Net::ICal::Recurrence([ OPTION_PAIRS ]) ;

WARNING

Top

This implementation of Recurrences needs serious work and refactoring for clarity. The API is not stable. Patches and suggestions welcome.

DESCRIPTION

Top

Recurrence holds a single recurrence property, ala section 4.3.10 of RFC 2445.

CONSTRUCTOR

Top

new([ OPTIONS_PAIRS ])

Create a new recurrence rule. Values for any of the accessors (below) may be specified at intialization time.


Net-ICal documentation Contained in the Net-ICal distribution.
#!/usr/bin/perl -w
# -*- Mode: perl -*-
#======================================================================
#
# This package is free software and is provided "as is" without
# express or implied warranty.  It may be used, redistributed and/or
# modified under the same terms as perl itself. ( Either the Artistic
# License or the GPL. )
#
# $Id: Recurrence.pm,v 1.14 2001/08/04 04:59:36 srl Exp $
#
# (C) COPYRIGHT 2000-2001, Reefknot developers.
#
# See the AUTHORS file included in the distribution for a full list.
#======================================================================

package Net::ICal::Recurrence;
use strict; 

use base qw(Net::ICal::Property);

use Carp;

#TODO: remove Date::Calc usage from this module; it's not epoch-safe.
use Date::Calc qw(:all);
use POSIX qw(strftime);
use Time::Local;

my %freqorder = do {
   my $i = 0;
   map { $_ => $i++ } qw(SECONDLY MINUTELY HOURLY DAILY WEEKLY MONTHLY YEARLY);
};

my @oDoW = qw[ SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA ];
my %oDoW = map { $oDoW[$_] => $_ } (0..6);

my $enum_freq      = [ qw(SECONDLY MINUTELY HOURLY DAILY),
                       qw(WEEKLY MONTHLY YEARLY) ];
my $enum_wday      = [ qw(MO TU WE TH FR SA SU) ];
my $is_weekdaynum  = qr[^(?:(?:-|\+)?\d+)?(?:SU|MO|TU|WE|TH|FR|SA)$]i;

# Simple ranges (sets with end value that doesn't change)
my $is_second      = [0, 59];
my $is_minute      = [0, 59];
my $is_hour        = [0, 23];
my $is_monthnum    = [1, 12];

# Ranges with variable upper boundaries (negative offsets supported)
my $is_ordyrday    = [1, 366];
my $is_ordmoday    = [1,  31];
my $is_ordwk       = [1,  53];


sub new {
   my $class = shift;
   my ($value, %args) = @_;
   $args{content} = $value;

   return $class->_create(%args);
}

sub new_from_ical {
   my $class = shift;
   my $ical  = shift;

   my ($name, $delim, $rest) = $ical =~ /^(\w+)([:;])(.*)/;
   return undef unless $name;
   my $fdelim = $delim eq ';' ? ':' : ';';
   my $self = $class->_create();
   my @pairs = split(/[=$fdelim]/, $rest);
   while (my ($k, $v) = splice(@pairs, 0, 2)) {
      $self->set(lc($k), $v);
   }
   return $self;
}





sub as_ical_value () {
  my $self = shift;

  my @comps;

  # FREQ is always forced to to the front of list
  foreach my $key (sort { $a eq 'freq' ? -1 : $b eq 'freq' ? 1 : ($a cmp $b) }
                        keys %$self)
  {
    next if $key eq 'name' || $key eq 'content';
    my $val = $self->{$key};
    if (exists($val->{value}) && defined($val->{value})) {
      my $value = $val->{value};
      if (!ref($value)) {			# single value
	push(@comps, uc($key).'='.uc($value));
      } elsif (ref($value) eq 'ARRAY') {	# list of values
	push(@comps, uc($key).'='.uc(join(',', @$value)));
      } elsif (ref($value) =~ /::/) {		# Internal type
	push(@comps, uc($key).'='.$value->as_ical_value);
      } else {
	croak "'$key' component of recurrence has an unexpected value ($value)";
      }
    }
  }
  return ':'.join(';', @comps);
}

sub as_ical () { (shift)->as_ical_value() }

sub by () {
   my $self = shift;

   my %by;
   foreach my $bfreq (keys %$self) {
      next unless $bfreq =~ /^by(.*)/;
      my $bywhat = uc($1);
      next unless defined $self->{$bfreq}->{value};
      foreach my $value (@{$self->{$bfreq}->{value}}) {
	 if ($bywhat eq 'DAY') {
	    my ($ord, $day) = $value =~ /^([-+]?\d+)?(MO|TU|WE|TH|FR|SA|SU)/;
	    if ($day) {
	       $by{$bywhat}->{$day} = $ord;
	    } else {
	       warn "BYDAY element unparseable: $value";
	    }
	 } else {
	    $by{$bywhat}->{$value} = undef;
	 }
      }
   }

   return \%by;
}

sub occurrences ($) {
   my $self = shift;
   my $comp = shift;
   my $reqperiod = shift || croak "Missing period parameter for occurrences()";

   # Define period start and end as simple int's
   my ($pstart, $pend) = ($reqperiod->start->as_int, $reqperiod->end->as_int);
  
   # Get this event's dtstart, and bump up req
   my $dtstart = $comp->dtstart; # TODO: What do we do if this isn't defined?
   if (!defined($dtstart)) {
      carp "Component has no DTSTART.  Can't determine occurrences.";
      return [ ];
   }

   # When does each occurence of this event end?  Is it specified with
   # a duration, or a hard end time?
   my $dtend    = $comp->dtend;
   my $duration = $comp->duration;

   if (!$duration && $dtend) {
      $duration = Net::ICal::Duration->new($dtend->as_int - $dtstart->as_int);
   }

   my @occurrences;

   # Here we go...

   # For now, we try to set this to the beginning of the event, not
   # the beginning of the period.  We'll get this working the brute force
   # way (preferably bug-free) before we get more exotic with the math


   # Fortunately, RFC2445 says that the DTSTART *must* be the first
   # occurrence.

   # Does this recurrence have an end time specified?
   my $until;
   if (defined(my $runtil = $self->until)) {
      $until = $runtil->as_int;
   }

   my $ccount = 1;			# Keep track of the occurence count
   my $count = $self->count();

   # This is ignored for now
   my %bysetpos;
   my $bysetpos = $self->bysetpos();
   if (defined($bysetpos)) {
      %bysetpos = map { $_ => 1 } split(/\s*,\s*/, $bysetpos);
   }

   my %bywhat = %{$self->by};


   # The "candidate occurrence" queue
   my @coqueue = ( );
   # The event always specifies the first candidate occurrence
   # FIXME: just make the this the first occurrence, not the first candidate
   push(@coqueue, $dtstart);

   while (@coqueue) {
      my $cstart = shift @coqueue;

      # Is event bounded by an UNTIL?
      last if defined($until) && $cstart->as_int > $until;

      # Is event bounded by a recurrence limit?
      last if defined($count) && $ccount > $count;

      # Have we reached the end of the viewing period?
      last if $cstart->as_int > $pend;

      # Get the goods on this start time
      # FIXME:  Hardcoded local time zone!
      my ($ss, $mm, $hh, $DD, $MM, $YY, $pDoW) = localtime($cstart->as_int);
      #my $DoW = (qw(SU MO TU WE TH FR SA))[$pDoW];
      my $DoW = $self->_tz_dow($cstart);
      my $MoY = $MM+1;
      my $YYYY = $YY+1900;

      # Check the BY* rules one-by-one -- these are *restrictions* only
      # (i.e., they determine whether this occurrence is valid).
      # These apply where BY* rule specifies a unit *less* than or the
      # same as the frequency (e.g., if FREQ=DAILY, and BYMONTH=TU,TH,
      # then this occurrence is invalidated if it falls outside those days,
      # and the count is DECREMENTED.

      # FIXME
      # For now, we IGNORE BY* where the * is an interval that is
      # *less* than the recurrence frequency.  This violates the spec.
      # (is this even necessary if a DURATION hasn't been specified?)

      # BYDAY
      if (defined(my $hr_byday = $bywhat{'DAY'})) {
	 # If this day doesn't match any of the keys, skip it
	 if (!exists($hr_byday->{$DoW})) {
	    #warn "This day($DoW) isn't in the BYDAY spec";
	    goto INCREMENT_CSTART;
	 }
      }

      # We have a winner.  We must increment the count even if it's not
      # a candidate due to it occurring before the period
      $ccount++;

      # Does this occurrence start before the viewing period?
      goto INCREMENT_CSTART if $cstart->as_int < $pstart;

      # Push into the occurrence array
      if ($duration) {
	 push(@occurrences, Net::ICal::Period->new($cstart, $duration));
      } else {
	 push(@occurrences, $cstart);
      }

      INCREMENT_CSTART:
      # This is only done when the candidate queue is empty
      $self->_supplement_queue(\@coqueue, \%bywhat, $dtstart, $cstart)
	 unless @coqueue;
   }

   return \@occurrences;
}

sub _create ($;%) {
   my $class = shift;
   my @args  = @_;

   return $class->SUPER::new(
     'RECUR',
     {

       # for Property.pm
       content => {  type		=> 'volatile',
		     doc		=> 'Full value of property',
		     #domain	=> 'reclass',
		     #options	=> { default => 'Net::ICal::Recurrence' },
		     value 	=> undef,
		  },

       # "FREQ"=freq
       # freq       = "SECONDLY" / "MINUTELY" / "HOURLY" / "DAILY"
       #            / "WEEKLY" / "MONTHLY" / "YEARLY"
       freq => { type    => 'volatile',
		 doc     => 'Recurrence frequency',
		 domain  => 'enum',
		 options => $enum_freq,
       },

       # ( ";" "COUNT" "=" 1*DIGIT )
       count => { type    => 'volatile',
		  doc     => 'End of recurrence range',
		  domain  => 'positive_int',
       },

       # ( ";" "UNTIL" "=" enddate )
       until => { type    => 'volatile',
		  doc     => 'End of recurrence range',
		  domain  => 'ref',
		  options => 'Net::ICal::Time',
       },
       # ( ";" "INTERVAL" "=" 1*DIGIT )
       interval => { type    => 'volatile',
		     doc     => 'Event occurs every Nth instance',
		     domain  => 'positive_int',
		     value	=> 1,
       },

       # ( ";" "BYSECOND" "=" byseclist )        /
       # byseclist  = seconds / ( seconds *("," seconds) )
       # seconds    = 1DIGIT / 2DIGIT       ;0 to 59
       bysecond => { type    => 'volatile',
		     doc     => 'Valid seconds within each minute',
		     domain  => 'multi_fixed_range',
		     options	=> $is_second,
       },

       # ( ";" "BYMINUTE" "=" byminlist )        /
       # byminlist  = minutes / ( minutes *("," minutes) )
       # minutes    = 1DIGIT / 2DIGIT       ;0 to 59
       byminute => { type    => 'volatile',
		     doc     => 'Valid minutes within each hour',
		     domain  => 'multi_fixed_range',
		     options	=> $is_minute,
       },

       # ( ";" "BYHOUR" "=" byhrlist )           /
       # byhrlist   = hour / ( hour *("," hour) )
       # hour       = 1DIGIT / 2DIGIT       ;0 to 23
       byhour => { type    => 'volatile',
		   doc     => 'Valid hours within each day',
		   domain  => 'multi_fixed_range',
		   options	=> $is_hour,
       },

       # ( ";" "BYDAY" "=" bywdaylist )          /
       # bywdaylist = weekdaynum / ( weekdaynum *("," weekdaynum) )
       # weekdaynum = [([plus] ordwk / minus ordwk)] weekday
       # plus       = "+"
       # minus      = "-"
       # ordwk      = 1DIGIT / 2DIGIT       ;1 to 53
       byday => { type    => 'volatile',
		  doc     => 'Valid weekdsays within week',
		  domain  => 'multi_match',
		  options => $is_weekdaynum,
       },

       # ( ";" "BYMONTHDAY" "=" bymodaylist )    /
       # bymodaylist = monthdaynum / ( monthdaynum *("," monthdaynum) )
       # monthdaynum = ([plus] ordmoday) / (minus ordmoday)
       # ordmoday   = 1DIGIT / 2DIGIT       ;1 to 31
       bymonthday => { type    => 'volatile',
		       doc     => 'Valid days within week',
		       domain  => 'multi_ordinal_range',
		       options => $is_ordmoday,
       },

       # ( ";" "BYYEARDAY" "=" byyrdaylist )     /
       # byyrdaylist = yeardaynum / ( yeardaynum *("," yeardaynum) )
       # yeardaynum = ([plus] ordyrday) / (minus ordyrday)
       # plus       = "+"
       # minus      = "-"
       # ordyrday   = 1DIGIT / 2DIGIT / 3DIGIT      ;1 to 366
       byyearday => { type    => 'volatile',
		      doc     => 'Valid days within year',
		      domain  => 'multi_ordinal_range',
		      options => $is_ordyrday,
       },

       # ( ";" "BYWEEKNO" "=" bywknolist )       /
       # bywknolist = weeknum / ( weeknum *("," weeknum) )
       # weeknum    = ([plus] ordwk) / (minus ordwk)
       # plus       = "+"
       # minus      = "-"
       # ordwk      = 1DIGIT / 2DIGIT       ;1 to 53
       byweekno => { type    => 'volatile',
		     doc     => 'Valid weeks within year',
		     domain	=> 'multi_ordinal_range',
		     options	=> $is_ordwk,
       },

       # ( ";" "BYMONTH" "=" bymolist )          /
       # bymolist   = monthnum / ( monthnum *("," monthnum) )
       # monthnum   = 1DIGIT / 2DIGIT       ;1 to 12
       bymonth => { type    => 'volatile',
		    doc     => 'Valid months within year',
		    domain  => 'multi_fixed_range',
		    options	=> $is_monthnum,
       },

       # ( ";" "BYSETPOS" "=" bysplist )         /
       # bysplist   = setposday / ( setposday *("," setposday) )
       # setposday  = yeardaynum
       # yeardaynum = ([plus] ordyrday) / (minus ordyrday)
       # plus       = "+"
       # minus      = "-"
       # ordyrday   = 1DIGIT / 2DIGIT / 3DIGIT      ;1 to 366
       bysetpos => { type    => 'volatile',
		     doc     => 'Valid occurrences of recurrence rule',
		     domain  => 'multi_ordinal_range',
		     options => $is_ordyrday,
       },

       # ( ";" "WKST" "=" weekday )              /
       wkst => { type    => 'volatile',
		 doc     => 'First day of week',
		 domain  => 'enum',
		 options => $enum_wday,
		 value   => 'MO',
       },
     },
     @args);
}



sub _positive_int_set ($$) {
  my $self = shift;
  my ($key, $val) = @_;

  if (!defined($val) || ref($val) || int($val) != $val || $val < 1) {
    carp "'$val' is not a positive integer";
    return undef;
  }

  $self->{$key}->{value} = $val;
}

sub _multi_fixed_range_set ($$) {
  my $self = shift;
  my ($key, $vals) = @_;

  my $ar_minmax = $self->{$key}->{options} ||
    croak "Missing required 'options' for multi_fixed_range check on '$key'";

  my ($min, $max) = @$ar_minmax;

  my @vals;
  if (ref($vals) eq 'ARRAY') {
    @vals = @$vals;
  } elsif (!ref($vals)) {
    @vals = ($vals);
  } else {
    warn "value for $key is neither a scalar nor an array reference";
    return undef;
  }

  foreach my $val (@vals) {
    if (!defined($val)) {
      carp "undefined values can't be within a numeric range";
      return undef;
    }
    if ($val < $min || $val > $max) {
      carp "'$val' is outside of allowable range of $min to $max";
      return undef;
    }
  }

  $self->{$key}->{value} = \@vals;
}


sub _multi_match_set ($$) {
  my $self = shift;
  my ($key, $vals) = @_;

  my $regex = $self->{$key}->{options} ||
    croak "Missing required 'options' for multi_match check on '$key'";

  my @vals;
  if (ref($vals) eq 'ARRAY') {
    @vals = @$vals;
  } elsif (!ref($vals)) {
    if ($vals =~ /,/) {
      @vals = split(/,/, $vals);
    } else {
      @vals = ($vals);
    }
  } else {
    warn "value for $key is neither a scalar nor an array reference";
    return undef;
  }

  foreach my $val (@vals) {
    if (!defined($val)) {
      carp "undefined values not permitted";
      return undef;
    }
    if ($val !~ $regex) {
      carp "'$val' is not an allowable value";
      return undef;
    }
  }

  $self->{$key}->{value} = \@vals;
}

sub _multi_ordinal_range_set ($$) {
  my $self = shift;
  my ($key, $vals) = @_;

  my $ar_minmax = $self->{$key}->{options} ||
    croak "Missing required 'options' for multi_ordinal_range check on '$key'";

  my ($min, $max) = @$ar_minmax;

  my @vals;
  if (ref($vals) eq 'ARRAY') {
    @vals = @$vals;
  } elsif (!ref($vals)) {
    @vals = ($vals);
  } else {
    warn "value for $key is neither a scalar nor an array reference";
    return undef;
  }

  foreach my $val (@vals) {
    if (!defined($val)) {
      carp "undefined values can't be within a numeric range";
      return undef;
    }
    if (abs($val) < $min || abs($val) > $max) {
      carp "'$val' is outside of allowable range ".
           "of -$max to -$min and $min to $max";
      return undef;
    }
  }

  $self->{$key}->{value} = \@vals;
}

sub _supplement_queue ($$) {
   my $self = shift;

   my $ar_ocqueue = shift;
   my %bywhat	  = %{shift()};
   my $dtstart    = shift;
   my $cstart     = shift;

   my $rfreq     = $self->freq()        || 'DAILY';
   my $freqorder = $freqorder{$rfreq};
   my $rinterval = int($self->interval) || 1;


   if ($rfreq eq 'DAILY') {
      my $toadd = Net::ICal::Duration->new(sprintf('P%dD', $rinterval));
      push(@$ar_ocqueue, $cstart->add($toadd));
   } elsif ($rfreq eq 'WEEKLY') {
      # Handle the simplest case first -- no "BY*" components
      # components
      # TODO: add BY{WEEKNO,MONTH,MONTHDAY,YEARDAY}
      if (keys(%bywhat) == 0) {
	 my $toadd = Net::ICal::Duration->new(sprintf('P%dW', $rinterval));
	 push(@$ar_ocqueue, $cstart->add($toadd));
      } else {
	 if (my $hr_days = $bywhat{DAY}) {
	    # Are we still working on the first week?  If so, populate any
	    # remaining BYDAY's that apply to this week
	    my @newdays;
	    if ($cstart->as_int == $dtstart->as_int) {
	       my ($this_dow) =
		  $self->_order_days_of_week($self->_tz_dow($cstart));
	       my @tDoW = $self->_order_days_of_week(keys %$hr_days);
	       my @offsets;
	       foreach my $tDoW (@tDoW) {
		  next if $tDoW <= $this_dow;
		  push(@offsets, $tDoW - $this_dow);
	       }
	       @newdays = $self->_compute_set_of_days($cstart, @offsets)
		  if @offsets;
	    }

	    if (!@newdays) {
	       # Find out what the beginning of this week is, increment
	       # it by seven days, and push in the appropriate days from
	       # the BYDAY list.  The day of week of this event must be
	       # determined within the time's preferred timezone.  The Time
	       # object doesn't currently track this, hence the need to run
	       # it back through localtime.
	       my $nextweek = $self->_first_day_of_next_week($cstart,
	                                                     $rinterval);

	       # And get that next set of days
	       @newdays =
		  $self->_compute_set_of_days($nextweek,
					      $self->_order_days_of_week(keys %$hr_days));
	    }
	    push(@$ar_ocqueue, @newdays);
	 }
      }
   } elsif ($rfreq eq 'MONTHLY') {
      # Handle the simplest case first -- no "BY*" components
      # components
      if (keys(%bywhat) == 0) {
	 # Start with the DTSTART rather than current time to preserve
	 # the day of month -- adjust down only if necessary
	 my $nexttime = $dtstart->clone;
	 my $nextMoY  = $cstart->month + $rinterval;
	 my $nextYYYY = $cstart->year;
	 my $nextDD   = $dtstart->day;
	 while ($nextMoY > 12) {
	    $nextMoY -= 12;
	    $nextYYYY++;
	 }
	 # Move back to last day if the corresponding day in the DTSTART
	 # is beyond the end of this month
	 my $DiM = Days_in_Month($nextYYYY, $nextMoY);
	 $nexttime->day($DiM) if $nextDD > $DiM;
	 $nexttime->year($nextYYYY);
	 $nexttime->month($nextMoY);
	 push(@$ar_ocqueue, $nexttime);
      } else {
	 if (my $hr_mdays = $bywhat{MONTHDAY}) {
	    my ($nYYYY, $nMoY, $nDD) =
	       ($cstart->year, $cstart->month, $cstart->day);
	    my $last_day_of_month;
	    my @newdays;
	    # Are we still working on the first month?  If so, populate any
	    # remaining BYMONTHDAY's that apply to this month
	    if ($cstart->as_int == $dtstart->as_int) {
	       my $DiM = Days_in_Month($nYYYY, $nMoY);
	       my @DDs;
	       foreach my $dayord (keys %$hr_mdays) {
		  if ($dayord > 1) {
		     push(@DDs, $dayord > $DiM ? $DiM : $dayord);
		  } elsif ($dayord < 0) {
		     my $newday = $DiM + $dayord + 1;
		     push(@DDs, $newday < 1 ? 1 : $newday);
		  }
	       }
	       # Now, prune out the events for days before the dtstart DD
	       my $sDD = $dtstart->day;
	       foreach my $thisDD (sort @DDs) {
		  next if $thisDD <= $sDD;
		  my $newtime = $dtstart->clone();
		  $newtime->day($thisDD);
		  push(@newdays, $newtime);
	       }
	    }

	    # We're either in the next month, or there were no valid
	    # occurrence candidates left in the first month
	    if (!@newdays) {
	       $nMoY += $rinterval;
	       while ($nMoY > 12) {
		  $nMoY -= 12;
		  $nYYYY++;
	       }
	       my $firsttime = $dtstart->clone();
	       my $DiM = Days_in_Month($nYYYY, $nMoY);
	       my @DDs;
	       foreach my $dayord (keys %$hr_mdays) {
		  if ($dayord > 1) {
		     push(@DDs, $dayord > $DiM ? $DiM : $dayord);
		  } elsif ($dayord < 0) {
		     my $newday = $DiM + $dayord + 1;
		     push(@DDs, $newday < 1 ? 1 : $newday);
		  }
	       }
	       foreach my $thisDD (sort @DDs) {
		  my $newtime = $dtstart->clone();
		  # FIXME: This gets around the auto-normalize
		  $newtime->day(1);
		  $newtime->month($nMoY);
		  $newtime->year($nYYYY);
		  # FIXME: End of workaround
		  $newtime->day($thisDD);
		  push(@newdays, $newtime);
	       }
	    }
	    push(@$ar_ocqueue, @newdays);
	 }
      }
   } else {
      croak "Can't handle frequency of $rfreq just yet...";
   }

}

#########
# FIXME #
##########################################################################
# Yes, folks the following code  is truly bizarre and probably unnecessary
# but I'm leaving in for now until I can thow some of this WKST support
# into the ::Time module.  Off hand, the only reason I can think of that
# WKST even matters is computing the week number within the year, but I
# must've been smoking some good crack when I wrote this.  -SHUTTON
##########################################################################


sub _order_days_of_week {
   my $self = shift;
   my @days = @_;

   my $wkst_day = $oDoW{$self->wkst() || 'SU'};
   
   # Prepare a map order to speed things up
   # TODO: cache this or set it up when the module loads
   my %order = map { $oDoW[($_+$wkst_day) % 7] => $_ } (0 .. 6);

   # Return the day indices based on this order
   return sort @order{@days};
}

sub _first_day_of_next_week {
   my $self = shift;
   my $time = shift;
   my $interval = shift;

   local %ENV;
   $ENV{TZ} = $time->timezone || '';
   my $cDoW = (localtime($time->as_int))[6];

   # Compute the beginning of the week
   my $wkst_day = $self->wkst() || 'SU';
   my $week_began_days_ago = ($cDoW+7 - $oDoW{$wkst_day}) % 7;

   # Build the new day
   my ($bYYYY, $bMoY, $bDD) = Add_Delta_Days($time->year,
					     $time->month,
					     $time->day,
					     -1*$week_began_days_ago+7*$interval);
   my $bow = $time->clone();
   $bow->year($bYYYY);
   $bow->month($bMoY);
   $bow->day($bDD);

   return $bow;
}

sub _first_day_of_next_month {
   my $self = shift;
   my $time = shift;

   my $newtime = $time->clone();
   my ($YYYY, $MoY) = ($newtime->year, $newtime->month);
   if (++$MoY > 12) {
      $MoY = 1;
      $YYYY++;
   }
   $newtime->year($YYYY);
   $newtime->month($MoY);

   return $newtime;
}

sub _tz_dow {
   my $self = shift;
   my $time = shift;

   local %ENV;
   $ENV{TZ} = $time->timezone || '';
   return $oDoW[(localtime($time->as_int))[6]];
}

sub _days_till_next_week {
   my $self = shift;
   my $time = shift;

   return 7 - $self->_tz_dow($time);
}

sub _compute_set_of_days {
   my $self = shift;

   my $start      = shift;
   my @increments = @_;

   my ($sYYYY, $sMoY, $sDD) = ($start->year, $start->month, $start->day);
   my ($HH, $MM, $SS)       = ($start->year, $start->month, $start->day);
   my @days;
   foreach my $inc (@increments) {
      my $newtime = $start->clone();
      my ($nYYYY, $nMoY, $nDD) = Add_Delta_Days($sYYYY, $sMoY, $sDD, $inc);
      $newtime->year($nYYYY);
      $newtime->month($nMoY);
      $newtime->day($nDD);
      push(@days, $newtime);
   }
   return @days;
}

1;