File Coverage

lib/Date/Manip/Base.pm

Criterion	Covered	Total	%
statement	1084	1187	91.3
branch	477	592	80.5
condition	207	312	66.3
subroutine	111	112	99.1
pod	21	21	100.0
total	1900	2224	85.4

package Date::Manip::Base;
# Copyright (c) 1995-2026 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!
###############################################################################

require 5.010000;
use strict;
use warnings;
use integer;
use utf8;
use Carp;
#use re 'debug';

use Date::Manip::Obj;
use Date::Manip::TZ_Base;
our @ISA = qw(Date::Manip::Obj Date::Manip::TZ_Base);

use Encode qw(encode_utf8 from_to find_encoding decode _utf8_off _utf8_on is_utf8);
require Date::Manip::Lang::index;

our $VERSION;
$VERSION='6.99';
END { undef $VERSION; }

###############################################################################
# BASE METHODS
###############################################################################

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

   $self->_init_cache();
   $self->_init_language();
   $self->_init_config();
   $self->_init_events();
   $self->_init_holidays();
   $self->_init_now();

   return;
}

# The base object has some config-independant information which is
# always reused, and only needs to be initialized once.
sub _init_cache {
   my($self) = @_;
   return  if (exists $$self{'cache'}{'init'});
   $$self{'cache'}{'init'}    = 1;

   # ly          => {Y}    = 0/1  1 if it is a leap year
   # ds1_mon     => {Y}{M} = N    days since 1BC for Y/M/1
   # dow_mon     => {Y}{M} = DOW  day of week of Y/M/1

   $$self{'cache'}{'ly'}      = {};
   $$self{'cache'}{'ds1_mon'} = {};
   $$self{'cache'}{'dow_mon'} = {};

   return;
}

# Config dependent data. Needs to be reset every time the config is reset.
sub _init_data {
   my($self,$force) = @_;
   return  if (exists $$self{'data'}{'calc'}  &&  ! $force);

   $$self{'data'}{'calc'}     = {};     # Calculated values

   return;
}

# Initializes config dependent data
sub _init_config {
   my($self,$force) = @_;
   return  if (exists $$self{'data'}{'sections'}{'conf'}  &&  ! $force);
   $self->_init_data();

   #
   # Set config defaults
   #

   $$self{'data'}{'sections'}{'conf'} =
     {
      # Reset config, holiday lists, or events lists

      'defaults'         => '',
      'eraseholidays'    => '',
      'eraseevents'      => '',

      # Which language to use when parsing dates.

      'language'         => '',

      # 12/10 = Dec 10 (US) or Oct 12 (anything else)

      'dateformat'       => '',

      # Define the work week (1=monday, 7=sunday)
      #
      # These have to be predefined to avoid a bootstrap issue, but
      # the true defaults are defined below.

      'workweekbeg'      => 1,
      'workweekend'      => 5,

      # If non-nil, a work day is treated as 24 hours long
      # (WorkDayBeg/WorkDayEnd ignored)

      'workday24hr'      => '',

      # Start and end time of the work day (any time format allowed,
      # seconds ignored). If the defaults change, be sure to change
      # the starting value of bdlength above.

      'workdaybeg'       => '',
      'workdayend'       => '',

      # 2 digit years fall into the 100 year period given by [ CURR-N,
      # CURR+(99-N) ] where N is 0-99.  Default behavior is 89, but
      # other useful numbers might be 0 (forced to be this year or
      # later) and 99 (forced to be this year or earlier).  It can
      # also be set to 'c' (current century) or 'cNN' (i.e.  c18
      # forces the year to bet 1800-1899).  Also accepts the form
      # cNNNN to give the 100 year period NNNN to NNNN+99.

      'yytoyyyy'         => '',

      # First day of the week (1=monday, 7=sunday).  ISO 8601 says
      # monday.

      'firstday'         => '',

      # If this is a value 'jan1' to 'jan7', then it means that the first
      # week of the year contains that date.  If the value is 'dow1' to
      # 'dow7', then the first week of the year is the one that contains
      # the first occurence of the DoW given.  If the value is 'firstday',
      # then the first week of the year is the one that contains the first
      # occurence of the DoW given in the FirstDay config variable.
      #
      # The default ISO 8601 definition is the first week is the one which
      # contains Jan 4 (so at least 4 of the days).

      'week1ofyear'      => '',

      # Date::Manip printable format
      #   0 = YYYYMMDDHH:MN:SS
      #   1 = YYYYHHMMDDHHMNSS
      #   2 = YYYY-MM-DD-HH:MN:SS

      'printable'        => '',

      # If 'today' is a holiday, we look either to 'tomorrow' or
      # 'yesterday' for the nearest business day.  By default, we'll
      # always look 'tomorrow' first.

      'tomorrowfirst'    => 1,

      # Used to set the current date/time/timezone.

      'forcedate'        => 0,
      'setdate'          => 0,

      # Use this to set the default range of the recurrence.

      'recurrange'       => '',
      'maxrecurattempts' => 100,

      # Use this to set the default time.

      'defaulttime'      => 'midnight',

      # Whether or not to use a period as a time separator.

      'periodtimesep'    => 0,

      # How to parse mmm#### strings

      'format_mmmyyyy'   => '',

      # Whether to use the default printf formats or the POSIX ones.

      'use_posix_printf' => 0,

      # *** DEPRECATED 7.0 ***

      'tz'               => '',
      'jan1week1'        => '',
     };

   #
   # Calculate delta field lengths
   #

   # non-business
   $$self{'data'}{'len'}{'standard'} =
     { 'yl'   => 31556952,  # 365.2425 * 24 * 3600
       'ml'   => 2629746,   # yl / 12
       'wl'   => 604800,    # 6 * 24 * 3600
       'dl'   => 86400,     # 24 * 3600
     };
   $self->_calc_workweek();

   #
   # Initialize some config variables that do some additional work.
   #

   $self->_config_var('workday24hr',  1);
   $self->_config_var('workdaybeg',   '08:00:00');
   $self->_config_var('workdayend',   '17:00:00');
   $self->_config_var('workday24hr',  0);
   $self->_config_var('dateformat',   'US');
   $self->_config_var('yytoyyyy',     89);
   $self->_config_var('printable',    0);
   $self->_config_var('firstday',     1);
   $self->_config_var('week1ofyear',  'jan4');
   $self->_config_var('workweekbeg',  1);
   $self->_config_var('workweekend',  5);
   $self->_config_var('language',     'english');
   $self->_config_var('recurrange',   'none');
   $self->_config_var('maxrecurattempts', 100);
   $self->_config_var('defaulttime',  'midnight');

   # Set OS specific defaults

   my $os = $self->_os();

   return;
}

sub _calc_workweek {
   my($self,$beg,$end) = @_;

   $beg = $self->_config('workweekbeg')  if (! $beg);
   $end = $self->_config('workweekend')  if (! $end);

   $$self{'data'}{'len'}{'workweek'} = $end - $beg + 1;

   return;
}

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

   my @beg = @{ $$self{'data'}{'calc'}{'workdaybeg'} };
   my @end = @{ $$self{'data'}{'calc'}{'workdayend'} };

   $$self{'data'}{'len'}{'bdlength'} =
     ($end[0]-$beg[0])*3600 + ($end[1]-$beg[1])*60 + ($end[2]-$beg[2]);

   return;
}

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

   no integer;
   my $x      = $$self{'data'}{'len'}{'workweek'};
   my $y_to_d = $x/7 * 365.2425;
   my $d_to_s = $$self{'data'}{'len'}{'bdlength'};
   my $w_to_d = $x;

   $$self{'data'}{'len'}{'business'} = { 'yl' => $y_to_d * $d_to_s,
                                         'ml' => $y_to_d * $d_to_s / 12,
                                         'wl' => $w_to_d * $d_to_s,
                                         'dl' => $d_to_s,
                                       };

   return;
}

# Events and holidays are reset only when they are read in.
sub _init_events {
   my($self,$force) = @_;
   return  if (exists $$self{'data'}{'events'}  &&  ! $force);

   # {data}{sections}{events} = [ STRING, EVENT_NAME, ... ]
   #
   # {data}{events}{I}{type}  = TYPE
   #                  {name}  = NAME
   #    TYPE: specified         An event with a start/end date (only parsed once)
   #                  {beg}   = DATE_OBJECT
   #                  {end}   = DATE_OBJECT
   #    TYPE: ym
   #                  {beg}   = YM_STRING
   #                  {end}   = YM_STRING (only for YM;YM)
   #                  {YEAR}  = [ DATE_OBJECT, DATE_OBJECT ]
   #    TYPE: date              An event specified by a date string and delta
   #                  {beg}   = DATE_STRING
   #                  {end}   = DATE_STRING  (only for Date;Date)
   #                  {delta} = DELTA_OBJECT (only for Date;Delta)
   #                  {YEAR}  = [ DATE_OBJECT, DATE_OBJECT ]
   #    TYPE: recur
   #                  {recur} = RECUR_OBJECT
   #                  {delta} = DELTA_OBJECT
   #
   # {data}{eventyears}{YEAR} = 0/1
   # {data}{eventobjs}        = 0/1

   $$self{'data'}{'events'}             = {};
   $$self{'data'}{'sections'}{'events'} = [];
   $$self{'data'}{'eventyears'}         = {};
   $$self{'data'}{'eventobjs'}          = 0;

   return;
}

