olsondb.pm

网页留言本,比一般的留言簿管用

package DateTime::TimeZone::OlsonDB;

use strict;

use vars qw( %MONTHS %DAYS $PLUS_ONE_DAY_DUR $MINUS_ONE_DAY_DUR );

use Params::Validate qw( validate SCALAR );

sub DEBUG () { 0 }

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

$x = 1;
%DAYS = map { $_ => $x++ }
        qw( Mon Tue Wed Thu Fri Sat Sun );

$PLUS_ONE_DAY_DUR =  DateTime::Duration->new( days => 1 );
$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($_);
    }
}

sub _parse_line
{
    my $self = shift;
    my $line = shift;

    return if $line =~ /^\s+$/;
    return if $line =~ /^#/;

    # remove any comments at the end of the 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 '-';

    # As of the 2003a data, there are no rules with a type set
    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; # remove "Zone"
        $name = shift @items;
    }

    return if $name =~ /[WCME]ET/ && ! $self->{backwards_compat};

    @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 = validate( @_, { name => { type => SCALAR },
                            expand_to_year => { type => SCALAR,
                                                default => (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 $day if $day =~ /^\d+$/;

    if ( $day =~ /^last(\w\w\w)$/ )
    {
        my $dow = $DateTime::TimeZone::OlsonDB::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->day;
    }
    elsif ( $day =~ /^(\w\w\w)([><])=(\d\d?)$/ )
    {
        my $dow = $DateTime::TimeZone::OlsonDB::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->day;
    }
    else
    {
        die "Invalid on spec for rule: $day\n";
    }
}

sub utc_datetime_for_time_spec
{
    my %p = validate( @_, { spec  => { type => SCALAR },
                            year  => { type => SCALAR },
                            month => { type => SCALAR },
                            day   => { type => SCALAR },
                            offset_from_utc => { type => SCALAR },
                            offset_from_std => { type => SCALAR },
                          },
                    );

    # 'w'all - ignore it, because that's the default
    $p{spec} =~ s/w$//;

    # 'g'reenwich, 'u'tc, or 'z'ulu
    my $is_utc = $p{spec} =~ s/[guz]$//;

    # 's'tandard time - ignore DS offset
    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 = 0;
        $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;
}


package DateTime::TimeZone::OlsonDB::Zone;

use strict;

use DateTime::TimeZone;

use Params::Validate qw( validate SCALAR ARRAYREF );

sub new
{
    my $class = shift;
    my %p = validate( @_, { name => { type => SCALAR },
                            observances => { type => ARRAYREF },
                            olson_db => 1,
                          }
                    );

    my $self = { name => $p{name},
                 observances => $p{observances},
                 changes => [],
                 infinite_rules => {},
               };

    return bless $self, $class;
}

sub name { $_[0]->{name} }

sub expand_observances
{
    my $self = shift;
    my $odb = shift;
    my $max_year = shift;

    my $prev_until;
    for ( my $x = 0; $x < @{ $self->{observances} }; $x++ )
    {
        my %p = %{ $self->{observances}[$x] };
        my $rules_name = delete $p{rules};

        my $last_offset_from_std =
            $self->last_change ? $self->last_change->offset_from_std : 0;
        my $last_offset_from_utc =
            $self->last_change ? $self->last_change->offset_from_utc : 0;

        my $obs =
            DateTime::TimeZone::OlsonDB::Observance->new
                ( %p,
                  utc_start_datetime => $prev_until,
                  rules => [ $odb->rules_by_name($rules_name) ],
                  last_offset_from_utc => $last_offset_from_utc,
                  last_offset_from_std => $last_offset_from_std,
                );

        my $rule = $obs->first_rule;
        my $letter = $rule ? $rule->letter : '';

        my $change =
            DateTime::TimeZone::OlsonDB::Change->new
                ( type => 'observance',
                  utc_start_datetime   => $obs->utc_start_datetime,
                  local_start_datetime => $obs->local_start_datetime,
                  short_name => sprintf( $obs->format, $letter ),
                  observance => $obs,
                  $rule ? ( rule => $rule ) : (),
                );

        if (DateTime::TimeZone::OlsonDB::DEBUG)
        {
            warn "Adding observance change ...\n";

            $change->_debug_output;
        }

        $self->add_change($change);

        if ( $obs->rules )
        {
            $obs->expand_from_rules( $self, $max_year );
        }

        $prev_until =
            $obs->until( $self->last_change ? $self->last_change->offset_from_std : 0 );

        # last observance
        if ( $x == $#{ $self->{observances} } )
        {
            foreach my $rule ( $obs->rules )
            {
                if ( $rule->is_infinite )
                {
                    $self->add_infinite_rule($rule);
                }
            }
        }
    }
}

sub add_change
{
    my $self = shift;
    my $change = shift;

    if ( defined $change->utc_start_datetime )
    {
        if ( @{ $self->{changes} }
             && $self->{changes}[-1]->utc_start_datetime
             && $self->{changes}[-1]->utc_start_datetime == $change->utc_start_datetime
           )
        {
            die "Cannot add two different changes that have the same UTC start datetime!\n";
        }

        my $last_change = $self->last_change;

        if ( $last_change->short_name eq $change->short_name
             && $last_change->total_offset == $change->total_offset
             && $last_change->is_dst == $change->is_dst
             && $last_change->observance eq $change->observance
           )
        {
            my $last_rule = $last_change->rule || '';
            my $new_rule = $change->rule || '';

            if ( $last_rule eq $new_rule )
            {
                warn "Skipping identical change\n" if DateTime::TimeZone::OlsonDB::DEBUG;

                return;
            }
        }

        push @{ $self->{changes} }, $change;
    }
    else
    {
        if ( $self->{earliest} )
        {
            die "There can only be one earliest time zone change!";
        }
        else
        {
            $self->{earliest} = $change;
        }
    }
}

sub add_infinite_rule
{
    $_[0]->{infinite_rules}{ $_[1] } = $_[1];
}

sub last_change { return unless @{ $_[0]->{changes} } || $_[0]->{earliest};
                  return ( @{ $_[0]->{changes} } ?
                           $_[0]->{changes}[-1] :
                           $_[0]->{earliest} ); }

sub sorted_changes { ( ( defined $_[0]->{earliest} ? $_[0]->{earliest} : () ),
                       sort { $a->utc_start_datetime <=> $b->utc_start_datetime }
                       @{ $_[0]->{changes} } ) }

sub infinite_rules { values %{ $_[0]->{infinite_rules} } }


package DateTime::TimeZone::OlsonDB::Observance;

use strict;

use DateTime;

use Params::Validate qw( validate SCALAR ARRAYREF UNDEF OBJECT );

sub new
{
    my $class = shift;
    my %p = validate( @_, { gmtoff => { type => SCALAR },
                            rules  => { type => ARRAYREF },
                            format => { type => SCALAR },
                            until  => { type => SCALAR, default => '' },
                            utc_start_datetime => { type => OBJECT | UNDEF },
                            offset_from_std => { type => SCALAR, default => 0 },
                            last_offset_from_utc => { type => SCALAR, default => 0 },
                            last_offset_from_std => { type => SCALAR, default => 0 },
                          }
                    );

    my $offset_from_utc = DateTime::TimeZone::offset_as_seconds( $p{gmtoff} );
    my $offset_from_std = DateTime::TimeZone::offset_as_seconds( $p{offset_from_std} );

    my $last_offset_from_utc = delete $p{last_offset_from_utc};
    my $last_offset_from_std = delete $p{last_offset_from_std};

    my $self = bless { %p,
                       offset_from_utc => $offset_from_utc,
                       offset_from_std => $offset_from_std,
                       until => [ split /\s+/, $p{until} ],
                     }, $class;

    my $local_start_datetime;
    if ( $p{utc_start_datetime} )
    {
        $self->{first_rule} =
            $self->_first_rule( $last_offset_from_utc, $last_offset_from_std );

        $offset_from_std += $self->{first_rule}->offset_from_std if $self->{first_rule};

        $local_start_datetime = $p{utc_start_datetime}->clone;

        $local_start_datetime +=
            DateTime::Duration->new( seconds => $offset_from_utc + $offset_from_std );

        $self->{local_start_datetime} = $local_start_datetime;
    }