#!/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;

    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;
        }

        next if $utc_year == 1901 || $loc_year == 1901;
        next if $utc_year == 2038 || $loc_year == 2038;

        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,
                     }
    }

    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)' );

  TODO:
    {
        local \$TODO = 'zdump gives bogus short names for many zones';
        is( \$dt->time_zone_short_name, '$t->{short_name}', 'short name should be $t->{short_name} ($local_datetime)' );
    }
}

EOF
    }
}