package Date::Manip::Date;
# Copyright (c) 1995-2010 Sullivan Beck. All rights reserved.
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

########################################################################
# Any routine that starts with an underscore (_) is NOT intended for
# public use.  They are for internal use in the the Date::Manip
# modules and are subject to change without warning or notice.
#
# ABSOLUTELY NO USER SUPPORT IS OFFERED FOR THESE ROUTINES!
########################################################################

use Date::Manip::Obj;
@ISA = ('Date::Manip::Obj');

require 5.010000;
use warnings;
use strict;
use integer;
use IO::File;
#use re 'debug';

use Date::Manip::Base;
use Date::Manip::TZ;

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

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

# Call this every time a new date is put in to make sure everything is
# correctly initialized.
#
sub _init {
   my($self) = @_;

   $$self{'err'}              = '';

   $$self{'data'} =
     {
      'set'    => 0,         # 1 if the date has been set
                             # 2 if the date is in the process of being set

      # The date as input
      'in'     => '',        # the string that was parsed (if any)
      'zin'    => '',        # the timezone that was parsed (if any)

      # The date in the parsed timezone
      'date'   => [],        # the parsed date split
      'def'    => [0,0,0,0,0,0],

      # 1 for each field that came from
      # defaults rather than parsed
      # '' for an implied field
      'tz'     => '',        # the timezone of the date
      'isdst'  => '',        # 1 if the date is in DST.
      'offset' => [],        # The offset from GMT
      'abb'    => '',        # The timezone abbreviation.
      'f'      => {},        # fields used in printing a date

      # The date in GMT
      'gmt'    => [],        # the date converted to GMT

      # The date in local timezone
      'loc'    => [],        # the date converted to local timezone
     };
}

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

   my @args = @{ $$self{'args'} };
   if (@args) {
      if ($#args == 0) {
         $self->parse($args[0]);
      } else {
         warn "WARNING: [new] invalid arguments: @args\n";
      }
   }
}

sub input {
   my($self) = @_;
   return  $$self{'data'}{'in'};
}

########################################################################
# DATE PARSING
########################################################################

sub parse {
   my($self,$instring,@opts) = @_;
   $self->_init();
   my $noupdate = 0;

   if (! $instring) {
      $$self{'err'} = '[parse] Empty date string';
      return 1;
   }

   my %opts     = map { $_,1 } @opts;

   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   my($done,$y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off,$dow,$got_time,
      $default_time,$firsterr);

 ENCODING: foreach my $string ($dmb->_encoding($instring)) {
      $got_time     = 0;
      $default_time = 0;

   # Put parse in a simple loop for an easy exit.
    PARSE: {
         my(@tmp,$tmp);
         $$self{'err'} = '';

         # Check the standard date format

         $tmp = $dmb->split('date',$string);
         if (defined($tmp)) {
            ($y,$m,$d,$h,$mn,$s) = @$tmp;
            $got_time = 1;
            last PARSE;
         }

         # Parse ISO 8601 dates now (which may have a timezone).

         unless (exists $opts{'noiso8601'}) {
            ($done,@tmp) = $self->_parse_datetime_iso8601($string,\$noupdate);
            if ($done) {
               ($y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off) = @tmp;
               $got_time = 1;
               last PARSE;
            }
         }

         # There's lots of ways that commas may be included. Remove
         # them.

         $string =~ s/,/ /g;

         # Some special full date/time formats

         unless (exists $opts{'nospecial'}) {
            ($done,@tmp) = $self->_parse_datetime_other($string,\$noupdate);
            if ($done) {
               ($y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off) = @tmp;
               $got_time = 1;
               last PARSE;
            }
         }

         # Parse (and remove) the time

         ($got_time,@tmp) = $self->_parse_time('parse',$string,\$noupdate,%opts);
         if ($got_time) {
            ($string,$h,$mn,$s,$tzstring,$zone,$abb,$off) = @tmp;
         }

         if (! $string) {
            ($y,$m,$d) = $self->_def_date($y,$m,$d,\$noupdate);
            last;
         }

         # Parse (and remove) the day of week. Also, handle the simple DoW
         # formats.

         unless (exists $opts{'nodow'}) {
            ($done,@tmp) = $self->_parse_dow($string,\$noupdate);
            if (@tmp) {
               if ($done) {
                  ($y,$m,$d)    = @tmp;
                  $default_time = 1;
                  last PARSE;
               } else {
                  ($string,$dow) = @tmp;
               }
            }
         }
         $dow = 0  if (! $dow);

         (@tmp) = $self->_parse_date($string,$dow,\$noupdate,%opts);
         if (@tmp) {
            ($y,$m,$d,$dow) = @tmp;
            $default_time = 1;
            last PARSE;
         }

         # Parse deltas
         #
         # Occasionally, a delta is entered for a date (which is interpreted
         # as the date relative to now). There can be some confusion between
         # a date and a delta, but the most important conflicts are the
         # ISO 8601 dates (many of which could be interpreted as a delta),
         # but those have already been taken care of.

         unless (exists $opts{'nodelta'}) {
            ($done,@tmp) = $self->_parse_delta($string,$dow,$got_time,$h,$mn,$s,\$noupdate);
            if (@tmp) {
               ($y,$m,$d,$h,$mn,$s) = @tmp;
               $got_time = 1;
               $dow = '';
            }
            last PARSE  if ($done);
         }

         $$self{'err'} = '[parse] Invalid date string';
         last PARSE;
      }

      # We got an error parsing this encoding of the string. It could be that
      # it is a genuine error, or it may be that we simply need to try a different
      # encoding. If ALL encodings fail, we'll return the error from the first one.

      if ($$self{'err'}) {
         if (! $firsterr) {
            $firsterr = $$self{'err'};
         }
         next ENCODING;
      }

      # If we didn't get an error, this is the string to use.

      last ENCODING;
   }

   if ($$self{'err'}) {
      $$self{'err'} = $firsterr;
      return 1;
   }

   # Make sure that a time is set

   if (! $got_time) {
      if ($default_time) {
         if ($dmb->_config('defaulttime') eq 'midnight') {
            ($h,$mn,$s) = (0,0,0);
         } else {
            ($h,$mn,$s) = $dmt->_now('time',$noupdate);
            $noupdate = 1;
         }
         $got_time = 1;
      } else {
         ($h,$mn,$s) = $self->_def_time(undef,undef,undef,\$noupdate);
      }
   }

   $$self{'data'}{'set'} = 2;
   return $self->_parse_check('parse',$instring,
                              $y,$m,$d,$h,$mn,$s,$dow,$tzstring,$zone,$abb,$off);
}

sub parse_time {
   my($self,$string) = @_;
   my $noupdate = 0;

   if (! $string) {
      $$self{'err'} = '[parse_time] Empty time string';
      return 1;
   }

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

   if ($$self{'err'}) {
      $self->_init();
   }
   if ($$self{'data'}{'set'}) {
      ($y,$m,$d,$h,$mn,$s) = @{ $$self{'data'}{'date'} };
   } else {
      my $dmt = $$self{'tz'};
      ($y,$m,$d,$h,$mn,$s) = $dmt->_now('now',$noupdate);
      $noupdate = 1;
   }
   my($tzstring,$zone,$abb,$off);

   ($h,$mn,$s,$tzstring,$zone,$abb,$off) =
     $self->_parse_time('parse_time',$string,\$noupdate);

   return 1  if ($$self{'err'});

   $$self{'data'}{'set'} = 2;
   return $self->_parse_check('parse_time','',
                              $y,$m,$d,$h,$mn,$s,'',$tzstring,$zone,$abb,$off);
}

sub parse_date {
   my($self,$string,@opts) = @_;
   my %opts     = map { $_,1 } @opts;
   my $noupdate = 0;

   if (! $string) {
      $$self{'err'} = '[parse_date] Empty date string';
      return 1;
   }

   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};
   my($y,$m,$d,$h,$mn,$s);

   if ($$self{'err'}) {
      $self->_init();
   }
   if ($$self{'data'}{'set'}) {
      ($y,$m,$d,$h,$mn,$s) = @{ $$self{'data'}{'date'} };
   } else {
      ($h,$mn,$s) = (0,0,0);
   }

   # Put parse in a simple loop for an easy exit.
   my($done,@tmp,$dow);
 PARSE: {

      # Parse ISO 8601 dates now

      unless (exists $opts{'noiso8601'}) {
         ($done,@tmp) = $self->_parse_date_iso8601($string,\$noupdate);
         if ($done) {
            ($y,$m,$d) = @tmp;
            last PARSE;
         }
      }

      (@tmp) = $self->_parse_date($string,undef,\$noupdate,%opts);
      if (@tmp) {
         ($y,$m,$d,$dow) = @tmp;
         last PARSE;
      }

      $$self{'err'} = '[parse_date] Invalid date string';
      return 1;
   }

   return 1  if ($$self{'err'});

   $y = $dmt->_fix_year($y);

   $$self{'data'}{'set'} = 2;
   return $self->_parse_check('parse_date','',$y,$m,$d,$h,$mn,$s,$dow);
}

sub _parse_date {
   my($self,$string,$dow,$noupdate,%opts) = @_;

   # There's lots of ways that commas may be included. Remove
   # them.
   #
   # Also remove some words we should ignore.

   $string =~ s/,/ /g;

   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};
   my $ign = (exists $$dmb{'data'}{'rx'}{'other'}{'ignore'} ?
              $$dmb{'data'}{'rx'}{'other'}{'ignore'} :
              $self->_other_rx('ignore'));
   $string =~ s/$ign/ /g;
   my $of  = $+{'of'};

   $string =~ s/\s*$//;
   return ()  if (! $string);

   my($done,$y,$m,$d,@tmp);

   # Put parse in a simple loop for an easy exit.
 PARSE: {

      # Parse (and remove) the day of week. Also, handle the simple DoW
      # formats.

      unless (exists $opts{'nodow'}) {
         if (! defined($dow)) {
            ($done,@tmp) = $self->_parse_dow($string,$noupdate);
            if (@tmp) {
               if ($done) {
                  ($y,$m,$d) = @tmp;
                  last PARSE;
               } else {
                  ($string,$dow) = @tmp;
               }
            }
            $dow = 0  if (! $dow);
         }
      }

      # Parse common dates

      unless (exists $opts{'nocommon'}) {
         (@tmp) = $self->_parse_date_common($string,$noupdate);
         if (@tmp) {
            ($y,$m,$d) = @tmp;
            last PARSE;
         }
      }

      # Parse less common dates

      unless (exists $opts{'noother'}) {
         (@tmp) = $self->_parse_date_other($string,$dow,$of,$noupdate);
         if (@tmp) {
            ($y,$m,$d,$dow) = @tmp;
            last PARSE;
         }
      }

      return ();
   }

   return($y,$m,$d,$dow);
}

sub parse_format {
   my($self,$format,$string) = @_;
   $self->_init();
   my $noupdate = 0;

   if (! $string) {
      $$self{'err'} = '[parse_format] Empty date string';
      return 1;
   }

   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   my($err,$re) = $self->_format_regexp($format);
   return $err  if ($err);
   return 1     if ($string !~ $re);

   my($y,$m,$d,$h,$mn,$s,
      $mon_name,$mon_abb,$dow_name,$dow_abb,$dow_char,$dow_num,
      $doy,$nth,$ampm,$epochs,$epocho,
      $tzstring,$off,$abb,$zone,
      $g,$w,$l,$u) =
        @+{qw(y m d h mn s
              mon_name mon_abb dow_name dow_abb dow_char dow_num doy
              nth ampm epochs epocho tzstring off abb zone g w l u)};

   while (1) {
      # Get y/m/d/h/mn/s from:
      #     $epochs,$epocho

      if (defined($epochs)) {
         ($y,$m,$d,$h,$mn,$s) = @{ $dmb->secs_since_1970($epochs) };
         my $z;
         if ($zone) {
            $z = $dmt->_zone($zone);
            return 'Invalid zone'  if (! $z);
         } elsif ($abb  ||  $off) {
            $z = $dmt->zone($off,$abb);
            return 'Invalid zone'  if (! $z);
         } else {
            ($z) = $dmt->_now('tz',$noupdate);
            $noupdate = 1;
         }
         ($y,$m,$d,$h,$mn,$s) =
           @{ $dmb->convert_from_gmt([$y,$m,$d,$h,$mn,$s],$z) };
         last;
      }

      if (defined($epocho)) {
         ($y,$m,$d,$h,$mn,$s) = @{ $dmb->secs_since_1970($epocho) };
         last;
      }

      # Get y/m/d from:
      #     $y,$m,$d,
      #     $mon_name,$mon_abb
      #     $doy,$nth
      #     $g/$w,$l/$u

      if ($mon_name) {
         $m = $$dmb{'data'}{'wordmatch'}{'month_name'}{lc($mon_name)};
      } elsif ($mon_abb) {
         $m = $$dmb{'data'}{'wordmatch'}{'month_abb'}{lc($mon_abb)};
      }

      if ($nth) {
         $d = $$dmb{'data'}{'wordmatch'}{'nth'}{lc($nth)};
      }

      if ($doy) {
         ($y) = $dmt->_now('y',$noupdate)  if (! $y);
         $noupdate = 1;
         ($y,$m,$d) = @{ $dmb->day_of_year($y,$doy) };

      } elsif ($g) {
         ($y) = $dmt->_now('y',$noupdate)  if (! $y);
         $noupdate = 1;
         ($y,$m,$d) = @{ $dmb->_week_of_year($g,$w,1) };

      } elsif ($l) {
         ($y) = $dmt->_now('y',$noupdate)  if (! $y);
         $noupdate = 1;
         ($y,$m,$d) = @{ $dmb->_week_of_year($l,$u,7) };

      } elsif ($m) {
         ($y,$m,$d) = $self->_def_date($y,$m,$d,\$noupdate);
      }

      # Get h/mn/s from:
      #     $h,$mn,$s,$ampm

      if ($h) {
         ($h,$mn,$s) = $self->_def_time($h,$mn,$s,\$noupdate);
      }

      if ($ampm) {
         if ($$dmb{'data'}{'wordmatch'}{'ampm'}{lc($ampm)} == 2) {
            # pm times
            $h+=12  unless ($h==12);
         } else {
            # am times
            $h=0  if ($h==12);
         }
      }

      # Get dow from:
      #     $dow_name,$dow_abb,$dow_char,$dow_num

      if ($dow_name) {
         $dow_num = $$dmb{'data'}{'wordmatch'}{'day_name'}{lc($dow_name)};
      } elsif ($dow_abb) {
         $dow_num = $$dmb{'data'}{'wordmatch'}{'day_abb'}{lc($dow_abb)};
      } elsif ($dow_char) {
         $dow_num = $$dmb{'data'}{'wordmatch'}{'day_char'}{lc($dow_char)};
      }

      last;
   }

   if (! $m) {
      ($y,$m,$d) = $dmt->_now('now',$noupdate);
      $noupdate = 1;
   }
   if (! $h) {
      ($h,$mn,$s) = (0,0,0);
   }

   $$self{'data'}{'set'} = 2;
   return $self->_parse_check('parse_format',$string,
                              $y,$m,$d,$h,$mn,$s,$dow_num,
                              $tzstring,$zone,$abb,$off);
}

