#!/usr/bin/perl -w

# Copyright (c) 2008-2017 Sullivan Beck.  All rights reserved.

# This program is free software; you can redistribute it and/or modify it

# under the same terms as Perl itself.

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

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

# This script is used to automatically generate the Date::Manip::Zones

# and Date::Manip::TZ::_ZONE_ modules from the original time zone data.

use lib "./lib";

use lib "./internal";

require 5.010000;

use YAML;

use IO::File;

use Date::Manip::Base;

use Date::Manip::TZdata;

use strict;

use warnings;

our $VERSION;

$VERSION='6.60';

our ($dmb);

$dmb = new Date::Manip::Base;

our $curry = ( localtime(time) )[5] + 1900;

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

# GLOBAL VARIABLES

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

our ($first_date,$last_date,$tzdata_src,$tzdata_dir,$tzdata_data,$tzdata_code,

     $mod_dir,$off_dir,

     $curr_year,$keep_year,$test_year,$zones_pm,$zones_pod,

     %def_off,%nontzdata_zones,%def_alias2,%def_abbrev,%no_last,

     %last_zone_offsets

    );

# The first and last dates (UT) known by this module (everything in the

# 0001 - 9999 range except for the first and last 24 hours of that range).

$first_date = "0001010200:00:00";

$last_date  = "9999123100:00:00";

# The source for the tzdata/tzcode files:

$tzdata_src = "ftp.iana.org";

$tzdata_dir = "tz";

$tzdata_data= "tzdata-latest.tar.gz";

$tzdata_code= "tzcode-latest.tar.gz";

require "data.offset.pl";

require "data.abbrev.pl";

require "data.alias.pl";

require "data.misc.pl";

# so the CPAN indexer won't treat this as a POD file

our $podstr = '=pod';

our $hdstr  = '=head1';

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

# HELP

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

our ($usage);

my $COM = $0;

$COM =~ s/^.*\///;

$usage=

  "usage: $COM OPTIONS

      -h/--help       : Print help.

      -v/--verbose    : Increasing levels of verbosity

      -a/--all        : Do all steps

      -f/--ftp        : Download the tzdata/tzcode files from

                        the source and build the tools

      -l/--list       : Get a list of all time zones to dump

      -d/--dump       : This dumps out zone info for all of

                        the zones

      -m/--mods       : This creates the modules from the dumps

      -o/--offset     : Creates the offset modules

      -z/--zones      : Create the zones module

      -c/--clean      : Removes tzdata files

";

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

# PARSE ARGUMENTS

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

our ($verbose);

$verbose     = 0;

my $do_all   = 0;

my $do_ftp   = 0;

my $do_build = 0;

my $do_list  = 0;

my $do_dump  = 0;

my $do_mods  = 0;

my $do_off   = 0;

my $do_zones = 0;

my $do_clean = 0;

while ($_ = shift) {

   (print $usage),   exit  if ($_ eq "-h"   ||  $_ eq "--help");

   $verbose = 1,     next  if ($_ eq "-v"   ||  $_ eq "--verbose");

   $do_all = 1,      next  if ($_ eq "-a"   ||  $_ eq "--all");

   $do_ftp = 1,      next  if ($_ eq "-f"   ||  $_ eq "--ftp");

   $do_build = 1,    next  if ($_ eq "-b"   ||  $_ eq "--build");

   $do_list = 1,     next  if ($_ eq "-l"   ||  $_ eq "--list");

   $do_dump = 1,     next  if ($_ eq "-d"   ||  $_ eq "--dump");

   $do_mods = 1,     next  if ($_ eq "-m"   ||  $_ eq "--mods");

   $do_off = 1,      next  if ($_ eq "-o"   ||  $_ eq "--offset");

   $do_zones = 1,    next  if ($_ eq "-z"   ||  $_ eq "--zones");

   $do_clean = 1,    next  if ($_ eq "-c"   ||  $_ eq "--clean");

}

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

# MAIN PROGRAM

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

do_ftp()    if ($do_all  ||  $do_ftp);

do_build()  if ($do_all  ||  $do_build);

