#!/usr/bin/perl -w

use strict;

use lib './lib';

use Data::Dumper;
use DateTime::TimeZone::OlsonDB;
use File::Copy;
use File::Find;
use File::Path;
use File::Spec;
use Getopt::Long;

$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 1;

my $VERSION = "0.02";

my $INFINITY  = 10 ** 10 ** 10;

my %opts;
GetOptions( 'dir:s' => \$opts{dir},
            'old'   => \$opts{old},
            'help'  => \$opts{help},
          );


$opts{help} = 1
    unless defined $opts{dir} && -d $opts{dir};
if ( $opts{help} )
{
    print <<'EOF';

This script parses the Olson time zone database files and turns them
into a set of Perl modules.  It also generates the
DateTime::TimeZoneCatalog module, which contains a list of all the
available time zone names.

By default, it looks for files named africa, antarctica, asia,
australasia, europe, northamerica, pacificnew, southamerica, and
ignores any others.

It takes the following arguments:

  --dir   A directory containing Olson db files.

  --old   Also look for files named backward, etcetera, factory, and systemv

  --help  What you are reading

EOF

    exit;
}

my @files = qw( africa antarctica asia australasia
                europe northamerica pacificnew
                southamerica
              );

push @files, qw( backward etcetera factory systemv )
    if $opts{old};

copy( 'MANIFEST.base', 'MANIFEST' );
open MAN, ">>MANIFEST";

my ( @zones, %categories, @links );
foreach my $f (@files)
{
    my $file = File::Spec->catfile( $opts{dir}, $f );

    die "No such file $file\n" unless -e $file;

    print "Now parsing $file\n";

    my $odb = DateTime::TimeZone::OlsonDB->new;

    $odb->parse_file($file);

    push @links, $odb->links;

    foreach my $zone_name ( $odb->zone_names )
    {
        push @zones, $zone_name;

        my ($category, $name) = split /\//, $zone_name, 2;
        push @{ $categories{$category} }, $name;

        (my $dir = $category) =~ tr/-/_/;
        (my $file = $name) =~ tr/-/_/;

        (my $mod_name = $zone_name) =~ s/\//::/g;
        $mod_name =~ tr/-/_/;

        my $max_year = (localtime)[5] + 1910;
        my $zone = $odb->expanded_zone( name => $zone_name,
                                        expand_to_year => $max_year,
                                      );

        my $spans = Dumper zone_as_data($zone);

        $spans =~ s/'inf'/DateTime::TimeZone::INFINITY/g;
        $spans =~ s/'-inf'/DateTime::TimeZone::NEG_INFINITY/g;

        $spans =~ s/('(?:start|end)_date'\s+=>\s+)'(\d+)'/$1$2/g;

        my $generator = zone_generator($zone);

        my $body = <<"EOF";
# This file is auto-generated by the Perl DateTime Suite time zone
# code generator ($VERSION) This code generator comes with the
# DateTime::TimeZone module distribution in the tools/ directory
#
# Generated from $file.
#
# Do not edit this file directly.
#
package DateTime::TimeZone::$mod_name;

use strict;

use Class::Singleton;
use DateTime::TimeZone;
use DateTime::TimeZone::OlsonDB;

\@DateTime::TimeZone::${mod_name}::ISA = ( 'Class::Singleton', 'DateTime::TimeZone' );

my \$spans =
$spans;

my \$max_year = $max_year;

sub _new_instance
{
    return shift->_init( \@_, spans => \$spans );
}

$generator

1;

EOF

        my @name_pieces = split /\//, $file;
        my $filename = (pop @name_pieces) . '.pm';

        my $outdir = File::Spec->catdir( qw( lib DateTime TimeZone ),
                                         $dir, @name_pieces  );

        mkpath( $outdir, 1, 0755 );

        my $outfile = File::Spec->catfile( $outdir, $filename );

        open OUT,">$outfile" or die "Cannot write to $outfile: $!";
        print OUT $body;
        close (OUT);

        print MAN "$outfile\n";
    }
}

my $links = Dumper { @links };
$links =~ s/{/(/;
$links =~ s/}/)/;


my $zones = join "\n", map { "  $_" } sort @zones;
my $cat_names = join "\n", map { "  $_" } sort keys %categories;
my $cat = '';
foreach my $c ( sort keys %categories )
{
    $cat .= "'$c' => [ qw(\n";
    $cat .= join "\n", map { "  $_" } sort @{ $categories{$c} };
    $cat .= "\n) ],\n";
}
my $zonecatalog = <<"EOF";
# This file is auto-generated by the Perl DateTime Suite VTIMEZONE
# parser ($VERSION).
#
# Do not edit this file directly.

package DateTime::TimeZone;

