local-lib5/lib/perl5/DateTime/TimeZone/OlsonDB/Observance.pm

   1 package DateTime::TimeZone::OlsonDB::Observance;
   2
   3 use strict;
   4 use warnings;
   5
   6 use DateTime::Duration;
   7 use DateTime::TimeZone::OlsonDB;
   8 use DateTime::TimeZone::OlsonDB::Change;
   9
  10 use List::Util qw( first );
  11 use Params::Validate qw( validate SCALAR ARRAYREF UNDEF OBJECT );
  12
  13 sub new
  14 {
  15     my $class = shift;
  16     my %p = validate( @_, { gmtoff => { type => SCALAR },
  17                             rules  => { type => ARRAYREF },
  18                             format => { type => SCALAR },
  19                             until  => { type => SCALAR, default => '' },
  20                             utc_start_datetime => { type => OBJECT | UNDEF },
  21                             offset_from_std => { type => SCALAR, default => 0 },
  22                             last_offset_from_utc => { type => SCALAR, default => 0 },
  23                             last_offset_from_std => { type => SCALAR, default => 0 },
  24                           }
  25                     );
  26
  27     my $offset_from_utc = DateTime::TimeZone::offset_as_seconds( $p{gmtoff} );
  28     my $offset_from_std = DateTime::TimeZone::offset_as_seconds( $p{offset_from_std} );
  29
  30     my $last_offset_from_utc = delete $p{last_offset_from_utc};
  31     my $last_offset_from_std = delete $p{last_offset_from_std};
  32
  33     my $self = bless { %p,
  34                        offset_from_utc => $offset_from_utc,
  35                        offset_from_std => $offset_from_std,
  36                        until => [ split /\s+/, $p{until} ],
  37                      }, $class;
  38
  39     $self->{first_rule} =
  40         $self->_first_rule( $last_offset_from_utc, $last_offset_from_std );
  41
  42     if ( $p{utc_start_datetime} )
  43     {
  44         $offset_from_std += $self->{first_rule}->offset_from_std if $self->{first_rule};
  45
  46         my $local_start_datetime = $p{utc_start_datetime}->clone;
  47
  48         $local_start_datetime +=
  49             DateTime::Duration->new( seconds => $offset_from_utc + $offset_from_std );
  50
  51         $self->{local_start_datetime} = $local_start_datetime;
  52     }
  53
  54     return $self;
  55 }
  56
  57 sub offset_from_utc { $_[0]->{offset_from_utc} }
  58 sub offset_from_std { $_[0]->{offset_from_std} }
  59 sub total_offset { $_[0]->offset_from_utc + $_[0]->offset_from_std }
  60
  61 sub rules { @{ $_[0]->{rules} } }
  62 sub first_rule { $_[0]->{first_rule} }
  63
  64 sub format { $_[0]->{format} }
  65
  66 sub utc_start_datetime   { $_[0]->{utc_start_datetime} }
  67 sub local_start_datetime { $_[0]->{local_start_datetime} }
  68
  69 sub expand_from_rules
  70 {
  71     my $self = shift;
  72     my $zone = shift;
  73     # real max is year + 1 so we include max year
  74     my $max_year = (shift) + 1;
  75
  76     my $min_year;
  77
  78     if ( $self->utc_start_datetime )
  79     {
  80         $min_year = $self->utc_start_datetime->year;
  81     }
  82     else
  83     {
  84         # There is at least one time zone that has an infinite
  85         # observance, but that observance has rules that only start at
  86         # a certain point - Pacific/Chatham
  87
  88         # In this case we just find the earliest rule and start there
  89
  90         $min_year = ( sort { $a <=> $b } map { $_->min_year } $self->rules )[0];
  91     }
  92
  93     my $until = $self->until( $zone->last_change->offset_from_std );
  94     if ($until)
  95     {
  96         $max_year = $until->year;
  97     }
  98     else
  99     {
 100         # Some zones, like Asia/Tehran, have a predefined fixed set of
 101         # rules that go well into the future (2037 for Asia/Tehran)
 102         my $max_rule_year = 0;
 103         foreach my $rule ( $self->rules )
 104         {
 105             $max_rule_year = $rule->max_year
 106                 if $rule->max_year && $rule->max_year > $max_rule_year;
 107         }
 108
 109         $max_year = $max_rule_year if $max_rule_year > $max_year;
 110     }
 111
 112     foreach my $year ( $min_year .. $max_year )
 113     {
 114         my @rules = $self->_sorted_rules_for_year($year);
 115
 116         foreach my $rule (@rules)
 117         {
 118             my $dt =
 119                 $rule->utc_start_datetime_for_year
 120                     ( $year, $self->offset_from_utc, $zone->last_change->offset_from_std );
 121
 122             next if $self->utc_start_datetime && $dt <= $self->utc_start_datetime;
 123
 124             my $until = $self->until( $zone->last_change->offset_from_std );
 125
 126             next if $until && $dt >= $until;
 127
 128             my $change =
 129                 DateTime::TimeZone::OlsonDB::Change->new
 130                     ( type => 'rule',
 131                       utc_start_datetime   => $dt,
 132                       local_start_datetime =>
 133                       $dt +
 134                       DateTime::Duration->new
 135                           ( seconds => $self->total_offset + $rule->offset_from_std ),
 136                       short_name => sprintf( $self->{format}, $rule->letter ),
 137                       observance => $self,
 138                       rule       => $rule,
 139                     );
 140
 141             if ($DateTime::TimeZone::OlsonDB::DEBUG)
 142             {
 143                 print "Adding rule change ...\n";
 144
 145                 $change->_debug_output;
 146             }
 147
 148             $zone->add_change($change);
 149         }
 150     }
 151 }
 152
 153 sub _sorted_rules_for_year
 154 {
 155     my $self = shift;
 156     my $year = shift;
 157
 158     return
 159         ( map { $_->[0] }
 160           sort { $a->[1] <=> $b->[1] }
 161           map { my $dt = $_->utc_start_datetime_for_year( $year, $self->offset_from_utc, 0 );
 162                 [ $_, $dt ] }
 163           grep { $_->min_year <= $year && ( ( ! $_->max_year ) || $_->max_year >= $year ) }
 164           $self->rules
 165         );
 166 }
 167
 168 sub until
 169 {
 170     my $self = shift;
 171     my $offset_from_std = shift || $self->offset_from_std;
 172
 173     return unless defined $self->until_year;
 174
 175     my $utc =
 176         DateTime::TimeZone::OlsonDB::utc_datetime_for_time_spec
 177                 ( spec  => $self->until_time_spec,
 178                   year  => $self->until_year,
 179                   month => $self->until_month,
 180                   day   => $self->until_day,
 181                   offset_from_utc => $self->offset_from_utc,
 182                   offset_from_std => $offset_from_std,
 183                 );
 184
 185     return $utc;
 186 }
 187
 188 sub until_year { $_[0]->{until}[0] }
 189
 190 sub until_month
 191 {
 192     ( defined $_[0]->{until}[1] ?
 193       $DateTime::TimeZone::OlsonDB::MONTHS{ $_[0]->{until}[1] } :
 194       1
 195     );
 196 }
 197
 198 sub until_day
 199 {
 200     ( defined $_[0]->{until}[2]
 201       ? DateTime::TimeZone::OlsonDB::parse_day_spec
 202             ( $_[0]->{until}[2], $_[0]->until_month, $_[0]->until_year )
 203       : 1
 204     );
 205 }
 206
 207 sub until_time_spec
 208 {
 209     defined $_[0]->{until}[3] ? $_[0]->{until}[3] : '00:00:00';
 210 }
 211
 212 sub _first_rule
 213 {
 214     my $self = shift;
 215     my $last_offset_from_utc = shift;
 216     my $last_offset_from_std = shift;
 217
 218     return unless $self->rules;
 219
 220     my $date = $self->utc_start_datetime
 221         or return $self->_first_no_dst_rule;
 222
 223     my @rules = $self->rules;
 224
 225     my %possible_rules;
 226
 227     my $year = $date->year;
 228     foreach my $rule (@rules)
 229     {
 230         # We need to look at what the year _would_ be if we added the
 231         # rule's offset to the UTC date.  Otherwise we can end up with
 232         # a UTC date in year X, and a rule that starts in _local_ year
 233         # X + 1, where that rule really does apply to that UTC date.
 234         my $temp_year =
 235             $date->clone->add
 236                 ( seconds => $self->offset_from_utc + $rule->offset_from_std )->year;
 237
 238         # Save the highest value
 239         $year = $temp_year if $temp_year > $year;
 240
 241         next if $rule->min_year > $temp_year;
 242
 243         $possible_rules{$rule} = $rule;
 244     }
 245
 246     my $earliest_year = $year - 1;
 247     foreach my $rule (@rules)
 248     {
 249         $earliest_year = $rule->min_year
 250             if $rule->min_year < $earliest_year;
 251     }
 252
 253     # figure out what date each rule would start on _if_ that rule
 254     # were applied to this current observance.  this could be a rule
 255     # that started much earlier, but is only now active because of an
 256     # observance switch.  An obnoxious example of this is
 257     # America/Phoenix in 1944, which applies the US rule in April,
 258     # thus (re-)instating the "war time" rule from 1942.  Can you say
 259     # ridiculous crack-smoking stupidity?
 260     my @rule_dates;
 261     foreach my $y ( $earliest_year .. $year )
 262     {
 263       RULE:
 264         foreach my $rule ( values %possible_rules )
 265         {
 266             # skip rules that can't have applied the year before the
 267             # observance started.
 268             if ( $rule->min_year > $y )
 269             {
 270                 print "Skipping rule beginning in ", $rule->min_year, ".  Year is $y.\n"
 271                     if $DateTime::TimeZone::OlsonDB::DEBUG;
 272
 273                 next RULE;
 274             }
 275
 276             if ( $rule->max_year && $rule->max_year < $y )
 277             {
 278                 print "Skipping rule ending in ", $rule->max_year, ".     Year is $y.\n"
 279                     if $DateTime::TimeZone::OlsonDB::DEBUG;
 280
 281                 next RULE;
 282             }
 283
 284             my $rule_start =
 285                 $rule->utc_start_datetime_for_year
 286                     ( $y, $last_offset_from_utc, $last_offset_from_std );
 287
 288             push @rule_dates, [ $rule_start, $rule ];
 289         }
 290     }
 291
 292     @rule_dates = sort { $a->[0] <=> $b->[0] } @rule_dates;
 293
 294     print "Looking for first rule ...\n" if $DateTime::TimeZone::OlsonDB::DEBUG;
 295     print " Observance starts: ", $date->datetime, "\n\n"
 296         if $DateTime::TimeZone::OlsonDB::DEBUG;
 297
 298     # ... look through the rules to see if any are still in
 299     # effect at the beginning of the observance
 300     for ( my $x = 0; $x < @rule_dates; $x++ )
 301     {
 302         my ( $dt, $rule ) = @{ $rule_dates[$x] };
 303         my ( $next_dt, $next_rule ) =
 304             $x < @rule_dates - 1 ? @{ $rule_dates[ $x + 1 ] } : undef;
 305
 306         next if $next_dt && $next_dt < $date;
 307
 308         print " This rule starts:  ", $dt->datetime, "\n"
 309             if $DateTime::TimeZone::OlsonDB::DEBUG;
 310
 311         print " Next rule starts:  ", $next_dt->datetime, "\n"
 312             if $next_dt && $DateTime::TimeZone::OlsonDB::DEBUG;
 313
 314         print " No next rule\n\n"
 315             if ! $next_dt && $DateTime::TimeZone::OlsonDB::DEBUG;
 316
 317         if ( $dt <= $date )
 318         {
 319             if ($next_dt)
 320             {
 321                 return $rule if $date < $next_dt;
 322                 return $next_rule if $date == $next_dt;
 323             }
 324             else
 325             {
 326                 return $rule;
 327             }
 328         }
 329     }
 330
 331     # If this observance has rules, but the rules don't have any
 332     # defined changes until after the observance starts, we get the
 333     # earliest standard time rule and use it. If there is none, shit
 334     # blows up (but this is not the case for any time zones as of
 335     # 2009a). I really, really hate the Olson database a lot of the
 336     # time! Could this be more arbitrary?
 337     my $std_time_rule = $self->_first_no_dst_rule;
 338
 339     die "Cannot find a rule that applies to the observance's date range and cannot find a rule without DST to apply"
 340         unless $std_time_rule;
 341
 342     return $std_time_rule;
 343 }
 344
 345 sub _first_no_dst_rule
 346 {
 347     my $self = shift;
 348
 349     return
 350         first { ! $_->offset_from_std } sort { $a->min_year <=> $b->min_year } $self->rules;
 351 }
 352
 353 1;