do_list()   if ($do_all  ||  $do_list);

do_dump()   if ($do_all  ||  $do_dump);

do_mods()   if ($do_all  ||  $do_mods);

do_off()    if ($do_all  ||  $do_off);

do_zones()  if ($do_all  ||  $do_zones);

do_clean()  if (             $do_clean);

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

# DO_FTP

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

# FTP the tzdata/tzcode packages

#

sub do_ftp {

   print "FTP...\n";

   system("rm -rf tzdata; mkdir tzdata");

   chdir("tzdata");

   #

   # Get the tz*latest.tar.gz links to determine the versions

   #

   system("wget -q 'ftp://$tzdata_src/$tzdata_dir/$tzdata_data' " .

          "'ftp://$tzdata_src/$tzdata_dir/$tzdata_code'");

   if (! -f $tzdata_data) {

      die "ERROR: unable to ftp data.  Try again later.";

   }

   if (! -f $tzdata_code) {

      die "ERROR: unable to ftp code.  Try again later.";

   }

   system("tar xzf $tzdata_data");

   my $tzdata_vers = _release('data');

   system("tar xzf $tzdata_code");

   my $tzcode_vers = _release('code');

   print "  TZdata : $tzdata_vers\n";

   print "  Tzcode : $tzcode_vers\n";

   system("echo $tzdata_vers > _version; " .

          "echo $tzcode_vers >> _version; ");

}

sub _release {

   my($type) = @_;

   if (! -f 'NEWS') {

      die "ERROR: unable to determine version (no NEWS): $type\n";

   }

   my $vers = `grep Release NEWS | head -1 | awk '{print \$2}'`;

   chomp($vers);

   if ($vers !~ /^\d\d\d\d[a-z]$/) {

      die "ERROR: uknown version format: $type: $vers\n";

   }

   system("mv NEWS NEWS.$type");

   return $vers;

}

# Build the package

#

sub do_build {

   print "Build...\n";

   system("cd tzdata; " .

          "touch NEWS; " .

          "make TOPDIR=./tmp INSTALL;");

}

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

# DO_LIST

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

# Get a list of all zones in the tzdata files which we will create

# modules for. Store a list of them and the associated module name.

#

# Stored in: _zone

#

sub do_list {

   print "List...\n";

   #

   # Get a list of zones from all Zone lines in the standard files in

   # the tzdata package.

   #

   my(@zone);

   foreach my $file (@Date::Manip::TZdata::StdFiles) {

      my @tmp = `grep '^Zone' tzdata/$file | awk '{print \$2}'`;

      chomp(@tmp);

      push(@zone,@tmp);

   }

   #

   # Generate a module name for every zone (excepting some which

   # we're ignoring, or creating in other ways).

   #

   my %module  = ();

   my %modname = ();

   my %alias   = ();

   foreach my $zone (sort @zone) {

      next  if (exists $nontzdata_zones{$zone}  ||

                exists $def_alias2{$zone});

      my $module        = _do_list_modname(\%modname,$zone);

      $module{$zone}    = [ $module, "tzdata" ];

      $alias{$zone}     = [ $zone, "tzdata" ];

   }

   #

   # Generate a module name for every zone which is created as

   # an offset (e.g. GMT-3).

   #

   foreach my $zone (sort keys %nontzdata_zones) {

      my($type,$val) = @{ $nontzdata_zones{$zone} };

      if ($type eq "offset") {

         my $module        = _do_list_modname(\%modname,$zone);

         $module{$zone}    = [ $module, "offset", $val ];

         $alias{$zone}     = [ $zone, "offset" ];

      }

   }

   #

   # Handle all other special cases such as special aliases and

   # ignored zones.

   #

   foreach my $zone (sort keys %nontzdata_zones) {

      my($type,$val) = @{ $nontzdata_zones{$zone} };

      if ($type eq "offset") {

         next;

      } elsif ($type eq "alias") {

         warn "[do_list] unknown alias [$zone: $val]\n"

           if (! exists $module{$val});

         $alias{$zone}     = [ $val, $type ];

      } elsif ($type eq "ignore") {

         $alias{$zone}     = [ $val, $type ];

      } else {

         warn "[do_list] unknown type [$zone: $type]\n";

      }

   }

   # Write out the official list of zones and aliases.

   _yaml_write(\%module,"tzdata/_zone_list",0);

   _yaml_write(\%alias, "tzdata/_alias_list",0);

}

