our $VERSION = '2.65';
my $x = 1;
our %MONTHS = map { $_ => $x++ } qw( Jan Feb Mar Apr May Jun
Jul Aug Sep Oct Nov Dec);
$MONTHS{April} = $MONTHS{Apr};
$x = 1;
our %DAYS = map { $_ => $x++ } qw( Mon Tue Wed Thu Fri Sat Sun );
our $PLUS_ONE_DAY_DUR = DateTime::Duration->new( days => 1 );
our $MINUS_ONE_DAY_DUR = DateTime::Duration->new( days => -1 );
sub new {
my $class = shift;
return bless {
rules => {},
zones => {},
links => {},
}, $class;
}
sub parse_file {
my $self = shift;
my $file = shift;
open my $fh, '<', $file
or die "Cannot read $file: $!";
while (<$fh>) {
chomp;
$self->_parse_line($_);
}
close $fh or die $!;
}
sub _parse_line {
my $self = shift;
my $line = shift;
return if $line =~ /^\s+$/;
return if $line =~ /^
$line =~ s/\s*
if ( $self->{in_zone} && $line =~ /^[ \t]/ ) {
$self->_parse_zone( $line, $self->{in_zone} );
return;
}
foreach (qw( Rule Zone Link )) {
if ( substr( $line, 0, 4 ) eq $_ ) {
my $m = '_parse_' . lc $_;
$self->$m($line);
}
}
}
sub _parse_rule {
my $self = shift;
my $rule = shift;
my @items = split /\s+/, $rule, 10;
shift @items;
my $name = shift @items;
my %rule;
@rule{qw( from to type in on at save letter )} = @items;
delete $rule{letter} if $rule{letter} eq '-';
delete $rule{type} if $rule{type} eq '-';
push @{ $self->{rules}{$name} },
DateTime::TimeZone::OlsonDB::Rule->new( name => $name, %rule );
undef $self->{in_zone};
}
sub _parse_zone {
my $self = shift;
my $zone = shift;
my $name = shift;
my $expect = $name ? 5 : 6;
my @items = grep { defined && length } split /\s+/, $zone, $expect;
my %obs;
unless ($name) {
shift @items;
$name = shift @items;
}
@obs{qw( gmtoff rules format until )} = @items;
if ( $obs{rules} =~ /\d\d?:\d\d/ ) {
$obs{offset_from_std} = delete $obs{rules};
}
else {
delete $obs{rules} if $obs{rules} eq '-';
}
delete $obs{until} unless defined $obs{until};
push @{ $self->{zones}{$name} }, \%obs;
$self->{in_zone} = $name;
}
sub _parse_link {
my $self = shift;
my $link = shift;
my @items = split /\s+/, $link, 3;
$self->{links}{ $items[2] } = $items[1];
undef $self->{in_zone};
}
sub links { %{ $_[0]->{links} } }
sub zone_names { keys %{ $_[0]->{zones} } }
sub zone {
my $self = shift;
my $name = shift;
die "Invalid zone name $name"
unless exists $self->{zones}{$name};
return DateTime::TimeZone::OlsonDB::Zone->new(
name => $name,
observances => $self->{zones}{$name},
olson_db => $self,
);
}
sub expanded_zone {
my $self = shift;
my %p = @_;
$p{expand_to_year} ||= (localtime)[5] + 1910;
my $zone = $self->zone( $p{name} );
$zone->expand_observances( $self, $p{expand_to_year} );
return $zone;
}
sub rules_by_name {
my $self = shift;
my $name = shift;
return unless defined $name;
die "Invalid rule name $name"
unless exists $self->{rules}{$name};
return @{ $self->{rules}{$name} };
}
sub parse_day_spec {
my ( $day, $month, $year ) = @_;
return ( $month, $day ) if $day =~ /^\d+$/;
if ( $day =~ /^last(\w\w\w)$/ ) {
my $dow = $DAYS{$1};
my $last_day = DateTime->last_day_of_month(
year => $year,
month => $month,
time_zone => 'floating',
);
my $dt = DateTime->new(
year => $year,
month => $month,
day => $last_day->day,
time_zone => 'floating',
);
while ( $dt->day_of_week != $dow ) {
$dt -= $PLUS_ONE_DAY_DUR;
}
return ( $dt->month, $dt->day );
}
elsif ( $day =~ /^(\w\w\w)([><])=(\d\d?)$/ ) {
my $dow = $DAYS{$1};
my $dt = DateTime->new(
year => $year,
month => $month,
day => $3,
time_zone => 'floating',
);
my $dur = $2 eq '<' ? $MINUS_ONE_DAY_DUR : $PLUS_ONE_DAY_DUR;
while ( $dt->day_of_week != $dow ) {
$dt += $dur;
}
return ( $dt->month, $dt->day );
}
else {
die "Invalid on spec for rule: $day\n";
}
}
sub utc_datetime_for_time_spec {
my %p = @_;
$p{spec} =~ s/w$//;
my $is_utc = $p{spec} =~ s/[guz]$//;
my $is_std = $p{spec} =~ s/s$//;
my ( $hour, $minute, $second ) = split /:/, $p{spec};
$minute = 0 unless defined $minute;
$second = 0 unless defined $second;
my $add_day = 0;
if ( $hour >= 24 ) {
$hour = $hour - 24;
$add_day = 1;
}
my $utc;
if ($is_utc) {
$utc = DateTime->new(
year => $p{year},
month => $p{month},
day => $p{day},
hour => $hour,
minute => $minute,
second => $second,
time_zone => 'floating',
);
}
else {
my $local = DateTime->new(
year => $p{year},
month => $p{month},
day => $p{day},
hour => $hour,
minute => $minute,
second => $second,
time_zone => 'floating',
);
$p{offset_from_std} = 0 if $is_std;
my $dur = DateTime::Duration->new(
seconds => $p{offset_from_utc} + $p{offset_from_std} );
$utc = $local - $dur;
}
$utc->add( days => 1 ) if $add_day;
return $utc;
}
1;