use strict;

\@DateTime::TimeZone::ALL =
qw(
$zones
);

\@DateTime::TimeZone::CATEGORY_NAMES =
qw(
$cat_names
);

\%DateTime::TimeZone::CATEGORIES =
(
$cat
);

\%DateTime::TimeZone::Links =
$links
;

sub all_names { wantarray ? \@DateTime::TimeZone::ALL : \\\@DateTime::TimeZone::ALL }
sub categories { wantarray ? \@DateTime::TimeZone::CATEGORY_NAMES : \\\@DateTime::TimeZone::CATEGORY_NAMES }

sub names_in_category
{
    return unless exists \$DateTime::TimeZone::CATEGORIES{ \$_[0] };

    return wantarray ? \@{ \$DateTime::TimeZone::CATEGORIES{ \$_[0] } } : \$DateTime::TimeZone::CATEGORIES{ \$_[0] };
}

1;

__END__

=head1 NAME

DateTime::TimeZoneCatalog - Provides a list of all valid time zone names

=head1 SYNOPSIS

See DateTime::TimeZone for usage details.

=head1 DESCRIPTION

This module contains an enumerated list of all known system timezones,
so that applications can easily present a list of timezones.

=cut

EOF

open OUT2, ">lib/DateTime/TimeZoneCatalog.pm" or die $!;
print OUT2 $zonecatalog;
close OUT2;

sub zone_as_data
{
    my $zone = shift;

    my @spans;

    my @changes = $zone->sorted_changes;

    for ( my $x = 1; $x < @changes; $x++ )
    {
        my $last_offset = $x > 1 ? $changes[ $x - 2 ]->offset : undef;

        push @spans,
            DateTime::TimeZone::OlsonDB::Change::two_changes_as_span
                ( @changes[ $x - 1, $x ], $last_offset );
    }

    unless ( $zone->infinite_rules )
    {
        my $last_observance = $changes[-1]->observance;

        my $utc_start =
            @spans ? $spans[-1]{utc_end} : -1 * $INFINITY;

        push @spans, { utc_start   => $utc_start,
                       utc_end     => $INFINITY,
                       local_start => $utc_start - $last_observance->offset,
                       local_end   => $INFINITY,
                       short_name  => sprintf( $last_observance->format, '' ),
                       offset      => $last_observance->offset,
                     };
    }

    return \@spans;
}

sub zone_generator
{
    my $zone = shift;

    return '' unless $zone->infinite_rules;

    my $generator = <<'EOF';
my $rules = !RULES;
my $last_observance = !LAST_OBSERVANCE;

sub _generate_spans_until_match
{
    my $self = shift;
    my $dt = shift;

    my $generate_until_year = $dt->utc_year + 1;

    my @changes;
    foreach my $rule (@$rules)
    {
        foreach my $year ( $max_year .. $generate_until_year )
        {
            my $next = $rule->date_for_year( $year, !OFFSET );

            # don't bother with changes we've seen already
            next if $next->{utc}->utc_rd_as_seconds < $self->{max_span}{utc_end};

            push @changes,
                DateTime::TimeZone::OlsonDB::Change->new
                    ( start_date => $next->{local},
                      short_name =>
                      sprintf( $last_observance->format, $rule->letter ),
                      observance => $last_observance,
                      rule       => $rule,
                    );
        }
    }

    $max_year = $generate_until_year;
    my @sorted = sort { $a->start_date <=> $b->start_date } @changes;

    my $seconds = $dt->utc_rd_as_seconds;
    my $match;

    for ( my $x = 1; $x < @sorted; $x++ )
    {
        my $last_offset =
            $x == 1 ? $self->{max_span}{offset} : $changes[ $x - 2 ]->offset;

        my $span =
            DateTime::TimeZone::OlsonDB::Change::two_changes_as_span
                ( @sorted[ $x - 1, $x ], $last_offset );

        push @{ $self->{spans} }, $span;

        $match = $span
            if $seconds >= $span->{utc_start} && $seconds < $span->{utc_end};
    }

    return $match;
}
EOF

    my $last_observance = ($zone->sorted_changes)[-1]->observance;

    # This assumes that there is only one observance from end of
    # changes til end of time, which should be guaranteed by code in
    # OlsonDB module.
    my $offset = $last_observance->offset;

    my @rules = $zone->infinite_rules;

    # This is cleaner than making the above a double-quoted string
    $generator =~ s/!RULES/Dumper \@rules/eg;
    $generator =~ s/!LAST_OBSERVANCE/Dumper $last_observance/eg;
    $generator =~ s/!OFFSET/$offset/g;
    $generator =~ s/!OFFSET/$offset/g;

    return $generator;
}