sub _init_holidays {
   my($self,$force) = @_;
   return  if (exists $$self{'data'}{'holidays'}  &&  ! $force);

   # {data}{sections}{holidays} = [ STRING, HOLIDAY_NAME, ... ]
   #
   # {data}{holidays}{init}     = 1  if holidays have been initialized
   #                 {ydone}    = { Y => 1 }
   #                 {yhols}    = { Y => NAME => [Y,M,D] }
   #                 {hols}     = { NAME => Y => [Y,M,D] }
   #                 {dates}    = { Y => M => D => NAME }
   #                 {defs}     = [ NAME DEF NAME DEF ... ]
   #                                 NAME is the name of a holiday (it will
   #                                 be 'DMunnamed I' for the Ith unnamed
   #                                 holiday)
   #                                 DEF is a string or a Recur
   # {data}{init_holidays}      = 1  if currently initializing holidays

   $$self{'data'}{'holidays'}             = {};
   $$self{'data'}{'sections'}{'holidays'} = [];
   $$self{'data'}{'init_holidays'}        = 0;

   return;
}

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

   #  {'data'}{'now'} = {
   #                     date     => [Y,M,D,H,MN,S]  now
   #                     isdst    => ISDST
   #                     offset   => [H,MN,S]
   #                     abb      => ABBREV
   #
   #                     force    => 0/1             SetDate/ForceDate information
   #                     set      => 0/1
   #                     setsecs  => SECS            time (secs since epoch) when
   #                                                 SetDate was called
   #                     setdate  => [Y,M,D,H,MN,S]  date (IN GMT) we're calling
   #                                                 now when SetDate was called
   #
   #                     tz       => ZONE            timezone we're working in
   #                     systz    => ZONE            timezone of the system
   #                    }
   #

   $$self{'data'}{'now'}          = {};
   $$self{'data'}{'now'}{'force'} = 0;
   $$self{'data'}{'now'}{'set'}   = 0;
   $$self{'data'}{'tmpnow'}       = [];

   return;
}

# Language information only needs to be initialized if the language changes.
sub _init_language {
   my($self,$force) = @_;
   return  if (exists $$self{'data'}{'lang'}  &&  ! $force);

   $$self{'data'}{'lang'}      = {};     # Current language info
   $$self{'data'}{'rx'}        = {};     # Regexps generated from language
   $$self{'data'}{'words'}     = {};     # Types of words in the language
   $$self{'data'}{'wordval'}   = {};     # Value of words in the language

   return;
}

###############################################################################
# MAIN METHODS
###############################################################################

# Use an algorithm from Calendar FAQ (except that I subtract 305 to get
# Jan 1, 0001 = day #1).
#
sub days_since_1BC {
   my($self,$arg) = @_;

   if (ref($arg)) {
      my($y,$m,$d) = @$arg;
      $m = ($m + 9) % 12;
      $y = $y - $m/10;
      return 365*$y + $y/4 - $y/100 + $y/400 + ($m*306 + 5)/10 + ($d - 1) - 305;
   } else {
      my $g   = $arg + 305;
      no integer;
      my $y   = int((10000*$g + 14780)/3652425);
      use integer;
      my $ddd = $g - (365*$y + $y/4 - $y/100 + $y/400);
      if ($ddd < 0) {
         $y   = $y - 1;
         $ddd = $g - (365*$y + $y/4 - $y/100 + $y/400);
      }
      my $mi  = (100*$ddd + 52)/3060;
      my $mm  = ($mi + 2) % 12 + 1;
      $y      = $y + ($mi + 2)/12;
      my $dd  = $ddd - ($mi*306 + 5)/10 + 1;
      return [$y, $mm, $dd];
   }
}

# Algorithm from the Calendar FAQ
#
sub day_of_week {
   my($self,$date) = @_;
   my($y,$m,$d)    = @$date;

   my $a   = (14-$m)/12;
   $y      = $y-$a;
   $m      = $m + 12*$a - 2;
   my $dow = ($d + $y + $y/4 - $y/100 + $y/400 + (31*$m)/12) % 7;
   $dow    = 7  if ($dow==0);
   return $dow;
}

sub leapyear {
   my($self,$y) = @_;
   return 1  if ( ( ($y % 4 == 0) and ($y % 100 != 0) ) or
                  $y % 400 == 0 );
   return 0;
}

sub days_in_year {
   my($self,$y) = @_;
   return ($self->leapyear($y) ? 366 : 365);
}

# Uses algorithm from:
# http://www.dispersiondesign.com/articles/time/number_of_days_in_a_month
#
sub days_in_month {
   my($self,$y,$m) = @_;
   if (! $m) {
      return (31,29,31,30, 31,30,31,31, 30,31,30,31)  if ($self->leapyear($y));
      return (31,28,31,30, 31,30,31,31, 30,31,30,31);

   } elsif ($m == 2) {
      return 28 + $self->leapyear($y);

   } else {
      return 31 - ($m-1) % 7 % 2;
   }
}

{
   # DinM        =      (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
   my(@doy_days) = ( [0, 31, 59, 90,120,151,181,212,243,273,304,334,365],
                     [0, 31, 60, 91,121,152,182,213,244,274,305,335,366],
                   );


   sub day_of_year {
      my($self,@args) = @_;
      no integer;
      my($n,$ly,$tmp,$remain,$day,$y,$m,$d,$h,$mn,$s,$time);

      if (@args == 2) {
         # $date = day_of_year($y,$day);

         ($y,$tmp) = @args;

         $ly     = $self->leapyear($y);
         $time   = 1  if ($tmp =~ /\./);
         $n      = int($tmp);
         $remain = $tmp - $n;

         # Calculate the month and the day
         for ($m=1; $m<=12; $m++) {
            last  if ($n<=($doy_days[$ly][$m]));
         }
         $d = $n-($doy_days[$ly][$m-1]);
         return [$y,$m,$d]  if (! $time);

         # Calculate the hours, minutes, and seconds into the day.

         $s       = $remain * 86400;
         $mn      = int($s/60);
         $s       = $s - ($mn*60);
         $s       = sprintf('%0.2f',$s)  if ("$s" ne int($s));
         $h       = int($mn/60);
         $mn      = $mn % 60;

         return [$y,$m,$d,$h,$mn,$s];

      } else {
         ($y,$m,$d,$h,$mn,$s) = @{ $args[0] };

         $ly      = ($m > 2 ? $self->leapyear($y) : 0);
         $day     = ($doy_days[$ly][$m-1]+$d);

         return $day  if (! defined $h);

         $day    += ($h*3600 + $mn*60 + $s)/86400;
         return $day;
      }
   }
}

# Can be the nth DoW of year or month (if $m given).  Returns undef if
# the date doesn't exists (i.e. 5th Sunday in a month with only 4).
#
sub nth_day_of_week {
   my($self,$y,$n,$dow,$m) = @_;
   $y += 0;
   $m  = ($m ? $m+0 : 0);

   # $d    is the current DoM (if $m) or DoY
   # $max  is the max value allowed for $d
   # $ddow is the DoW of $d

   my($d,$max,$ddow);

   if ($m) {
      $max = $self->days_in_month($y,$m);
      $d   = ($n<0 ? $max : 1);
      $ddow = $self->day_of_week([$y,$m,$d]);
   } else {
      $max = $self->days_in_year($y);
      $d   = ($n<0 ? $max : 1);
      if ($n<0) {
         $d = $max;
         $ddow = $self->day_of_week([$y,12,31]);
      } else {
         $d = 1;
         $ddow = $self->day_of_week([$y,1,1]);
      }
   }

   # Find the first occurrence of $dow on or after $d (if $n>0)
   # or the last occurrence of $dow on or before $d (if ($n<0);

   if ($dow < $ddow) {
      $d += 7 - ($ddow-$dow);
   } else {
      $d += ($dow-$ddow);
   }
   $d -= 7  if ($d > $max);

   # Find the nth occurrence of $dow

   if ($n > 1) {
      $d += 7*($n-1);
      return undef  if ($d > $max);
   } elsif ($n < -1) {
      $d -= 7*(-1*$n-1);
      return undef  if ($d < 1);
   }

   # Return the date

   if ($m) {
      return [$y,$m,$d];
   }
   return $self->day_of_year($y,$d);
}

{
   # Integer arithmetic doesn't work due to the size of the numbers.
   no integer;
   # my $sec_70 =($self->days_since_1BC([1970,1,1])-1)*24*3600;
   my $sec_70 = 62135596800;

   # Using 'global' variables saves 4%
   my($y,$m,$d,$h,$mn,$s,$sec,$sec_0,$tmp);
   sub secs_since_1970 {
      my($self,$arg) = @_;

      if (ref($arg)) {
         ($y,$m,$d,$h,$mn,$s) = @$arg;
         $sec_0 = ($self->days_since_1BC([$y,$m,$d])-1)*24*3600 + $h*3600 +
           $mn*60 + $s;
         $sec = $sec_0 - $sec_70;
         return $sec;

      } else {
         ($sec)     = $arg;
         $sec_0     = $sec_70 + $sec;
         $tmp       = int($sec_0/24/3600)+1;
         my $ymd    = $self->days_since_1BC($tmp);
         ($y,$m,$d) = @$ymd;
         $sec_0    -= ($tmp-1)*24*3600;
         $h         = int($sec_0/3600);
         $sec_0    -= $h*3600;
         $mn        = int($sec_0/60);
         $s         = $sec_0 - $mn*60;
         return [$y,$m,$d,$h,$mn,$s];
      }
   }
}

sub check {
   my($self,$date) = @_;
   my($y,$m,$d,$h,$mn,$s) = @$date;

   return 0  if (! $self->check_time([$h,$mn,$s])  ||
                 $y<1  ||  $y>9999  ||
                 $m<1  ||  $m>12);

   my $days = $self->days_in_month($y,$m);

   return 0  if ($d<1  ||  $d>$days);
   return 1;
}

sub check_time {
   my($self,$hms) = @_;
   my($h,$mn,$s) = @$hms;

   return 0  if ("$h:$mn:$s" !~ /^\d\d?:\d\d?:\d\d?$/o  ||
                 $h > 24  ||  $mn > 59  ||  $s > 59  ||
                 ($h == 24  &&  ($mn  ||  $s)));
   return 1;
}

sub week1_day1 {
   my($self,$year)  = @_;
   my $firstday     = $self->_config('firstday');
   my $week1ofyear  = $self->_config('week1ofyear');
   $self->_week1_day1($year,$firstday,$week1ofyear);
}
sub _week1_day1 {
   my($self,$year,$firstday,$week1ofyear) = @_;
   return $$self{'cache'}{'week1day1'}{$firstday}{$week1ofyear}{$year}
     if (exists $$self{'cache'}{'week1day1'}{$firstday}{$week1ofyear}{$year});

   my($y,$m,$d,$firstdow);

   # Get the starting date.

   if ($week1ofyear =~ /^jan([1-7])$/) {
      # First week contains 1/D/YYYY where D is $1
      ($y,$m,$d) = ($year,1,$1);
   } else {
      # First week contains the first DOW given by $1 or firstday
      # We'll start at Jan 1.
      if ($week1ofyear =~ /^dow([1-7])$/) {
         $firstdow = $1;
      } else {
         $firstdow = $firstday;
      }

      # Start at Jan 1 and move forward to the first DOW
      ($y,$m,$d) = ($year,1,1);
   }

   my $dow = $self->day_of_week([$y,$m,$d]);

   # If we're looking for the first occurence of a DOW, move forward to it
   # (counting today).

   if ($firstdow) {
      my $forward = $firstdow - $dow;
      $forward   += 7   if ($forward < 0);
      $d         += $forward;
      $dow        = $firstdow;
   }

   # Go back to the previous (counting today) $firstday

   my $backward   = $dow - $firstday;
   $backward     += 7   if ($backward < 0);
   $d            -= $backward;
   if ($d<1) {
      $y--;
      $m = 12;
      $d += 31;
   }

   $$self{'cache'}{'week1day1'}{$firstday}{$week1ofyear}{$year} = [ $y,$m,$d ];
   return [$y,$m,$d];
}