BEGIN {
   my %y_form   = map { $_,1 } qw( Y y s o G L );
   my %m_form   = map { $_,1 } qw( m f b h B j s o W U );
   my %d_form   = map { $_,1 } qw( j d e E s o W U );
   my %h_form   = map { $_,1 } qw( H I k i s o );
   my %mn_form  = map { $_,1 } qw( M s o );
   my %s_form   = map { $_,1 } qw( S s o );

   my %dow_form = map { $_,1 } qw( v a A w );
   my %am_form  = map { $_,1 } qw( p s o );
   my %z_form   = map { $_,1 } qw( Z z N );
   my %mon_form = map { $_,1 } qw( b h B );
   my %day_form = map { $_,1 } qw( v a A );

   sub _format_regexp {
      my($self,$format) = @_;
      my $dmt = $$self{'tz'};
      my $dmb = $$dmt{'base'};

      if (exists $$dmb{'data'}{'format'}{$format}) {
         return @{ $$dmb{'data'}{'format'}{$format} };
      }

      my $re;
      my $err;
      my($y,$m,$d,$h,$mn,$s) = (0,0,0,0,0,0);
      my($dow,$ampm,$zone,$G,$W,$L,$U) = (0,0,0,0,0,0,0);

      while ($format) {
         last  if ($format eq '%');

         if ($format =~ s/^([^%]+)//) {
            $re .= $1;
            next;
         }

         $format =~ s/^%(.)//;
         my $f = $1;

         if (exists $y_form{$f}) {
            if ($y) {
               $err = 'Year specified multiple times';
               last;
            }
            $y = 1;
         }

         if (exists $m_form{$f}) {
            if ($m) {
               $err = 'Month specified multiple times';
               last;
            }
            $m = 1;
         }

         if (exists $d_form{$f}) {
            if ($d) {
               $err = 'Day specified multiple times';
               last;
            }
            $d = 1;
         }

         if (exists $h_form{$f}) {
            if ($h) {
               $err = 'Hour specified multiple times';
               last;
            }
            $h = 1;
         }

         if (exists $mn_form{$f}) {
            if ($mn) {
               $err = 'Minutes specified multiple times';
               last;
            }
            $mn = 1;
         }

         if (exists $s_form{$f}) {
            if ($s) {
               $err = 'Seconds specified multiple times';
               last;
            }
            $s = 1;
         }

         if (exists $dow_form{$f}) {
            if ($dow) {
               $err = 'Day-of-week specified multiple times';
               last;
            }
            $dow = 1;
         }

         if (exists $am_form{$f}) {
            if ($ampm) {
               $err = 'AM/PM specified multiple times';
               last;
            }
            $ampm = 1;
         }

         if (exists $z_form{$f}) {
            if ($zone) {
               $err = 'Zone specified multiple times';
               last;
            }
            $zone = 1;
         }

         if ($f eq 'G') {
            if ($G) {
               $err = 'G specified multiple times';
               last;
            }
            $G = 1;

         } elsif ($f eq 'W') {
            if ($W) {
               $err = 'W specified multiple times';
               last;
            }
            $W = 1;

         } elsif ($f eq 'L') {
            if ($L) {
               $err = 'L specified multiple times';
               last;
            }
            $L = 1;

         } elsif ($f eq 'U') {
            if ($U) {
               $err = 'U specified multiple times';
               last;
            }
            $U = 1;
         }

         ###

         if ($f eq 'Y') {
            $re .= '(?<y>\d\d\d\d)';

         } elsif ($f eq 'y') {
            $re .= '(?<y>\d\d)';

         } elsif ($f eq 'm') {
            $re .= '(?<m>\d\d)';

         } elsif ($f eq 'f') {
            $re .= '(?:(?<m>\d\d)| (?<m>\d))';

         } elsif (exists $mon_form{$f}) {
            my $abb = $$dmb{'data'}{'rx'}{'month_abb'}[0];
            my $nam = $$dmb{'data'}{'rx'}{'month_name'}[0];
            $re .= "(?:(?<mon_name>$nam)|(?<mon_abb>$abb))";

         } elsif ($f eq 'j') {
            $re .= '(?<doy>\d\d\d)';

         } elsif ($f eq 'd') {
            $re .= '(?<d>\d\d)';

         } elsif ($f eq 'e') {
            $re .= '(?:(?<d>\d\d)| ?(?<d>\d))';

         } elsif (exists $day_form{$f}) {
            my $abb  = $$dmb{'data'}{'rx'}{'day_abb'}[0];
            my $name = $$dmb{'data'}{'rx'}{'day_name'}[0];
            my $char = $$dmb{'data'}{'rx'}{'day_char'}[0];
            $re .= "(?:(?<dow_name>$name)|(?<dow_abb>$abb)|(?<dow_char>$char))";

         } elsif ($f eq 'w') {
            $re .= '(?<dow_num>[1-7])';

         } elsif ($f eq 'E') {
            my $nth = $$dmb{'data'}{'rx'}{'nth'}[0];
            $re .= "(?<nth>$nth)"

         } elsif ($f eq 'H'  ||  $f eq 'I') {
            $re .= '(?<h>\d\d)';

         } elsif ($f eq 'k'  ||  $f eq 'i') {
            $re .= '(?:(?<h>\d\d)| (?<h>\d))';

         } elsif ($f eq 'p') {
            my $ampm = $$dmb{data}{rx}{ampm}[0];
            $re .= "(?<ampm>$ampm)";

         } elsif ($f eq 'M') {
            $re .= '(?<mn>\d\d)';

         } elsif ($f eq 'S') {
            $re .= '(?<s>\d\d)';

         } elsif (exists $z_form{$f}) {
            $re .= $dmt->_zrx();

         } elsif ($f eq 's') {
            $re .= '(?<epochs>\d+)';

         } elsif ($f eq 'o') {
            $re .= '(?<epocho>\d+)';

         } elsif ($f eq 'G') {
            $re .= '(?<g>\d\d\d\d)';

         } elsif ($f eq 'W') {
            $re .= '(?<w>\d\d)';

         } elsif ($f eq 'L') {
            $re .= '(?<l>\d\d\d\d)';

         } elsif ($f eq 'U') {
            $re .= '(?<u>\d\d)';

         } elsif ($f eq 'c') {
            $format = '%a %b %e %H:%M:%S %Y' . $format;

         } elsif ($f eq 'C'  ||  $f eq 'u') {
            $format = '%a %b %e %H:%M:%S %Z %Y' . $format;

         } elsif ($f eq 'g') {
            $format = '%a, %d %b %Y %H:%M:%S %Z' . $format;

         } elsif ($f eq 'D') {
            $format = '%m/%d/%y' . $format;

         } elsif ($f eq 'r') {
            $format = '%I:%M:%S %p' . $format;

         } elsif ($f eq 'R') {
            $format = '%H:%M' . $format;

         } elsif ($f eq 'T'  ||  $f eq 'X') {
            $format = '%H:%M:%S' . $format;

         } elsif ($f eq 'V') {
            $format = '%m%d%H%M%y' . $format;

         } elsif ($f eq 'Q') {
            $format = '%Y%m%d' . $format;

         } elsif ($f eq 'q') {
            $format = '%Y%m%d%H%M%S' . $format;

         } elsif ($f eq 'P') {
            $format = '%Y%m%d%H:%M:%S' . $format;

         } elsif ($f eq 'O') {
            $format = '%Y\\-%m\\-%dT%H:%M:%S' . $format;

         } elsif ($f eq 'F') {
            $format = '%A, %B %e, %Y' . $format;

         } elsif ($f eq 'K') {
            $format = '%Y-%j' . $format;

         } elsif ($f eq 'J') {
            $format = '%G-W%W-%w' . $format;

         } elsif ($f eq 'x') {
            if ($dmb->_config('dateformat') eq 'US') {
               $format = '%m/%d/%y' . $format;
            } else {
               $format = '%d/%m/%y' . $format;
            }

         } elsif ($f eq 't') {
            $re .= "\t";

         } elsif ($f eq '%') {
            $re .= '%';

         } elsif ($f eq '+') {
            $re .= '\\+';
         }
      }

      if ($m != $d) {
         $err = 'Date not fully specified';
      } elsif ( ($h || $mn || $s)  &&  (! $h  ||  ! $mn) ) {
         $err = 'Time not fully specified';
      } elsif ($ampm  &&  ! $h) {
         $err = 'Time not fully specified';
      } elsif ($G != $W) {
         $err = 'G/W must both be specified';
      } elsif ($L != $U) {
         $err = 'L/U must both be specified';
      }

      if ($err) {
         $$dmb{'data'}{'format'}{$format} = [$err];
         return ($err);
      }

      $$dmb{'data'}{'format'}{$format} = [0, qr/$re/i];
      return @{ $$dmb{'data'}{'format'}{$format} };
   }
}

########################################################################
# DATE FORMATS
########################################################################

sub _parse_check {
   my($self,$caller,$instring,
      $y,$m,$d,$h,$mn,$s,$dow,$tzstring,$zone,$abb,$off) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   # Check day_of_week for validity BEFORE converting 24:00:00 to the
   # next day

   if ($dow) {
      my $tmp = $dmb->day_of_week([$y,$m,$d]);
      if ($tmp != $dow) {
         $$self{'err'} = "[$caller] Day of week invalid";
         return 1;
      }
   }

   # Handle 24:00:00 times.

   if ($h == 24) {
      ($h,$mn,$s) = (0,0,0);
      ($y,$m,$d)  = @{ $dmb->calc_date_days([$y,$m,$d],1) };
   }

   if (! $dmb->check([$y,$m,$d,$h,$mn,$s])) {
      $$self{'err'} = "[$caller] Invalid date";
      return 1;
   }

   # Interpret timezone information and check that date is valid
   # in the timezone.

   my $zonename;
   if (defined($zone)) {
      $zonename = $dmt->_zone($zone);

      if (! $zonename) {
         $$self{'err'} = "[$caller] Unable to determine timezone: $zone";
         return 1;
      }

   } elsif (defined($abb) ||  defined($off)) {
      my (@tmp,$err);
      push(@tmp,[$y,$m,$d,$h,$mn,$s]);
      push(@tmp,$off)     if (defined $off);
      push(@tmp,$abb)     if (defined $abb);
      $zonename = $dmt->zone(@tmp);

      if (! $zonename) {
         $$self{'err'} = 'Unable to determine timezone';
         return 1;
      }

   } else {
      ($zonename) = $dmt->_now('tz',1);
   }

   # Store the date

   $self->set('zdate',$zonename,[$y,$m,$d,$h,$mn,$s]);
   $$self{'data'}{'in'}    = $instring;
   $$self{'data'}{'zin'}   = $zone  if (defined($zone));

   return 0;
}

# Set up the regular expressions for ISO 8601 parsing. Returns the
# requested regexp. $rx can be:
#    cdate    : regular expression for a complete date
#    tdate    : regular expression for a truncated date
#    ctime    : regular expression for a complete time
#    ttime    : regular expression for a truncated time
#    date     : regular expression for a date only
#    time     : regular expression for a time only
#    UNDEF    : regular expression for a valid date and/or time
#
# Date matches are:
#    y m d doy w dow yod c
# Time matches are:
#    h h24 mn s fh fm
#
sub _iso8601_rx {
   my($self,$rx) = @_;
   my $dmt       = $$self{'tz'};
   my $dmb       = $$dmt{'base'};

   return $$dmb{'data'}{'rx'}{'iso'}{$rx}
     if (exists $$dmb{'data'}{'rx'}{'iso'}{$rx});

   if ($rx eq 'cdate'  ||  $rx eq 'tdate') {

      my $y4  = '(?<y>\d\d\d\d)';
      my $y2  = '(?<y>\d\d)';
      my $m   = '(?<m>\d\d)';
      my $d   = '(?<d>\d\d)';
      my $doy = '(?<doy>\d\d\d)';
      my $w   = '(?<w>\d\d)';
      my $dow = '(?<dow>\d)';
      my $yod = '(?<yod>\d)';
      my $cc  = '(?<c>\d\d)';

      my $cdaterx =
        "${y4}${m}${d}|" .                 # CCYYMMDD
        "${y4}\\-${m}\\-${d}|" .           # CCYY-MM-DD
          "\\-${y2}${m}${d}|" .            # -YYMMDD
          "\\-${y2}\\-${m}\\-${d}|" .      # -YY-MM-DD
          "\\-?${y2}${m}${d}|" .           # YYMMDD
          "\\-?${y2}\\-${m}\\-${d}|" .     # YY-MM-DD
          "\\-\\-${m}\\-?${d}|" .          # --MM-DD   --MMDD
          "\\-\\-\\-${d}|" .               # ---DD

          "${y4}\\-?${doy}|" .             # CCYY-DoY  CCYYDoY
          "\\-?${y2}\\-?${doy}|" .         # YY-DoY    -YY-DoY
                                           # YYDoY     -YYDoY
          "\\-${doy}|" .                   # -DoY

          "${y4}W${w}${dow}|" .            # CCYYWwwD
          "${y4}\\-W${w}\\-${dow}|" .      # CCYY-Www-D
          "\\-?${y2}W${w}${dow}|" .        # YYWwwD    -YYWwwD
          "\\-?${y2}\\-W${w}\\-${dow}|" .  # YY-Www-D  -YY-Www-D

          "\\-?${yod}W${w}${dow}|" .       # YWwwD     -YWwwD
          "\\-?${yod}\\-W${w}\\-${dow}|" . # Y-Www-D   -Y-Www-D
          "\\-W${w}\\-?${dow}|" .          # -Www-D    -WwwD
          "\\-W\\-${dow}|" .               # -W-D
          "\\-\\-\\-${dow}";               # ---D
      $cdaterx = qr/(?:$cdaterx)/i;

      my $tdaterx =
        "${y4}\\-${m}|" .                  # CCYY-MM
        "${y4}|" .                         # CCYY
        "\\-${y2}\\-?${m}|" .              # -YY-MM    -YYMM
        "\\-${y2}|" .                      # -YY
        "\\-\\-${m}|" .                    # --MM

        "${y4}\\-?W${w}|" .                # CCYYWww   CCYY-Www
        "\\-?${y2}\\-?W${w}|" .            # YY-Www    YYWww
                                           # -YY-Www   -YYWww
        "\\-?W${w}|" .                     # -Www      Www

        "${cc}";                           # CC
      $tdaterx = qr/(?:$tdaterx)/i;

      $$dmb{'data'}{'rx'}{'iso'}{'cdate'} = $cdaterx;
      $$dmb{'data'}{'rx'}{'iso'}{'tdate'} = $tdaterx;

   } elsif ($rx eq 'ctime'  ||  $rx eq 'ttime') {

      my $hh     = '(?<h>[0-1][0-9]|2[0-3])';
      my $mn     = '(?<mn>[0-5][0-9])';
      my $ss     = '(?<s>[0-5][0-9])';
      my $h24a   = '(?<h24>24(?::00){0,2})';
      my $h24b   = '(?<h24>24(?:00){0,2})';

      my $fh     = '(?:[\.,](?<fh>\d*))'; # fractional hours (keep)
      my $fm     = '(?:[\.,](?<fm>\d*))'; # fractional seconds (keep)
      my $fs     = '(?:[\.,]\d*)'; # fractional hours (discard)

      my $zrx    = $dmt->_zrx();

      my $ctimerx =
        "${hh}${mn}${ss}${fs}?|" .         # HHMNSS[,S+]
        "${hh}:${mn}:${ss}${fs}?|" .       # HH:MN:SS[,S+]
        "${hh}:?${mn}${fm}|" .             # HH:MN,M+       HHMN,M+
        "${hh}${fh}|" .                    # HH,H+
        "\\-${mn}:?${ss}${fs}?|" .         # -MN:SS[,S+]    -MNSS[,S+]
        "\\-${mn}${fm}|" .                 # -MN,M+
        "\\-\\-${ss}${fs}?|" .             # --SS[,S+]
        "${hh}:?${mn}|" .                  # HH:MN          HHMN
        "${h24a}|" .                       # 24:00:00       24:00       24
        "${h24b}";                         # 240000         2400
      $ctimerx = qr/(?:$ctimerx)(?:\s*$zrx)?/;

      my $ttimerx =
        "${hh}|" .                         # HH
        "\\-${mn}";                        # -MN
      $ttimerx = qr/(?:$ttimerx)/;

      $$dmb{'data'}{'rx'}{'iso'}{'ctime'} = $ctimerx;
      $$dmb{'data'}{'rx'}{'iso'}{'ttime'} = $ttimerx;

   } elsif ($rx eq 'date') {

      my $cdaterx = $self->_iso8601_rx('cdate');
      my $tdaterx = $self->_iso8601_rx('tdate');
      $$dmb{'data'}{'rx'}{'iso'}{'date'} = qr/(?:$cdaterx|$tdaterx)/;

   } elsif ($rx eq 'time') {

      my $ctimerx = $self->_iso8601_rx('ctime');
      my $ttimerx = $self->_iso8601_rx('ttime');
      $$dmb{'data'}{'rx'}{'iso'}{'time'} = qr/(?:$ctimerx|$ttimerx)/;

   } elsif ($rx eq 'fulldate') {

      # A parseable string contains:
      #   a complete date and complete time
      #   a complete date and truncated time
      #   a truncated date
      #   a complete time
      #   a truncated time

      # If the string contains both a time and date, they may be adjacent
      # or separated by:
      #   whitespace
      #   T (which must be followed by a number)
      #   a dash

      my $cdaterx = $self->_iso8601_rx('cdate');
      my $tdaterx = $self->_iso8601_rx('tdate');
      my $ctimerx = $self->_iso8601_rx('ctime');
      my $ttimerx = $self->_iso8601_rx('ttime');

      my $sep     = qr/(?:T|\-|\s*)/i;

      my $daterx  = qr/^\s*(?: $cdaterx(?:$sep(?:$ctimerx|$ttimerx))? |
                          $tdaterx |
                          $ctimerx |
                          $ttimerx
                       )\s*$/x;

      $$dmb{'data'}{'rx'}{'iso'}{'fulldate'} = $daterx;
   }

   return $$dmb{'data'}{'rx'}{'iso'}{$rx};
}

