#!/usr/bin/perl -w

use strict;

use lib './lib';

use DateTime::TimeZone;
use File::Spec;
use Getopt::Long;

my %opts;
GetOptions(
    'name:s'     => \@{ $opts{name} },
    'zoneinfo:s' => \$opts{zoneinfo},
    'zdump:s'    => \$opts{zdump},
    'verbose'    => \$opts{verbose},
    'help'       => \$opts{help},
);

if ( $opts{help} ) {
    print <<'EOF';

This script uses the zdump utility to generate comprehensive tests for
time zones.

Tests are generated as files in the t/ directory starting with "zd_".

By default, it generates tests for all time zones.

For each time zone name, it checks to see that the zoneinfo directory
has a corresponding file.  This is done because zdump will happily
generate garbage output if given a non-existent time zone name.

Note, if your version of the zoneinfo data is different from that used
to generate the Perl time zone modules then you will almost certainly
end up generating some tests that fail.

It takes the following arguments:

  --name      Only create tests for this zone.
              May be given multiple times.

  --zoneinfo  The location of your zoneinfo directory.
              Defaults to /usr/share/zoneinfo.

  --zdump     Path to zdump binary.  Default is just 'zdump'.

  --verbose   Blab about what it's doing as it does it.

  --help      What you are reading

EOF

    exit;
}

$opts{zoneinfo} ||= '/usr/share/zoneinfo';

die "No zoneinfo directory at $opts{zoneinfo}!\n" unless -d $opts{zoneinfo};

$opts{zdump} ||= 'zdump';

my $x = 1;
my %months = map { $_ => $x++ } qw( Jan Feb Mar Apr May Jun
    Jul Aug Sep Oct Nov Dec);

my @pieces = qw( year month day hour minute second );

my @names
    = @{ $opts{name} } ? @{ $opts{name} } : DateTime::TimeZone::all_names();
foreach my $tz_name (@names) {
    unless ( -e File::Spec->catfile( $opts{zoneinfo}, split /\//, $tz_name ) )
    {
        print "\nNo zoneinfo file for $tz_name - skipping\n"
            if $opts{verbose};
        next;
    }

    print "\nGetting change data for $tz_name\n" if $opts{verbose};

    my @tests;
    my $command = "$opts{zdump} -v $tz_name";
    my @lines   = `$command`;

    die
        qq|Nothing returning from calling "$command".  Did you specify a valid zdump binary?\n|
        unless @lines;

    my $last_short_name = '';
    foreach my $line (@lines) {

        # This seems to happen on 64-bit systems.
        next if $line =~ /= NULL$/;

        my (
            $utc_mon_name, $utc_day, $utc_hour, $utc_min, $utc_sec, $utc_year,
            $loc_mon_name, $loc_day, $loc_hour, $loc_min, $loc_sec, $loc_year,
            $short_name, $is_dst, $offset_from_utc
            )
            = $line =~ m/ ^
                        \w+(?:\/[\w\/-]+)? # zone name
                        \s+
                        \w\w\w        # UTC day name
                        \s+
                        (\w\w\w)      # UTC month name
                        \s+
                        (\d+)         # UTC day of month
                        \s+
                        (\d\d):(\d\d):(\d\d)  # UTC time
                        \s+
                        (\d\d\d\d)    # UTC year
                        \s+
                        (?:UTC|GMT)   # some systems say one, some the other
                        \s+
                        =
                        \s+
                        \w\w\w        # local day name
                        \s+
                        (\w\w\w)      # local month name
                        \s+
                        (\d+)         # local day of month
                        \s+
                        (\d\d):(\d\d):(\d\d)  # local time
                        \s+
                        (\d\d\d\d)    # local year
                        \s+
                        (\w+)         # local short name
                        \s+
                        isdst=(1|0)
                        \s+
                        gmtoff=(-?\d+)
                      /x;

        unless ($1) {
            warn "Can't parse zump output:\n$line\n";
            next;
        }

        # On a 32-bit system, I suspect that this will generate bogus
        # changes at the edges (1901 & 2038), but on my 64-bit system
        # it works for those years.

        # There seems to be a bug (on my system, at least) where the
        # last change zdump generates has the local zone as UTC. For
        # example, see Africa/Cairo, which in 2408 supposedly goes
        # from EEST to UTC.
        if (   $last_short_name
            && $short_name eq 'UTC'
            && $last_short_name ne 'UTC' ) {
            print
                "  skipping $last_short_name -> $short_name change in $loc_year\n"
                if $opts{verbose};
            next;
        }

        my $utc_month = $months{$utc_mon_name};
        my $loc_month = $months{$loc_mon_name};

        # use '1 * ' to make sure everything is treated as numbers,
        push @tests, {
            time_zone => $tz_name,
            utc       => {
                year   => 1 * $utc_year,
                month  => 1 * $utc_month,
                day    => 1 * $utc_day,
                hour   => 1 * $utc_hour,
                minute => 1 * $utc_min,
                second => 1 * $utc_sec,
            },
            local => {
                year   => 1 * $loc_year,
                month  => 1 * $loc_month,
                day    => 1 * $loc_day,
                hour   => 1 * $loc_hour,
                minute => 1 * $loc_min,
                second => 1 * $loc_sec,
            },
            short_name => $short_name,
            is_dst     => 1 * $is_dst,
            offset     => 1 * $offset_from_utc,
            };

        $last_short_name = $short_name;
    }

    unless (@tests) {
        print
            "No change data in time_t range for $tz_name - can't create tests\n"
            if $opts{verbose};
        next;
    }

    local *T;

    ( my $test_file_name = $tz_name ) =~ s,/,-,g;
    my $file = File::Spec->catfile( 't', "zd_$test_file_name.t" );
    open T, ">$file"
        or die "Cannot write to $file: $!";

    print "Creating tests for $tz_name in $file\n" if $opts{verbose};

    my $test_count = scalar @tests * 9;

    print T <<"EOF";
#!/usr/bin/perl -w

use strict;

use DateTime;

use Test::More tests => $test_count;

EOF

    foreach my $t (@tests) {
        my $utc_new = join ', ', map {"$_ => $t->{utc}{$_}"} @pieces;

        # This makes finding tests that fail much easier.
        my $local_datetime = sprintf(
            '%04d-%02d-%02d %02d:%02d:%02d',
            @{ $t->{local} }{qw( year month day hour minute second )}
        );

        print T <<"EOF";
{
    my \$dt = DateTime->new( $utc_new,
                            time_zone => 'UTC',
                           );
    \$dt->set_time_zone( '$t->{time_zone}' );

EOF

        foreach my $p (@pieces) {
            print T <<"EOF";
    is( \$dt->$p, $t->{local}{$p}, 'local $p should be $t->{local}{$p} ($local_datetime)' );
EOF
        }

        print T <<"EOF";

    is( \$dt->is_dst, $t->{is_dst}, 'is_dst should be $t->{is_dst} ($local_datetime)' );
    is( \$dt->offset, $t->{offset}, 'offset should be $t->{offset} ($local_datetime)' );
    is( \$dt->time_zone_short_name, '$t->{short_name}', 'short name should be $t->{short_name} ($local_datetime)' );
}

EOF
    }
}