sub weeks_in_year {
   my($self,$y)     = @_;
   my $firstday     = $self->_config('firstday');
   my $week1ofyear  = $self->_config('week1ofyear');
   return $$self{'cache'}{'wiy'}{$firstday}{$week1ofyear}{$y}
     if (exists $$self{'cache'}{'wiy'}{$firstday}{$week1ofyear}{$y});

   # Get the week1 day1 dates for this year and the next one.
   my ($y1,$m1,$d1) = @{ $self->_week1_day1($y,$firstday,$week1ofyear) };
   my ($y2,$m2,$d2) = @{ $self->_week1_day1($y+1,$firstday,$week1ofyear) };

   # Calculate the number of days between them.
   my $diy          = $self->days_in_year($y);
   if ($y1 < $y) {
      $diy += (32-$d1);
   } else {
      $diy -= ($d1-1);
   }
   if ($y2 < $y+1) {
      $diy -= (32-$d2);
   } else {
      $diy += ($d2-1);
   }

   $diy = $diy/7;
   $$self{'cache'}{'wiy'}{$firstday}{$week1ofyear}{$y} = $diy;
   return $diy;
}

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

   my $firstday     = $self->_config('firstday');
   my $week1ofyear  = $self->_config('week1ofyear');
   $self->_week_of_year($firstday,$week1ofyear,@args);
}
sub _week_of_year {
   my($self,$firstday,$week1ofyear,@args) = @_;

   if ($#args == 1) {
      # (y,m,d) = week_of_year(y,w)
      my($year,$w) = @args;

      return $$self{'cache'}{'woy'}{$firstday}{$week1ofyear}{$year}{$w}
        if (exists $$self{'cache'}{'woy'}{$firstday}{$week1ofyear}{$year}{$w});

      my $ymd = $self->_week1_day1($year,$firstday,$week1ofyear);
      $ymd = $self->calc_date_days($ymd,($w-1)*7)  if ($w > 1);

      $$self{'cache'}{'woy'}{$firstday}{$week1ofyear}{$year}{$w} = $ymd;
      return $ymd;
   }

   # (y,w) = week_of_year([y,m,d])
   my($y,$m,$d) = @{ $args[0] };

   # Get the first day of the first week. If the date is before that,
   # it's the last week of last year.

   my($y0,$m0,$d0) = @{ $self->_week1_day1($y,$firstday,$week1ofyear) };
   if ($y0==$y  &&  $m==1  &&  $d<$d0) {
      return($y-1,$self->weeks_in_year($y-1));
   }

   # Otherwise, we'll figure out how many days are between the two and
   # divide by 7 to figure out how many weeks in it is.

   my $n = $self->day_of_year([$y,$m,$d]);
   if ($y0<$y) {
      $n += (32-$d0);
   } else {
      $n -= ($d0-1);
   }
   my $w = 1+int(($n-1)/7);

   # Make sure we're not into the first week of next year.

   if ($w>$self->weeks_in_year($y)) {
      return($y+1,1);
   }
   return($y,$w);
}

###############################################################################
# CALC METHODS
###############################################################################

sub calc_date_date {
   my($self,$date0,$date1) = @_;

   # Order them so date0 < date1
   # If $minus = 1, then the delta is negative

   my $minus   = 0;
   my $cmp     = $self->cmp($date0,$date1);

   if ($cmp == 0) {
      return [0,0,0];

   } elsif ($cmp == 1) {
      $minus  = 1;
      my $tmp = $date1;
      $date1  = $date0;
      $date0  = $tmp;
   }

   my($y0,$m0,$d0,$h0,$mn0,$s0) = @$date0;
   my($y1,$m1,$d1,$h1,$mn1,$s1) = @$date1;

   my $sameday = ($y0 == $y1  &&  $m0 == $m1  &&  $d0 == $d1  ? 1 : 0);

   # Handle the various cases.

   my($dh,$dm,$ds);
   if ($sameday) {
      ($dh,$dm,$ds) = @{ $self->_calc_hms_hms([$h0,$mn0,$s0],[$h1,$mn1,$s1]) };

   } else {
      # y0-m0-d0 h0:mn0:s0 -> y0-m0-d0 24:00:00
      # y1-m1-d1 h1:mn1:s1 -> y1-m1-d1 00:00:00

      my $t1 = $self->_calc_hms_hms([$h0,$mn0,$s0],[24,0,0]);
      my $t2 = $self->_calc_hms_hms([0,0,0],[$h1,$mn1,$s1]);
      ($dh,$dm,$ds) = @{ $self->calc_time_time($t1,$t2) };

      my $dd0 = $self->days_since_1BC([$y0,$m0,$d0]);
      $dd0++;
      my $dd1 = $self->days_since_1BC([$y1,$m1,$d1]);
      $dh    += ($dd1-$dd0)*24;
   }

   if ($minus) {
      $dh *= -1;
      $dm *= -1;
      $ds *= -1;
   }
   return [$dh,$dm,$ds];
}

sub calc_date_days {
   my($self,$date,$n,$subtract) = @_;
   my($y,$m,$d,$h,$mn,$s)       = @$date;
   my($ymdonly)                 = (defined $h ? 0 : 1);

   $n        *= -1  if ($subtract);
   my $d1bc   = $self->days_since_1BC([$y,$m,$d]);
   $d1bc     += $n;
   my $ymd    = $self->days_since_1BC($d1bc);

   if ($ymdonly) {
      return $ymd;
   } else {
      return [@$ymd,$h*1,$mn*1,$s*1];
   }
}

sub calc_date_delta {
   my($self,$date,$delta,$subtract) = @_;
   my($y,$m,$d,$h,$mn,$s)           = @$date;
   my($dy,$dm,$dw,$dd,$dh,$dmn,$ds) = @$delta;

   ($y,$m,$d) =
     @{ $self->_calc_date_ymwd([$y,$m,$d], [$dy,$dm,$dw,$dd], $subtract) };

   return $self->calc_date_time([$y,$m,$d,$h,$mn,$s],[$dh,$dmn,$ds],$subtract);
}

sub calc_date_time {
   my($self,$date,$time,$subtract) = @_;
   my($y,$m,$d,$h,$mn,$s)          = @$date;
   my($dh,$dmn,$ds)                = @$time;

   if ($ds > 59  ||  $ds < -59) {
      $dmn += int($ds/60);
      $ds   = $ds % 60;
   }
   if ($dmn > 59  ||  $dmn < -59) {
      $dh  += int($dmn/60);
      $dmn  = $dmn % 60;
   }
   my $dd = 0;
   if ($dh > 23  ||  $dh < -23) {
      $dd  = int($dh/24);
      $dh  = $dh % 24;
   }

   # Handle subtraction
   if ($subtract) {
      $dh  *= -1;
      $dmn *= -1;
      $ds  *= -1;
      $dd  *= -1;
   }

   if ($dd == 0) {
      $y *= 1;
      $m *= 1;
      $d *= 1;
   } else {
      ($y,$m,$d) = @{ $self->calc_date_days([$y,$m,$d],$dd) };
   }

   $self->_mod_add(60,$ds,\$s,\$mn);
   $self->_mod_add(60,$dmn,\$mn,\$h);
   $self->_mod_add(24,$dh,\$h,\$d);

   if ($d<1) {
      $m--;
      $y--, $m=12  if ($m<1);
      my $day_in_mon = $self->days_in_month($y,$m);
      $d += $day_in_mon;
   } else {
      my $day_in_mon = $self->days_in_month($y,$m);
      if ($d>$day_in_mon) {
         $d -= $day_in_mon;
         $m++;
         $y++, $m=1  if ($m>12);
      }
   }

   return [$y,$m,$d,$h,$mn,$s];
}

sub _calc_date_time_strings {
   my($self,$date,$time,$subtract) = @_;
   my @date = @{ $self->split('date',$date) };
   return ''  if (! @date);
   my @time = @{ $self->split('time',$time) };

   my @date2 = @{ $self->calc_date_time(\@date,\@time,$subtract) };

   return $self->join('date',\@date2);
}

sub _calc_date_ymwd {
   my($self,$date,$ymwd,$subtract) = @_;
   my($y,$m,$d,$h,$mn,$s)          = @$date;
   my($dy,$dm,$dw,$dd)             = @$ymwd;
   my($ymdonly)                    = (defined $h ? 0 : 1);

   $dd += $dw*7;

   if ($subtract) {
      $y -= $dy;
      $self->_mod_add(-12,-1*$dm,\$m,\$y);
      $dd *= -1;

   } else {
      $y += $dy;
      $self->_mod_add(-12,$dm,\$m,\$y);
   }

   my $dim = $self->days_in_month($y,$m);
   $d      = $dim  if ($d > $dim);

   my $ymd;
   if ($dd == 0) {
      $ymd = [$y,$m,$d];
   } else {
      $ymd = $self->calc_date_days([$y,$m,$d],$dd);
   }

   if ($ymdonly) {
      return $ymd;
   } else {
      return [@$ymd,$h,$mn,$s];
   }
}

sub _calc_hms_hms {
   my($self,$hms0,$hms1) = @_;
   my($h0,$m0,$s0,$h1,$m1,$s1) = (@$hms0,@$hms1);

   my($s) = ($h1-$h0)*3600 + ($m1-$m0)*60  +  $s1-$s0;
   my($m) = int($s/60);
   $s    -= $m*60;
   my($h) = int($m/60);
   $m    -= $h*60;
   return [$h,$m,$s];
}

sub calc_time_time {
   my($self,$time0,$time1,$subtract) = @_;
   my($h0,$m0,$s0,$h1,$m1,$s1)       = (@$time0,@$time1);

   if ($subtract) {
      $h1 *= -1;
      $m1 *= -1;
      $s1 *= -1;
   }
   my($s) = (($h0+$h1)*60 + ($m0+$m1))*60 + $s0+$s1;
   my($m) = int($s/60);
   $s    -= $m*60;
   my($h) = int($m/60);
   $m    -= $h*60;

   return [$h,$m,$s];
}

###############################################################################

# Returns -1 if date0 is before date1, 0 if date0 is the same as date1, and
# 1 if date0 is after date1.
#
sub cmp {
   my($self,$date0,$date1) = @_;
   return ($$date0[0]  <=> $$date1[0]  ||
           $$date0[1]  <=> $$date1[1]  ||
           $$date0[2]  <=> $$date1[2]  ||
           $$date0[3]  <=> $$date1[3]  ||
           $$date0[4]  <=> $$date1[4]  ||
           $$date0[5]  <=> $$date1[5]);
}

###############################################################################
# This determines the OS.

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

   my $os = '';

   if ($^O =~ /MSWin32/io    ||
       $^O =~ /Windows_95/io ||
       $^O =~ /Windows_NT/io
      ) {
      $os = 'Windows';

   } elsif ($^O =~ /MacOS/io  ||
            $^O =~ /MPE/io    ||
            $^O =~ /OS2/io    ||
            $^O =~ /NetWare/io
           ) {
      $os = 'Other';

   } elsif ($^O =~ /VMS/io) {
      $os = 'VMS';

   } else {
      $os = 'Unix';
   }

   return $os;
}

###############################################################################
# Config variable functions

# $self->config(SECT);
#    Creates a new section (if it doesn't already exist).
#
# $self->config(SECT,'_vars');
#    Returns a list of (VAR VAL VAR VAL ...)
#
# $self->config(SECT,VAR,VAL);
#    Adds (VAR,VAL) to the list.
#
sub _section {
   my($self,$sect,$var,$val) = @_;
   $sect = lc($sect);

   #
   # $self->_section(SECT)    creates a new section
   #

   if (! defined $var  &&
       ! exists $$self{'data'}{'sections'}{$sect}) {
      if ($sect eq 'conf') {
         $$self{'data'}{'sections'}{$sect} = {};
      } else {
         $$self{'data'}{'sections'}{$sect} = [];
      }
      return '';
   }

   if ($var eq '_vars') {
      return @{ $$self{'data'}{'sections'}{$sect} };
   }

   push @{ $$self{'data'}{'sections'}{$sect} },($var,$val);
   return;
}

# This sets a config variable. It also performs all side effects from
# setting that variable.
#
sub _config_var_base {
   my($self,$var,$val) = @_;

   if ($var eq 'defaults') {
      # Reset the configuration if desired.
      $self->_init_config(1);
      return;

   } elsif ($var eq 'eraseholidays') {
      $self->_init_holidays(1);
      return;

   } elsif ($var eq 'eraseevents') {
      $self->_init_events(1);
      return;

   } elsif ($var eq 'configfile') {
      $self->_config_file($val);
      return;

   } elsif ($var eq 'encoding') {
      my $err = $self->_config_var_encoding($val);
      return if ($err);

   } elsif ($var eq 'language') {
      my $err = $self->_language($val);
      return  if ($err);
      $err    = $self->_config_var_encoding();
      return  if ($err);

   } elsif ($var eq 'yytoyyyy') {
      $val = lc($val);
      if ($val ne 'c'  &&
          $val !~ /^c\d\d$/o  &&
          $val !~ /^c\d\d\d\d$/o  &&
          $val !~ /^\d+$/o) {
         carp "ERROR: [config_var] invalid: YYtoYYYY: $val";
         return;
      }

   } elsif ($var eq 'workweekbeg') {
      my $err = $self->_config_var_workweekbeg($val);
      return  if ($err);

   } elsif ($var eq 'workweekend') {
      my $err = $self->_config_var_workweekend($val);
      return  if ($err);

   } elsif ($var eq 'workday24hr') {
      my $err = $self->_config_var_workday24hr($val);
      return  if ($err);

   } elsif ($var eq 'workdaybeg') {
      my $err = $self->_config_var_workdaybegend(\$val,'WorkDayBeg');
      return  if ($err);

   } elsif ($var eq 'workdayend') {
      my $err = $self->_config_var_workdaybegend(\$val,'WorkDayEnd');
      return  if ($err);

   } elsif ($var eq 'firstday') {
      my $err = $self->_config_var_firstday($val);
      return  if ($err);

   } elsif ($var eq 'week1ofyear') {
      my $err = $self->_config_var_week1ofyear($val);
      return  if ($err);

   } elsif ($var eq 'tz'  ||
            $var eq 'forcedate'  ||
            $var eq 'setdate') {
      # These can only be used if the Date::Manip::TZ module has been loaded
      carp "ERROR: [config_var] $var config variable requires TZ module";
      return;

   } elsif ($var eq 'recurrange') {
      my $err = $self->_config_var_recurrange($val);
      return  if ($err);

   } elsif ($var eq 'defaulttime') {
      my $err = $self->_config_var_defaulttime($val);
      return  if ($err);

   } elsif ($var eq 'periodtimesep') {
      # We have to redo the time regexp
      delete $$self{'data'}{'rx'}{'time'};

   } elsif ($var eq 'format_mmmyyyy') {
      my $err = $self->_config_var_format_mmmyyyy($val);
      return  if ($err);

   } elsif ($var eq 'dateformat'       ||
            $var eq 'printable'        ||
            $var eq 'tomorrowfirst'    ||
            $var eq 'use_posix_printf' ||
            $var eq 'maxrecurattempts') {
      # do nothing

   } elsif ($var eq 'jan1week1') {
      carp "WARNING: the jan1week1 Date::Manip config variable is deprecated\n" .
           "         and will be removed in version 7.00.  Please use\n" .
           "         the Week1ofYear config variable instead.\n";
      if ($val) {
         $self->_config_var_base('week1ofyear','jan1');
      } else {
         $self->_config_var_base('week1ofyear','jan4');
      }
      return;

   } else {
      carp "ERROR: [config_var] invalid config variable: $var";
      return '';
   }

   $$self{'data'}{'sections'}{'conf'}{$var} = $val;
   return;
}

###############################################################################
# Specific config variable functions

sub _config_var_encoding {
   my($self,$val) = @_;

   if (! $val) {
      $$self{'data'}{'calc'}{'enc_in'}  = [ @{ $$self{'data'}{'enc'} } ];
      $$self{'data'}{'calc'}{'enc_out'} = 'UTF-8';

   } elsif ($val =~ /^(.*),(.*)$/o) {
      my($in,$out) = ($1,$2);
      if ($in) {
         my $o = find_encoding($in);
         if (! $o) {
            carp "ERROR: [config_var] invalid: Encoding: $in";
            return 1;
         }
      }
      if ($out) {
         my $o = find_encoding($out);
         if (! $o) {
            carp "ERROR: [config_var] invalid: Encoding: $out";
            return 1;
         }
      }

      if ($in  &&  $out) {
         $$self{'data'}{'calc'}{'enc_in'}  = [ $in ];
         $$self{'data'}{'calc'}{'enc_out'} = $out;

      } elsif ($in) {
         $$self{'data'}{'calc'}{'enc_in'}  = [ $in ];
         $$self{'data'}{'calc'}{'enc_out'} = 'UTF-8';

      } elsif ($out) {
         $$self{'data'}{'calc'}{'enc_in'}  = [ @{ $$self{'data'}{'enc'} } ];
         $$self{'data'}{'calc'}{'enc_out'} = $out;

      } else {
         $$self{'data'}{'calc'}{'enc_in'}  = [ @{ $$self{'data'}{'enc'} } ];
         $$self{'data'}{'calc'}{'enc_out'} = 'UTF-8';
      }

   } else {
      my $o = find_encoding($val);
      if (! $o) {
         carp "ERROR: [config_var] invalid: Encoding: $val";
         return 1;
      }
      $$self{'data'}{'calc'}{'enc_in'}  = [ $val ];
      $$self{'data'}{'calc'}{'enc_out'} = $val;
   }

   if (! @{ $$self{'data'}{'calc'}{'enc_in'} }) {
      $$self{'data'}{'calc'}{'enc_in'}  = [ qw(utf-8 perl) ];
   }

   return 0;
}

sub _config_var_recurrange {
   my($self,$val) = @_;

   $val = lc($val);
   if ($val =~ /^(none|year|month|week|day|all)$/o) {
      return 0;
   }

   carp "ERROR: [config_var] invalid: RecurRange: $val";
   return 1;
}

sub _config_var_workweekbeg {
   my($self,$val) = @_;

   if (! $self->_is_int($val,1,7)) {
      carp "ERROR: [config_var] invalid: WorkWeekBeg: $val";
      return 1;
   }
   if ($val >= $self->_config('workweekend')) {
      carp "ERROR: [config_var] WorkWeekBeg must be before WorkWeekEnd";
      return 1;
   }

   $self->_calc_workweek($val,'');
   $self->_init_business_length();
   return 0;
}

sub _config_var_workweekend {
   my($self,$val) = @_;

   if (! $self->_is_int($val,1,7)) {
      carp "ERROR: [config_var] invalid: WorkWeekBeg: $val";
      return 1;
   }
   if ($val <= $self->_config('workweekbeg')) {
      carp "ERROR: [config_var] WorkWeekEnd must be after WorkWeekBeg";
      return 1;
   }

   $self->_calc_workweek('',$val);
   $self->_init_business_length();
   return 0;
}

sub _config_var_workday24hr {
   my($self,$val) = @_;

   if ($val) {
      $$self{'data'}{'sections'}{'conf'}{'workdaybeg'} = '00:00:00';
      $$self{'data'}{'sections'}{'conf'}{'workdayend'} = '24:00:00';
      $$self{'data'}{'calc'}{'workdaybeg'}             = [0,0,0];
      $$self{'data'}{'calc'}{'workdayend'}             = [24,0,0];

      $self->_calc_bdlength();
      $self->_init_business_length();
   }

   return 0;
}