sub _parse_datetime_iso8601 {
   my($self,$string,$noupdate) = @_;
   my $dmt                     = $$self{'tz'};
   my $dmb                     = $$dmt{'base'};
   my $daterx                  = $self->_iso8601_rx('fulldate');

   my($y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off);
   my($doy,$dow,$yod,$c,$w,$fh,$fm,$h24);

   if ($string =~ $daterx) {
      ($y,$m,$d,$h,$mn,$s,$doy,$dow,$yod,$c,$w,$fh,$fm,$h24,
       $tzstring,$zone,$abb,$off) =
         @+{qw(y m d h mn s doy dow yod c w fh fm h24 tzstring zone abb off)};

      if (defined $w  ||  defined $dow) {
         ($y,$m,$d)   = $self->_def_date_dow($y,$w,$dow,$noupdate);
      } elsif (defined $doy) {
         ($y,$m,$d) = $self->_def_date_doy($y,$doy,$noupdate);
      } else {
         $y = $c . '00'  if (defined $c);
         ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
      }

      ($h,$mn,$s) = $self->_time($h,$mn,$s,$fh,$fm,$h24,undef,$noupdate);
   } else {
      return (0);
   }

   return (1,$y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off);
}

sub _parse_date_iso8601 {
   my($self,$string,$noupdate) = @_;
   my $dmt                     = $$self{'tz'};
   my $dmb                     = $$dmt{'base'};
   my $daterx                  = $self->_iso8601_rx('date');

   my($y,$m,$d);
   my($doy,$dow,$yod,$c,$w);

   if ($string =~ /^$daterx$/) {
      ($y,$m,$d,$doy,$dow,$yod,$c,$w) =
        @+{qw(y m d doy dow yod c w)};

      if (defined $w  ||  defined $dow) {
         ($y,$m,$d)   = $self->_def_date_dow($y,$w,$dow,$noupdate);
      } elsif (defined $doy) {
         ($y,$m,$d) = $self->_def_date_doy($y,$doy,$noupdate);
      } else {
         $y = $c . '00'  if (defined $c);
         ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
      }
   } else {
      return (0);
   }

   return (1,$y,$m,$d);
}

# Handle all of the time fields.
#
no integer;
sub _time {
   my($self,$h,$mn,$s,$fh,$fm,$h24,$ampm,$noupdate) = @_;

   if (defined($ampm)  &&  $ampm) {
      my $dmt = $$self{'tz'};
      my $dmb = $$dmt{'base'};
      if ($$dmb{'data'}{'wordmatch'}{'ampm'}{lc($ampm)} == 2) {
         # pm times
         $h+=12  unless ($h==12);
      } else {
         # am times
         $h=0  if ($h==12);
      }
   }

   if (defined $h24) {
      return(24,0,0);
   } elsif (defined $fh  &&  $fh ne "") {
      $fh = "0.$fh";
      $s  = int($fh * 3600);
      $mn = int($s/60);
      $s -= $mn*60;
   } elsif (defined $fm  &&  $fm ne "") {
      $fm = "0.$fm";
      $s  = int($fm*60);
   }
   ($h,$mn,$s) = $self->_def_time($h,$mn,$s,$noupdate);
   return($h,$mn,$s);
}
use integer;

# Set up the regular expressions for other date and time formats. Returns the
# requested regexp.
#
sub _other_rx {
   my($self,$rx) = @_;
   my $dmt       = $$self{'tz'};
   my $dmb       = $$dmt{'base'};
   $rx           = '_'  if (! defined $rx);

   if ($rx eq 'time') {

      my $h24    = '(2[0-3]|1[0-9]|0?[0-9])'; # 0-23      00-23
      my $h12    = '(1[0-2]|0?[1-9])';        # 1-12      01-12
      my $mn     = '([0-5][0-9])';            # 00-59
      my $ss     = '([0-5][0-9])';            # 00-59

      # how to express fractions

      my($f1,$f2,$sepfr);
      if (exists $$dmb{'data'}{'rx'}{'sepfr'}  &&
          $$dmb{'data'}{'rx'}{'sepfr'}) {
         $sepfr = $$dmb{'data'}{'rx'}{'sepfr'};
      } else {
         $sepfr = '';
      }

      if ($sepfr) {
         $f1 = "(?:[.,]|$sepfr)";
         $f2 = "(?:[.,:]|$sepfr)";
      } else {
         $f1 = "[.,]";
         $f2 = "[.,:]";
      }
      my $fh     = "(?:$f1(\\d*))";  # fractional hours (keep)
      my $fm     = "(?:$f1(\\d*))";  # fractional minutes (keep)
      my $fs     = "(?:$f2\\d*)";    # fractional seconds

      # AM/PM

      my($ampm);
      if (exists $$dmb{'data'}{'rx'}{'ampm'}) {
         $ampm   = "(?:\\s*($$dmb{data}{rx}{ampm}[0]))";
      }

      # H:MN and MN:S separators

      my @hm = (':');
      my @ms = (':');
      if (exists $$dmb{'data'}{'rx'}{'sephm'}   &&
          defined $$dmb{'data'}{'rx'}{'sephm'}  &&
          exists $$dmb{'data'}{'rx'}{'sepms'}   &&
          defined $$dmb{'data'}{'rx'}{'sepms'}) {
         push(@hm,@{ $$dmb{'data'}{'rx'}{'sephm'} });
         push(@ms,@{ $$dmb{'data'}{'rx'}{'sepms'} });
      }

      # How to express the time
      #  matches = (H, FH, MN, FMN, S, AM, TZSTRING, ZONE, ABB, OFF, ABB)

      my @time   = ();
      for (my $i=0; $i<=$#hm; $i++) {
         push(@time,
              "${h12}()$hm[$i]${mn}()$ms[$i]${ss}${fs}?${ampm}?" # H:MN:SS[,S+] [AM]
             )  if ($ampm);
         push(@time,
              "${h24}()$hm[$i]${mn}()$ms[$i]${ss}${fs}?()",      # H:MN:SS[,S+]
              "(24)()$hm[$i](00)()$ms[$i](00)()"                 # 24:00:00
             );
      }
      for (my $i=0; $i<=$#hm; $i++) {
         push(@time,
              "${h12}()$hm[$i]${mn}${fm}()${ampm}?"              # H:MN,M+ [AM]
             ) if ($ampm);
         push(@time,
              "${h24}()$hm[$i]${mn}${fm}()()"                    # H:MN,M+
             );
      }
      push(@time,
           "${h12}${fh}()()()${ampm}?"                           # H,H+ [AM]
          )  if ($ampm);
      push(@time,
           "${h24}${fh}()()()()"                                 # H,H+
          );
      for (my $i=0; $i<=$#hm; $i++) {
         push(@time,
              "${h12}()$hm[$i]${mn}()()${ampm}?"                 # H:MN [AM]
             ) if ($ampm);
         push(@time,
              "${h24}()$hm[$i]${mn}()()()",                      # H:MN
              "(24)()$hm[$i](00)()()()"                          # 24:00
             );
      }
      push(@time,"${h12}()()()()${ampm}") if ($ampm);            # H AM

      my $zrx    = $dmt->_zrx();
      my $timerx = join('|',@time);
      my $at     = $$dmb{'data'}{'rx'}{'at'};
      my $atrx   = qr/(?:^|\s+)(?:$at)\s+/;
      $timerx    = qr/(?:$atrx|^|\s+)(?|$timerx)(?:\s*$zrx)?(?:\s+|$)/i;

      $$dmb{'data'}{'rx'}{'other'}{$rx} = $timerx;

   } elsif ($rx eq 'common_1') {

      # These are of the format M/D/Y

      # Do NOT replace <m> and <y> with a regular expression to
      # match 1-12 since the DateFormat config may reverse the two.
      my $y4  = '(?<y>\d\d\d\d)';
      my $y2  = '(?<y>\d\d)';
      my $m   = '(?<m>\d\d?)';
      my $d   = '(?<d>\d\d?)';
      my $sep = '(?<sep>[\s\.\/\-])';

      my $daterx =
        "${m}${sep}${d}\\k<sep>$y4|" .  # M/D/YYYY
        "${m}${sep}${d}\\k<sep>$y2|" .  # M/D/YY
        "${m}${sep}${d}";               # M/D

      $daterx = qr/^\s*(?:$daterx)\s*$/;
      $$dmb{'data'}{'rx'}{'other'}{$rx} = $daterx;

   } elsif ($rx eq 'common_2') {

      my $abb = $$dmb{'data'}{'rx'}{'month_abb'}[0];
      my $nam = $$dmb{'data'}{'rx'}{'month_name'}[0];

      my $y4  = '(?<y>\d\d\d\d)';
      my $y2  = '(?<y>\d\d)';
      my $m   = '(?<m>\d\d?)';
      my $d   = '(?<d>\d\d?)';
      my $dd  = '(?<d>\d\d)';
      my $mmm = "(?:(?<mmm>$abb)|(?<month>$nam))";
      my $sep = '(?<sep>[\s\.\/\-])';

      my $daterx =
        "${y4}${sep}${m}\\k<sep>$d|" .        # YYYY/M/D

        "${mmm}\\s*${dd}\\s*${y4}|" .         # mmmDDYYYY
        "${mmm}\\s*${dd}\\s*${y2}|" .         # mmmDDYY
        "${mmm}\\s*${d}|" .                   # mmmD
        "${d}\\s*${mmm}\\s*${y4}|" .          # DmmmYYYY
        "${d}\\s*${mmm}\\s*${y2}|" .          # DmmmYY
        "${d}\\s*${mmm}|" .                   # Dmmm
        "${y4}\\s*${mmm}\\s*${d}|" .          # YYYYmmmD

        "${mmm}${sep}${d}\\k<sep>${y4}|" .    # mmm/D/YYYY
        "${mmm}${sep}${d}\\k<sep>${y2}|" .    # mmm/D/YY
        "${mmm}${sep}${d}|" .                 # mmm/D
        "${d}${sep}${mmm}\\k<sep>${y4}|" .    # D/mmm/YYYY
        "${d}${sep}${mmm}\\k<sep>${y2}|" .    # D/mmm/YY
        "${d}${sep}${mmm}|" .                 # D/mmm
        "${y4}${sep}${mmm}\\k<sep>${d}|" .    # YYYY/mmm/D

        "${mmm}${sep}?${d}\\s+${y2}|" .       # mmmD YY      mmm/D YY
        "${mmm}${sep}?${d}\\s+${y4}|" .       # mmmD YYYY    mmm/D YYYY
        "${d}${sep}?${mmm}\\s+${y2}|" .       # Dmmm YY      D/mmm YY
        "${d}${sep}?${mmm}\\s+${y4}|" .       # Dmmm YYYY    D/mmm YYYY

        "${y2}\\s+${mmm}${sep}?${d}|" .       # YY   mmmD    YY   mmm/D
        "${y4}\\s+${mmm}${sep}?${d}|" .       # YYYY mmmD    YYYY mmm/D
        "${y2}\\s+${d}${sep}?${mmm}|" .       # YY   Dmmm    YY   D/mmm
        "${y4}\\s+${d}${sep}?${mmm}|" .       # YYYY Dmmm    YYYY D/mmm

        "${y4}:${m}:${d}";                    # YYYY:MM:DD


      $daterx = qr/^\s*(?:$daterx)\s*$/i;
      $$dmb{'data'}{'rx'}{'other'}{$rx} = $daterx;

   } elsif ($rx eq 'dow') {

      my $day_abb  = $$dmb{'data'}{'rx'}{'day_abb'}[0];
      my $day_name = $$dmb{'data'}{'rx'}{'day_name'}[0];

      my $on     = $$dmb{'data'}{'rx'}{'on'};
      my $onrx   = qr/(?:^|\s+)(?:$on)\s+/;
      my $dowrx  = qr/(?:$onrx|^|\s+)(?<dow>$day_name|$day_abb)($|\s+)/i;

      $$dmb{'data'}{'rx'}{'other'}{$rx} = $dowrx;

   } elsif ($rx eq 'ignore') {

      my $of    = $$dmb{'data'}{'rx'}{'of'};

      my $ignrx = qr/(?:^|\s+)(?<of>$of)(\s+|$)/;
      $$dmb{'data'}{'rx'}{'other'}{$rx} = $ignrx;

   } elsif ($rx eq 'miscdatetime') {

      my $special  = $$dmb{'data'}{'rx'}{'offset_time'}[0];

      $special     = "(?<special>$special)";
      my $secs     = "(?<epoch>[-+]?\\d+)";

      my $daterx   =
        "${special}|" .       # now

        "epoch\\s+$secs";     # epoch SECS

      $daterx = qr/^\s*(?:$daterx)\s*$/i;
      $$dmb{'data'}{'rx'}{'other'}{$rx} = $daterx;

   } elsif ($rx eq 'misc') {

      my $abb      = $$dmb{'data'}{'rx'}{'month_abb'}[0];
      my $nam      = $$dmb{'data'}{'rx'}{'month_name'}[0];
      my $next     = $$dmb{'data'}{'rx'}{'nextprev'}[0];
      my $last     = $$dmb{'data'}{'rx'}{'last'};
      my $yf       = $$dmb{data}{rx}{fields}[1];
      my $mf       = $$dmb{data}{rx}{fields}[2];
      my $wf       = $$dmb{data}{rx}{fields}[3];
      my $df       = $$dmb{data}{rx}{fields}[4];
      my $nth      = $$dmb{'data'}{'rx'}{'nth'}[0];
      my $nth_wom  = $$dmb{'data'}{'rx'}{'nth_wom'}[0];
      my $special  = $$dmb{'data'}{'rx'}{'offset_date'}[0];

      my $y        = '(?:(?<y>\d\d\d\d)|(?<y>\d\d))';
      my $mmm      = "(?:(?<mmm>$abb)|(?<month>$nam))";
      $next        = "(?<next>$next)";
      $last        = "(?<last>$last)";
      $yf          = "(?<field_y>$yf)";
      $mf          = "(?<field_m>$mf)";
      $wf          = "(?<field_w>$wf)";
      $df          = "(?<field_d>$df)";
      my $fld      = "(?:$yf|$mf|$wf)";
      $nth         = "(?<nth>$nth)";
      $nth_wom     = "(?<nth>$nth_wom)";
      $special     = "(?<special>$special)";

      my $daterx   =
        "${mmm}\\s+${nth}\\s*$y?|" .    # Dec 1st [1970]
        "${nth}\\s+${mmm}\\s*$y?|" .    # 1st Dec [1970]
        "$y\\s+${mmm}\\s+${nth}|" .     # 1970 Dec 1st
        "$y\\s+${nth}\\s+${mmm}|" .     # 1970 1st Dec

        "${next}\\s+${fld}|" .          # next year, next month, next week
        "${next}|" .                    # next friday

        "${last}\\s+${mmm}\\s*$y?|" .   # last friday in october 95
        "${last}\\s+${df}\\s+${mmm}\\s*$y?|" .
                                        # last day in october 95
        "${last}\\s*$y?|" .             # last friday in 95

        "${nth_wom}\\s+${mmm}\\s*$y?|" .
                                        # nth DoW in MMM [YYYY]
        "${nth}\\s*$y?|" .              # nth DoW in [YYYY]

        "${nth}\\s+${wf}\\s*$y?|" .     # DoW Nth week [YYYY]
        "${wf}\\s+(?<n>\\d+)\\s*$y?|" . # DoW week N [YYYY]

        "${special}|" .                 # today, tomorrow
        "${special}\\s+${wf}|" .        # today week
                                        #   British: same as 1 week from today

        "${nth}|" .                     # nth

        "${wf}";                        # monday week
                                        #   British: same as 'in 1 week on monday'

      $daterx = qr/^\s*(?:$daterx)\s*$/i;
      $$dmb{'data'}{'rx'}{'other'}{$rx} = $daterx;

   }

   return $$dmb{'data'}{'rx'}{'other'}{$rx};
}

sub _parse_time {
   my($self,$caller,$string,$noupdate,%opts) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   # Make time substitutions (i.e. noon => 12:00:00)

   unless (exists $opts{'noother'}) {
      my @rx = @{ $$dmb{'data'}{'rx'}{'times'} };
      shift(@rx);
      foreach my $rx (@rx) {
         if ($string =~ $rx) {
            my $repl = $$dmb{'data'}{'wordmatch'}{'times'}{lc($1)};
            $string =~ s/$rx/$repl/g;
         }
      }
   }

   # Check to see if there is a time in the string

   my $timerx = (exists $$dmb{'data'}{'rx'}{'other'}{'time'} ?
                 $$dmb{'data'}{'rx'}{'other'}{'time'} :
                 $self->_other_rx('time'));
   my $got_time = 0;

   my($h,$mn,$s,$fh,$fm,$h24,$ampm,$tzstring,$zone,$abb,$off,$tmp);

   if ($string =~ s/$timerx/ /i) {
      ($h,$fh,$mn,$fm,$s,$ampm,$tzstring,$zone,$abb,$off,$tmp) =
        ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12);

      $off      = $tmp  if (! defined($off));
      $h24      = 1  if ($h == 24  &&  $mn == 0  &&  $s == 0);
      $string   =~ s/\s*$//;
      $got_time = 1;
   }

   # If we called this from $date->parse()
   #    returns the string and a list of time components

   if ($caller eq 'parse') {
      if ($got_time) {
         ($h,$mn,$s) = $self->_time($h,$mn,$s,$fh,$fm,$h24,$ampm,$noupdate);
         return ($got_time,$string,$h,$mn,$s,$tzstring,$zone,$abb,$off);
      } else {
         return (0);
      }
   }

   # If we called this from $date->parse_time()

   if (! $got_time  ||  $string) {
      $$self{'err'} = "[$caller] Invalid time string";
      return ();
   }

   ($h,$mn,$s) = $self->_time($h,$mn,$s,$fh,$fm,$h24,$ampm,$noupdate);
   return ($h,$mn,$s,$tzstring,$zone,$abb,$off);
}

# Parse common dates
sub _parse_date_common {
   my($self,$string,$noupdate) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   # Since we want whitespace to be used as a separator, turn all
   # whitespace into single spaces. This is necessary since the
   # regexps do backreferences to make sure that separators are
   # not mixed.
   $string =~ s/\s+/ /g;

   my $daterx = (exists $$dmb{'data'}{'rx'}{'other'}{'common_1'} ?
                 $$dmb{'data'}{'rx'}{'other'}{'common_1'} :
                 $self->_other_rx('common_1'));

   if ($string =~ $daterx) {
      my($y,$m,$d) = @+{qw(y m d)};

      if ($dmb->_config('dateformat') ne 'US') {
         ($m,$d) = ($d,$m);
      }

      ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
      return($y,$m,$d);
   }

   $daterx = (exists $$dmb{'data'}{'rx'}{'other'}{'common_2'} ?
              $$dmb{'data'}{'rx'}{'other'}{'common_2'} :
              $self->_other_rx('common_2'));

   if ($string =~ $daterx) {
      my($y,$m,$d,$mmm,$month) = @+{qw(y m d mmm month)};

      if ($mmm) {
         $m = $$dmb{'data'}{'wordmatch'}{'month_abb'}{lc($mmm)};
      } elsif ($month) {
         $m = $$dmb{'data'}{'wordmatch'}{'month_name'}{lc($month)};
      }

      ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
      return($y,$m,$d);
   }

   return ();
}

sub _parse_dow {
   my($self,$string,$noupdate) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};
   my($y,$m,$d,$dow);

   # Remove the day of week

   my $rx = (exists $$dmb{'data'}{'rx'}{'other'}{'dow'} ?
             $$dmb{'data'}{'rx'}{'other'}{'dow'} :
             $self->_other_rx('dow'));
   if ($string =~ s/$rx/ /) {
      $dow = $+{'dow'};
      $dow = lc($dow);

      $dow = $$dmb{'data'}{'wordmatch'}{'day_abb'}{$dow}
        if (exists $$dmb{'data'}{'wordmatch'}{'day_abb'}{$dow});
      $dow = $$dmb{'data'}{'wordmatch'}{'day_name'}{$dow}
        if (exists $$dmb{'data'}{'wordmatch'}{'day_name'}{$dow});
   } else {
      return (0);
   }

   $string =~ s/\s*$//;

   return (0,$string,$dow)  if ($string);

   # Handle the simple DoW format

   ($y,$m,$d)  = $self->_def_date($y,$m,$d,$noupdate);

   my($w,$dow1);

   ($y,$w)       = $dmb->week_of_year([$y,$m,$d]);  # week of year
   ($y,$m,$d)    = @{ $dmb->week_of_year($y,$w) };  # first day
   $dow1         = $dmb->day_of_week([$y,$m,$d]);   # DoW of first day
   $dow1 -= 7    if ($dow1 > $dow);
   ($y,$m,$d)    = @{ $dmb->calc_date_days([$y,$m,$d],$dow-$dow1) };

   return(1,$y,$m,$d);
}

sub _parse_delta {
   my($self,$string,$dow,$got_time,$h,$mn,$s,$noupdate) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};
   my($y,$m,$d);

   my $delta = $self->new_delta();
   my $err   = $delta->parse($string);

   if (! $err) {
      my($dy,$dm,$dw,$dd,$dh,$dmn,$ds) = @{ $$delta{'data'}{'delta'} };

      if ($got_time  &&
          ($dh != 0  ||  $dmn != 0  ||  $ds != 0)) {
         $$self{'err'} = '[parse] Two times entered or implied';
         return (1);
      }

      if ($got_time) {
         ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
      } else {
         ($y,$m,$d,$h,$mn,$s) = $dmt->_now('now',$$noupdate);
         $$noupdate = 1;
      }

      my $business = $$delta{'data'}{'business'};
      ($y,$m,$d,$h,$mn,$s) =
        @{ $self->__calc_date_delta($business,[$y,$m,$d,$h,$mn,$s],
                                    [$dy,$dm,$dw,$dd,$dh,$dmn,$ds],0) };

      if ($dow) {
         if ($dd != 0  ||  $dh != 0  || $dmn != 0  ||  $ds != 0) {
            $$self{'err'} = '[parse] Day of week not allowed';
            return (1);
         }

         my($w,$dow1);

         ($y,$w)       = $dmb->week_of_year([$y,$m,$d]); # week of year
         ($y,$m,$d)    = @{ $dmb->week_of_year($y,$w) }; # first day
         $dow1         = $dmb->day_of_week([$y,$m,$d]); # DoW of first day
         $dow1 -= 7    if ($dow1 > $dow);
         ($y,$m,$d)    = @{ $dmb->calc_date_days([$y,$m,$d],$dow-$dow1) };
      }

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

   return (0);
}

sub _parse_datetime_other {
   my($self,$string,$noupdate) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   my $rx = (exists $$dmb{'data'}{'rx'}{'other'}{'miscdatetime'} ?
                 $$dmb{'data'}{'rx'}{'other'}{'miscdatetime'} :
                 $self->_other_rx('miscdatetime'));

   if ($string =~ $rx) {
      my ($special,$epoch) = @+{qw(special epoch)};

      if (defined($special)) {
         my $delta  = $$dmb{'data'}{'wordmatch'}{'offset_time'}{lc($special)};
         my @delta  = @{ $dmb->split('delta',$delta) };
         my @date   = $dmt->_now('now',$$noupdate);
         $$noupdate = 1;
         @date      = @{ $self->__calc_date_delta(0,[@date],[@delta]) };
         return (1,@date);

      } elsif (defined($epoch)) {
         my $date   = [1970,1,1,0,0,0];
         my @delta  = (0,0,$epoch);
         $date      = $dmb->calc_date_time($date,\@delta);
         my($err);
         ($err,$date) = $dmt->convert_from_gmt($date);
         return (1,@$date);
      }
   }

   return (0);
}

sub _parse_date_other {
   my($self,$string,$dow,$of,$noupdate) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};
   my($y,$m,$d,$h,$mn,$s);

   my $rx = (exists $$dmb{'data'}{'rx'}{'other'}{'misc'} ?
                 $$dmb{'data'}{'rx'}{'other'}{'misc'} :
                 $self->_other_rx('misc'));

   my($mmm,$month,$nextprev,$last,$field_y,$field_m,$field_w,$field_d,$nth);
   my($special,$got_m,$n,$got_y);
   if ($string =~ $rx) {
      ($y,$mmm,$month,$nextprev,$last,$field_y,$field_m,$field_w,$field_d,$nth,
       $special,$n) =
         @+{qw(y mmm month next last field_y field_m field_w field_d nth special n)};

      if (defined($y)) {
         $y     = $dmt->_fix_year($y);
         $got_y = 1;
         return ()  if (! $y);
      } else {
         ($y)  = $dmt->_now('y',$$noupdate);
         $$noupdate = 1;
         $got_y = 0;
         $$self{'data'}{'def'}[0] = '';
      }

      if (defined($mmm)) {
         $m     = $$dmb{'data'}{'wordmatch'}{'month_abb'}{lc($mmm)};
         $got_m = 1;
      } elsif ($month) {
         $m     = $$dmb{'data'}{'wordmatch'}{'month_name'}{lc($month)};
         $got_m = 1;
      }

      if ($nth) {
         $nth   = $$dmb{'data'}{'wordmatch'}{'nth'}{lc($nth)};
      }

      if ($got_m  &&  $nth  &&  ! $dow) {
         # Dec 1st 1970
         # 1st Dec 1970
         # 1970 Dec 1st
         # 1970 1st Dec

         $d = $nth;

      } elsif ($nextprev) {

         my $next = 0;
         my $sign = -1;
         if ($$dmb{'data'}{'wordmatch'}{'nextprev'}{lc($nextprev)} == 1) {
            $next  = 1;
            $sign = 1;
         }

         if ($field_y || $field_m || $field_w) {
            # next/prev year/month/week

            my(@delta);
            if ($field_y) {
               @delta = ($sign*1,0,0,0,0,0,0);
            } elsif ($field_m) {
               @delta = (0,$sign*1,0,0,0,0,0);
            } else {
               @delta = (0,0,$sign*1,0,0,0,0);
            }

            my @now = $dmt->_now('now',$$noupdate);
            $$noupdate = 1;
            ($y,$m,$d,$h,$mn,$s) = @{ $self->__calc_date_delta(0,[@now],[@delta],0) };

         } elsif ($dow) {
            # next/prev friday

            my @now = $dmt->_now('now',$$noupdate);
            $$noupdate = 1;
            ($y,$m,$d,$h,$mn,$s) = @{ $self->__next_prev(\@now,$next,$dow,0) };
            $dow = 0;

         } else {
            return ();
         }

      } elsif ($last) {

         if ($field_d  &&  $got_m) {
            # last day in october 95

            $d = $dmb->days_in_month($y,$m);

         } elsif ($dow  &&  $got_m) {
            # last friday in october 95

            $d = $dmb->days_in_month($y,$m);
            ($y,$m,$d,$h,$mn,$s) =
              @{ $self->__next_prev([$y,$m,$d,0,0,0],0,$dow,1) };
            $dow = 0;

         } elsif ($dow) {
            # last friday in 95

            ($y,$m,$d,$h,$mn,$s) =
              @{ $self->__next_prev([$y,12,31,0,0,0],0,$dow,0) };

         } else {
            return ();
         }

      } elsif ($nth  &&  $dow  &&  ! $field_w) {

         if ($got_m) {
            if ($of) {
               # nth DoW of MMM [YYYY]
               return ()  if ($nth > 5);

               $d = 1;
               ($y,$m,$d,$h,$mn,$s) = @{ $self->__next_prev([$y,$m,1,0,0,0],1,$dow,1) };
               my $m2 = $m;
               ($y,$m2,$d) = @{ $dmb->calc_date_days([$y,$m,$d],7*($nth-1)) }  if ($nth > 1);
               return ()  if (! $m2  ||  $m2 != $m);

            } else {
               # DoW, nth MMM [YYYY]       (i.e. Sunday, 9th Dec 2008)
               $d = $nth;
            }

         } else {
            # nth DoW [in YYYY]

            ($y,$m,$d,$h,$mn,$s) = @{ $self->__next_prev([$y,1,1,0,0,0],1,$dow,1) };
            ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],7*($nth-1)) }  if ($nth > 1);
         }

      } elsif ($field_w  &&  $dow) {

         if (defined($n)  ||  $nth) {
            # sunday week 22 in 1996
            # sunday 22nd week in 1996

            $n = $nth  if ($nth);
            return ()  if (! $n);
            ($y,$m,$d) = @{ $dmb->week_of_year($y,$n) };
            ($y,$m,$d) = @{ $self->__next_prev([$y,$m,$d,0,0,0],1,$dow,1) };

         } else {
            # DoW week

            ($y,$m,$d) = $dmt->_now('now',$$noupdate);
            $$noupdate = 1;
            my $tmp    = $dmb->_config('firstday');
            ($y,$m,$d) = @{ $self->__next_prev([$y,$m,$d,0,0,0],1,$tmp,0) };
            ($y,$m,$d) = @{ $self->__next_prev([$y,$m,$d,0,0,0],1,$dow,1) };
         }

      } elsif ($nth  &&  ! $got_y) {
         ($y,$m,$d)    = $dmt->_now('now',$$noupdate);
         $$noupdate    = 1;
         $d            = $nth;

      } elsif ($special) {

         my $delta  = $$dmb{'data'}{'wordmatch'}{'offset_date'}{lc($special)};
         my @delta  = @{ $dmb->split('delta',$delta) };
         ($y,$m,$d) = $dmt->_now('now',$$noupdate);
         $$noupdate = 1;
         ($y,$m,$d) = @{ $self->__calc_date_delta(0,[$y,$m,$d,0,0,0],[@delta]) };

         if ($field_w) {
            ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],7) };
         }
      }

   } else {
      return ();
   }

   return($y,$m,$d,$dow);
}

# Supply defaults for missing values (Y/M/D)
sub _def_date {
   my($self,$y,$m,$d,$noupdate) = @_;
   $y                 = ''  if (! defined $y);
   $m                 = ''  if (! defined $m);
   $d                 = ''  if (! defined $d);
   my $defined        = 0;
   my $dmt            = $$self{'tz'};
   my $dmb            = $$dmt{'base'};

   # If year was not specified, defaults to current year.
   #
   # We'll also fix the year (turn 2-digit into 4-digit).

   if ($y eq '') {
      ($y)       = $dmt->_now('y',$$noupdate);
      $$noupdate = 1;
      $$self{'data'}{'def'}[0] = '';
   } else {
      $y       = $dmt->_fix_year($y);
      $defined = 1;
   }

   # If the month was not specifed, but the year was, a default of
   # 01 is supplied (this is a truncated date).
   #
   # If neither was specified, month defaults to the current month.

   if ($m ne '') {
      $defined = 1;
   } elsif ($defined) {
      $m = 1;
      $$self{'data'}{'def'}[1] = 1;
   } else {
      ($m) = $dmt->_now('m',$$noupdate);
      $$noupdate = 1;
      $$self{'data'}{'def'}[1] = '';
   }

   # If the day was not specified, but the year or month was, a default
   # of 01 is supplied (this is a truncated date).
   #
   # If none were specified, it default to the current day.

   if ($d ne '') {
      $defined = 1;
   } elsif ($defined) {
      $d = 1;
      $$self{'data'}{'def'}[2] = 1;
   } else {
      ($d) = $dmt->_now('d',$$noupdate);
      $$noupdate = 1;
      $$self{'data'}{'def'}[2] = '';
   }

   return($y,$m,$d);
}

# Supply defaults for missing values (Y/DoY)
sub _def_date_doy {
   my($self,$y,$doy,$noupdate) = @_;
   $y                = ''  if (! defined $y);
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   # If year was not specified, defaults to current year.
   #
   # We'll also fix the year (turn 2-digit into 4-digit).

   if ($y eq '') {
      ($y) = $dmt->_now('y',$$noupdate);
      $$noupdate = 1;
      $$self{'data'}{'def'}[0] = '';
   } else {
      $y = $dmt->_fix_year($y);
   }

   # DoY must be specified.

   my($m,$d);
   my $ymd = $dmb->day_of_year($y,$doy);

   return @$ymd;
}

# Supply defaults for missing values (YY/Www/D) and (Y/Www/D)
sub _def_date_dow {
   my($self,$y,$w,$dow,$noupdate) = @_;
   $y                   = ''  if (! defined $y);
   $w                   = ''  if (! defined $w);
   $dow                 = ''  if (! defined $dow);
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   # If year was not specified, defaults to current year.
   #
   # If it was specified and is a single digit, it is the
   # year in the current decade.
   #
   # We'll also fix the year (turn 2-digit into 4-digit).

   if ($y ne '') {
      if (length($y) == 1) {
         my ($tmp) = $dmt->_now('y',$$noupdate);
         $tmp      =~ s/.$/$y/;
         $y        = $tmp;
         $$noupdate = 1;

      } else {
         $y       = $dmt->_fix_year($y);

      }

   } else {
      ($y) = $dmt->_now('y',$$noupdate);
      $$noupdate = 1;
      $$self{'data'}{'def'}[0] = '';
   }

   # If week was not specified, it defaults to the current
   # week. Get the first day of the week.

   my($m,$d);
   if ($w ne '') {
      ($y,$m,$d) = @{ $dmb->week_of_year($y,$w) };
   } else {
      my($nowy,$nowm,$nowd) = $dmt->_now('now',$$noupdate);
      $$noupdate = 1;
      my $noww;
      ($nowy,$noww) = $dmb->week_of_year([$nowy,$nowm,$nowd]);
      ($y,$m,$d)    = @{ $dmb->week_of_year($nowy,$noww) };
   }

   # Handle the DoW

   if ($dow eq '') {
      $dow  = 1;
   }
   my $n    = $dmb->days_in_month($y,$m);
   $d      += ($dow-1);
   if ($d > $n) {
      $m++;
      if ($m==12) {
         $y++;
         $m = 1;
      }
      $d = $d-$n;
   }

   return($y,$m,$d);
}

# Supply defaults for missing values (HH:MN:SS)
sub _def_time {
   my($self,$h,$m,$s,$noupdate) = @_;
   $h                 = ''  if (! defined $h);
   $m                 = ''  if (! defined $m);
   $s                 = ''  if (! defined $s);
   my $defined        = 0;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   # If no time was specified, defaults to 00:00:00.

   if ($h eq ''  &&
       $m eq ''  &&
       $s eq '') {
      $$self{'data'}{'def'}[3] = 1;
      $$self{'data'}{'def'}[4] = 1;
      $$self{'data'}{'def'}[5] = 1;
      return(0,0,0);
   }

   # If hour was not specified, defaults to current hour.

   if ($h ne '') {
      $defined = 1;
   } else {
      ($h) = $dmt->_now('h',$$noupdate);
      $$noupdate = 1;
      $$self{'data'}{'def'}[3] = '';
   }

   # If the minute was not specifed, but the hour was, a default of
   # 00 is supplied (this is a truncated time).
   #
   # If neither was specified, minute defaults to the current minute.

   if ($m ne '') {
      $defined = 1;
   } elsif ($defined) {
      $m = 0;
      $$self{'data'}{'def'}[4] = 1;
   } else {
      ($m) = $dmt->_now('mn',$$noupdate);
      $$noupdate = 1;
      $$self{'data'}{'def'}[4] = '';
   }

   # If the second was not specified (either the hour or the minute were),
   # a default of 00 is supplied (this is a truncated time).

   if ($s eq '') {
      $s = 0;
      $$self{'data'}{'def'}[5] = 1;
   }

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

########################################################################
# OTHER DATE METHODS
########################################################################

# Gets the date in the parsed timezone (if $type = ''), local timezone
# (if $type = 'local') or GMT timezone (if $type = 'gmt').
#
# Gets the string value in scalar context, the split value in list
# context.
#
sub value {
   my($self,$type) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};
   my $date;

   while (1) {
      if (! $$self{'data'}{'set'}) {
         $$self{'err'} = '[value] Object does not contain a date';
         last;
      }

      $type           = ''  if (! $type);

      if ($type eq 'gmt') {

         if (! @{ $$self{'data'}{'gmt'} }) {
            my $zone = $$self{'data'}{'tz'};
            my $date = $$self{'data'}{'date'};

            if ($zone eq 'Etc/GMT') {
               $$self{'data'}{'gmt'}      = $date;

            } else {
               my $isdst   = $$self{'data'}{'isdst'};
               my($err,$d) = $dmt->convert_to_gmt($date,$zone,$isdst);
               if ($err) {
                  $$self{'err'} = '[value] Unable to convert date to GMT';
                  last;
               }
               $$self{'data'}{'gmt'}      = $d;
            }
         }
         $date = $$self{'data'}{'gmt'};

      } elsif ($type eq 'local') {

         if (! @{ $$self{'data'}{'loc'} }) {
            my $zone  = $$self{'data'}{'tz'};
            $date     = $$self{'data'}{'date'};
            my ($local) = $dmt->_now('tz',1);

            if ($zone eq $local) {
               $$self{'data'}{'loc'}      = $date;

            } else {
               my $isdst   = $$self{'data'}{'isdst'};
               my($err,$d) = $dmt->convert_to_local($date,$zone,$isdst);
               if ($err) {
                  $$self{'err'} = '[value] Unable to convert date to localtime';
                  last;
               }
               $$self{'data'}{'loc'}      = $d;
            }
         }
         $date = $$self{'data'}{'loc'};

      } else {

         $date = $$self{'data'}{'date'};

      }

      last;
   }

   if ($$self{'err'}) {
      if (wantarray) {
         return ();
      } else {
         return '';
      }
   }

   if (wantarray) {
      return @$date;
   } else {
      return $dmb->join('date',$date);
   }
}

sub cmp {
   my($self,$date) = @_;
   if ($$self{'err'}  ||  ! $$self{'data'}{'set'}) {
      warn "WARNING: [cmp] Arguments must be valid dates: date1\n";
      return undef;
   }

   if (! ref($date) eq 'Date::Manip::Date') {
      warn "WARNING: [cmp] Argument must be a Date::Manip::Date object\n";
      return undef;
   }
   if ($$date{'err'}  ||  ! $$date{'data'}{'set'}) {
      warn "WARNING: [cmp] Arguments must be valid dates: date2\n";
      return undef;
   }

   my($d1,$d2);
   if ($$self{'data'}{'tz'} eq $$date{'data'}{'tz'}) {
      $d1 = $self->value();
      $d2 = $date->value();
   } else {
      $d1 = $self->value('gmt');
      $d2 = $date->value('gmt');
   }

   return ($d1 cmp $d2);
}

BEGIN {
   my %field = qw(y 0 m 1 d 2 h 3 mn 4 s 5);

   sub set {
      my($self,$field,@val) = @_;
      $field    = lc($field);
      my $dmt = $$self{'tz'};
      my $dmb = $$dmt{'base'};

      # Make sure $self includes a valid date (unless the entire date is
      # being set, in which case it doesn't matter).

      my($date,@def,$tz,$isdst);

      if ($field eq 'zdate') {
         # If {data}{set} = 2, we want to preserve the defaults. Also, we've
         # already initialized.
         #
         # It is only set in the parse routines which means that this was
         # called via _parse_check.

         $self->_init()  if ($$self{'data'}{'set'} != 2);
         @def = @{ $$self{'data'}{'def'} };

      } elsif ($field eq 'date') {
         if ($$self{'data'}{'set'}  &&  ! $$self{'err'}) {
            $tz      = $$self{'data'}{'tz'};
         } else {
            ($tz)    = $dmt->_now('tz',1);
         }
         $self->_init();
         @def = @{ $$self{'data'}{'def'} };

      } else {
         return 1  if ($$self{'err'}  ||  ! $$self{'data'}{'set'});
         $date    = $$self{'data'}{'date'};
         $tz      = $$self{'data'}{'tz'};
         $isdst   = $$self{'data'}{'isdst'};
         @def = @{ $$self{'data'}{'def'} };
         $self->_init();
      }

      # Check the arguments

      my($err,$new_tz,$new_date,$new_time);

      if ($field eq 'date') {

         if ($#val == 0) {
            # date,DATE
            $new_date = $val[0];
         } elsif ($#val == 1) {
            # date,DATE,ISDST
            ($new_date,$isdst) = @val;
         } else {
            $err = 1;
         }
         for (my $i=0; $i<=5; $i++) {
            $def[$i] = 0  if ($def[$i]);
         }

      } elsif ($field eq 'time') {

         if ($#val == 0) {
            # time,TIME
            $new_time = $val[0];
         } elsif ($#val == 1) {
            # time,TIME,ISDST
            ($new_time,$isdst) = @val;
         } else {
            $err = 1;
         }
         $def[3] = 0  if ($def[3]);
         $def[4] = 0  if ($def[4]);
         $def[5] = 0  if ($def[5]);

      } elsif ($field eq 'zdate') {

         if ($#val == 0) {
            # zdate,DATE
            $new_date = $val[0];
         } elsif ($#val == 1    &&  ($val[1] eq '0'  ||  $val[1] eq '1')) {
            # zdate,DATE,ISDST
            ($new_date,$isdst) = @val;
         } elsif ($#val == 1) {
            # zdate,ZONE,DATE
            ($new_tz,$new_date) = @val;
         } elsif ($#val == 2) {
            # zdate,ZONE,DATE,ISDST
            ($new_tz,$new_date,$isdst) = @val;
         } else {
            $err = 1;
         }
         for (my $i=0; $i<=5; $i++) {
            $def[$i] = 0  if ($def[$i]);
         }
         ($tz) = $dmt->_now('tz',1)  if (! $new_tz);

      } elsif ($field eq 'zone') {

         if ($#val == -1) {
            # zone
         } elsif ($#val == 0  &&  ($val[0] eq '0'  ||  $val[0] eq '1')) {
            # zone,ISDST
            $isdst = $val[0];
         } elsif ($#val == 0) {
            # zone,ZONE
            $new_tz = $val[0];
         } elsif ($#val == 1) {
            # zone,ZONE,ISDST
            ($new_tz,$isdst) = @val;
         } else {
            $err = 1;
         }
         ($tz) = $dmt->_now('tz',1)  if (! $new_tz);

      } elsif (exists $field{$field}) {

         my $i   = $field{$field};
         my $val;
         if ($#val == 0) {
            $val = $val[0];
         } elsif ($#val == 1) {
            ($val,$isdst) = @val;
         } else {
            $err = 1;
         }

         $$date[$i] = $val;
         $def[$i]   = 0  if ($def[$i]);

      } else {

         $err = 2;

      }

      if ($err) {
         if ($err == 1) {
            $$self{'err'} = '[set] Invalid arguments';
         } else {
            $$self{'err'} = '[set] Invalid field';
         }
         return 1;
      }

      # Handle the arguments

      if ($new_tz) {
         my $tmp = $dmt->_zone($new_tz);
         if ($tmp) {
            # A zone/alias
            $tz = $tmp;

         } else {
            # An offset
            my ($err,@args);
            push(@args,$date)  if ($date);
            push(@args,$new_tz);
            push(@args,($isdst ? 'dstonly' : 'stdonly'))  if (defined $isdst);
            $tz = $dmb->zone(@args);

            if (! $tz) {
               $$self{'err'} = "[set] Invalid timezone argument: $new_tz";
               return 1;
            }
         }
      }

      if ($new_date) {
         if ($dmb->check($new_date)) {
            $date = $new_date;
         } else {
            $$self{'err'} = '[set] Invalid date argument';
            return 1;
         }
      }

      if ($new_time) {
         if ($dmb->check_time($new_time)) {
            $$date[3] = $$new_time[0];
            $$date[4] = $$new_time[1];
            $$date[5] = $$new_time[2];
         } else {
            $$self{'err'}     = '[set] Invalid time argument';
            return 1;
         }
      }

      # Check the date/timezone combination

      my($abb,$off);
      if ($tz eq 'etc/gmt') {
         $abb                 = 'GMT';
         $off                 = [0,0,0];
         $isdst               = 0;
      } else {
         my $per              = $dmt->date_period($date,$tz,1,$isdst);
         if (! $per) {
            $$self{'err'} = '[set] Invalid date/timezone';
            return 1;
         }
         $isdst               = $$per[5];
         $abb                 = $$per[4];
         $off                 = $$per[3];
      }

      # Set the information

      $$self{'data'}{'set'}   = 1;
      $$self{'data'}{'date'}  = $date;
      $$self{'data'}{'tz'}    = $tz;
      $$self{'data'}{'isdst'} = $isdst;
      $$self{'data'}{'offset'}= $off;
      $$self{'data'}{'abb'}   = $abb;
      $$self{'data'}{'def'}   = [ @def ];

      return 0;
   }
}

########################################################################
# NEXT/PREV METHODS

sub prev {
   my($self,@args) = @_;
   return 1  if ($$self{'err'}  ||  ! $$self{'data'}{'set'});
   my $date        = $$self{'data'}{'date'};

   $date           = $self->__next_prev($date,0,@args);

   return 1  if (! defined($date));
   $self->set('date',$date);
   return 0;
}

sub next {
   my($self,@args) = @_;
   return 1  if ($$self{'err'}  ||  ! $$self{'data'}{'set'});
   my $date        = $$self{'data'}{'date'};

   $date           = $self->__next_prev($date,1,@args);

   return 1  if (! defined($date));
   $self->set('date',$date);
   return 0;
}

sub __next_prev {
   my($self,$date,$next,$dow,$curr,$time) = @_;

   my ($caller,$sign,$prev);
   if ($next) {
      $caller = 'next';
      $sign   = 1;
      $prev   = 0;
   } else {
      $caller = 'prev';
      $sign   = -1;
      $prev   = 1;
   }

   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};
   my $orig = [ @$date ];

   # Check the time (if any)

   if (defined($time)) {
      if ($dow) {
         # $time will refer to a full [H,MN,S]
         my($err,$h,$mn,$s) = $dmb->_normalize_hms('norm',@$time);
         if ($err) {
            $$self{'err'} = "[$caller] invalid time argument";
            return undef;
         }
         $time = [$h,$mn,$s];
      } else {
         # $time may have leading undefs
         my @tmp = @$time;
         if ($#tmp != 2) {
            $$self{'err'} = "[$caller] invalid time argument";
            return undef;
         }
         my($h,$mn,$s) = @$time;
         if (defined($h)) {
            $mn = 0  if (! defined($mn));
            $s  = 0  if (! defined($s));
         } elsif (defined($mn)) {
            $s  = 0  if (! defined($s));
         } else {
            $s  = 0  if (! defined($s));
         }
         $time = [$h,$mn,$s];
      }
   }

   # Find the next DoW

   if ($dow) {

      if (! $dmb->_is_int($dow,1,7)) {
         $$self{'err'} = "[$caller] Invalid DOW: $dow";
         return undef;
      }

      # Find the next/previous occurrence of DoW

      my $curr_dow = $dmb->day_of_week($date);
      my $adjust   = 0;

      if ($dow == $curr_dow) {
         $adjust = 1  if ($curr == 0);

      } else {
         my $num;
         if ($next) {
            # force $dow to be more than $curr_dow
            $dow += 7  if ($dow<$curr_dow);
            $num  = $dow - $curr_dow;
         } else {
            # force $dow to be less than $curr_dow
            $dow -= 7  if ($dow>$curr_dow);
            $num  = $curr_dow - $dow;
            $num *= -1;
         }

         # Add/subtract $num days
         $date = $dmb->calc_date_days($date,$num);
      }

      if (defined($time)) {
         my ($y,$m,$d,$h,$mn,$s) = @$date;
         ($h,$mn,$s)             = @$time;
         $date = [$y,$m,$d,$h,$mn,$s];
      }

      my $cmp = $dmb->cmp($orig,$date);
      $adjust = 1  if ($curr == 2  &&  $cmp != -1*$sign);

      if ($adjust) {
         # Add/subtract 1 week
         $date = $dmb->calc_date_days($date,$sign*7);
      }

      return $date;
   }

   # Find the next Time

   if (defined($time)) {

      my ($h,$mn,$s)    = @$time;
      my $orig          = [ @$date ];

      my $cmp;
      if (defined $h) {
         # Find next/prev HH:MN:SS

         @$date[3..5]   = @$time;
         $cmp           = $dmb->cmp($orig,$date);
         if ($cmp == -1) {
            if ($prev) {
               $date    = $dmb->calc_date_days($date,-1);
            }
         } elsif ($cmp == 1) {
            if ($next) {
               $date    = $dmb->calc_date_days($date,1);
            }
         } else {
            if (! $curr) {
               $date    = $dmb->calc_date_days($date,$sign);
            }
         }

      } elsif (defined $mn) {
         # Find next/prev MN:SS

         @$date[4..5]   = @$time[1..2];

         $cmp           = $dmb->cmp($orig,$date);
         if ($cmp == -1) {
            if ($prev) {
               $date    = $dmb->calc_date_time($date,[-1,0,0]);
            }
         } elsif ($cmp == 1) {
            if ($next) {
               $date    = $dmb->calc_date_time($date,[1,0,0]);
            }
         } else {
            if (! $curr) {
               $date    = $dmb->calc_date_time($date,[$sign,0,0]);
            }
         }

      } else {
         # Find next/prev SS

         $$date[5]      = $$time[2];

         $cmp           = $dmb->cmp($orig,$date);
         if ($cmp == -1) {
            if ($prev) {
               $date    = $dmb->calc_date_time($date,[0,-1,0]);
            }
         } elsif ($cmp == 1) {
            if ($next) {
               $date    = $dmb->calc_date_time($date,[0,1,0]);
            }
         } else {
            if (! $curr) {
               $date    = $dmb->calc_date_time($date,[0,$sign,0]);
            }
         }
      }

      return $date;
   }

   $$self{'err'} = "[$caller] Either DoW or time (or both) required";
   return undef;
}

########################################################################
# CALC METHOD

sub calc {
   my($self,$obj,@args) = @_;
   if ($$self{'err'}  ||  ! $$self{'data'}{'set'}) {
      $$self{'err'} = '[calc] First object invalid (date)';
      return undef;
   }

   if (ref($obj) eq 'Date::Manip::Date') {
      if ($$obj{'err'}  ||  ! $$obj{'data'}{'set'}) {
         $$self{'err'} = '[calc] Second object invalid (date)';
         return undef;
      }
      return $self->_calc_date_date($obj,@args);

   } elsif (ref($obj) eq 'Date::Manip::Delta') {
      if ($$obj{'err'}) {
         $$self{'err'} = '[calc] Second object invalid (delta)';
         return undef;
      }
      return $self->_calc_date_delta($obj,@args);

   } else {
      $$self{'err'} = '[calc] Second object must be a Date/Delta object';
      return undef;
   }
}

sub _calc_date_date {
   my($self,$date,@args) = @_;
   my $ret               = $self->new_delta();

   # Handle subtract/mode arguments

   my($subtract,$mode);

   if ($#args == -1) {
      ($subtract,$mode) = (0,'');
   } elsif ($#args == 0) {
      if ($args[0] eq '0'  ||  $args[0] eq '1') {
         ($subtract,$mode) = ($args[0],'');
      } else {
         ($subtract,$mode) = (0,$args[0]);
      }

   } elsif ($#args == 1) {
      ($subtract,$mode) = @args;
   } else {
      $$ret{'err'} = '[calc] Invalid arguments';
      return $ret;
   }
   $mode   = 'exact'  if (! $mode);

   if ($mode !~ /^(business|bapprox|approx|exact)$/i) {
      $$ret{'err'} = '[calc] Invalid mode argument';
      return $ret;
   }

   # if business mode
   #    dates must be in the same timezone
   #    use dates in that zone
   #
   # otherwise if both dates are in the same timezone  &&  approx mode
   #    use the dates in that zone
   #
   # otherwise
   #    convert to gmt
   #    use those dates

   my($date1,$date2);
   if ($mode eq 'business'  ||  $mode eq 'bapprox') {
      if ($$self{'data'}{'tz'} eq $$date{'data'}{'tz'}) {
         $date1 = [ $self->value() ];
         $date2 = [ $date->value() ];
      } else {
         $$ret{'err'} = '[calc] Dates must be in the same timezone for ' .
           'business mode calculations';
         return $ret;
      }

   } elsif ($mode eq 'approx'  &&
            $$self{'data'}{'tz'} eq $$date{'data'}{'tz'}) {
      $date1 = [ $self->value() ];
      $date2 = [ $date->value() ];

   } else {
      $date1 = [ $self->value('gmt') ];
      $date2 = [ $date->value('gmt') ];
   }

   # Do the calculation

   my(@delta);
   if ($subtract) {
      if ($mode eq 'business'  ||  $mode eq 'exact'  ||  $subtract == 2) {
         @delta = @{ $self->__calc_date_date($mode,$date2,$date1) };
      } else {
         @delta = @{ $self->__calc_date_date($mode,$date1,$date2) };
         @delta = map { -1*$_ } @delta;
      }
   } else {
      @delta = @{ $self->__calc_date_date($mode,$date1,$date2) };
   }

   # Set the signs and save the delta

   for (my $i=0; $i<7; $i++) {
      $delta[$i] = '+'.$delta[$i]  if ($delta[$i]>=0);
   }

   if ($mode eq 'business' || $mode eq 'bapprox') {
      $ret->set('business',\@delta);
   } else {
      $ret->set('delta',\@delta);
   }
   return $ret;
}

sub __calc_date_date {
   my($self,$mode,$date1,$date2) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   my($y1,$m1,$d1,$h1,$mn1,$s1) = @$date1;
   my($y2,$m2,$d2,$h2,$mn2,$s2) = @$date2;
   my @delta;

   if ($mode eq 'exact'  ||
       $mode eq 'approx') {

      # form the delta for hour/min/sec
      $delta[4] = $h2-$h1;
      $delta[5] = $mn2-$mn1;
      $delta[6] = $s2-$s1;

      # form the delta for yr/mon/wk/day

      if ($mode eq 'exact') {
         $delta[0] = 0;
         $delta[1] = 0;
         $delta[2] = 0;
         $delta[3] = $dmb->days_since_1BC($date2) -
           $dmb->days_since_1BC($date1);
      } else {
         # If $d1 is greater than the number of days allowed in the
         # month $y2/$m2, set it equal to the number of days. In other
         # words:
         #   Jan 31 2006 to Feb 28 2008 = 2 years 1 month
         #
         my $dim   = $dmb->days_in_month($y2,$m2);
         $d1       = $dim  if ($d1 > $dim);

         $delta[0] = $y2-$y1;
         $delta[1] = $m2-$m1;
         $delta[2] = 0;
         $delta[3] = $d2-$d1;
      }

   } else {
      # Business mode (business or bapprox)

      # do yr/mon/wk part

      if ($mode eq 'business') {
         $delta[0] = 0;
         $delta[1] = 0;
         $delta[2] = 0;

      } else {
         $delta[0] = $y2-$y1;
         $delta[1] = $m2-$m1;
         $delta[2] = 0;

         $y1       = $y2;
         $m1       = $m2;
         my $dim   = $dmb->days_in_month($y2,$m2);
         $d1       = $dim  if ($d1 > $dim);
      }

      # make sure both are work days

      ($y1,$m1,$d1,$h1,$mn1,$s1) =
        @{ $self->__nextprev_business_day(0,0,1,[$y1,$m1,$d1,$h1,$mn1,$s1]) };
      ($y2,$m2,$d2,$h2,$mn2,$s2) =
        @{ $self->__nextprev_business_day(0,0,1,[$y2,$m2,$d2,$h2,$mn2,$s2]) };

      # find out which direction we need to move $date1 to get to $date2

      my $dir = 0;
      if ($y1 < $y2) {
         $dir = 1;
      } elsif ($y1 > $y2) {
         $dir = -1;
      } elsif ($m1 < $m2) {
         $dir = 1;
      } elsif ($m1 > $m2) {
         $dir = -1;
      } elsif ($d1 < $d2) {
         $dir = 1;
      } elsif ($d1 > $d2) {
         $dir = -1;
      }

      # now do the day part (to get to the same day)

      $delta[3] = 0;
      while ($dir) {
         ($y1,$m1,$d1) = @{ $dmb->calc_date_days([$y1,$m1,$d1],$dir) };
         $delta[3] += $dir  if ($self->__is_business_day([$y1,$m1,$d1,0,0,0],0));
         $dir = 0  if ($y1 == $y2  &&  $m1 == $m2  &&  $d1 == $d2);
      }

      # both dates are now on a business day, and during business
      # hours, so do the hr/min/sec part trivially

      $delta[4] = $h2-$h1;
      $delta[5] = $mn2-$mn1;
      $delta[6] = $s2-$s1;
   }

   return [ @delta ];
}

sub _calc_date_delta {
   my($self,$delta,$subtract) = @_;

   # Get the date/delta fields

   $subtract        = 0  if (! $subtract);
   my @delta        = @{ $$delta{'data'}{'delta'} };
   my $business     = $$delta{'data'}{'business'};
   my $approx       = 0;
   my ($dy,$dm,$dw) = (@delta);
   $approx          = 1  if ($dy != 0  ||  $dm != 0  ||  ($business && $dw != 0));

   $subtract        = 1  if ($business  &&  $subtract == 2);
   my @date;
   if ($business  ||  $approx) {
      @date = $self->value();
   } else {
      @date = $self->value('gmt');
   }

   my $ret = $self->new_date();

   my $date2;
   if ($approx  &&  $subtract == 2) {
      $date2 = $self->__calc_date_delta_inverse([@date],[@delta]);
      if (! defined($date2)) {
         $$ret{'err'} = '[calc_date_delta] Impossible error (report this please)';
         return $ret;
      }

   } else {
      @delta = map { -1*$_ } @delta  if ($subtract);
      $date2 = $self->__calc_date_delta($business,[@date],[@delta]);
   }

   if ($business || $approx) {
      $ret->set('date',$date2);
   } else {
      $ret->set('zdate','gmt',$date2);
      my $zone = $$self{'data'}{'tz'};
      $ret->convert($zone);
   }
   return $ret;
}

# Do a date+delta calculation on raw data instead of objects
#
sub __calc_date_delta {
   my($self,$business,$date,$delta) = @_;

   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};
   my($y,$m,$d,$h,$mn,$s)           = @$date;
   my($dy,$dm,$dw,$dd,$dh,$dmn,$ds) = @$delta;

   #
   # Do the year/month/week part.
   #

   $y += $dy;
   $dmb->_mod_add(-12,$dm,\$m,\$y); # -12 means 1-12 instead of 0-11

   # If we are past the last day of a month, move the date back to
   # the last day of the month. i.e. Jan 31 + 1 month = Feb 28.

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

   # Do the week part

   if ($business) {
      # In business mode, add the number of weeks exactly ignoring any
      # timezone affects).
      ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],$dw*7) }  if ($dw);
   } else {
      $dd       += $dw*7;
   }

   #
   # In business mode, set the day to a work day at this point so the d/h/mn/s
   # stuff will work out
   #

   if ($business) {
      ($y,$m,$d,$h,$mn,$s) =
        @{ $self->__nextprev_business_day(0,0,1,[$y,$m,$d,$h,$mn,$s]) };
   }

   #
   # Do the seconds, minutes, and hours part
   #

   if ($business) {

      my ($hbeg,$mbeg,$sbeg) = @{ $$dmb{'data'}{'calc'}{'workdaybeg'} };
      my ($hend,$mend,$send) = @{ $$dmb{'data'}{'calc'}{'workdayend'} };
      my $bdlen = $$dmb{'data'}{'calc'}{'bdlength'};

      no integer;
      my $tmp;
      $ds += $dh*3600 + $dmn*60;
      $tmp = int($ds/$bdlen);
      $dd += $tmp;
      $ds -= $tmp*$bdlen;
      $dh  = int($ds/3600);
      $ds -= $dh*3600;
      $dmn = int($ds/60);
      $ds -= $dmn*60;
      use integer;

      # At this point, we're adding less than a day for the
      # hours/minutes/seconds part AND we know that the current
      # day is during business hours.
      #
      # We'll add them (without affecting days... we'll need to
      # test things by hand to make sure we should or shouldn't
      # do that.

      $dmb->_mod_add(60,$ds,\$s,\$mn);
      $dmb->_mod_add(60,$dmn,\$mn,\$h);
      $h += $dh;

      if ($h > $hend  ||
          ($h == $hend  &&  $mn > $mend)  ||
          ($h == $hend  &&  $mn == $mend  &&  $s > $send)  ||
          ($h == $hend  &&  $mn == $mend  &&  $s == $send)) {

         # We've gone past the end of the business day.

         my $t2 = $dmb->calc_time_time([$h,$mn,$s],[$hend,$mend,$send],1);
         $d++;
         ($h,$mn,$s) = @{ $dmb->calc_time_time([$hbeg,$mbeg,$sbeg],$t2) };

      } elsif ($h < $hbeg  ||
               ($h == $hbeg  &&  $mn < $mbeg)  ||
               ($h == $hbeg  &&  $mn == $mbeg  &&  $s < $sbeg)) {

         # We've gone back past the start of the business day.

         my $t2 = $dmb->calc_time_time([$hbeg,$mbeg,$sbeg],[$h,$mn,$s],1);
         $dd--;
         ($h,$mn,$s) = @{ $dmb->calc_time_time([$hend,$mend,$send],$t2,1) };
      }

   } else {
      $dmb->_mod_add(60,$ds,\$s,\$mn);
      $dmb->_mod_add(60,$dmn,\$mn,\$h);
      $dmb->_mod_add(24,$dh,\$h,\$d);
   }

   #
   # If we have just gone past the first/last day of the month, we
   # need to make up for this:
   #

   if ($d > $dim) {
      $dd += $d-$dim;
      $d   = $dim;
   } elsif ($d < 1) {
      $dd += $d-1;
      $d   = 1;
   }

   #
   # Now add the days part.
   #

   if ($business) {
      my $prev = 0;
      if ($dd < 1) {
         $prev = 1;
         $dd  *= -1;
      }

      ($y,$m,$d,$h,$mn,$s) =
        @{ $self->__nextprev_business_day($prev,$dd,0,[$y,$m,$d,$h,$mn,$s]) };

   } else {
      ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],$dd) };
   }

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

# Calculates @date2 such that @date2 + @delta = @date .
#
# *** FIX ***
# This is impossible in some cases. If @date is "Dec 31" and
# @delta is "+ 1 month", there is no value for @date2 which
# satisfies this.
#
sub __calc_date_delta_inverse {
   my($self,$date,$delta) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   my @date     = @$date;
   my @delta    = @$delta;

   # Our first estimate for @date2 is:
   #
   #   @date2 = @date + -(@delta)
   #
   # @deltasub = -(@delta)

   my @deltasub = map { -1*$_ } @$delta;

   # Add @deltasub to @date it to get a first guess for @date2.  Then,
   # add the original delta back to get @altdate (which we want to be
   # identical to @date).

   my @date2    = @{ $self->__calc_date_delta(0,[@date],[@deltasub]) };
   my @altdate  = @{ $self->__calc_date_delta(0,[@date2],[@delta]) };

   # The H/Mn/S part of @date and @date2 should be identical. The only
   # thing that may differ is the Y/M/D part.

   if ($date[3] != $altdate[3]  ||
       $date[4] != $altdate[4]  ||
       $date[5] != $altdate[5]) {
      return undef;
   }

   # If @altdate = @date, we're done.

   my $flag = $dmb->cmp(\@date,\@altdate);
   return [@date2]  if ($flag == 0);

   # Otherwise, we need to adjust @date2 forward or back 1 day at
   # a time until the resulting @date2 + @delta is equal to @date.
   #
   # If $flag < 0, it means that @date < @altdate and @date2 needs to
   # be 1 day earlier.
   #
   # If $flag > 0, it means that @altdate > @date, and @date2 needs to
   # be 1 dat later.

   while (1) {
      @date2 = @{ $dmb->calc_date_days([@date2],$flag) };

      @altdate  = @{ $self->__calc_date_delta(0,[@date2],[@delta]) };
      my $f = $dmb->cmp(\@date,\@altdate);
      return [@date2]  if ($f == 0);

      # If we've overshot, it's an impossible error... otherwise, we'll
      # adjust another day.

      return undef  if ($f != $flag);
   }
}

########################################################################
# MISC METHODS

sub secs_since_1970_GMT {
   my($self,$secs) = @_;

   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   if (defined $secs) {
      my $date     = $dmb->secs_since_1970($secs);
      my $err;
      ($err,$date) = $dmt->convert_from_gmt($date);
      return 1  if ($err);
      $self->set('date',$date);
      return 0;
   }

   my @date = $self->value('gmt');
   $secs    = $dmb->secs_since_1970(\@date);
   return $secs;
}

sub week_of_year {
   my($self,$first) = @_;
   if ($$self{'err'}  ||  ! $$self{'data'}{'set'}) {
      warn "WARNING: [week_of_year] Object must contain a valid date\n";
      return undef;
   }

   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};
   my $date     = $$self{'data'}{'date'};
   my $y        = $$date[0];

   my($day,$dow,$doy,$f);
   $doy = $dmb->day_of_year($date);

   # The date in January which must belong to the first week, and
   # it's DayOfWeek.
   if ($dmb->_config('jan1week1')) {
      $day=1;
   } else {
      $day=4;
   }
   $dow = $dmb->day_of_week([$y,1,$day]);

   # The start DayOfWeek. If $first is passed in, use it. Otherwise,
   # use FirstDay.

   if (! $first) {
      $first = $dmb->_config('firstday');
   }

   # Find the pseudo-date of the first day of the first week (it may
   # be negative meaning it occurs last year).

   $first  -= 7  if ($first > $dow);
   $day    -= ($dow-$first);

   return 0  if ($day>$doy);    # Day is in last week of previous year
   return (($doy-$day)/7 + 1);
}

sub complete {
   my($self,$field) = @_;
   if ($$self{'err'}  ||  ! $$self{'data'}{'set'}) {
      warn "WARNING: [complete] Object must contain a valid date\n";
      return undef;
   }

   if (! $field) {
      return 1  if (! $$self{'data'}{'def'}[1]  &&
                    ! $$self{'data'}{'def'}[2]  &&
                    ! $$self{'data'}{'def'}[3]  &&
                    ! $$self{'data'}{'def'}[4]  &&
                    ! $$self{'data'}{'def'}[5]);
      return 0;
   }

   if ($field eq 'm') {
      return 1  if (! $$self{'data'}{'def'}[1]);
   }

   if ($field eq 'd') {
      return 1  if (! $$self{'data'}{'def'}[2]);
   }

   if ($field eq 'h') {
      return 1  if (! $$self{'data'}{'def'}[3]);
   }

   if ($field eq 'mn') {
      return 1  if (! $$self{'data'}{'def'}[4]);
   }

   if ($field eq 's') {
      return 1  if (! $$self{'data'}{'def'}[5]);
   }
   return 0;
}

sub convert {
   my($self,$zone) = @_;
   if ($$self{'err'}  ||  ! $$self{'data'}{'set'}) {
      warn "WARNING: [convert] Object must contain a valid date\n";
      return 1;
   }
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   my $zonename = $dmt->_zone($zone);

   if (! $zonename) {
      $$self{'err'} = "[convert] Unable to determine timezone: $zone";
      return 1;
   }

   my $date0       = $$self{'data'}{'date'};
   my $zone0       = $$self{'data'}{'tz'};
   my $isdst0      = $$self{'data'}{'isdst'};

   my($err,$date,$off,$isdst,$abb) = $dmt->convert($date0,$zone0,$zonename,$isdst0);

   if ($err) {
      $$self{'err'} = '[convert] Unable to convert date to new timezone';
      return 1;
   }

   $self->_init();
   $$self{'data'}{'date'}   = $date;
   $$self{'data'}{'tz'}     = $zonename;
   $$self{'data'}{'isdst'}  = $isdst;
   $$self{'data'}{'offset'} = $off;
   $$self{'data'}{'abb'}    = $abb;
   $$self{'data'}{'set'}    = 1;

   return 0;
}

########################################################################
# BUSINESS DAY METHODS

sub is_business_day {
   my($self,$checktime) = @_;
   if ($$self{'err'}  ||  ! $$self{'data'}{'set'}) {
      warn "WARNING: [is_business_day] Object must contain a valid date\n";
      return undef;
   }
   my $date             = $$self{'data'}{'date'};
   return $self->__is_business_day($date,$checktime);
}

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

   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   # Return 0 if it's a weekend.

   my $dow = $dmb->day_of_week([$y,$m,$d]);
   return 0  if ($dow < $dmb->_config('workweekbeg')  ||
                 $dow > $dmb->_config('workweekend'));

   # Return 0 if it's not during work hours (and we're checking
   # for that).

   if ($checktime  &&
       ! $dmb->_config('workday24hr')) {
      my $t  = $dmb->join('hms',[$h,$mn,$s]);
      my $t0 = $dmb->join('hms',$$dmb{'data'}{'calc'}{'workdaybeg'});
      my $t1 = $dmb->join('hms',$$dmb{'data'}{'calc'}{'workdayend'});
      return 0  if ($t lt $t0  ||  $t gt $t1);
   }

   # Check for holidays

   $self->_holidays($y,2) unless ($noupdate);

   return 1  if (! exists $$dmb{'data'}{'holidays'}{'dates'});

   return 0  if (exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}  &&
                 exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}  &&
                 exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0});

   return 1;
}

sub list_holidays {
   my($self,$y) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   ($y) = $dmt->_now('y',1)  if (! $y);
   $self->_holidays($y,2);

   my @ret;
   my @m = sort { $a <=> $b } keys %{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0} };
   foreach my $m (@m) {
      my @d = sort { $a <=> $b } keys %{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m} };
      foreach my $d (@d) {
         my $hol = $self->new_date();
         $hol->set('date',[$y,$m,$d,0,0,0]);
         push(@ret,$hol);
      }
   }

   return @ret;
}

sub holiday {
   my($self) = @_;
   if ($$self{'err'}  ||  ! $$self{'data'}{'set'}) {
      warn "WARNING: [holiday] Object must contain a valid date\n";
      return undef;
   }
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   my($y,$m,$d) = @{ $$self{'data'}{'date'} };
   $self->_holidays($y,2);

   if (exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}  &&
       exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}  &&
       exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0}) {
      my $tmp = $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0};
      return ''  if (! $tmp);
      return $tmp;
   }
   return undef;
}

sub next_business_day {
   my($self,$off,$checktime) = @_;
   if ($$self{'err'}  ||  ! $$self{'data'}{'set'}) {
      warn "WARNING: [next_business_day] Object must contain a valid date\n";
      return undef;
   }
   my $date                  = $$self{'data'}{'date'};

   $date = $self->__nextprev_business_day(0,$off,$checktime,$date);
   $self->set('date',$date);
}

sub prev_business_day {
   my($self,$off,$checktime) = @_;
   if ($$self{'err'}  ||  ! $$self{'data'}{'set'}) {
      warn "WARNING: [prev_business_day] Object must contain a valid date\n";
      return undef;
   }
   my $date                  = $$self{'data'}{'date'};

   $date = $self->__nextprev_business_day(1,$off,$checktime,$date);
   $self->set('date',$date);
}

sub __nextprev_business_day {
   my($self,$prev,$off,$checktime,$date) = @_;
   my($y,$m,$d,$h,$mn,$s) = @$date;

   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   # Get day 0

   while (! $self->__is_business_day([$y,$m,$d,$h,$mn,$s],$checktime)) {
      if ($checktime) {
         ($y,$m,$d,$h,$mn,$s) =
           @{ $self->__next_prev([$y,$m,$d,$h,$mn,$s],1,undef,0,
                                 $$dmb{'data'}{'calc'}{'workdaybeg'}) };
      } else {
         # Move forward 1 day
         ($y,$m,$d)             = @{ $dmb->calc_date_days([$y,$m,$d],1) };
      }
   }

   # Move $off days into the future/past

   while ($off > 0) {
      while (1) {
         if ($prev) {
            # Move backward 1 day
            ($y,$m,$d)             = @{ $dmb->calc_date_days([$y,$m,$d],-1) };
         } else {
            # Move forward 1 day
            ($y,$m,$d)             = @{ $dmb->calc_date_days([$y,$m,$d],1) };
         }
         last  if ($self->__is_business_day([$y,$m,$d,$h,$mn,$s]));
      }
      $off--;
   }

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

sub nearest_business_day {
   my($self,$tomorrow) = @_;
   if ($$self{'err'}  ||  ! $$self{'data'}{'set'}) {
      warn "WARNING: [nearest_business_day] Object must contain a valid date\n";
      return undef;
   }

   my $date = $$self{'data'}{'date'};
   $date    = $self->__nearest_business_day($tomorrow,$date);

   # If @date is empty, the date is a business day and doesn't need
   # to be changed.

   return  if (! defined($date));

   $self->set('date',$date);
}

sub __nearest_business_day {
   my($self,$tomorrow,$date) = @_;

   # We're done if this is a business day
   return undef  if ($self->__is_business_day($date,0));

   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   $tomorrow = $dmb->_config('tomorrowfirst')  if (! defined $tomorrow);

   my($a1,$a2);
   if ($tomorrow) {
      ($a1,$a2) = (1,-1);
   } else {
      ($a1,$a2) = (-1,1);
   }

   my ($y,$m,$d,$h,$mn,$s) = @$date;
   my ($y1,$m1,$d1) = ($y,$m,$d);
   my ($y2,$m2,$d2) = ($y,$m,$d);

   while (1) {
      ($y1,$m1,$d1) = @{ $dmb->calc_date_days([$y1,$m1,$d1],$a1) };
      if ($self->__is_business_day([$y1,$m1,$d1,$h,$mn,$s],0)) {
         ($y,$m,$d) = ($y1,$m1,$d1);
         last;
      }
      ($y2,$m2,$d2) = @{ $dmb->calc_date_days([$y2,$m2,$d2],$a2) };
      if ($self->__is_business_day([$y2,$m2,$d2,$h,$mn,$s],0)) {
         ($y,$m,$d) = ($y2,$m2,$d2);
         last;
      }
   }

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

# We need to create all the objects which will be used to determine holidays.
# By doing this once only, a lot of time is saved.
#
sub _holiday_objs {
   my($self) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   # We need a new date object so that we can work with other forced dates,
   # but we don't want to create it over and over.
   my $date       = new Date::Manip::Date;
   $$dmb{'data'}{'holidays'}{'date'} = $date;

   # Go through all of the strings from the config file.
   #
   my (@str)      = @{ $$dmb{'data'}{'sections'}{'holidays'} };
   $$dmb{'data'}{'holidays'}{'hols'} = [];

   while (@str) {
      my($string) = shift(@str);
      my($name)   = shift(@str);

      # If $string is a parse_date string AND it contains a year, we'll
      # store the date as a holiday, but not store the holiday description
      # so it never needs to be re-parsed.

      $date->_init();
      my $err = $date->parse_date($string);
      if (! $err) {
         if ($$date{'data'}{'def'}[0] eq '') {
            push(@{ $$dmb{'data'}{'holidays'}{'hols'} },$string,$name);
         } else {
            my($y,$m,$d) = @{ $$date{'data'}{'date'} };
            $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} = $name;
         }

         next;
      }
      $date->err(1);

      # If $string is a recurrence, we'll create a Recur object (which we
      # only have to do once) and store it.

      my $recur = $date->new_recur();
      $err      = $recur->parse($string);
      if (! $err) {
         push(@{ $$dmb{'data'}{'holidays'}{'hols'} },$recur,$name);
         next;
      }

      warn "WARNING: invalid holiday description: $string\n";
   }
}

# Make sure that holidays are set for a given year.
#
sub _holidays {
   my($self,$year,$level) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};
   $self->_holiday_objs($year)  if (! exists $$dmb{'data'}{'holidays'}{'date'});

   $$dmb{'data'}{'holidays'}{$year} = 0
     if (! exists $$dmb{'data'}{'holidays'}{$year});

   return  if ($$dmb{'data'}{'holidays'}{$year} >= $level);

   # Parse the year

   if ($$dmb{'data'}{'holidays'}{$year} == 0) {
      $$dmb{'data'}{'holidays'}{$year} = 1;
      $self->_holidays_year($year);

      return  if ($level == 1);
   }

   # Parse the years around it.

   $$dmb{'data'}{'holidays'}{$year} = 2;
   $self->_holidays($year-1,1);
   $self->_holidays($year+1,1);
}

sub _holidays_year {
   my($self,$y) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   # Get the objects and set them to use the new year. Also, get the
   # range for recurrences.

   my @hol      = @{ $$dmb{'data'}{'holidays'}{'hols'} };
   my $date     = $$dmb{'data'}{'holidays'}{'date'};
   $date->config('forcedate',"${y}-01-01-00:00:00");

   my $beg      = $self->new_date();
   $beg->set('date',[$y-1,12,1,0,0,0]);
   my $end      = $self->new_date();
   $end->set('date',[$y+1,2,1,0,0,0]);

   # Get the date for each holiday.

   while (@hol) {

      my($obj)  = shift(@hol);
      my($name) = shift(@hol);

      if (ref($obj)) {
         # It's a recurrence

         my @d     = $obj->dates($beg,$end);

         foreach my $d (@d) {
            my($y,$m,$d) = @{ $$d{'data'}{'date'} };
            $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} = $name;
         }

      } else {
         $date->parse_date($obj);
         my($y,$m,$d) = @{ $$date{'data'}{'date'} };
         $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} = $name;
      }
   }
}

########################################################################
# PRINTF METHOD

BEGIN {
   my %pad_0  = map { $_,1 } qw ( Y m d H M S I j G W L U );
   my %pad_sp = map { $_,1 } qw ( y f e k i );
   my %hr     = map { $_,1 } qw ( H k I i );
   my %dow    = map { $_,1 } qw ( v a A w );
   my %num    = map { $_,1 } qw ( Y m d H M S y f e k I i j G W L U );

   sub printf {
      my($self,@in) = @_;
      if ($$self{'err'}  ||  ! $$self{'data'}{'set'}) {
         warn "WARNING: [printf] Object must contain a valid date\n";
         return undef;
      }

      my $dmt = $$self{'tz'};
      my $dmb = $$dmt{'base'};

      my($y,$m,$d,$h,$mn,$s) = @{ $$self{'data'}{'date'} };

      my(@out);
      foreach my $in (@in) {
         my $out       = '';
         while ($in) {
            last  if ($in eq '%');

            if ($in =~ s/^([^%]+)//) {
               $out .= $1;
               next;
            }

            $in =~ s/^%(.)//;
            my $f = $1;

            if (exists $$self{'data'}{'f'}{$f}) {
               $out .= $$self{'data'}{'f'}{$f};
               next;
            }

            my ($val,$pad,$len,$dow);

            if (exists $pad_0{$f}) {
               $pad = '0';
            }

            if (exists $pad_sp{$f}) {
               $pad = ' ';
            }

            if ($f eq 'G'  ||  $f eq 'W') {
               my($yy,$ww) = $dmb->_week_of_year(1,[$y,$m,$d]);
               if ($f eq 'G') {
                  $val = $yy;
                  $len = 4;
               } else {
                  $val = $ww;
                  $len = 2;
               }
            }

            if ($f eq 'L'  ||  $f eq 'U') {
               my($yy,$ww) = $dmb->_week_of_year(7,[$y,$m,$d]);
               if ($f eq 'L') {
                  $val = $yy;
                  $len = 4;
               } else {
                  $val = $ww;
                  $len = 2;
               }
            }

            if ($f eq 'Y'  ||  $f eq 'y') {
               $val = $y;
               $len = 4;
            }

            if ($f eq 'm'  ||  $f eq 'f') {
               $val = $m;
               $len = 2;
            }

            if ($f eq 'd'  ||  $f eq 'e') {
               $val = $d;
               $len = 2;
            }

            if ($f eq 'j') {
               $val = $dmb->day_of_year([$y,$m,$d]);
               $len = 3;
            }


            if (exists $hr{$f}) {
               $val = $h;
               if ($f eq 'I'  ||  $f eq 'i') {
                  $val -= 12  if ($val > 12);
                  $val  = 12  if ($val == 0);
               }
               $len = 2;
            }

            if ($f eq 'M') {
               $val = $mn;
               $len = 2;
            }

            if ($f eq 'S') {
               $val = $s;
               $len = 2;
            }

            if (exists $dow{$f}) {
               $dow = $dmb->day_of_week([$y,$m,$d]);
            }

            ###

            if (exists $num{$f}) {
               while (length($val) < $len) {
                  $val = "$pad$val";
               }

               $val = substr($val,2,2)  if ($f eq 'y');

            } elsif ($f eq 'b'  ||  $f eq 'h') {
               $val = $$dmb{'data'}{'wordlistL'}{'month_abb'}[$m-1];

            } elsif ($f eq 'B') {
               $val = $$dmb{'data'}{'wordlistL'}{'month_name'}[$m-1];

            } elsif ($f eq 'v') {
               $val = $$dmb{'data'}{'wordlistL'}{'day_char'}[$dow-1];

            } elsif ($f eq 'a') {
               $val = $$dmb{'data'}{'wordlistL'}{'day_abb'}[$dow-1];

            } elsif ($f eq 'A') {
               $val = $$dmb{'data'}{'wordlistL'}{'day_name'}[$dow-1];

            } elsif ($f eq 'w') {
               $val = $dow;

            } elsif ($f eq 'p') {
               my $i = ($h >= 12 ? 1 : 0);
               $val  = $$dmb{'data'}{'wordlistL'}{'ampm'}[$i];

            } elsif ($f eq 'Z') {
               $val  = $$self{'data'}{'abb'};

            } elsif ($f eq 'N') {
               my $off = $$self{'data'}{'offset'};
               $val = $dmb->join('offset',$off);

            } elsif ($f eq 'z') {
               my $off = $$self{'data'}{'offset'};
               $val = $dmb->join('offset',$off);
               $val =~ s/://g;
               $val =~ s/00$//;

            } elsif ($f eq 'E') {
               $val = $$dmb{'data'}{'wordlistL'}{'nth_dom'}[$d-1];

            } elsif ($f eq 's') {
               $val = $self->secs_since_1970_GMT();

            } elsif ($f eq 'o') {
               my $date2 = $self->new_date();
               $date2->parse('1970-01-01 00:00:00');
               my $delta = $date2->calc($self);
               $val = $delta->printf('%sys');

            } elsif ($f eq 'l') {
               my $d0 = $self->new_date();
               my $d1 = $self->new_date();
               $d0->parse('-0:6:0:0:0:0:0'); # 6 months ago
               $d1->parse('+0:6:0:0:0:0:0'); # in 6 months
               $d0      = $d0->value();
               $d1      = $d1->value();
               my $date = $self->value();
               if ($date lt $d0  ||  $date ge $d1) {
                  $in  = '%b %e  %Y' . $in;
               } else {
                  $in  = '%b %e %H:%M' . $in;
               }
               $val = '';

            } elsif ($f eq 'c') {
               $in  = '%a %b %e %H:%M:%S %Y' . $in;
               $val = '';

            } elsif ($f eq 'C'  ||  $f eq 'u') {
               $in  = '%a %b %e %H:%M:%S %Z %Y' . $in;
               $val = '';

            } elsif ($f eq 'g') {
               $in  = '%a, %d %b %Y %H:%M:%S %Z' . $in;
               $val = '';

            } elsif ($f eq 'D') {
               $in  = '%m/%d/%y' . $in;
               $val = '';

            } elsif ($f eq 'r') {
               $in  = '%I:%M:%S %p' . $in;
               $val = '';

            } elsif ($f eq 'R') {
               $in  = '%H:%M' . $in;
               $val = '';

            } elsif ($f eq 'T'  ||  $f eq 'X') {
               $in  = '%H:%M:%S' . $in;
               $val = '';

            } elsif ($f eq 'V') {
               $in  = '%m%d%H%M%y' . $in;
               $val = '';

            } elsif ($f eq 'Q') {
               $in  = '%Y%m%d' . $in;
               $val = '';

            } elsif ($f eq 'q') {
               $in  = '%Y%m%d%H%M%S' . $in;
               $val = '';

            } elsif ($f eq 'P') {
               $in  = '%Y%m%d%H:%M:%S' . $in;
               $val = '';

            } elsif ($f eq 'O') {
               $in  = '%Y-%m-%dT%H:%M:%S' . $in;
               $val = '';

            } elsif ($f eq 'F') {
               $in  = '%A, %B %e, %Y' . $in;
               $val = '';

            } elsif ($f eq 'K') {
               $in  = '%Y-%j' . $in;
               $val = '';

            } elsif ($f eq 'x') {
               if ($dmb->_config('dateformat') eq 'US') {
                  $in  = '%m/%d/%y' . $in;
               } else {
                  $in  = '%d/%m/%y' . $in;
               }
               $val = '';

            } elsif ($f eq 'J') {
               $in  = '%G-W%W-%w' . $in;
               $val = '';

            } elsif ($f eq 'n') {
               $val = "\n";

            } elsif ($f eq 't') {
               $val = "\t";

            } else {
               $val = $f;
            }

            if ($val) {
               $$self{'data'}{'f'}{$f} = $val;
               $out .= $val;
            }
         }
         push(@out,$out);
      }

      if (wantarray) {
         return @out;
      } elsif (@out == 1) {
         return $out[0];
      }

      return ''
   }
}

########################################################################
# EVENT METHODS

sub list_events {
   my($self,@args) = @_;
   if ($$self{'err'}  ||  ! $$self{'data'}{'set'}) {
      warn "WARNING: [list_events] Object must contain a valid date\n";
      return undef;
   }
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};

   # Arguments

   my($date,$day,$format);
   if (@args  &&  $args[$#args] eq 'dates') {
      pop(@args);
      $format = 'dates';
   } else {
      $format = 'std';
   }

   if (@args  &&  $#args==0  &&  ref($args[0]) eq 'Date::Manip::Date') {
      $date = $args[0];
   } elsif (@args  &&  $#args==0  &&  $args[0]==0) {
      $day  = 1;
   } elsif (@args) {
      warn "ERROR: [list_events] unknown argument list\n";
      return [];
   }

   # Get the beginning/end dates we're looking for events in

   my($beg,$end);
   if ($date) {
      $beg = $self;
      $end = $date;
   } elsif ($day) {
      $beg = $self->new_date();
      $end = $self->new_date();
      my($y,$m,$d) = $self->value();
      $beg->set('date',[$y,$m,$d,0,0,0]);
      $end->set('date',[$y,$m,$d,23,59,59]);
   } else {
      $beg = $self;
      $end = $self;
   }

   if ($beg->cmp($end) == 1) {
      my $tmp = $beg;
      $beg    = $end;
      $end    = $tmp;
   }

   # We need to get a list of all events which may apply.

   my($y0) = $beg->value();
   my($y1) = $end->value();
   foreach my $y ($y0..$y1) {
      $self->_events_year($y);
   }

   my @events = ();
   foreach my $i (keys %{ $$dmb{'data'}{'events'} }) {
      my $event = $$dmb{'data'}{'events'}{$i};
      my $type  = $$event{'type'};
      my $name  = $$event{'name'};

      if ($type eq 'specified') {
         my $d0 = $$dmb{'data'}{'events'}{$i}{'beg'};
         my $d1 = $$dmb{'data'}{'events'}{$i}{'end'};
         push @events,[$d0,$d1,$name];

      } elsif ($type eq 'ym'  ||  $type eq 'date') {
         foreach my $y ($y0..$y1) {
            if (exists $$dmb{'data'}{'events'}{$i}{$y}) {
               my($d0,$d1) = @{ $$dmb{'data'}{'events'}{$i}{$y} };
               push @events,[$d0,$d1,$name];
            }
         }

      } elsif ($type eq 'recur') {
         my $rec = $$dmb{'data'}{'events'}{$i}{'recur'};
         my $del = $$dmb{'data'}{'events'}{$i}{'delta'};
         my @d   = $rec->dates($beg,$end);
         foreach my $d0 (@d) {
            my $d1 = $d0->calc($del);
            push @events,[$d0,$d1,$name];
         }
      }
   }

   # Next we need to see which ones apply.

   my @tmp;
   foreach my $e (@events) {
      my($d0,$d1,$name) = @$e;

      push(@tmp,$e)  if ($beg->cmp($d1) != 1  &&
                         $end->cmp($d0) != -1);
   }

   # Now format them...

   if ($format eq 'std') {
      @events = sort { $$a[0]->cmp($$b[0])  ||
                       $$a[1]->cmp($$b[1])  ||
                       $$a[2] cmp $$b[2] } @tmp;

   } elsif ($format eq 'dates') {
      my $p1s = $self->new_delta();
      $p1s->parse('+0:0:0:0:0:0:1');

      @events = ();
      my (@tmp2);
      foreach my $e (@tmp) {
         my $name = $$e[2];
         if ($$e[0]->cmp($beg) == -1) {
            # Event begins before the start
            push(@tmp2,[$beg,'+',$name]);
         } else {
            push(@tmp2,[$$e[0],'+',$name]);
         }

         my $d1 = $$e[1]->calc($p1s);

         if ($d1->cmp($end) == -1) {
            # Event ends before the end
            push(@tmp2,[$d1,'-',$name]);
         }
      }

      @tmp2 = sort { $$a[0]->cmp($$b[0])  ||
                     $$a[1] cmp $$b[1]    ||
                     $$a[2] cmp $$b[2] } @tmp2;

      # @tmp2 is now:
      #   ( [ DATE1, OP1, NAME1 ], [ DATE2, OP2, NAME2 ], ... )
      # which is sorted by date.

      my $d = $tmp2[0]->[0];

      if ($beg->cmp($d) != 0) {
         push(@events,[$beg]);
      }

      my %e;
      while (1) {

         # If the first element is the same date as we're
         # currently working with, just perform the operation
         # and remove it from the list. If the list is not empty,
         # we'll proceed to the next element.

         my $d0 = $tmp2[0]->[0];
         if ($d->cmp($d0) == 0) {
            my $e  = shift(@tmp2);
            my $op = $$e[1];
            my $n  = $$e[2];
            if ($op eq '+') {
               $e{$n} = 1;
            } else {
               delete $e{$n};
            }

            next  if (@tmp2);
         }

         # We need to store the existing %e.

         my @n = sort keys %e;
         push(@events,[$d,@n]);

         # If the list is empty, we're done. Otherwise, we need to
         # reset the date and continue.

         last  if (! @tmp2);
         $d = $tmp2[0]->[0];
      }
   }

   return @events;
}

# The events of type date and ym are determined on a year-by-year basis
#
sub _events_year {
   my($self,$y) = @_;
   my $dmt      = $$self{'tz'};
   my $dmb      = $$dmt{'base'};
   my ($tz)     = $dmt->_now('tz',1);
   return  if (exists $$dmb{'data'}{'eventyears'}{$y});
   $self->_event_objs()  if (! $$dmb{'data'}{'eventobjs'});

   my $d = $self->new_date();
   $d->config('forcedate',"${y}-01-01-00:00:00,$tz");

   my $hrM1  = $d->new_delta();
   $hrM1->set('delta',[0,0,0,0,0,59,59]);

   my $dayM1 = $d->new_delta();
   $dayM1->set('delta',[0,0,0,0,23,59,59]);

   foreach my $i (keys %{ $$dmb{'data'}{'events'} }) {
      my $event = $$dmb{'data'}{'events'}{$i};
      my $type  = $$event{'type'};

      if ($type eq 'ym') {
         my $beg = $$event{'beg'};
         my $end = $$event{'end'};
         my $d0  = $d->new_date();
         $d0->parse_date($beg);
         $d0->set('time',[0,0,0]);

         my $d1;
         if ($end) {
            $d1  = $d0->new_date();
            $d1->parse_date($end);
            $d1->set('time',[23,59,59]);
         } else {
            $d1  = $d0->calc($dayM1);
         }
         $$dmb{'data'}{'events'}{$i}{$y} = [ $d0,$d1 ];

      } elsif ($type eq 'date') {
         my $beg = $$event{'beg'};
         my $end = $$event{'end'};
         my $del = $$event{'delta'};
         my $d0  = $d->new_date();
         $d0->parse($beg);

         my $d1;
         if ($end) {
            $d1  = $d0->new_date();
            $d1->parse($end);
         } elsif ($del) {
            $d1 = $d0->calc($del);
         } else {
            $d1  = $d0->calc($hrM1);
         }
         $$dmb{'data'}{'events'}{$i}{$y} = [ $d0,$d1 ];
      }
   }
}

# This parses the raw event list.  It only has to be done once.
#
sub _event_objs {
   my($self) = @_;
   my $dmt = $$self{'tz'};
   my $dmb = $$dmt{'base'};
   # Only parse once.
   $$dmb{'data'}{'eventobjs'} = 1;

   my $hrM1  = $self->new_delta();
   $hrM1->set('delta',[0,0,0,0,0,59,59]);

   my $M1    = $self->new_delta();
   $M1->set('delta',[0,0,0,0,0,0,-1]);

   my @tmp   = @{ $$dmb{'data'}{'sections'}{'events'} };
   my $i     = 0;
   while (@tmp) {
      my $string = shift(@tmp);
      my $name   = shift(@tmp);
      my @event  = split(/\s*;\s*/,$string);

      if ($#event == 0) {

         # YMD/YM

         my $d1  = $self->new_date();
         my $err = $d1->parse_date($event[0]);
         if (! $err) {
            if ($$d1{'data'}{'def'}[0] eq '') {
               # YM
               $$dmb{'data'}{'events'}{$i++} = { 'type' => 'ym',
                                                 'name' => $name,
                                                 'beg'  => $event[0] };
            } else {
               # YMD
               my $d2         = $d1->new_date();
               my ($y,$m,$d)  = $d1->value();
               $d1->set('time',[0,0,0]);
               $d2->set('date',[$y,$m,$d,23,59,59]);
               $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
                                                 'name' => $name,
                                                 'beg'  => $d1,
                                                 'end'  => $d2 };
            }
            next;
         }

         # Date

         $err = $d1->parse($event[0]);
         if (! $err) {
            if ($$d1{'data'}{'def'}[0] eq '') {
               # Date (no year)
               $$dmb{'data'}{'events'}{$i++} = { 'type'  => 'date',
                                                 'name'  => $name,
                                                 'beg'   => $event[0],
                                                 'delta' => $hrM1
                                               };
            } else {
               # Date (year)
               my $d2 = $d1->calc($hrM1);
               $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
                                                 'name' => $name,
                                                 'beg'  => $d1,
                                                 'end'  => $d2
                                               };
            }
            next;
         }

         # Recur

         my $r = $self->new_recur();
         $err  = $r->parse($event[0]);
         if ($err) {
            warn "ERROR: invalid event definition (must be Date, YMD, YM, or Recur)\n"
               . "       $string\n";
            next;
         }

         my @d = $r->dates();
         if (@d) {
            foreach my $d (@d) {
               my $d2 = $d->calc($hrM1);
               $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
                                                 'name' => $name,
                                                 'beg'  => $d1,
                                                 'end'  => $d2
                                               };
            }
         } else {
            $$dmb{'data'}{'events'}{$i++} = { 'type'  => 'recur',
                                              'name'  => $name,
                                              'recur' => $r,
                                              'delta' => $hrM1
                                            };
         }

      } elsif ($#event == 1) {
         my($o1,$o2) = @event;

         # YMD;YMD
         # YM;YM

         my $d1   = $self->new_date();
         my $err = $d1->parse_date($o1);
         if (! $err) {
            my $d2 = $self->new_date();
            $err   = $d2->parse_date($o2);
            if ($err) {
               warn "ERROR: invalid event definition (must be YMD;YMD or YM;YM)\n"
                  . "       $string\n";
               next;
            } elsif ($$d1{'data'}{'def'}[0] ne $$d2{'data'}{'def'}[0]) {
               warn "ERROR: invalid event definition (YMD;YM or YM;YMD not allowed)\n"
                  . "       $string\n";
               next;
            }

            if ($$d1{'data'}{'def'}[0] eq '') {
               # YM;YM
               $$dmb{'data'}{'events'}{$i++} = { 'type' => 'ym',
                                                 'name' => $name,
                                                 'beg'  => $o1,
                                                 'end'  => $o2
                                               };
            } else {
               # YMD;YMD
               $d1->set('time',[0,0,0]);
               $d2->set('time',[23,59,59]);
               $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
                                                 'name' => $name,
                                                 'beg'  => $d1,
                                                 'end'  => $d2 };
            }
            next;
         }

         # Date;Date
         # Date;Delta

         $err = $d1->parse($o1);
         if (! $err) {

            my $d2 = $self->new_date();
            $err   = $d2->parse($o2,'nodelta');

            if (! $err) {
               # Date;Date
               if ($$d1{'data'}{'def'}[0] ne $$d2{'data'}{'def'}[0]) {
                  warn "ERROR: invalid event definition (year must be absent or\n"
                     . "       included in both dats in Date;Date)\n"
                     . "       $string\n";
                  next;
               }

               if ($$d1{'data'}{'def'}[0] eq '') {
                  # Date (no year)
                  $$dmb{'data'}{'events'}{$i++} = { 'type' => 'date',
                                                    'name' => $name,
                                                    'beg'  => $o1,
                                                    'end'  => $o2
                                                  };
               } else {
                  # Date (year)
                  $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
                                                    'name' => $name,
                                                    'beg'  => $d1,
                                                    'end'  => $d2
                                                  };
               }
               next;
            }

            # Date;Delta
            my $del = $self->new_delta();
            $err    = $del->parse($o2);

            if ($err) {
               warn "ERROR: invalid event definition (must be Date;Date or Date;Delta)\n"
                  . "       $string\n";
               next;
            }

            $del    = $del->calc($M1);
            if ($$d1{'data'}{'def'}[0] eq '') {
               # Date (no year)
               $$dmb{'data'}{'events'}{$i++} = { 'type'  => 'date',
                                                 'name'  => $name,
                                                 'beg'   => $o1,
                                                 'delta' => $del
                                               };
            } else {
               # Date (year)
               $d2 = $d1->calc($del);
               $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
                                                 'name' => $name,
                                                 'beg'  => $d1,
                                                 'end'  => $d2
                                               };
            }
            next;
         }

         # Recur;Delta

         my $r = $self->new_recur();
         $err  = $r->parse($o1);

         my $del = $self->new_delta();
         if (! $err) {
            $err    = $del->parse($o2);
         }

         if ($err) {
            warn "ERROR: invalid event definition (must be Date;Date, YMD;YMD, YM;YM,"
              .  "      Date;Delta, or Recur;Delta)\n"
              . "       $string\n";
            next;
         }

         $del  = $del->calc($M1);
         my @d = $r->dates();
         if (@d) {
            foreach my $d1 (@d) {
               my $d2 = $d1->calc($del);
               $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
                                                 'name' => $name,
                                                 'beg'  => $d1,
                                                 'end'  => $d2
                                               };
            }
         } else {
            $$dmb{'data'}{'events'}{$i++} = { 'type'  => 'recur',
                                              'name'  => $name,
                                              'recur' => $r,
                                              'delta' => $del
                                            };
         }

      } else {
         warn "ERROR: invalid event definition\n"
            . "       $string\n";
         next;
      }
   }
}

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: -2
# End:
