use strict;
use lib './lib';
use Data::Dumper;
use DateTime::TimeZone::OlsonDB;
use File::Copy;
use File::Find::Rule;
use File::Path;
use File::Spec;
use Getopt::Long;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Terse = 1;
my $VERSION = "0.07";
my $INFINITY = 100 ** 100 ** 100;
my %opts;
GetOptions( 'dir:s' => \$opts{dir},
'clean' => \$opts{clean},
'version:s' => \$opts{version},
'old' => \$opts{old},
'file:s' => \$opts{file},
'name:s' => \$opts{name},
'help' => \$opts{help},
);
$opts{help} = 1
unless defined $opts{dir} && -d $opts{dir};
$opts{help} = 1
unless defined $opts{version} || $opts{file} || $opts{name};
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 MANIFEST and 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
backward. All other files are ignored.
It takes the following arguments:
--dir A directory containing Olson db files.
--version The version of the Olson data files being used.
Required unless one of the debugging options is given.
--clean Remove old generated modules (which may not be valid with
the latest Olson database)
--file Parse just the file with the given name. For debugging.
--name Only create the specified time zone. For debugging.
--old Also look for files named etcetera, factory, and systemv
--help What you are reading
If the --file or --name options are specified, the MANIFEST and
DateTime::TimeZoneCatalog files will not be generated.
EOF
exit;
}
clean() if $opts{clean};
my @files;
if ( $opts{file} )
{
@files = $opts{file};
}
else
{
@files = qw( africa antarctica asia australasia
europe northamerica pacificnew
southamerica backward
);
push @files, qw( etcetera factory systemv )
if $opts{old};
}
unless ( $opts{name} || $opts{file} )
{
copy( 'MANIFEST.base', 'MANIFEST' );
open MAN, ">>MANIFEST" or die "Cannot write to MANIFEST: $!";
}
my ( @zones, %categories, %links );
my $autogen_warning = <<"EOF";
EOF
foreach my $f ( sort @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);
%links = ( %links, $odb->links );
foreach my $zone_name ( sort $odb->zone_names )
{
if ( $opts{name} )
{
next unless $zone_name eq $opts{name};
}
print " creating zone $zone_name\n";
push @zones, $zone_name;
my $name;
my @dir;
if ( $zone_name =~ m{/} )
{
my $category;
( $category, $name ) = split /\//, $zone_name, 2;
push @{ $categories{$category} }, $name;
($dir[0] = $category) =~ tr/-/_/;
}
else
{
$name = $zone_name;
}
(my $outfile1 = $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 = serialize_spans(zone_as_spans($zone));
$spans =~ s/-inf/DateTime::TimeZone::NEG_INFINITY/g;
$spans =~ s/inf/DateTime::TimeZone::INFINITY/g;
$spans =~ s/('(?:start|end)_date'\s+=>\s+)'(\d+)'/$1$2/g;
my $generator = zone_generator($zone);
my $has_dst_changes = grep { $_->is_dst } $zone->sorted_changes;
my $from = "Generated from $file.";
$from .= " Olson data version $opts{version}"
if defined $opts{version};
my $body = <<"EOF";
$autogen_warning
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;
sub has_dst_changes { $has_dst_changes }
sub _max_year { $max_year }
sub _new_instance
{
return shift->_init( \@_, spans => \$spans );
}
$generator
1;
EOF
my @name_pieces = split /\//, $outfile1;
my $filename = (pop @name_pieces) . '.pm';
my $outdir = File::Spec->catdir( qw( lib DateTime TimeZone ),
@dir, @name_pieces );
mkpath( $outdir, 1, 0755 );
my $outfile2 = File::Spec->catfile( $outdir, $filename );
open OUT,">$outfile2" or die "Cannot write to $outfile2: $!";
print OUT $body or die "Cannot write to $outfile2: $!";
close (OUT) or die "Cannot write to $outfile2: $!";
unless ( $opts{name} || $opts{file} )
{
print MAN "$outfile2\n" or die "Cannot write to MANIFEST: $!"
}
}
}
exit if $opts{name};
%links =
( %links,
'Etc/GMT+0' => 'UTC',
'Etc/Universal' => 'UTC',
'Etc/Zulu' => 'UTC',
'Etc/UCT' => 'UTC',
'GMT0' => 'UTC',
'GMT' => 'UTC',
);
delete $links{UTC};
delete $links{EST};
delete $links{MST};
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";
$autogen_warning
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 links { wantarray ? %DateTime::TimeZone::LINKS : { %DateTime::TimeZone::LINKS } }
sub names_in_category
{
shift if \$_[0]->isa('DateTime::TimeZone');
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 or die $!;
close OUT2 or die $!;
sub clean
{
for my $f ( File::Find::Rule
->file
->name('*.pm')
->grep('This file is auto-generated' )
->in('lib')
)
{
unlink $f or die "Cannot unlink $f: $!";
}
}
sub zone_as_spans
{
my $zone = shift;
my @spans;
my @changes = $zone->sorted_changes;
for ( my $x = 1; $x < @changes; $x++ )
{
my $last_total_offset = $x > 1 ? $changes[ $x - 2 ]->total_offset : undef;
my $span =
DateTime::TimeZone::OlsonDB::Change::two_changes_as_span
( @changes[ $x - 1, $x ], $last_total_offset );
push @spans, $span;
if (@spans > 2)
{
die "Gap in UTC end/start datetime for " . $zone->name
unless $spans[-2]{utc_end} == $spans[-1]{utc_start};
}
}
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->total_offset,
local_end => $INFINITY,
short_name => sprintf( $last_observance->format, '' ),
offset => $last_observance->total_offset,
is_dst => 0,
};
}
return \@spans;
}
sub serialize_spans
{
my $spans = shift;
my $string = "[\n";
$string .= join "\n", map { serialize_span($_) } @$spans;
$string .= "\n]";
return $string;
}
sub serialize_span
{
my $span = shift;
my @keys = qw( utc_start utc_end local_start local_end offset is_dst );
my $string = " [\n";
$string .= join ",\n", @$span{@keys};
$string .= ",\n'$span->{short_name}'";
$string .= "\n ],";
return $string;
}
sub zone_generator
{
my $zone = shift;
return '' unless $zone->infinite_rules;
my $generator = <<'EOF';
sub _last_offset { !OFFSET }
my $last_observance = !LAST_OBSERVANCE;
sub _last_observance { $last_observance }
my $rules = !RULES;
sub _rules { $rules }
EOF
my $last_observance = ($zone->sorted_changes)[-1]->observance;
delete $last_observance->{utc_start_datetime}{locale};
delete $last_observance->{local_start_datetime}{locale};
delete $last_observance->{utc_start_datetime}{local_c};
delete $last_observance->{local_start_datetime}{local_c};
delete $last_observance->{rules};
delete $last_observance->{first_rule};
my $offset = $last_observance->total_offset;
my @rules = $zone->infinite_rules;
$generator =~ s/!RULES/Dumper \@rules/eg;
$generator =~ s/!LAST_OBSERVANCE/Dumper $last_observance/eg;
$generator =~
s/\$VAR1->{'local_start_datetime'}{'tz'}/bless( {
'name' => 'floating',
'offset' => 0
}, 'DateTime::TimeZone::Floating' )/;
$generator =~
s/\$VAR1->{'utc_start_datetime'}{'tz'}/bless( {
'name' => 'floating',
'offset' => 0
}, 'DateTime::TimeZone::Floating' )/;
$generator =~ s/!OFFSET/$offset/g;
return $generator;
}