sub _config_var_workdaybegend {
   my($self,$val,$conf) = @_;

   # Must be a valid time.  Entered as H, H:M, or H:M:S

   my $tmp = $self->split('hms',$$val);
   if (! defined $tmp) {
      carp "ERROR: [config_var] invalid: $conf: $$val";
      return 1;
   }
   $$self{'data'}{'calc'}{lc($conf)} = $tmp;
   $$val = $self->join('hms',$tmp);

   # workdaybeg < workdayend

   my @beg = @{ $$self{'data'}{'calc'}{'workdaybeg'} };
   my @end = @{ $$self{'data'}{'calc'}{'workdayend'} };
   my $beg = $beg[0]*3600 + $beg[1]*60 + $beg[2];
   my $end = $end[0]*3600 + $end[1]*60 + $end[2];

   if ($beg > $end) {
      carp "ERROR: [config_var] WorkDayBeg not before WorkDayEnd";
      return 1;
   }

   # Calculate bdlength

   $$self{'data'}{'sections'}{'conf'}{'workday24hr'} = 0;

   $self->_calc_bdlength();
   $self->_init_business_length();

   return 0;
}

sub _config_var_firstday {
   my($self,$val) = @_;

   if (! $self->_is_int($val,1,7)) {
      carp "ERROR: [config_var] invalid: FirstDay: $val";
      return 1;
   }

   return 0;
}

sub _config_var_week1ofyear {
   my($self,$val) = @_;
   $val = lc($val);

   if ($val =~ /^jan[1-7]$/  ||
       $val =~ /^dow[1-7]$/  ||
       $val eq 'firstday') {
      return 0;
   }
   carp "ERROR: [config_var] invalid: Week1ofYear: $val";
   return 1;
}

sub _config_var_defaulttime {
   my($self,$val) = @_;

   if (lc($val) eq 'midnight'  ||
       lc($val) eq 'curr') {
      return 0;
   }
   carp "ERROR: [config_var] invalid: DefaultTime: $val";
   return 1;
}

sub _config_var_format_mmmyyyy {
   my($self,$val) = @_;

   if (lc($val) eq 'first'  ||
       lc($val) eq 'last'   ||
       lc($val) eq '') {
      return 0;
   }
   carp "ERROR: [config_var] invalid: Format_MMMYYYY: $val";
   return 1;
}

###############################################################################
# Language functions

# This reads in a langauge module and sets regular expressions
# and word lists based on it.
#
no strict 'refs';
sub _language {
   my($self,$lang) = @_;
   $lang = lc($lang);

   if (! exists $Date::Manip::Lang::index::Lang{$lang}) {
      carp "ERROR: [language] invalid: $lang";
      return 1;
   }

   return 0  if (exists $$self{'data'}{'sections'}{'conf'}  &&
                 $$self{'data'}{'sections'}{'conf'} eq $lang);
   $self->_init_language(1);

   my $mod = $Date::Manip::Lang::index::Lang{$lang};
   eval "require Date::Manip::Lang::${mod}";
   if ($@) {
      croak "ERROR: failed to load Date::Manip::Lang::${mod}: $@\n";
   }

   no warnings 'once';
   $$self{'data'}{'lang'} = ${ "Date::Manip::Lang::${mod}::Language" };
   $$self{'data'}{'enc'}  = [ @{ "Date::Manip::Lang::${mod}::Encodings" } ];

   # Common words
   $self->_rx_wordlist('at');
   $self->_rx_wordlist('each');
   $self->_rx_wordlist('last');
   $self->_rx_wordlist('of');
   $self->_rx_wordlist('on');
   $self->_rx_wordlists('when');

   # Next/prev
   $self->_rx_wordlists('nextprev');

   # Field names (years, year, yr, ...)
   $self->_rx_wordlists('fields');

   # Numbers (first, 1st)
   $self->_rx_wordlists('nth');
   $self->_rx_wordlists('nth','nth_dom',31);  # 1-31
   $self->_rx_wordlists('nth','nth_wom',5);   # 1-5

   # Calendar names (Mon, Tue  and  Jan, Feb)
   $self->_rx_wordlists('day_abb');
   $self->_rx_wordlists('day_char');
   $self->_rx_wordlists('day_name');
   $self->_rx_wordlists('month_abb');
   $self->_rx_wordlists('month_name');

   # H:M:S separators
   $self->_rx_simple('sephm');
   $self->_rx_simple('sepms');
   $self->_rx_simple('sepfr');

   # Time replacement strings
   $self->_rx_replace('times');

   # Some offset strings
   $self->_rx_replace('offset_date');
   $self->_rx_replace('offset_time');

   # AM/PM strings
   $self->_rx_wordlists('ampm');

   # Business/non-business mode
   $self->_rx_wordlists('mode');

   return 0;
}
use strict 'refs';

# This takes a string or strings from the language file which is a
# regular expression and copies it to the regular expression cache.
#
# If the language file contains a list of strings, a list of strings
# is stored in the regexp cache.
#
sub _rx_simple {
   my($self,$ele) = @_;

   if (exists $$self{'data'}{'lang'}{$ele}) {
      if (ref($$self{'data'}{'lang'}{$ele})) {
         @{ $$self{'data'}{'rx'}{$ele} } = @{ $$self{'data'}{'lang'}{$ele} };
      } else {
         $$self{'data'}{'rx'}{$ele} = $$self{'data'}{'lang'}{$ele};
      }
   } else {
      $$self{'data'}{'rx'}{$ele} = undef;
   }

   return;
}

# We need to quote strings that will be used in regexps, but we don't
# want to quote UTF-8 characters.
#
sub _qe_quote {
   my($string) = @_;
   $string     =~ s/([-.+*?])/\\$1/g;
   return $string;
}

# This takes a list of words and creates a simple regexp which matches
# any of them.
#
# The first word in the list is the default way to express the word using
# a normal ASCII character set.
#
# The second word in the list is the default way to express the word using
# a locale character set. If it isn't defined, it defaults to the first word.
#
sub _rx_wordlist {
   my($self,$ele) = @_;

   if (exists $$self{'data'}{'lang'}{$ele}) {
      my @tmp = @{ $$self{'data'}{'lang'}{$ele} };

      $$self{'data'}{'wordlist'}{$ele} = $tmp[0];

      my @tmp2;
      foreach my $tmp (@tmp) {
         push(@tmp2,_qe_quote($tmp))  if ($tmp);
      }
      @tmp2  = sort _sortByLength(@tmp2);

      $$self{'data'}{'rx'}{$ele} = join('|',@tmp2);

   } else {
      $$self{'data'}{'rx'}{$ele} = undef;
   }

   return;
}

no strict 'vars';
sub _sortByLength {
   return (length $b <=> length $a);
}
use strict 'vars';

# This takes a hash of the form:
#    word => string
# and creates a regular expression to match word (which must be surrounded
# by word boundaries).
#
sub _rx_replace {
   my($self,$ele) = @_;

   if (! exists $$self{'data'}{'lang'}{$ele}) {
      $$self{'data'}{'rx'}{$ele} = [];
      return;
   }

   my(@key) = keys %{ $$self{'data'}{'lang'}{$ele} };
   my $i    = 1;
   foreach my $key (sort(@key)) {
      my $val = $$self{'data'}{'lang'}{$ele}{$key};
      my $k   = _qe_quote($key);
      $$self{'data'}{'rx'}{$ele}[$i++] = qr/(?:^|\b)($k)(?:\b|$)/i;
      $$self{'data'}{'wordmatch'}{$ele}{lc($key)} = $val;
   }

   @key   = sort _sortByLength(@key);
   @key   = map { _qe_quote($_) } @key;
   my $rx = join('|',@key);

   $$self{'data'}{'rx'}{$ele}[0] = qr/(?:^|\b)(?:$rx)(?:\b|$)/i;

   return;
}

# This takes a list of values, each of which can be expressed in multiple
# ways, and gets a regular expression which matches any of them, a default
# way to express each value, and a hash which matches a matched string to
# a value (the value is 1..N where N is the number of values).
#
sub _rx_wordlists {
   my($self,$ele,$subset,$max) = @_;
   $subset = $ele  if (! $subset);

   if (exists $$self{'data'}{'lang'}{$ele}) {
      my @vallist = @{ $$self{'data'}{'lang'}{$ele} };
      $max        = $#vallist+1  if (! $max  ||  $max > $#vallist+1);
      my (@all);

      for (my $i=1; $i<=$max; $i++) {
         my @tmp = @{ $$self{'data'}{'lang'}{$ele}[$i-1] };
         $$self{'data'}{'wordlist'}{$subset}[$i-1] = $tmp[0];

         my @str;
         foreach my $str (@tmp) {
            next  if (! $str);
            $$self{'data'}{'wordmatch'}{$subset}{lc($str)} = $i;
            push(@str,_qe_quote($str));
         }
         push(@all,@str);

         @str  = sort _sortByLength(@str);
         $$self{'data'}{'rx'}{$subset}[$i] = join('|',@str);
      }

      @all  = sort _sortByLength(@all);
      $$self{'data'}{'rx'}{$subset}[0] = join('|',@all);

   } else {
      $$self{'data'}{'rx'}{$subset} = undef;
   }

   return;
}

###############################################################################
# Year functions
#
# $self->_method(METHOD)      use METHOD as the method for YY->YYYY
#                             conversions
#
# YEAR = _fix_year(YR)        converts a 2-digit to 4-digit year
#                             _fix_year is in TZ_Base

sub _method {
   my($self,$method) = @_;
   $self->_config('yytoyyyy',$method);

   return;
}

###############################################################################
# $self->_mod_add($N,$add,\$val,\$rem);
#   This calculates $val=$val+$add and forces $val to be in a certain
#   range.  This is useful for adding numbers for which only a certain
#   range is allowed (for example, minutes can be between 0 and 59 or
#   months can be between 1 and 12).  The absolute value of $N determines
#   the range and the sign of $N determines whether the range is 0 to N-1
#   (if N>0) or 1 to N (N<0).  $rem is adjusted to force $val into the
#   appropriate range.
#   Example:
#     To add 2 hours together (with the excess returned in days) use:
#       $self->_mod_add(-24,$h1,\$h,\$day);
#     To add 2 minutes together (with the excess returned in hours):
#       $self->_mod_add(60,$mn1,\$mn,\$hr);
sub _mod_add {
   my($self,$N,$add,$val,$rem)=@_;
   return  if ($N==0);
   $$val+=$add;
   if ($N<0) {
      # 1 to N
      $N = -$N;
      if ($$val>$N) {
         $$rem+= int(($$val-1)/$N);
         $$val = ($$val-1)%$N +1;
      } elsif ($$val<1) {
         $$rem-= int(-$$val/$N)+1;
         $$val = $N-(-$$val % $N);
      }

   } else {
      # 0 to N-1
      if ($$val>($N-1)) {
         $$rem+= int($$val/$N);
         $$val = $$val%$N;
      } elsif ($$val<0) {
         $$rem-= int(-($$val+1)/$N)+1;
         $$val = ($N-1)-(-($$val+1)%$N);
      }
   }

   return;
}

# $flag = $self->_is_int($string [,$low, $high]);
#    Returns 1 if $string is a valid integer, 0 otherwise.  If $low is
#    entered, $string must be >= $low.  If $high is entered, $string must
#    be <= $high.  It is valid to check only one of the bounds.
sub _is_int {
   my($self,$N,$low,$high)=@_;
   return 0  if (! defined $N  or
                 $N !~ /^\s*[-+]?\d+\s*$/o  or
                 defined $low   &&  $N<$low  or
                 defined $high  &&  $N>$high);
   return 1;
}

# $flag = $self->_is_num($string [,$low, $high]);
#    Returns 1 if $string is a valid number (integer or real), 0 otherwise.
#    If $low is entered, $string must be >= $low.  If $high is entered,
#    $string must be <= $high.  It is valid to check only one of the bounds.
sub _is_num {
   my($self,$N,$low,$high)=@_;
   return 0  if (! defined $N  or
                 ($N !~ /^\s*[-+]?\d+(\.\d*)?\s*$/o  &&
                  $N !~ /^\s*[-+]?\.\d+\s*$/o)  or
                 defined $low   &&  $N<$low  or
                 defined $high  &&  $N>$high);
   return 1;
}

###############################################################################
# Split/Join functions

sub split {
   my($self,$op,$string,$arg) = @_;

   my %opts;
   if (ref($arg) eq 'HASH') {
      %opts = %{ $arg };
   } elsif ($arg) {
      # ***DEPRECATED 7.0***
      %opts = ('nonorm' => 1);
   }

   # ***DEPRECATED 7.0***
   if ($op eq 'delta') {
      $opts{'mode'} = 'standard';
   } elsif ($op eq 'business') {
      $opts{'mode'} = 'business';
      $op = 'delta';
   }

   if ($op eq 'date') {

      if ($string =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d):(\d\d):(\d\d)$/o  ||
          $string =~ /^(\d\d\d\d)\-(\d\d)\-(\d\d)\-(\d\d):(\d\d):(\d\d)$/o  ||
          $string =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/o) {
         my($y,$m,$d,$h,$mn,$s) = ($1+0,$2+0,$3+0,$4+0,$5+0,$6+0);
         return [$y,$m,$d,$h,$mn,$s];
      } else {
         return undef;
      }

   } elsif ($op eq 'hms') {
      if ($string =~ /^(\d\d)(\d\d)(\d\d)$/o     ||
          $string =~ /^(\d\d)(\d\d)()$/o         ||
          $string =~ /^(\d\d?):(\d\d):(\d\d)$/o  ||
          $string =~ /^(\d\d?):(\d\d)()$/o       ||
          $string =~ /^(\d\d?)()()$/o) {
         my($err,$h,$mn,$s) = $self->_hms_fields( { 'out' => 'list' },[$1,$2,$3]);
         return undef  if ($err);
         return [$h,$mn,$s];
      } else {
         return undef;
      }

   } elsif ($op eq 'offset') {
      if ($string =~ /^([-+]?\d\d)(\d\d)(\d\d)$/o       ||
          $string =~ /^([-+]?\d\d)(\d\d)()$/o           ||
          $string =~ /^([-+]?\d\d?):(\d\d?):(\d\d?)$/o  ||
          $string =~ /^([-+]?\d\d?):(\d\d?)()$/o        ||
          $string =~ /^([-+]?\d\d?)()()$/o) {
         my($err,$h,$mn,$s) = $self->_offset_fields( { 'source' => 'string',
                                                       'out'    => 'list'},
                                                     [$1,$2,$3]);
         return undef  if ($err);
         return [$h,$mn,$s];
      } else {
         return undef;
      }

   } elsif ($op eq 'time') {
      if ($string =~ /^[-+]?\d+(:[-+]?\d+){0,2}$/o) {
         my($err,$dh,$dmn,$ds) =
           $self->_time_fields( { 'nonorm'   =>
                                  (exists($opts{'nonorm'}) ? $opts{'nonorm'} : 0),
                                  'source'   => 'string',
                                  'sign'     => -1,
                                }, [split(/:/,$string)]);
         return undef  if ($err);
         return [$dh,$dmn,$ds];
      } else {
         return undef;
      }

   } elsif ($op eq 'delta') {
      my($err,@delta) = $self->_split_delta($string);
      return undef  if ($err);

      ($err,@delta) =
        $self->_delta_fields( { 'mode'     => $opts{'mode'},
                                'nonorm'   => (exists($opts{'nonorm'}) ?
                                               $opts{'nonorm'} : 0),
                                'source'   => 'string',
                                'sign'     => -1,
                              }, [@delta]);

      return undef  if ($err);
      return [@delta];
   }
}

sub join{
   my($self,$op,$data,$arg) = @_;

   my %opts;
   if (ref($arg) eq 'HASH') {
      %opts = %{ $arg };
   } elsif ($arg) {
      # ***DEPRECATED 7.0***
      %opts = ('nonorm' => 1);
   }

   # ***DEPRECATED 7.0***
   if ($op eq 'delta') {
      $opts{'mode'} = 'standard';
   } elsif ($op eq 'business') {
      $opts{'mode'} = 'business';
      $op = 'delta';
   }

   my @data = @$data;

   if ($op eq 'date') {

      my($err,$y,$m,$d,$h,$mn,$s) = $self->_date_fields(@data);
      return undef  if ($err);
      my $form = $self->_config('printable');
      if ($form == 1) {
         return "$y$m$d$h$mn$s";
      } elsif ($form == 2) {
         return "$y-$m-$d-$h:$mn:$s";
      } else {
         return "$y$m$d$h:$mn:$s";
      }

   } elsif ($op eq 'offset') {
      my($err,$h,$mn,$s) = $self->_offset_fields( { 'source' => 'list',
                                                    'out'    => 'string'},
                                                  [@data]);
      return undef  if ($err);
      return "$h:$mn:$s";

   } elsif ($op eq 'hms') {
      my($err,$h,$mn,$s) = $self->_hms_fields( { 'out' => 'string' },[@data]);
      return undef  if ($err);
      return "$h:$mn:$s";

   } elsif ($op eq 'time') {
      my($err,$dh,$dmn,$ds) =
        $self->_time_fields( { 'nonorm'   =>
                               (exists($opts{'nonorm'}) ? $opts{'nonorm'} : 0),
                               'source'   => 'list',
                               'sign'     => 0,
                             }, [@data]);
      return undef  if ($err);
      return "$dh:$dmn:$ds";

   } elsif ($op eq 'delta') {
      my ($err,@delta) =
        $self->_delta_fields( { 'mode'     => $opts{'mode'},
                                'nonorm'   => (exists($opts{'nonorm'}) ?
                                               $opts{'nonorm'} : 0),
                                'source'   => 'list',
                                'sign'     => 0,
                              }, [@data]);
      return undef  if ($err);
      return join(':',@delta);
   }
}

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

   my $sign    = '[-+]?';
   my $num     = '(?:\d+(?:\.\d*)?|\.\d+)';
   my $f       = "(?:$sign$num)?";

   if ($string =~ /^$f(:$f){0,6}$/o) {
      $string =~ s/::/:0:/go;
      $string =~ s/^:/0:/o;
      $string =~ s/:$/:0/o;
      my(@delta) = split(/:/,$string);
      return(0,@delta);
   } else {
      return(1);
   }
}

# Check that type is not inconsistent with @delta.
#
# An exact delta cannot have semi-exact or approximate fields set.
# A semi-exact delta cannot have approximate fields set.
# An exact, semi-exact, or approximate delta cannot have non-integer values.
#
# If the type was not explicitly specified, guess what it is.
#
# Returns ($err,$type,$type_from)
#
sub _check_delta_type {
   my($self,$mode,$type,$type_from,@delta) = @_;

   my $est    = 0;
   foreach my $f (@delta) {
      if (! $self->_is_int($f)) {
         $est = 1;
         last;
      }
   }

   my $approx = 0;
   if (! $est) {
      $approx = 1  if ($delta[0]  ||  $delta[1]);
   }

   my $semi   = 0;
   if (! $est  &&  ! $approx) {
      if ($mode eq 'business') {
         $semi = 1  if ($delta[2]);
      } else {
         $semi = 1  if ($delta[2]  ||  $delta[3]);
      }
   }

   if ($est) {
      # If some of the fields are non-integer, then type must be estimated.

      if ($type ne 'estimated') {
         if ($type_from eq 'opt') {
            return ("Type must be estimated for non-integers");
         }
         $type = 'estimated';
         $type_from = 'det';
      }

   } elsif ($approx) {
      # If some of the approximate fields are set, then type must be
      # approx or estimated.

      if ($type ne 'approx'  &&  $type ne 'estimated') {
         if ($type_from eq 'opt') {
            return("Type must be approx/estimated");
         }
         $type = 'approx';
         $type_from = 'det';
      }

   } elsif ($semi) {
      # If some of the semi-exact fields are set, then type must be
      # semi, approx, or estimated

      if ($type ne 'semi'  &&  $type ne 'approx'  &&  $type ne 'estimated') {
         if ($type_from eq 'opt') {
            return("Type must be semi/approx/estimated");
         }
         $type = 'semi';
         $type_from = 'det';
      }

   } else {

      if (! $type) {
         $type = 'exact';
         $type_from = 'det';
      }
   }

   return ('',$type,$type_from);
}

# This function returns the fields in a delta in the desired format.
#
# $opts = { mode     => standard/business
#           type     => exact/semi/approx/estimated
#           nonorm   => 0/1,
#           source   => string, list, delta
#           sign     => 0/1/-1
#         }
# $fields = [Y,M,W,D,H,Mn,S]
#
# If the business option is 1, treat it as a business delta.
#
# If the nonorm option is 1, fields are NOT normalized.  By default,
# they are normalized.
#
# If source is 'string', then the source of the fields is a string
# that has been split, so we need to handle carrying the signs.  If
# the option is 'list', then the source is a valid delta, so each
# field is correctly signed already.  In both cases, the type of
# delta will need to be determined.  If the source is 'delta', then
# it comes from a Date::Manip::Delta object.  In this case the type
# must be specified.  If type is not passed in, it will be set.
#
# If the sign option is 1, a sign is added to every field.  If the
# sign option is -1, all negative fields are signed.  If the sign
# option is 0, the minimum number of signs (for fields who's sign is
# different from the next higher field) will be added.
#
# It returns ($err,@fields)
#
sub _delta_fields {
   my($self,$opts,$fields) = @_;
   my @fields = @$fields;
   no integer;

   #
   # Make sure that all fields are defined, numerical, and that there
   # are 7 of them.
   #

   foreach my $f (@fields) {
      $f=0  if (! defined($f));
      return ("Non-numerical field")  if (! $self->_is_num($f));
   }
   return ("Delta may contain only 7 fields")  if (@fields > 7);
   while (@fields < 7) {
      unshift(@fields,0);
   }

   #
   # Make sure each field is the correct sign so that the math will
   # work correctly.  Get rid of all positive signs and leading 0's.
   #

   my $mode   = $$opts{'mode'};
   my $source = $$opts{'source'};
   @fields    = $self->_sign_source($source,@fields);

   #
   # Figure out the type of delta.  When called from Date::Manip::Base, it'll
   # be determined from the data.  When called from Date::Manip::Delta, it'll
   # be specified.
   #

   my ($type,$type_from);
   if (defined $source  &&  $source eq 'delta') {
      if (! exists $$opts{'type'}) {
         return ("Type must be specified");
      }
      $type = $$opts{'type'};

   } else {
      my $err;
      ($err,$type,$type_from) = $self->_check_delta_type($mode,'','init',@fields);
      $$opts{'type'}      = $type;
      $$opts{'type_from'} = $type_from;
      return($err)  if ($err);
   }

   #
   # Normalize values, if desired.
   #

   my $norm = 1-$$opts{'nonorm'};
   if ($norm) {
      if ($mode eq 'business') {

         if ($type eq 'estimated') {
            @fields = $self->_normalize_bus_est(@fields);

         } elsif ($type eq 'approx'  ||
                  $type eq 'semi') {
            @fields = $self->_normalize_bus_approx(@fields);

         } else {
            @fields = $self->_normalize_bus_exact(@fields);
         }

      } else {

         if ($type eq 'estimated') {
            @fields = $self->_normalize_est(@fields);

         } elsif ($type eq 'approx'  ||
                  $type eq 'semi') {
            @fields = $self->_normalize_approx(@fields);

         } else {
            @fields = $self->_normalize_exact(@fields);
         }

      }
   }

   #
   # Now make sure that the signs are included as appropriate.
   #

   @fields = $self->_sign_fields($$opts{'sign'},@fields);

   return (0,@fields);
}

# If a set of fields came from splitting a string, not all of the fields
# are signed.  If it comes from a list, we just want to remove extra '+'
# signs.
#
sub _sign_source {
   my($self,$source,@fields) = @_;

   # Needed to handle fractional fields
   no integer;
   if ($source eq 'string') {

      # if the source is splitting a delta, not all fields are signed,
      # so we need to carry the negative signs.

      my $sign = '+';
      foreach my $f (@fields) {
         if ($f =~ /^([-+])/o) {
            $sign = $1;
         } else {
            $f = "$sign$f";
         }
         $f *= 1;
      }

   } else {
      foreach my $f (@fields) {
         $f *= 1;
      }
   }

   return @fields;
}