# Takes a hashref $module{MODNAME} = ZONE and a zone and comes up

# with a unique module name for it. It returns the name of the module

# (as well as adds it to the hash).

#

sub _do_list_modname {

   my($modnames,$zone) = @_;

   my $modname = "";

   if ($zone =~ /\//) {

      my @tmp = split(/\//,$zone);

      $modname = substr($tmp[0],0,2) . substr($tmp[$#tmp],0,4);

   } else {

      $modname = substr($zone,0,6);

   }

   $modname =~ s/\-/m/g;

   $modname =~ s/\+/p/g;

   my $i = "00";

   while (exists $$modnames{"$modname$i"}) {

      $i++;

   }

   $modname .= $i;

   $$modnames{$modname} = 1;

   return lc($modname);

}

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

# DO_DUMP

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

# Dump every zone.

#

# Stored in: dump/MODNAME

#

sub do_dump {

   print "Dump...\n";

   my $tmp    = _yaml_read("tzdata/_zone_list");

   my %module = %$tmp;

   my $num    = keys %module;

   my $len    = length($num);

   my $i      = 0;

   system("rm -rf tzdata/dump; " .

          "mkdir tzdata/dump");

   print "   dumping "," "x($len-length($i)),"$i / $num";

   foreach my $zone (keys %module) {

      $i++;

      print "\010"x($len*2+3)," "x($len-length($i)),"$i / $num";

      my($module,$type) = @{ $module{$zone} };

      next  if ($type ne "tzdata");

      system("cd tzdata; " .

             "tmp/etc/zdump -c $test_year -v $zone > dump/$module");

   }

   print "\n";

}

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

# DO_MODS

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

# Creates the modules.

#

sub do_mods {

   print "Modules...\n";

   my $tzd = Date::Manip::TZdata->new();

   system("rm -f $mod_dir/*");

   my $zone_list = _yaml_read("tzdata/_zone_list");

   my %zone_list = %$zone_list;

   my $num       = keys %zone_list;

   my $len       = length($num);

   my $i         = 0;

   my $abbrev = {};

   my $data   = {};

   print "   module "," "x($len-length($i)),"$i / $num";

   foreach my $zone (keys %zone_list) {

      $i++;

      print "\010"x($len*2+3)," "x($len-length($i)),"$i / $num";

      my($module,$type,@args) = @{ $zone_list{$zone} };

      if ($type eq "tzdata") {

         _do_mods_tzdata($tzd,$abbrev,$data,$zone,$module,@args);

      } elsif ($type eq "offset") {

         _do_mods_offset($tzd,$abbrev,$data,$zone,$module,@args);

      }

   }

   print "\n";

   # $data now contains a hash of:

   #    YEAR => [ TYPE, VAL1, VAL2, ... ]

   # where TYPE is currently blank.

   #

   # VALi is a reference to a time change [ ABB, OFFSET, ISDST ]

   #

   # TYPE will be set to one of the following:

   #

   #    std0, : a standard year is  one with two time changes which must

   #    std1    be  with ISDST  =  1 and  0, and  both must be integers

   #            that differ by exactly 1.  If the ISDST = 0 comes first,

   #            it is set to std0.  Otherwise it is set to std1.

   #    last0,

   #    last1 : if it's a standard year AND the year is after $keep_year

   #    end   : a non-standard year after $keep_year

   #    non   : a non-standard year before $keep_year

   foreach my $zone (keys %$data) {

      my $lasttype = '';

      foreach my $year (keys %{ $$data{$zone} }) {

         my $type;

         my @tmp = @{ $$data{$zone}{$year} };

         shift(@tmp);

         # Standard times must have two changes

         $type = 'std';

         $type = 'non'  if (@tmp != 2);

         # Standard times must have both offsets on the hour.

         my ($off1,$off2);

         if ($type eq 'std') {

            $off1 = $tmp[0][1];

            $off2 = $tmp[1][1];

            if ($off1 !~ /:00:00$/  ||

                $off2 !~ /:00:00$/) {

               $type = 'non';

            } else {

               $type = 'std';

            }

         }

         # Standard times must have offsets that are 1 hour apart.

         if ($type eq 'std') {

            $off1 =~ s/:00:00$//;

            $off2 =~ s/:00:00$//;

            $type = 'non'  if (abs($off1 - $off2) != 1);

         }

         # Standard times have offsets with two offsets with ISDST = 0 and 1

         my $std;

         if      ($type eq 'std'   &&

                  $tmp[0][2] == 1  &&

                  $tmp[1][2] == 0) {

            $std = 1;

         } elsif ($type eq 'std'  &&

                  $tmp[0][2] == 0  &&

                  $tmp[1][2] == 1) {

            $std = 0;

         } else {

            $type = 'non';

         }

         # Set the type

         if ($type eq 'std') {

            if ($year > $keep_year) {

               $type  = "last$std";

            } else {

               $type .= $std;

            }

         } elsif ($year > $keep_year) {

            $type = 'end';

         }

         # We'll discard the very last year of a standard timezone

         # because they end on the first change of a year instead of

         # the second.

         next  if ($lasttype =~ /last/  &&  $type eq 'end');

         $lasttype = $type;

         $$data{$zone}{$year}[0] = $type;

      }

   }

   # Create a list of all EST5EDT style time zone aliases.

   # These only apply during standard years.

   #

   # Also, we will ignore aliases when the abbreviations are

   # offsets.

   my $alias2 = {};

 ZONE: foreach my $zone (keys %$data) {

      foreach my $year (sort keys %{ $$data{$zone} }) {

         my ($type,@tmp) = @{ $$data{$zone}{$year} };

         next  if ($type ne 'std0'  &&

                   $type ne 'std1'  &&

                   $type ne 'last0' &&

                   $type ne 'last1');

         # The format is

         #   STDABB STDOFFHR DSTABB

         # where STDABB and DSTABB are the abbreviations, and STDOFFHR

         # is the offset for standard time as an integer negated.

         my ($stdabb,$dstabb,$stdoff);

         if ($type eq 'std0'  ||  $type eq 'last0') {

            $stdabb = $tmp[0][0];

            $dstabb = $tmp[1][0];

            $stdoff = $tmp[0][1];

         } else {

            $stdabb = $tmp[1][0];

            $dstabb = $tmp[0][0];

            $stdoff = $tmp[1][1];

         }

         $stdoff    =~ s/:00:00$//;

         $stdoff   *= -1;

         next  if ($stdabb =~ /^[+-]?\d+$/  ||

                   $dstabb =~ /^[+-]?\d+$/);

         my $alias  = "${stdabb}${stdoff}${dstabb}";

         if ($type eq 'last0'  ||  $type eq 'last1') {

            _do_mods_years($alias2,$zone,$alias,$year,9999);

            next ZONE;

         }

         _do_mods_years($alias2,$zone,$alias,$year,$year);

      }

   }

   _yaml_write($data,  'tzdata/_data',0);

   _yaml_write($alias2,'tzdata/_alias2_un',0);

   $abbrev = _order_elements($abbrev);

   $alias2 = _order_elements($alias2);

   _yaml_write($abbrev,'tzdata/_abbrev_or',0);

   _yaml_write($alias2,'tzdata/_alias2_or',0);

}

# This creates a module from a tzdata dump.

#

sub _do_mods_tzdata {

   my($tzd,$abbrev,$data,$zone,$module) = @_;

   my @lines  = `cat tzdata/dump/$module`;

   chomp(@lines);

   while (@lines  &&  $lines[0] =~ /NULL$/) {

      shift(@lines);

   }

   while (@lines  &&  $lines[$#lines] =~ /NULL$/) {

      pop(@lines);

   }

   if (! @lines) {

      warn "[_do_mods_tzdata] empty zone [$zone]\n";

      return;

   }

   # Check the format of every line

   my $err = _do_mods_tzdata_check($zone,@lines);

   return  if ($err);

   _do_mods_tzdata_mod($tzd,$abbrev,$data,$zone,$module,@lines);

}

# This checks every line in a zdump file to make sure it is the

# correct format.

#

sub _do_mods_tzdata_check {

   my($zone,@lines) = @_;

   my($dow)  = '(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)';

   my($mon)  = '(?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)';

   my($dom)  = '(?:\d+)';

   my($time) = '(?:\d\d:\d\d:\d\d)';

   my($year) = '(?:\d\d\d\d)';

   my($drx)  = qr/$dow\s+$mon\s+$dom\s+$time\s+$year/;

   my($rx)   = qr/\Q$zone\E\s+$drx\s+UT\s+=\s+$drx\s+\S+\s+isdst=[01]\s+gmtoff=\-?\d+$/;

   my($err)  = 0;

   foreach my $line (@lines) {

      if ($line !~ /$rx/) {

         warn "[_do_mods_tzdata] invalid line [$zone]\n   $line\n";

         $err = 1;

      }

   }

   return $err;

}

sub _do_mods_tzdata_mod {

   my($tzd,$abbrev,$data,$zone,$module,@lines) = @_;

   ###

   ### Analyze the dump file and store information about all

   ### time zone periods in a list. A time zone period is a

   ### starting time and ending time during which the abbreviation,

   ### offset, and ISDST values remain unchanged.

   ###

   ### The first line in the dump file defines when the pre-use

   ### period (i.e. the period of time before the time zone was

   ### actually defined) ended.

   ###

   ### After the first line, all lines (except the last one) appear as

   ### pairs. The first one tells the time when a new time zone period

   ### starts (which should be exactly 1 second after the previous

   ### period ended) and the second line tells when the period ends.

   ###

   ### The last line defines the start of a new period that doesn't

   ### have an end defined. If the year is after $keep_year, then

   ### the period switches to LASTRULE handline. If it is before

   ### $keep_year, then the time zone stopped doing DST changes and

   ### stay in the same period for good.

   ###

   #

   # Parse the first dump line to determine the end of the

   # pre-zone period.

   #

   my @dates;

   my $last = 1;   # Whether or not to do LAST RULE

   my ($year,$year2);

   my $line = shift(@lines);

   my($dowU,$monU,$domU,$timeU,$yearU,$dowL,$monL,$domL,$timeL,$yearL,

      $abb,$isdst) = _do_mods_splitdump($line);

   if ($isdst) {

      warn "[_do_mods_tzdata] first line in DST [$zone]\n";

      return 1;

   }

   #

   # Calculate the offset of the pre-zone period.

   #

   my @endUT    = ($yearU,$monU,$domU,@{ $dmb->split("time",$timeU) });

   my @endLT    = ($yearL,$monL,$domL,@{ $dmb->split("time",$timeL) });

   my @offset   = @{ $dmb->calc_date_date(\@endUT,\@endLT) };

   my $offset   = $dmb->join("offset",\@offset);

   if ($offset eq ""  ||

       $abb    eq ""  ||

       $isdst  eq "") {

      warn "[_do_mods_tzdata] blank value in zone [$zone, @endUT]\n";

      return 1;

   }

   #

   # The pre-zone period starts on Jan 2 0001 at 00:00:00 and

   # ends at the time from the first dump line.

   #

   my @begUT    = @{ $dmb->split("date",$first_date) };

   my @begLT    = @{ $dmb->calc_date_time(\@begUT,\@offset) };

   @dates       = ("0001",[@begUT],[@begLT],$offset,[@offset],

                   $abb,$isdst,[@endUT],[@endLT]);

   $year2       = $endUT[0];

   _do_mods_years($abbrev,$zone,$abb,"0001",$year2)  if ($abb !~ /^[+-]?\d*$/);

   $$data{$zone}{"0001"} = [ '', [$abb,$offset,$isdst] ];

   #

   # Parse every pair of dump lines.

   #

   while (@lines) {

      #

      # The first line is the start of the period

      #

      $line     = shift(@lines);

      ($dowU,$monU,$domU,$timeU,$yearU,$dowL,$monL,$domL,$timeL,$yearL,

       $abb,$isdst) = _do_mods_splitdump($line);

      $year     = $yearU;

      @begUT    = ($yearU,$monU,$domU,@{ $dmb->split("time",$timeU) });

      @begLT    = ($yearL,$monL,$domL,@{ $dmb->split("time",$timeL) });

      my @tmp   = @{ $dmb->calc_date_time(\@endUT,[0,0,1]) };

      if ($dmb->cmp(\@tmp,\@begUT) != 0) {

         warn "[_do_mods_tzdata] invalid start in zone [$zone, @begUT]\n";

         return 1;

      }

      @offset   = @{ $dmb->calc_date_date(\@begUT,\@begLT) };

      $offset   = $dmb->join("offset",\@offset);

      if ($offset eq ""  ||

          $abb    eq ""  ||

          $isdst  eq "") {

         warn "[_do_mods_tzdata] blank value in zone [$zone, @begUT]\n";

         return 1;

      }

      #

      # If a second line exists, it is the end of the period.

      #

      # If no second line exists, then either we need to switch to

      # LAST RULE behavior (if the year of the first line is after

      # $keep_year), or the zone abandoned doing daylight savings

      # time and this line reflects the time until 9999.

      #

      if (@lines) {

         # A second line marks the end of the period

         my ($a,$i);

         $line     = shift(@lines);

         ($dowU,$monU,$domU,$timeU,$yearU,$dowL,$monL,$domL,$timeL,$yearL,

          $a,$i)   = _do_mods_splitdump($line);

         @endUT    = ($yearU,$monU,$domU,@{ $dmb->split("time",$timeU) });

         @endLT    = ($yearL,$monL,$domL,@{ $dmb->split("time",$timeL) });

         my @o     = @{ $dmb->calc_date_date(\@endUT,\@endLT) };

         my $o     = $dmb->join("offset",\@o);

         if ($o  eq ""  ||

             $a  eq ""  ||

             $i  eq "") {

            warn "[_do_mods_tzdata] blank value in zone [$zone, @endUT]\n";

            return 1;

         }

         if ($o ne $offset  ||

             $a ne $abb     ||

             $i ne $isdst) {

            warn "[_do_mods_tzdata] invalid value in zone [$zone, @endUT]\n";

            return 1;

         }

      } elsif ($year > $keep_year  &&

               ! exists $no_last{$zone}) {

         # If it's a single line after $keep_year, then it's the start

         # of a regular LAST RULE style time change. Discard it... we'll

         # use the LAST RULE to come up with those periods.

         last;

      } else {

         # A single line before $keep_year means that the time zone

         # stopped doing DST stuff, and switched to a single offset.

         # There is no LAST RULE in this case.

         #

         # This will also apply to zones which do not use the LAST

         # RULE method.

         @endUT    = @{ $dmb->split("date",$last_date) };

         @endLT    = @{ $dmb->calc_date_time(\@endUT,\@offset) };

         $last     = 0;

      }

      # Now store the data for this time zone period

      push(@dates,$year,[@begUT],[@begLT],$offset,[@offset],$abb,$isdst,[@endUT],[@endLT]);

      $year2 = $endUT[0];

      if (exists $$data{$zone}{$year}) {

         push(@{ $$data{$zone}{$year} },[$abb,$offset,$isdst]);

      } else {

         $$data{$zone}{$year} = [ '', [$abb,$offset,$isdst] ];

      }

      _do_mods_years($abbrev,$zone,$abb,$year,$year2)  if ($abb !~ /^[+-]?\d*$/);

   }

   ###

   ### Now we'll analyze all the critical dates. Three different things

   ### will occur:

   ###

   ### 1) For years < $keep_year, the data will simply get stored in

   ###    the module.

   ### 2) For year = $keep_year, the data will be stored in the module

   ###    and used to determine how LAST RULE critical dates are

   ###    determined.

   ### 3) For year > $keep_year, critical dates will not be stored, but

   ###    will be tested to make sure they are consistant with the methods

   ###    determined in 2). However, this step will be elsewhere. I will

   ###    use a dump script to create actual dumps and compare them to

   ###    the standard tzcode dump.

   ###

   my @mod;                # data to store in the module

   my %last;               # LAST RULE description

   my @mon;

   if ($last) {

      %last    = _do_mods_lastrule($tzd,$zone);

      @mon     = sort keys %{ $last{"rules"} };

   }

   foreach my $mon (@mon) {

      if ($mon == 1  ||  $mon == 12) {

         # If a change ever happens in Jan/Dec in the LAST RULE, we

         # may need to make sure that the year won't change (it would

         # be horrible if it did).

         warn "[_do_mods_tzdata] LAST RULE in Jan/Dec [$zone, $mon]\n";

      }

   }

   my $didlast = 0;

   my($begUT,$begLT,$endUT,$endLT,$offsetref);

   while (@dates) {

      ($year,$begUT,$begLT,$offset,$offsetref,$abb,$isdst,$endUT,$endLT,@dates) = @dates;

      @offset = @$offsetref;

      if      ($year <= $keep_year  ||  ! $last) {

         #

         # Store critical dates from dump files for years <= $keep_year

         #

         push(@mod,$year,$begUT,$begLT,$offset,$offsetref,$abb,$isdst,$endUT,$endLT);

         if ($year == $keep_year  &&  $last) {

            my $mon                        = shift(@mon);

            return 1  if (! $mon);

            if ($isdst != $last{"rules"}{$mon}{"isdst"}) {

               warn "[_do_mods_tzdata] isdst mismatch in LAST RULE " .

                 "[$zone, $mon]\n";

               return 1;

            }

            if ($offset ne

                $last{"zone"}{ ($isdst ? "dstoff" : "stdoff") }) {

               warn "[_do_mods_tzdata] offset mismatch in LAST RULE " .

                 "[$zone, $mon]\n";

               return 1;

            }

            $last{"rules"}{$mon}{"abb"}    = $abb;

            _do_mods_years($abbrev,$zone,$abb,$keep_year+1,9999)

              if ($abb !~ /^[+-]?\d*$/);

            $didlast++;

         }

      }

   }

   if ($last  &&  $didlast != 2) {

      warn "[_do_mods_tzdata] LAST RULE incomplete [$zone]\n";

      return 1;

   }

   _do_mods_write($zone,$module,[@mod],%last);

}

# This returns a hash of information concerning "last rules". This

# information will allow us to calculate critical dates in future

# years.

#

# Information consists of:

#    flag,dow,num     : See TZdata.pm (used to calculate a DoM)

#    add              : Some of the DoM calculations do not

#                       return the final DoM after offsets have

#                       been applied. If this is +1, it'll add

#                       a day. If it's -1, it'll subtract a day.

#    time,abb,offset  : Information that should be constant.

#    dst              : Whether it is a change to DST or not.

#

sub _do_mods_lastrule {

   my($tzd,$zone) = @_;

   # Get the rule dates that apply to $keep_year

   my @rules = $tzd->_zoneInfo($zone,"rules",$keep_year);

   my @r;

   while (@rules) {

      my $rule = shift(@rules);

      my $type = shift(@rules);

      # All LAST RULES are currently of type TZ_RULE . If this

      # ever changes, we'll have to add support.

      if ($type != $Date::Manip::TZdata::TZ_RULE) {

         warn "[_do_mods_lastrule] unsupported rule type [$zone]\n";

         return "";

      }

      push(@r,$tzd->_ruleInfo($rule,"rules",$keep_year));

   }

   # Make sure that there are exactly two rules. If there are

   # not, we'll need to add support.

   if ($#r != 1) {

      warn "[_do_mods_lastrule] two rules required [$zone]\n";

      return "";

   }

   # Also get the zone line that applies. There must be one or

   # we'll need to add support.

   my @zone = $tzd->_zoneInfo($zone,"zonelines",$keep_year);

   if ($#zone != 0) {

      warn "[_do_mods_lastrule] one zone line required [$zone]\n";

      return "";

   }