# This applies the correct sign to each field based on the $sign option:
#
#    1 : all fields signed
#   -1 : all negative fields signed
#    0 : minimum number of signs for a joined set of fields
#
sub _sign_fields {
   my($self,$sign,@fields) = @_;
   $sign = 0  if (! defined $sign);

   if      ($sign == 1) {
      # All fields signed
      foreach my $f (@fields) {
         $f = "+$f"  if ($f > 0);
      }

   } elsif ($sign == 0) {
      # Minimum number of signs
      my $s = ($fields[0] < 0 ? '-' : '+');
      foreach my $f (@fields[1..$#fields]) {
         if ($f > 0  &&  $s eq '-') {
            $f   = "+$f";
            $s   = '+';
         } elsif ($f < 0) {
            if ($s eq '-') {
               $f *= -1;
            } else {
               $s  = '-';
            }
         }
      }
   }

   return @fields;
}

# $opts = { nonorm   => 0/1,
#           source   => string, list
#           sign     => 0/1/-1
#         }
# $fields = [H,M,S]
#
# This function formats the fields in an amount of time measured in
# hours, minutes, and seconds.
#
# It is similar to how _delta_fields (above) works.
#
sub _time_fields {
   my($self,$opts,$fields) = @_;
   my @fields = @$fields;

   #
   # Make sure that all fields are defined, numerical, and that there
   # are 3 of them.
   #

   foreach my $f (@fields) {
      $f=0  if (! defined($f));
      return (1)  if (! $self->_is_int($f));
   }
   return (1)  if (@fields > 3);
   while (@fields < 3) {
      unshift(@fields,0);
   }

   #
   # Make sure each field is the correct sign so that the math will
   # work correctly.  Get rid of all positive signs and leading 0's.
   #

   my $source = $$opts{'source'};
   @fields    = $self->_sign_source($source,@fields);

   #
   # Normalize them.  Values will be signed only if they are
   # negative.
   #

   my $norm = 1-$$opts{'nonorm'};
   if ($norm) {
      my($h,$mn,$s) = @fields;
      $s  += $h*3600 + $mn*60;
      @fields = __normalize_hms($h,$mn,$s);
   }

   #
   # Now make sure that the signs are included as appropriate.
   #

   @fields = $self->_sign_fields($$opts{'sign'},@fields);

   return (0,@fields);
}

# $opts = { out   => string, list
#         }
# $fields = [H,M,S]
#
# This function formats the fields in an HMS.
#
# If the out options is string, it prepares the fields to be joined (i.e.
# they are all 2 digits long).  Otherwise, they are just numerical values
# (not necessarily 2 digits long).
#
# HH:MN:SS is always between 00:00:00 and 24:00:00.
#
# It returns ($err,@fields)
#
sub _hms_fields {
   my($self,$opts,$fields) = @_;
   my @fields = @$fields;

   #
   # Make sure that all fields are defined, numerical (with no sign),
   # and that there are 3 of them.
   #

   foreach my $f (@fields) {
      $f=0  if (! $f);
      return (1)  if (! $self->_is_int($f,0));
   }
   return (1)  if (@fields > 3);
   while (@fields < 3) {
      push(@fields,0);
   }

   #
   # Check validity.
   #

   my ($h,$m,$s) = @fields;
   return (1)  if ($h > 24  ||  $m > 59  ||  $s > 59  ||
                   ($h==24  &&  ($m > 0 ||  $s > 0)));

   #
   # Format
   #

   if ($$opts{'out'} eq 'list') {
      foreach my $f ($h,$m,$s) {
         $f *= 1;
      }

   } else {
      foreach my $f ($h,$m,$s) {
         $f = "0$f"  if (length($f)<2);
      }
   }

   return (0,$h,$m,$s);
}

# $opts = { source     => string, list
#           out        => string, list
#         }
# $fields = [H,M,S]
#
# This function formats the fields in a timezone offset measured in
# hours, minutes, and seconds.
#
# All offsets must be -23:59:59 <= offset <= 23:59:59 .
#
# The data comes from an offset in string or list format, and is
# formatted so that it can be used to create a string or list format
# output.
#
sub _offset_fields {
   my($self,$opts,$fields) = @_;
   my @fields = @$fields;

   #
   # Make sure that all fields are defined, numerical, and that there
   # are 3 of them.
   #

   foreach my $f (@fields) {
      $f=0  if (! defined $f  ||  $f eq '');
      return (1)  if (! $self->_is_int($f));
   }
   return (1)  if (@fields > 3);
   while (@fields < 3) {
      push(@fields,0);
   }

   #
   # Check validity.
   #

   my ($h,$m,$s) = @fields;
   if ($$opts{'source'} eq 'string') {
      # Values = -23 59 59 to +23 59 59
      return (1)  if ($h < -23  ||  $h > 23  ||
                      $m < 0    ||  $m > 59  ||
                      $s < 0    ||  $s > 59);
   } else {
      # Values (-23,-59,-59) to (23,59,59)
      # Non-zero values must have the same sign
      if ($h >0) {
         return (1)  if (              $h > 23  ||
                         $m < 0    ||  $m > 59  ||
                         $s < 0    ||  $s > 59);
      } elsif ($h < 0) {
         return (1)  if ($h < -23  ||
                         $m < -59  ||  $m > 0   ||
                         $s < -59  ||  $s > 0);
      } elsif ($m > 0) {
         return (1)  if (              $m > 59  ||
                         $s < 0    ||  $s > 59);
      } elsif ($m < 0) {
         return (1)  if ($m < -59  ||
                         $s < -59  ||  $s > 0);
      } else {
         return (1)  if ($s < -59  ||  $s > 59);
      }
   }

   #
   # Make sure each field is the correct sign so that the math will
   # work correctly.  Get rid of all positive signs and leading 0's.
   #

   if ($$opts{'source'} eq 'string') {

      # In a string offset, only the first field is signed, so we need
      # to carry negative signs.

      if ($h =~ /^\-/) {
         $h *= 1;
         $m *= -1;
         $s *= -1;
      } elsif ($m =~ /^\-/) {
         $h *= 1;
         $m *= 1;
         $s *= -1;
      } else {
         $h *= 1;
         $m *= 1;
         $s *= 1;
      }

   } else {
      foreach my $f (@fields) {
         $f *= 1;
      }
   }

   #
   # Format them.  They're already done for 'list' output.
   #

   if ($$opts{'out'} eq 'string') {
      my $sign;
      if ($h<0 || $m<0 || $s<0) {
         $h = abs($h);
         $m = abs($m);
         $s = abs($s);
         $sign = '-';
      } else {
         $sign = '+';
      }

      $h = "0$h"  if (length($h) < 2);
      $m = "0$m"  if (length($m) < 2);
      $s = "0$s"  if (length($s) < 2);
      $h = "$sign$h";
   }

   return (0,$h,$m,$s);
}

# ($err,$y,$m,$d,$h,$mn,$s) = $self->_date_fields($y,$m,$d,$h,$mn,$s);
#
# Makes sure the fields are the right length.
#
sub _date_fields {
   my($self,@fields) = @_;
   return (1)  if (@fields != 6);

   my($y,$m,$d,$h,$mn,$s) = @fields;

   $y = "0$y"     while (length($y) < 4);
   $m  = "0$m"    if (length($m)==1);
   $d  = "0$d"    if (length($d)==1);
   $h  = "0$h"    if (length($h)==1);
   $mn = "0$mn"   if (length($mn)==1);
   $s  = "0$s"    if (length($s)==1);

   if (wantarray) {
      return (0,$y,$m,$d,$h,$mn,$s);
   } else {
      return "$y$m$d$h:$mn:$s";
   }
}

# $self->_delta_convert(FORMAT,DELTA)
#    This converts delta into the given format. Returns '' if invalid.
#
sub _delta_convert {
   my($self,$format,$delta)=@_;
   my $fields = $self->split($format,$delta);
   return undef  if (! defined $fields);
   return $self->join($format,$fields);
}

###############################################################################
# Normalize the different types of deltas

sub __normalize_ym {
   my($y,$m,$s,$mon) = @_;
   no integer;

   if (defined($s)) {
      $m      = int($s/$mon);
      $s     -= int(sprintf('%f',$m*$mon));
      $y      = int($m/12);
      $m     -= $y*12;

      return($y,$m,$s);
   } else {
      $m     += $y*12;
      $y      = int($m/12);
      $m     -= $y*12;

      return($y,$m);
   }
}
sub __normalize_wd {
   my($w,$d,$s,$wk,$day) = @_;
   no integer;

   $d      = int($s/$day);
   $s     -= int($d*$day);
   $w      = int($d/$wk);
   $d     -= $w*$wk;

   return($w,$d,$s);
}
sub __normalize_hms {
   my($h,$mn,$s) = @_;
   no integer;

   $h      = int($s/3600);
   $s     -= $h*3600;
   $mn     = int($s/60);
   $s     -= $mn*60;
   $s      = int($s);

   return($h,$mn,$s);
}

sub _normalize_est {
   my($self,$y,$m,$w,$d,$h,$mn,$s) = @_;
   no integer;

   # Figure out how many seconds there are in the estimated delta
   #
   # 365.2425/12 days/month * 24 hours/day * 3600 sec/hour = 2629746 sec/month

   my $mon = 2629746;
   my $day = 86400;
   my $wk  = 7;
   $s     += ($y*12+$m)*$mon + ($w*$wk + $d)*$day +
             $h*3600 + $mn*60;

   ($y,$m,$s)  = __normalize_ym($y,$m,$s,$mon);
   ($w,$d,$s)  = __normalize_wd($w,$d,$s,$wk,$day);
   ($h,$mn,$s) = __normalize_hms($h,$mn,$s);

   return ($y,$m,$w,$d,$h,$mn,$s);
}
sub _normalize_bus_est {
   my($self,$y,$m,$w,$d,$h,$mn,$s) = @_;
   no integer;

   # Figure out how many seconds there are in the estimated delta
   #
   # 365.2425/12 * wk_len/7 days/month * day sec/day = X sec/month

   my $day = $$self{'data'}{'len'}{'bdlength'};
   my $wk  = $$self{'data'}{'len'}{'workweek'};
   my $mon = 365.2425/12 * $wk/7 * $day;

   $s     += ($y*12+$m)*$mon + ($w*$wk + $d)*$day +
             $h*3600 + $mn*60;

   ($y,$m,$s)  = __normalize_ym($y,$m,$s,$mon);
   ($w,$d,$s)  = __normalize_wd($w,$d,$s,$wk,$day);
   ($h,$mn,$s) = __normalize_hms($h,$mn,$s);

   return ($y,$m,$w,$d,$h,$mn,$s);
}

sub _normalize_approx {
   my($self,$y,$m,$w,$d,$h,$mn,$s) = @_;
   no integer;

   my $wk  = 7;
   my $day = 86400;
   $s     += ($w*$wk + $d)*$day + $h*3600 + $mn*60;

   ($y,$m)     = __normalize_ym($y,$m);
   ($w,$d,$s)  = __normalize_wd($w,$d,$s,$wk,$day);
   ($h,$mn,$s) = __normalize_hms($h,$mn,$s);

   return ($y,$m,$w,$d,$h,$mn,$s);
}
sub _normalize_bus_approx {
   my($self,$y,$m,$w,$d,$h,$mn,$s) = @_;
   no integer;

   my $wk  = $$self{'data'}{'len'}{'workweek'};
   my $day = $$self{'data'}{'len'}{'bdlength'};
   $s     += ($w*$wk + $d)*$day + $h*3600 + $mn*60;

   ($y,$m)     = __normalize_ym($y,$m);
   ($w,$d,$s)  = __normalize_wd($w,$d,$s,$wk,$day);
   ($h,$mn,$s) = __normalize_hms($h,$mn,$s);

   return ($y,$m,$w,$d,$h,$mn,$s);
}

sub _normalize_exact {
   my($self,$y,$m,$w,$d,$h,$mn,$s) = @_;
   no integer;

   $s     += $h*3600 + $mn*60;

   ($h,$mn,$s) = __normalize_hms($h,$mn,$s);

   return ($y,$m,$w,$d,$h,$mn,$s);
}
sub _normalize_bus_exact {
   my($self,$y,$m,$w,$d,$h,$mn,$s) = @_;
   no integer;

   my $day = $$self{'data'}{'len'}{'bdlength'};

   $s     += $d*$day + $h*3600 + $mn*60;

   # Calculate d

   $d      = int($s/$day);
   $s     -= $d*$day;

   ($h,$mn,$s) = __normalize_hms($h,$mn,$s);

   return ($y,$m,$w,$d,$h,$mn,$s);
}

###############################################################################
# Timezone critical dates

# NOTE: Although I would prefer to stick this routine in the
# Date::Manip::TZ module where it would be more appropriate, it must
# appear here as it will be used to generate the data that will be
# used by the Date::Manip::TZ module.
#
# This calculates a critical date based on timezone information. The
# critical date is the date (usually in the current time) at which
# the current timezone period ENDS.
#
# Input is:
#    $year,$mon,$flag,$num,$dow
#       This is information from the appropriate Rule line from the
#       zoneinfo files. These are used to determine the date (Y/M/D)
#       when the timezone period will end.
#    $isdst
#       Whether or not the next timezone period is a Daylight Saving
#       Time period.
#    $time,$timetype
#       The time of day when the change occurs. The timetype can be
#       'w' (wallclock time in the current period), 's' (standard
#       time which will match wallclock time in a non-DST period, or
#       be off an hour in a DST period), and 'u' (universal time).
#
# Output is:
#    $endUT, $endLT, $begUT, $begLT
#       endUT is the actual last second of the current timezone
#       period.  endLT is the same time expressed in local time.
#       begUT is the start (in UT) of the next time period. Note that
#       the begUT date is the one which actually corresponds to the
#       date/time specified in the input. begLT is the time in the new
#       local time. The endUT/endLT are the time one second earlier.
#
sub _critical_date {
   my($self,$year,$mon,$flag,$num,$dow,
      $isdst,$time,$timetype,$stdoff,$dstoff) = @_;

   #
   # Get the predicted Y/M/D
   #

   my($y,$m,$d) = ($year+0,$mon+0,1);

   if ($flag eq 'dom') {
      $d = $num;

   } elsif ($flag eq 'last') {
      my $ymd = $self->nth_day_of_week($year,-1,$dow,$mon);
      $d = $$ymd[2];

   } elsif ($flag eq 'ge') {
      my $ymd = $self->nth_day_of_week($year,1,$dow,$mon);
      $d = $$ymd[2];
      while ($d < $num) {
         $d += 7;
      }

   } elsif ($flag eq 'le') {
      my $ymd = $self->nth_day_of_week($year,-1,$dow,$mon);
      $d = $$ymd[2];
      while ($d > $num) {
         $d -= 7;
      }
   }

   #
   # Get the predicted time and the date (not yet taking into
   # account time type).
   #

   my($h,$mn,$s) = @{ $self->split('hms',$time) };
   my $date      = [ $y,$m,$d,$h,$mn,$s ];

   #
   # Calculate all the relevant dates.
   #

   my($endUT,$endLT,$begUT,$begLT,$offset);
   $stdoff = $self->split('offset',$stdoff);
   $dstoff = $self->split('offset',$dstoff);

   if ($timetype eq 'w') {
      $begUT = $self->calc_date_time($date,($isdst ? $stdoff : $dstoff), 1);
   } elsif ($timetype eq 'u') {
      $begUT = $date;
   } else {
      $begUT = $self->calc_date_time($date,$stdoff, 1);
   }

   $endUT    = $self->calc_date_time($begUT,[0,0,-1]);
   $endLT    = $self->calc_date_time($endUT,($isdst ? $stdoff : $dstoff));
   $begLT    = $self->calc_date_time($begUT,($isdst ? $dstoff : $stdoff));

   return ($endUT,$endLT,$begUT,$begLT);
}

###############################################################################
# Get a list of strings to try to parse.

sub _encoding {
   my($self,$string) = @_;
   my @ret;

   foreach my $enc (@{ $$self{'data'}{'calc'}{'enc_in'} }) {
      if (lc($enc) eq 'utf-8') {
         _utf8_on($string);
         push(@ret,$string) if is_utf8($string, 1);
      } elsif (lc($enc) eq 'perl') {
         push(@ret,encode_utf8($string));
      } else {
         my $tmp = $string;
         _utf8_off($tmp);
         $tmp = encode_utf8(decode($enc, $tmp));
         _utf8_on($tmp);
         push(@ret,$tmp) if is_utf8($tmp, 1);;
      }
   }

   return @ret;
}

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: