File Coverage

blib/lib/Time/Zone/Olson.pm
Criterion Covered Total %
statement 766 825 92.8
branch 198 258 76.7
condition 46 91 50.5
subroutine 109 110 99.0
pod 16 16 100.0
total 1135 1300 87.3


line stmt bran cond sub pod time code
1             package Time::Zone::Olson;
2              
3 3     3   39940 use 5.010;
  3         6  
4 3     3   9 use strict;
  3         3  
  3         43  
5 3     3   7 use warnings;
  3         5  
  3         55  
6              
7 3     3   1176 use FileHandle();
  3         21193  
  3         55  
8 3     3   13 use File::Spec();
  3         3  
  3         82  
9 3     3   10 use Config;
  3         3  
  3         76  
10 3     3   9 use Carp();
  3         3  
  3         40  
11 3     3   1308 use English qw( -no_match_vars );
  3         7905  
  3         12  
12 3     3   1924 use DirHandle();
  3         1047  
  3         43  
13 3     3   1243 use POSIX();
  3         12367  
  3         18480  
14              
15             our $VERSION = '0.11';
16              
17 1948     1948   4924 sub _SIZE_OF_TZ_HEADER { return 44 }
18 1461     1461   2687 sub _SIZE_OF_TRANSITION_TIME_V1 { return 4 }
19 974     974   1481 sub _SIZE_OF_TRANSITION_TIME_V2 { return 8 }
20 974     974   1564 sub _SIZE_OF_TTINFO { return 6 }
21 487     487   1256 sub _SIZE_OF_LEAP_SECOND_V1 { return 4 }
22 487     487   723 sub _SIZE_OF_LEAP_SECOND_V2 { return 8 }
23 974     974   1703 sub _PAIR { return 2 }
24 7175     7175   8377 sub _STAT_MTIME_IDX { return 9 }
25 974     974   1657 sub _MAX_LENGTH_FOR_TRAILING_TZ_DEFINITION { return 256 }
26 108     108   99 sub _MONTHS_IN_ONE_YEAR { return 12 }
27 108     108   93 sub _HOURS_IN_ONE_DAY { return 24 }
28 1106     1106   1719 sub _MINUTES_IN_ONE_HOUR { return 60 }
29 27217     27217   21412 sub _SECONDS_IN_ONE_MINUTE { return 60 }
30 7472     7472   5470 sub _SECONDS_IN_ONE_HOUR { return 3_600 }
31 153197     153197   112474 sub _SECONDS_IN_ONE_DAY { return 86_400 }
32 676     676   620 sub _NEGATIVE_ONE { return -1 }
33 2113     2113   3333 sub _LOCALTIME_ISDST_INDEX { return 8 }
34 26     26   41 sub _LOCALTIME_DAY_OF_WEEK_INDEX { return 6 }
35 36446     36446   38639 sub _LOCALTIME_YEAR_INDEX { return 5 }
36 4607     4607   5746 sub _LOCALTIME_MONTH_INDEX { return 4 }
37 12403     12403   12831 sub _LOCALTIME_DAY_INDEX { return 3 }
38 6161     6161   6312 sub _LOCALTIME_HOUR_INDEX { return 2 }
39 24380     24380   24858 sub _LOCALTIME_MINUTE_INDEX { return 1 }
40 844     844   1806 sub _LOCALTIME_SECOND_INDEX { return 0 }
41 3012     3012   3269 sub _LOCALTIME_BASE_YEAR { return 1900 }
42 3869     3869   4372 sub _EPOCH_YEAR { return 1970 }
43 2999     2999   2660 sub _EPOCH_WDAY { return 4 }
44 3025     3025   6498 sub _DAYS_IN_JANUARY { return 31 }
45 1676     1676   2013 sub _DAYS_IN_FEBRUARY_LEAP_YEAR { return 29 }
46 1349     1349   1618 sub _DAYS_IN_FEBRUARY_NON_LEAP { return 28 }
47 3025     3025   3464 sub _DAYS_IN_MARCH { return 31 }
48 3025     3025   3310 sub _DAYS_IN_APRIL { return 30 }
49 3025     3025   2940 sub _DAYS_IN_MAY { return 31 }
50 3025     3025   3173 sub _DAYS_IN_JUNE { return 30 }
51 3025     3025   2968 sub _DAYS_IN_JULY { return 31 }
52 3025     3025   3087 sub _DAYS_IN_AUGUST { return 31 }
53 3025     3025   3264 sub _DAYS_IN_SEPTEMBER { return 30 }
54 3025     3025   3744 sub _DAYS_IN_OCTOBER { return 31 }
55 3025     3025   3092 sub _DAYS_IN_NOVEMBER { return 30 }
56 3025     3025   7753 sub _DAYS_IN_DECEMBER { return 31 }
57 30567     30567   30064 sub _DAYS_IN_A_LEAP_YEAR { return 366 }
58 92492     92492   91026 sub _DAYS_IN_A_NON_LEAP_YEAR { return 365 }
59 26     26   43 sub _LAST_WEEK_VALUE { return 5 }
60 0     0   0 sub _LOCALTIME_WEEKDAY_HIGHEST_VALUE { return 6 }
61 3116     3116   2794 sub _DAYS_IN_ONE_WEEK { return 7 }
62 122978     122978   199758 sub _EVERY_FOUR_HUNDRED_YEARS { return 400 }
63 120745     120745   192974 sub _EVERY_FOUR_YEARS { return 4 }
64 28860     28860   54802 sub _EVERY_ONE_HUNDRED_YEARS { return 100 }
65 445     445   897 sub _DEFAULT_DST_START_HOUR { return 2 }
66 337     337   460 sub _DEFAULT_DST_END_HOUR { return 2 }
67              
68             sub _TIMEZONE_FULL_NAME_REGEX {
69 18869     18869   27720 return qr/(?\w+)(?:\/(?[\w\-\/]+))?/smx;
70             }
71              
72             my $_default_zoneinfo_directory = '/usr/share/zoneinfo';
73             if ( -e $_default_zoneinfo_directory ) {
74             }
75             else {
76             if ( -e '/usr/lib/zoneinfo' ) {
77             $_default_zoneinfo_directory = '/usr/lib/zoneinfo';
78             }
79             }
80             my $_zonetab_cache = {};
81             my $_tzdata_cache = {};
82              
83 79     79   279 sub _DEFAULT_ZONEINFO_DIRECTORY { return $_default_zoneinfo_directory }
84              
85             sub new {
86 79     79 1 303681 my ( $class, $params ) = @_;
87 79         281 my $self = {};
88 79         189 bless $self, $class;
89             $self->directory( $params->{directory}
90             || $ENV{TZDIR}
91 79   33     694 || _DEFAULT_ZONEINFO_DIRECTORY() );
92 79 100       239 if ( defined $params->{offset} ) {
93 1         3 $self->offset( $params->{offset} );
94             }
95             else {
96 78   66     290 $self->timezone( $params->{timezone} || $ENV{TZ} );
97             }
98 79         211 return $self;
99             }
100              
101             sub directory {
102 7820     7820 1 10556 my ( $self, $new ) = @_;
103 7820         9062 my $old = $self->{directory};
104 7820 100       11888 if ( @_ > 1 ) {
105 79         220 $self->{directory} = $new;
106             }
107 7820         75966 return $old;
108             }
109              
110             sub offset {
111 4166     4166 1 3799 my ( $self, $new ) = @_;
112 4166         4386 my $old = $self->{offset};
113 4166 100       7567 if ( @_ > 1 ) {
114 2         6 $self->{offset} = $new;
115 2         6 delete $self->{tz};
116             }
117 4166         8500 return $old;
118             }
119              
120             sub equiv {
121 3     3 1 15 my ( $self, $time_zone, $from_time ) = @_;
122 3   66     12 $from_time //= time;
123 3         6 my $class = ref $self;
124 3         14 my $compare = $class->new( { 'timezone' => $time_zone } );
125 3         6 my %offsets_compare;
126 3         15 foreach my $transition_time ( $compare->transition_times() ) {
127 319 100       578 if ( $transition_time >= $from_time ) {
128 179         253 $offsets_compare{$transition_time} =
129             $compare->local_offset($transition_time);
130             }
131             }
132 3         55 my %offsets_self;
133 3         6 foreach my $transition_time ( $self->transition_times() ) {
134 426 100       716 if ( $transition_time >= $from_time ) {
135 219         315 $offsets_self{$transition_time} =
136             $self->local_offset($transition_time);
137             }
138             }
139 3 100       87 if ( scalar keys %offsets_compare == scalar keys %offsets_self ) {
140 1         13 foreach my $transition_time ( sort { $a <=> $b } keys %offsets_compare )
  176         113  
141             {
142 43 50 33     187 if (
143             ( defined $offsets_self{$transition_time} )
144             && ( $offsets_self{$transition_time} ==
145             $offsets_compare{$transition_time} )
146             )
147             {
148             }
149             else {
150 0         0 return;
151             }
152             }
153 1         18 return 1;
154             }
155 2         92 return;
156             }
157              
158             sub _timezones {
159 46     46   52 my ($self) = @_;
160 46         82 my $path = File::Spec->catfile( $self->directory(), 'zone.tab' );
161 46 50       226 my $handle = FileHandle->new($path)
162             or Carp::croak("Failed to open $path for reading:$EXTENDED_OS_ERROR");
163 46 50       2954 my @stat = stat $handle
164             or Carp::croak("Failed to stat $path:$EXTENDED_OS_ERROR");
165 46         106 my $last_modified = $stat[ _STAT_MTIME_IDX() ];
166 46 100 66     256 if ( ( $self->{_zonetab_last_modified} )
    100 66        
167             && ( $self->{_zonetab_last_modified} == $last_modified ) )
168             {
169             }
170             elsif (( $_zonetab_cache->{_zonetab_last_modified} )
171             && ( $_zonetab_cache->{_zonetab_last_modified} == $last_modified ) )
172             {
173              
174 2         9 foreach my $key (qw(_zonetab_last_modified _comments _zones)) {
175 6         15 $self->{$key} = $_zonetab_cache->{$key};
176             }
177             }
178             else {
179 3         6 $self->{_zones} = [];
180 3         6 $self->{_comments} = {};
181 3         92 while ( my $line = <$handle> ) {
182 1320 100       2066 next if ( $line =~ /^[#]/smx );
183 1248         1158 chomp $line;
184 1248         3148 my ( $country_code, $coordinates, $timezone, $comment ) =
185             split /\t/smx, $line;
186 1248         1211 push @{ $self->{_zones} }, $timezone;
  1248         1545  
187 1248         4087 $self->{_comments}->{$timezone} = $comment;
188             }
189 3 50       23 close $handle
190             or Carp::croak("Failed to close $path:$EXTENDED_OS_ERROR");
191 3         6 $self->{_zonetab_last_modified} = $last_modified;
192 3         7 foreach my $key (qw(_zonetab_last_modified _comments _zones)) {
193 9         16 $_zonetab_cache->{$key} = $self->{$key};
194             }
195             }
196 46         50 my @sorted_zones = sort { $a cmp $b } @{ $self->{_zones} };
  139656         130669  
  46         616  
197 46         4532 return @sorted_zones;
198             }
199              
200             sub areas {
201 22     22 1 194204 my ($self) = @_;
202 22         26 my %areas;
203 22         50 foreach my $timezone ( $self->_timezones() ) {
204 9152         8147 my $timezone_full_name_regex = _TIMEZONE_FULL_NAME_REGEX();
205 9152 50       25762 if ( $timezone =~ /^$timezone_full_name_regex$/smx ) {
206 9152         26641 $areas{ $LAST_PAREN_MATCH{area} } = 1;
207             }
208             else {
209 0         0 Carp::croak(
210             "'$timezone' does not have a valid format for a TZ timezone");
211             }
212             }
213 22         583 my @sorted_areas = sort { $a cmp $b } keys %areas;
  522         375  
214 22         127 return @sorted_areas;
215             }
216              
217             sub locations {
218 22     22 1 1033 my ( $self, $area ) = @_;
219 22 50       44 if ( !length $area ) {
220 0         0 return ();
221             }
222 22         22 my %locations;
223 22         52 foreach my $timezone ( $self->_timezones() ) {
224 9152         7980 my $timezone_full_name_regex = _TIMEZONE_FULL_NAME_REGEX();
225 9152 50       26303 if ( $timezone =~ /^$timezone_full_name_regex$/smx ) {
226 9152 50 66     32881 if ( ( $area eq $LAST_PAREN_MATCH{area} )
227             && ( $LAST_PAREN_MATCH{location} ) )
228             {
229 856         2940 $locations{ $LAST_PAREN_MATCH{location} } = 1;
230             }
231             }
232             else {
233 0         0 Carp::croak(
234             "'$timezone' does not have a valid format for a TZ timezone");
235             }
236             }
237 22         669 my @sorted_locations = sort { $a cmp $b } keys %locations;
  4136         2704  
238 22         220 return @sorted_locations;
239             }
240              
241             sub comment {
242 2     2 1 6 my ( $self, $tz ) = @_;
243 2   33     8 $tz ||= $self->timezone();
244 2         9 $self->_timezones();
245 2 50       18 if ( defined $self->{_comments}->{$tz} ) {
246 2         12 return $self->{_comments}->{$tz};
247             }
248             else {
249 0         0 return;
250             }
251             }
252              
253             sub area {
254 3     3 1 12 my ($self) = @_;
255 3         15 return $self->{area};
256             }
257              
258             sub location {
259 6     6 1 533 my ($self) = @_;
260 6         35 return $self->{location};
261             }
262              
263             sub timezone {
264 16043     16043 1 1016535 my ( $self, $new ) = @_;
265 16043         16277 my $old = $self->{tz};
266 16043 100       25101 if ( @_ > 1 ) {
267 567 100       1300 if ( defined $new ) {
268 565         1438 my $timezone_full_name_regex = _TIMEZONE_FULL_NAME_REGEX();
269 565 50       6684 if ( $new !~ /^$timezone_full_name_regex$/smx ) {
270 0         0 Carp::croak(
271             "'$new' does not have a valid format for a TZ timezone");
272             }
273 565         5943 $self->{area} = $LAST_PAREN_MATCH{area};
274 565         2368 $self->{location} = $LAST_PAREN_MATCH{location};
275 565         1694 my $path = File::Spec->catfile( $self->directory(), $new );
276 565 50       13182 if ( !-f $path ) {
277 0         0 Carp::croak(
278             "'$new' is not an timezone in the existing Olson database");
279             }
280             }
281 567         895 $self->{tz} = $new;
282 567         573 delete $self->{offset};
283             }
284 16043         20614 return $old;
285             }
286              
287             sub _is_leap_year {
288 122978     122978   86780 my ( $self, $year ) = @_;
289 122978         72285 my $leap_year;
290 122978 100 100     101575 if (
      66        
291             ( $year % _EVERY_FOUR_HUNDRED_YEARS() == 0 )
292             || ( ( $year % _EVERY_FOUR_YEARS() == 0 )
293             && ( $year % _EVERY_ONE_HUNDRED_YEARS() != 0 ) )
294             )
295             {
296 31081         22403 $leap_year = 1;
297             }
298             else {
299 91897         64532 $leap_year = 0;
300             }
301 122978         113871 return $leap_year;
302             }
303              
304             sub _in_dst_according_to_tz {
305 13     13   17 my ( $self, $check_time, $tz_definition ) = @_;
306              
307 13 50 33     173 if ( ( defined $tz_definition->{start_day} )
      33        
      33        
      33        
      33        
308             && ( defined $tz_definition->{end_day} )
309             && ( defined $tz_definition->{start_week} )
310             && ( defined $tz_definition->{end_week} )
311             && ( defined $tz_definition->{start_month} )
312             && ( defined $tz_definition->{end_month} ) )
313             {
314 13         32 my $check_year =
315             ( $self->_gm_time($check_time) )[ _LOCALTIME_YEAR_INDEX() ] +
316             _LOCALTIME_BASE_YEAR();
317             my $dst_start_time = $self->_get_time_for_wday_week_month_year(
318             $tz_definition->{start_day}, $tz_definition->{start_week},
319             $tz_definition->{start_month}, $check_year
320             ) +
321             ( $tz_definition->{start_hour} *
322             _SECONDS_IN_ONE_MINUTE() *
323             _MINUTES_IN_ONE_HOUR() ) +
324             ( $tz_definition->{start_minute} * _SECONDS_IN_ONE_MINUTE() ) +
325             $tz_definition->{start_second} -
326 13         46 $tz_definition->{std_offset_in_seconds};
327             my $dst_end_time = $self->_get_time_for_wday_week_month_year(
328             $tz_definition->{end_day}, $tz_definition->{end_week},
329             $tz_definition->{end_month}, $check_year
330             ) +
331             ( $tz_definition->{end_hour} *
332             _SECONDS_IN_ONE_MINUTE() *
333             _MINUTES_IN_ONE_HOUR() ) +
334             ( $tz_definition->{end_minute} * _SECONDS_IN_ONE_MINUTE() ) +
335             $tz_definition->{end_second} -
336 13         27 $tz_definition->{dst_offset_in_seconds};
337              
338 13 50       29 if ( $dst_start_time < $dst_end_time ) {
339 0 0 0     0 if ( ( $dst_start_time < $check_time )
340             && ( $check_time < $dst_end_time ) )
341             {
342 0         0 return 1;
343             }
344             }
345             else {
346 13 50 33     85 if ( ( $check_time < $dst_start_time )
347             || ( $dst_end_time < $check_time ) )
348             {
349 13         35 return 1;
350             }
351             }
352             }
353              
354 0         0 return 0;
355             }
356              
357             sub _get_time_for_wday_week_month_year {
358 26     26   46 my ( $self, $wday, $week, $month, $year ) = @_;
359              
360 26         31 my $check_year = _EPOCH_YEAR();
361 26         21 my $time = 0;
362 26         20 my $increment = 0;
363 26         21 my $leap_year = 1;
364 26         42 while ( $check_year < $year ) {
365 1742         1088 $check_year += 1;
366 1742 100       1492 if ( $self->_is_leap_year($check_year) ) {
367 442         269 $leap_year = 1;
368 442         369 $increment = _DAYS_IN_A_LEAP_YEAR() * _SECONDS_IN_ONE_DAY();
369             }
370             else {
371 1300         780 $leap_year = 0;
372 1300         1402 $increment = _DAYS_IN_A_NON_LEAP_YEAR() * _SECONDS_IN_ONE_DAY();
373             }
374 1742         2176 $time += $increment;
375             }
376              
377 26         20 $increment = 0;
378 26         21 my $check_month = 1;
379 26         35 my @days_in_month = $self->_days_in_month($leap_year);
380 26         65 while ( $check_month < $month ) {
381              
382 156         169 $increment = $days_in_month[ $check_month - 1 ] * _SECONDS_IN_ONE_DAY();
383 156         106 $time += $increment;
384 156         199 $check_month += 1;
385             }
386              
387 26 50       32 if ( $week == _LAST_WEEK_VALUE() ) {
388 0         0 $time +=
389             ( $days_in_month[ $check_month - 1 ] - 1 ) * _SECONDS_IN_ONE_DAY();
390 0         0 my $check_day_of_week =
391             ( $self->_gm_time($time) )[ _LOCALTIME_DAY_OF_WEEK_INDEX() ];
392              
393 0         0 while ( $check_day_of_week != $wday ) {
394              
395 0         0 $time -= _SECONDS_IN_ONE_DAY;
396 0         0 $check_day_of_week -= 1;
397 0 0       0 if ( $check_day_of_week < 0 ) {
398 0         0 $check_day_of_week = _LOCALTIME_WEEKDAY_HIGHEST_VALUE();
399             }
400             }
401             }
402             else {
403 26         30 my $check_day_of_week =
404             ( $self->_gm_time($time) )[ _LOCALTIME_DAY_OF_WEEK_INDEX() ];
405 26         30 my $check_week = 1;
406 26         34 $increment = _DAYS_IN_ONE_WEEK() * _SECONDS_IN_ONE_DAY();
407 26         55 while ( $check_week < $week ) {
408 0         0 $check_week += 1;
409 0         0 $time += $increment;
410             }
411              
412 26         59 while ( $check_day_of_week != $wday ) {
413              
414 91         86 $time += _SECONDS_IN_ONE_DAY();
415 91         54 $check_day_of_week += 1;
416 91         86 $check_day_of_week = $check_day_of_week % _DAYS_IN_ONE_WEEK();
417             }
418             }
419              
420 26         60 return $time;
421             }
422              
423             sub _get_tz_offset_according_to_v2_tz_rule {
424 799     799   1018 my ( $self, $time ) = @_;
425 799 50       1139 if ( defined $self->offset() ) {
426 0         0 return ( 0, $self->offset() * _SECONDS_IN_ONE_MINUTE(), q[] );
427             }
428 799         1119 my $tz = $self->timezone();
429 799         707 my ( $isdst, $gmtoff, $abbr );
430 799         843 my $tz_definition = $self->{_tzdata}->{$tz}->{tz_definition};
431 799 50       1181 if ( defined $tz_definition->{std_name} ) {
432 799 100       1032 if ( defined $tz_definition->{dst_name} ) {
433 13 50       32 if ( $self->_in_dst_according_to_tz( $time, $tz_definition ) ) {
434 13         12 $isdst = 1;
435 13         11 $gmtoff = $tz_definition->{dst_offset_in_seconds};
436 13         21 $abbr = $tz_definition->{dst_name};
437             }
438             else {
439 0         0 $isdst = 0;
440 0         0 $gmtoff = $tz_definition->{std_offset_in_seconds};
441 0         0 $abbr = $tz_definition->{std_name};
442             }
443             }
444             else {
445 786         836 $isdst = 0;
446 786         650 $gmtoff = $tz_definition->{std_offset_in_seconds};
447 786         837 $abbr = $tz_definition->{std_name};
448             }
449             }
450 799         2283 return ( $isdst, $gmtoff, $abbr );
451             }
452              
453             sub _negative_gm_time {
454 81     81   81 my ( $self, $time ) = @_;
455 81         208 my $year = _EPOCH_YEAR() - 1;
456 81         93 my $wday = _EPOCH_WDAY() - 1;
457 81         88 my $check_time = 0;
458 81         53 my $number_of_days = 0;
459 81         59 my $leap_year;
460 81         65 YEAR: while (1) {
461 3105         2848 $leap_year = $self->_is_leap_year($year);
462 3105         2997 $number_of_days = $self->_number_of_days_in_a_year($leap_year);
463 3105         2749 my $increment = $number_of_days * _SECONDS_IN_ONE_DAY();
464 3105 100       3896 if ( $check_time - $increment > $time ) {
465 3024         2128 $check_time -= $increment;
466 3024         1842 $wday -= $number_of_days;
467 3024         2398 $year -= 1;
468             }
469             else {
470 81         175 last YEAR;
471             }
472             }
473 81         85 my $yday = $self->_number_of_days_in_a_year($leap_year);
474 81         97 $year -= _LOCALTIME_BASE_YEAR();
475              
476 81         100 my $month = _MONTHS_IN_ONE_YEAR();
477 81         115 my @days_in_month = $self->_days_in_month($leap_year);
478 81         79 MONTH: while (1) {
479              
480 741         525 $number_of_days = $days_in_month[ $month - 1 ];
481 741         602 my $increment = $number_of_days * _SECONDS_IN_ONE_DAY();
482 741 100       879 if ( $check_time - $increment > $time ) {
483 660         511 $check_time -= $increment;
484 660         467 $wday -= $number_of_days;
485 660         380 $yday -= $number_of_days;
486 660         537 $month -= 1;
487             }
488             else {
489 81         98 last MONTH;
490             }
491             }
492 81         72 $month -= 1;
493              
494 81         71 my $day = $days_in_month[$month];
495 81         71 my $increment = _SECONDS_IN_ONE_DAY();
496 81         57 DAY: while (1) {
497 1206 100       1357 if ( $check_time - $increment > $time ) {
498 1125         744 $check_time -= $increment;
499 1125         660 $day -= 1;
500 1125         664 $yday -= 1;
501 1125         767 $wday -= 1;
502             }
503             else {
504 81         74 last DAY;
505             }
506             }
507              
508 81         85 $wday = abs $wday % _DAYS_IN_ONE_WEEK();
509              
510 81         91 my $hour = _HOURS_IN_ONE_DAY() - 1;
511 81         81 $increment = _SECONDS_IN_ONE_HOUR();
512 81         59 HOUR: while (1) {
513 1770 100       1868 if ( $check_time - $increment > $time ) {
514 1689         1120 $check_time -= $increment;
515 1689         1098 $hour -= 1;
516             }
517             else {
518 81         81 last HOUR;
519             }
520             }
521 81         78 my $minute = _MINUTES_IN_ONE_HOUR() - 1;
522 81         83 $increment = _SECONDS_IN_ONE_MINUTE();
523 81         104 MINUTE: while (1) {
524 3318 100       3451 if ( $check_time - $increment > $time ) {
525 3237         2064 $check_time -= $increment;
526 3237         2085 $minute -= 1;
527             }
528             else {
529 81         70 last MINUTE;
530             }
531             }
532 81         79 my $seconds = _SECONDS_IN_ONE_MINUTE() - ( $check_time - $time );
533              
534 81         388 return ( $seconds, $minute, $hour, $day, $month, "$year", $wday, $yday, 0 );
535             }
536              
537             sub _positive_gm_time {
538 2074     2074   2313 my ( $self, $time ) = @_;
539 2074         6032 my $year = _EPOCH_YEAR();
540 2074         2533 my $wday = _EPOCH_WDAY();
541 2074         1944 my $check_time = 0;
542 2074         1566 my $number_of_days = 0;
543 2074         1350 my $leap_year;
544 2074         1444 YEAR: while (1) {
545 84230         78043 $leap_year = $self->_is_leap_year($year);
546 84230         80565 $number_of_days = $self->_number_of_days_in_a_year($leap_year);
547 84230         74550 my $increment = $number_of_days * _SECONDS_IN_ONE_DAY();
548 84230 100       109925 if ( $check_time + $increment <= $time ) {
549 82156         58734 $check_time += $increment;
550 82156         50255 $wday += $number_of_days;
551 82156         64580 $year += 1;
552             }
553             else {
554 2074         4427 last YEAR;
555             }
556             }
557 2074         2322 $year -= _LOCALTIME_BASE_YEAR();
558              
559 2074         1739 my $month = 0;
560 2074         2863 my @days_in_month = $self->_days_in_month($leap_year);
561 2074         2035 my $yday = 0;
562 2074         1431 MONTH: while (1) {
563              
564 11728         8386 $number_of_days = $days_in_month[$month];
565 11728         10116 my $increment = $number_of_days * _SECONDS_IN_ONE_DAY();
566 11728 100       16274 if ( $check_time + $increment <= $time ) {
567 9654         7287 $check_time += $increment;
568 9654         5896 $wday += $number_of_days;
569 9654         6044 $yday += $number_of_days;
570 9654         7559 $month += 1;
571             }
572             else {
573 2074         2879 last MONTH;
574             }
575             }
576 2074         1465 my $day = 1;
577 2074         1973 my $increment = _SECONDS_IN_ONE_DAY();
578 2074         1418 DAY: while (1) {
579 29486 100       32975 if ( $check_time + $increment <= $time ) {
580 27412         19108 $check_time += $increment;
581 27412         15549 $day += 1;
582 27412         15398 $yday += 1;
583 27412         18344 $wday += 1;
584             }
585             else {
586 2074         2023 last DAY;
587             }
588             }
589              
590 2074         2171 $wday = $wday % _DAYS_IN_ONE_WEEK();
591              
592 2074         1594 my $hour = 0;
593 2074         2012 $increment = _SECONDS_IN_ONE_HOUR();
594 2074         1560 HOUR: while (1) {
595 12657 100       14684 if ( $check_time + $increment <= $time ) {
596 10583         7891 $check_time += $increment;
597 10583         7081 $hour += 1;
598             }
599             else {
600 2074         2256 last HOUR;
601             }
602             }
603 2074         1347 my $minute = 0;
604 2074         2029 $increment = _SECONDS_IN_ONE_MINUTE();
605 2074         2808 MINUTE: while (1) {
606 54853 100       58927 if ( $check_time + $increment <= $time ) {
607 52779         34702 $check_time += $increment;
608 52779         34050 $minute += 1;
609             }
610             else {
611 2074         2312 last MINUTE;
612             }
613             }
614 2074         4035 my $seconds = $time - $check_time;
615              
616 2074         10487 return ( $seconds, $minute, $hour, $day, $month, "$year", $wday, $yday, 0 );
617             }
618              
619             sub _gm_time {
620 2155     2155   2323 my ( $self, $time ) = @_;
621 2155         2619 my @gmtime;
622 2155 100       4543 if ( $time < 0 ) {
623 81         209 @gmtime = $self->_negative_gm_time($time);
624             }
625             else {
626 2074         4794 @gmtime = $self->_positive_gm_time($time);
627             }
628 2155 100       3392 if (wantarray) {
629 2152         7128 return @gmtime;
630             }
631             else {
632 3         38 return POSIX::strftime( '%a %b %e %H:%M:%S %Y', @gmtime );
633             }
634             }
635              
636             sub time_local {
637 844     844 1 4167 my ( $self, @localtime ) = @_;
638 844         986 my $time = 0;
639 844         1125 $localtime[ _LOCALTIME_YEAR_INDEX() ] += _LOCALTIME_BASE_YEAR();
640 844 100       1043 if ( $localtime[ _LOCALTIME_YEAR_INDEX() ] >= _EPOCH_YEAR() ) {
641 817         1311 return $self->_positive_time_local(@localtime);
642             }
643             else {
644 27         69 return $self->_negative_time_local(@localtime);
645             }
646             }
647              
648             sub _positive_time_local {
649 817     817   1771 my ( $self, @localtime ) = @_;
650 817         859 my $check_year = _EPOCH_YEAR();
651 817         1026 my $wday = _EPOCH_WDAY();
652 817         938 my $time = 0;
653 817         605 my $leap_year = 0;
654 817         613 YEAR: while (1) {
655              
656 33710 100       30503 if ( $check_year < $localtime[ _LOCALTIME_YEAR_INDEX() ] ) {
657 32893         30152 $time += $self->_number_of_days_in_a_year($leap_year) *
658             _SECONDS_IN_ONE_DAY();
659 32893         21289 $check_year += 1;
660 32893         28977 $leap_year = $self->_is_leap_year($check_year);
661             }
662             else {
663 817         959 last YEAR;
664             }
665             }
666              
667 817         626 my $check_month = 0;
668 817         1052 my @days_in_month = $self->_days_in_month($leap_year);
669 817         1080 MONTH: while (1) {
670              
671 4360 100       3988 if ( $check_month < $localtime[ _LOCALTIME_MONTH_INDEX() ] ) {
672 3543         3528 $time += $days_in_month[$check_month] * _SECONDS_IN_ONE_DAY();
673 3543         2702 $check_month += 1;
674             }
675             else {
676 817         810 last MONTH;
677             }
678             }
679 817         816 my $check_day = 1;
680 817         587 DAY: while (1) {
681 12001 100       10036 if ( $check_day < $localtime[ _LOCALTIME_DAY_INDEX() ] ) {
682 11184         9538 $time += _SECONDS_IN_ONE_DAY();
683 11184         7865 $check_day += 1;
684             }
685             else {
686 817         764 last DAY;
687             }
688             }
689              
690 817         852 $wday = $wday % _DAYS_IN_ONE_WEEK();
691              
692 817         624 my $check_hour = 0;
693 817         598 HOUR: while (1) {
694 5571 100       4866 if ( $check_hour < $localtime[ _LOCALTIME_HOUR_INDEX() ] ) {
695 4754         4066 $time += _SECONDS_IN_ONE_HOUR();
696 4754         3412 $check_hour += 1;
697             }
698             else {
699 817         688 last HOUR;
700             }
701             }
702 817         689 my $check_minute = 0;
703 817         643 MINUTE: while (1) {
704 23247 100       19174 if ( $check_minute < $localtime[ _LOCALTIME_MINUTE_INDEX() ] ) {
705 22430         18565 $time += _SECONDS_IN_ONE_MINUTE();
706 22430         16528 $check_minute += 1;
707             }
708             else {
709 817         711 last MINUTE;
710             }
711             }
712 817         963 $time += $localtime[ _LOCALTIME_SECOND_INDEX() ];
713 817         2284 my ( $isdst, $gmtoff, $abbr ) =
714             $self->_get_isdst_gmtoff_abbr_calculating_for_time_local($time);
715 817         1739 $time -= $gmtoff;
716              
717 817         4985 return $time;
718             }
719              
720             sub _days_in_month {
721 3025     3025   2559 my ( $self, $leap_year ) = @_;
722             return (
723 3025 100       3474 _DAYS_IN_JANUARY(),
724             (
725             $leap_year
726             ? _DAYS_IN_FEBRUARY_LEAP_YEAR()
727             : _DAYS_IN_FEBRUARY_NON_LEAP()
728             ),
729             _DAYS_IN_MARCH(),
730             _DAYS_IN_APRIL(),
731             _DAYS_IN_MAY(),
732             _DAYS_IN_JUNE(),
733             _DAYS_IN_JULY(),
734             _DAYS_IN_AUGUST(),
735             _DAYS_IN_SEPTEMBER(),
736             _DAYS_IN_OCTOBER(),
737             _DAYS_IN_NOVEMBER(),
738             _DAYS_IN_DECEMBER(),
739             );
740             }
741              
742             sub _number_of_days_in_a_year {
743 121317     121317   83927 my ( $self, $leap_year ) = @_;
744 121317 100       113748 if ($leap_year) {
745 30125         26730 return _DAYS_IN_A_LEAP_YEAR();
746             }
747             else {
748 91192         77130 return _DAYS_IN_A_NON_LEAP_YEAR();
749             }
750             }
751              
752             sub _negative_time_local {
753 27     27   49 my ( $self, @localtime ) = @_;
754 27         29 my $check_year = _EPOCH_YEAR() - 1;
755 27         28 my $wday = _EPOCH_WDAY();
756 27         25 my $time = 0;
757 27         18 my $leap_year;
758 27         36 YEAR: while (1) {
759              
760 1035 100       889 if ( $check_year > $localtime[ _LOCALTIME_YEAR_INDEX() ] ) {
761 1008         945 $time -= $self->_number_of_days_in_a_year($leap_year) *
762             _SECONDS_IN_ONE_DAY();
763 1008         630 $check_year -= 1;
764 1008         885 $leap_year = $self->_is_leap_year($check_year);
765             }
766             else {
767 27         59 last YEAR;
768             }
769             }
770              
771 27         33 my $check_month = _MONTHS_IN_ONE_YEAR() - 1;
772 27         36 my @days_in_month = $self->_days_in_month($leap_year);
773 27         23 MONTH: while (1) {
774              
775 247 100       195 if ( $check_month > $localtime[ _LOCALTIME_MONTH_INDEX() ] ) {
776 220         192 $time -= $days_in_month[$check_month] * _SECONDS_IN_ONE_DAY();
777 220         175 $check_month -= 1;
778             }
779             else {
780 27         24 last MONTH;
781             }
782             }
783 27         26 my $check_day = $days_in_month[$check_month];
784 27         18 DAY: while (1) {
785 402 100       351 if ( $check_day > $localtime[ _LOCALTIME_DAY_INDEX() ] ) {
786 375         310 $time -= _SECONDS_IN_ONE_DAY();
787 375         245 $check_day -= 1;
788             }
789             else {
790 27         22 last DAY;
791             }
792             }
793              
794 27         26 $wday = $wday % _DAYS_IN_ONE_WEEK();
795              
796 27         37 my $check_hour = _HOURS_IN_ONE_DAY() - 1;
797 27         17 HOUR: while (1) {
798 590 100       471 if ( $check_hour > $localtime[ _LOCALTIME_HOUR_INDEX() ] ) {
799 563         451 $time -= _SECONDS_IN_ONE_HOUR();
800 563         373 $check_hour -= 1;
801             }
802             else {
803 27         23 last HOUR;
804             }
805             }
806 27         25 my $check_minute = _MINUTES_IN_ONE_HOUR();
807 27         38 MINUTE: while (1) {
808 1133 100       1014 if ( $check_minute > $localtime[ _LOCALTIME_MINUTE_INDEX() ] ) {
809 1106         849 $time -= _SECONDS_IN_ONE_MINUTE();
810 1106         866 $check_minute -= 1;
811             }
812             else {
813 27         26 last MINUTE;
814             }
815             }
816 27         36 $time += $localtime[ _LOCALTIME_SECOND_INDEX() ];
817 27         103 my ( $isdst, $gmtoff, $abbr ) =
818             $self->_get_isdst_gmtoff_abbr_calculating_for_time_local($time);
819 27         38 $time -= $gmtoff;
820              
821 27         156 return $time;
822             }
823              
824             sub _get_first_standard_time_type {
825 3353     3353   3991 my ( $self, $tz ) = @_;
826 3353         2300 my $first_standard_time_type;
827 3353 50       7427 if ( defined $self->{_tzdata}->{$tz}->{local_time_types}->[0] ) {
828             $first_standard_time_type =
829 3353         4250 $self->{_tzdata}->{$tz}->{local_time_types}->[0];
830             }
831             FIRST_STANDARD_TIME_TYPE:
832 3353         2458 foreach
833 3353         7610 my $local_time_type ( @{ $self->{_tzdata}->{$tz}->{local_time_types} } )
834             {
835 3353 50       6512 if ( $local_time_type->{isdst} ) {
836             }
837             else {
838 3353         3199 $first_standard_time_type = $local_time_type;
839 3353         4197 last FIRST_STANDARD_TIME_TYPE;
840             }
841             }
842 3353         4481 return $first_standard_time_type;
843             }
844              
845             sub _get_isdst_gmtoff_abbr_calculating_for_time_local {
846 844     844   1585 my ( $self, $time ) = @_;
847 844 100       2230 if ( defined $self->offset() ) {
848 2         5 return ( 0, $self->offset() * _SECONDS_IN_ONE_MINUTE(), q[] );
849             }
850 842         656 my ( $isdst, $gmtoff, $abbr );
851 842         1130 my $tz = $self->timezone();
852 842         1341 $self->_read_tzfile();
853 842         1433 my $first_standard_time_type = $self->_get_first_standard_time_type($tz);
854 842         731 my $transition_index = 0;
855 842         625 my $transition_time_found;
856 842         1435 my $previous_offset = $first_standard_time_type->{gmtoff};
857 842         1239 my $first_transition_time;
858             TRANSITION_TIME:
859              
860 842         1269 foreach my $transition_time_in_gmt ( $self->transition_times() ) {
861              
862 51205 100       67779 if ( !defined $first_transition_time ) {
863 842         2617 $first_transition_time = $transition_time_in_gmt;
864             }
865             my $local_time_index =
866 51205         60332 $self->{_tzdata}->{$tz}->{local_time_indexes}->[$transition_index];
867             my $local_time_type =
868 51205         48443 $self->{_tzdata}->{$tz}->{local_time_types}->[$local_time_index];
869 51205 100       64193 if ( $local_time_type->{gmtoff} < $previous_offset ) {
870 25045 100 100     80602 if (
    100          
871             ( $transition_time_in_gmt > $time - $previous_offset )
872             && ( $transition_time_in_gmt <=
873             $time - $local_time_type->{gmtoff} )
874             )
875             {
876 210         249 $transition_time_found = 1;
877 210         503 last TRANSITION_TIME;
878             }
879             elsif (
880             $transition_time_in_gmt > $time - $local_time_type->{gmtoff} )
881             {
882 276         296 $transition_time_found = 1;
883 276         582 last TRANSITION_TIME;
884             }
885             }
886             else {
887 26160 100       45945 if ( $transition_time_in_gmt > $time - $local_time_type->{gmtoff} )
888             {
889 92         108 $transition_time_found = 1;
890 92         196 last TRANSITION_TIME;
891             }
892             }
893 50627         36605 $transition_index += 1;
894 50627         59213 $previous_offset = $local_time_type->{gmtoff};
895             }
896 842         5770 my $offset_found;
897 842 100 33     8573 if (
    100 66        
898             ( defined $first_transition_time )
899             && ($first_standard_time_type)
900             && ( $time <
901             $first_transition_time + $first_standard_time_type->{gmtoff} )
902             )
903             {
904 1         3 $gmtoff = $first_standard_time_type->{gmtoff};
905 1         2 $isdst = $first_standard_time_type->{isdst};
906 1         3 $abbr = $first_standard_time_type->{abbr};
907 1         3 $offset_found = 1;
908             }
909             elsif ( !$transition_time_found ) {
910 264         495 ( $isdst, $gmtoff, $abbr ) =
911             $self->_get_tz_offset_according_to_v2_tz_rule($time);
912 264 50       486 if ( defined $gmtoff ) {
913 264         246 $offset_found = 1;
914             }
915             }
916 842 100       2510 if ($offset_found) {
    50          
917             }
918             elsif (
919             defined $self->{_tzdata}->{$tz}->{local_time_indexes}
920             ->[ $transition_index - 1 ] )
921             {
922             my $local_time_index = $self->{_tzdata}->{$tz}->{local_time_indexes}
923 577         1187 ->[ $transition_index - 1 ];
924             my $local_time_type =
925 577         845 $self->{_tzdata}->{$tz}->{local_time_types}->[$local_time_index];
926 577         714 $gmtoff = $local_time_type->{gmtoff};
927 577         773 $isdst = $local_time_type->{isdst};
928 577         1091 $abbr = $local_time_type->{abbr};
929             }
930             else {
931 0         0 $gmtoff = $first_standard_time_type->{gmtoff};
932 0         0 $isdst = $first_standard_time_type->{isdst};
933 0         0 $abbr = $first_standard_time_type->{abbr};
934             }
935 842         4023 return ( $isdst, $gmtoff, $abbr );
936             }
937              
938             sub _get_isdst_gmtoff_abbr_calculating_for_local_time {
939 2515     2515   2833 my ( $self, $time ) = @_;
940 2515         2150 my ( $isdst, $gmtoff, $abbr );
941 2515 100       5547 if ( defined $self->offset() ) {
942 4         6 return ( 0, $self->offset() * _SECONDS_IN_ONE_MINUTE(), q[] );
943             }
944 2511         4819 my $tz = $self->timezone();
945 2511         6979 $self->_read_tzfile();
946 2511         2323 my $transition_index = 0;
947 2511         2249 my $transition_time_found;
948             my $first_transition_time;
949             TRANSITION_TIME:
950 2511         4170 foreach my $transition_time_in_gmt ( $self->transition_times() ) {
951              
952 171405 100       212664 if ( !defined $first_transition_time ) {
953 2511         5364 $first_transition_time = $transition_time_in_gmt;
954             }
955 171405 100       237168 if ( $transition_time_in_gmt > $time ) {
956 1976         1709 $transition_time_found = 1;
957 1976         3280 last TRANSITION_TIME;
958             }
959 169429         152173 $transition_index += 1;
960             }
961 2511         22884 my $first_standard_time_type = $self->_get_first_standard_time_type($tz);
962 2511         1773 my $offset_found;
963 2511 100 66     17108 if ( ( defined $first_transition_time )
    100          
964             && ( $time < $first_transition_time ) )
965             {
966 3         7 $gmtoff = $first_standard_time_type->{gmtoff};
967 3         5 $isdst = $first_standard_time_type->{isdst};
968 3         5 $abbr = $first_standard_time_type->{abbr};
969 3         6 $offset_found = 1;
970             }
971             elsif ( !$transition_time_found ) {
972 535         1530 ( $isdst, $gmtoff, $abbr ) =
973             $self->_get_tz_offset_according_to_v2_tz_rule($time);
974 535 50       857 if ( defined $gmtoff ) {
975 535         502 $offset_found = 1;
976             }
977             }
978 2511 100       6669 if ($offset_found) {
    50          
979             }
980             elsif (
981             defined $self->{_tzdata}->{$tz}->{local_time_indexes}
982             ->[ $transition_index - 1 ] )
983             {
984             my $local_time_index = $self->{_tzdata}->{$tz}->{local_time_indexes}
985 1973         3404 ->[ $transition_index - 1 ];
986             my $local_time_type =
987 1973         3228 $self->{_tzdata}->{$tz}->{local_time_types}->[$local_time_index];
988 1973         2471 $gmtoff = $local_time_type->{gmtoff};
989 1973         2580 $isdst = $local_time_type->{isdst};
990 1973         4403 $abbr = $local_time_type->{abbr};
991             }
992             else {
993 0         0 $gmtoff = $first_standard_time_type->{gmtoff};
994 0         0 $isdst = $first_standard_time_type->{isdst};
995 0         0 $abbr = $first_standard_time_type->{abbr};
996             }
997 2511         9538 return ( $isdst, $gmtoff, $abbr );
998             }
999              
1000             sub local_offset {
1001 399     399 1 494 my ( $self, $time ) = @_;
1002 399 50       697 if ( !defined $time ) {
1003 0         0 $time = time;
1004             }
1005 399         499 my ( $isdst, $gmtoff, $abbr ) =
1006             $self->_get_isdst_gmtoff_abbr_calculating_for_local_time($time);
1007 399         670 return int( $gmtoff / _SECONDS_IN_ONE_MINUTE() );
1008             }
1009              
1010             sub local_time {
1011 2116     2116 1 2887694 my ( $self, $time ) = @_;
1012 2116 50       6210 if ( !defined $time ) {
1013 0         0 $time = time;
1014             }
1015              
1016 2116         5999 my ( $isdst, $gmtoff, $abbr ) =
1017             $self->_get_isdst_gmtoff_abbr_calculating_for_local_time($time);
1018 2116         3801 $time += $gmtoff;
1019              
1020 2116 100       3164 if (wantarray) {
1021 2113         3977 my (@local_time) = $self->_gm_time($time);
1022 2113         3218 $local_time[ _LOCALTIME_ISDST_INDEX() ] = $isdst;
1023 2113         18363 return @local_time;
1024             }
1025             else {
1026 3         9 return $self->_gm_time($time);
1027             }
1028             }
1029              
1030             sub transition_times {
1031 3360     3360 1 3267 my ($self) = @_;
1032 3360         4887 my $tz = $self->timezone();
1033 3360         5180 $self->_read_tzfile();
1034 3360         2715 return @{ $self->{_tzdata}->{$tz}->{transition_times} };
  3360         88942  
1035             }
1036              
1037             sub leap_seconds {
1038 416     416 1 125003 my ($self) = @_;
1039 416         743 my $tz = $self->timezone();
1040 416         670 $self->_read_tzfile();
1041             my @leap_seconds =
1042 416         430 sort { $a <=> $b } keys %{ $self->{_tzdata}->{$tz}->{leap_seconds} };
  0         0  
  416         1386  
1043 416         882 return @leap_seconds;
1044             }
1045              
1046             sub _read_header {
1047 974     974   1303 my ( $self, $handle, $path ) = @_;
1048 974         2388 my $result = $handle->read( my $buffer, _SIZE_OF_TZ_HEADER() );
1049 974 50       10487 if ( defined $result ) {
1050 974 50       1541 if ( $result != _SIZE_OF_TZ_HEADER() ) {
1051 0         0 Carp::croak(
1052             "Failed to read entire header from $path. $result bytes were read instead of the expected "
1053             . _SIZE_OF_TZ_HEADER() );
1054             }
1055             }
1056             else {
1057 0         0 Carp::croak("Failed to read header from $path:$EXTENDED_OS_ERROR");
1058             }
1059 974         8243 my ( $magic, $version, $ttisgmtcnt, $ttisstdcnt, $leapcnt, $timecnt,
1060             $typecnt, $charcnt )
1061             = unpack 'A4A1x15N!N!N!N!N!N!', $buffer;
1062 974 50       4010 ( $magic eq 'TZif' ) or Carp::croak("$path is not a TZ file");
1063 974         6871 my $header = {
1064             magic => $magic,
1065             version => $version,
1066             ttisgmtcnt => $ttisgmtcnt,
1067             ttisstdcnt => $ttisstdcnt,
1068             leapcnt => $leapcnt,
1069             timecnt => $timecnt,
1070             typecnt => $typecnt,
1071             charcnt => $charcnt
1072             };
1073              
1074 974         2367 return $header;
1075             }
1076              
1077             sub _read_transition_times {
1078 974     974   1346 my ( $self, $handle, $path, $timecnt, $sizeof_transition_time ) = @_;
1079 974         1465 my $sizeof_transition_times = $timecnt * $sizeof_transition_time;
1080 974         1849 my $result = $handle->read( my $buffer, $sizeof_transition_times );
1081 974 50       6611 if ( defined $result ) {
1082 974 50       2428 if ( $result != $sizeof_transition_times ) {
1083 0         0 Carp::croak(
1084             "Failed to read all the transition times from $path. $result bytes were read instead of the expected "
1085             . $sizeof_transition_times );
1086             }
1087             }
1088             else {
1089 0         0 Carp::croak(
1090             "Failed to read transition times from $path:$EXTENDED_OS_ERROR");
1091             }
1092 974         910 my @transition_times;
1093 974 100       1253 if ( $sizeof_transition_time == _SIZE_OF_TRANSITION_TIME_V1() ) {
    50          
1094 487         17432 @transition_times = unpack 'l>' . $timecnt, $buffer;
1095             }
1096             elsif ( $sizeof_transition_time == _SIZE_OF_TRANSITION_TIME_V2() ) {
1097 487 50       1267 eval { @transition_times = unpack 'q>' . $timecnt, $buffer; 1; } or do {
  487         11863  
  487         3080  
1098 0         0 require Math::Int64;
1099             @transition_times =
1100 0         0 map { Math::Int64::net_to_int64($_) } unpack '(a8)' . $timecnt,
  0         0  
1101             $buffer;
1102             };
1103             }
1104 974         6362 return \@transition_times;
1105             }
1106              
1107             sub _read_local_time_indexes {
1108 974     974   1439 my ( $self, $handle, $path, $timecnt ) = @_;
1109 974         1898 my $result = $handle->read( my $buffer, $timecnt );
1110 974 50       5827 if ( defined $result ) {
1111 974 50       2066 if ( $result != $timecnt ) {
1112 0         0 Carp::croak(
1113             "Failed to read all the local time indexes from $path. $result bytes were read instead of the expected "
1114             . $timecnt );
1115             }
1116             }
1117             else {
1118 0         0 Carp::croak(
1119             "Failed to read local time indexes from $path:$EXTENDED_OS_ERROR");
1120             }
1121 974         23275 my @local_time_indexes = unpack 'C' . $timecnt, $buffer;
1122 974         7196 return \@local_time_indexes;
1123             }
1124              
1125             sub _read_local_time_types {
1126 974     974   1367 my ( $self, $handle, $path, $typecnt ) = @_;
1127 974         1383 my $sizeof_local_time_types = $typecnt * _SIZE_OF_TTINFO();
1128 974         1828 my $result = $handle->read( my $buffer, $sizeof_local_time_types );
1129 974 50       5361 if ( defined $result ) {
1130 974 50       2029 if ( $result != $sizeof_local_time_types ) {
1131 0         0 Carp::croak(
1132             "Failed to read all the local time types from $path. $result bytes were read instead of the expected "
1133             . $sizeof_local_time_types );
1134             }
1135             }
1136             else {
1137 0         0 Carp::croak(
1138             "Failed to read local time types from $path:$EXTENDED_OS_ERROR");
1139             }
1140 974         817 my @local_time_types;
1141 974         5062 foreach my $local_time_type ( unpack '(a6)' . $typecnt, $buffer ) {
1142 5262         16661 my ( $c1, $c2, $c3 ) = unpack 'a4aa', $local_time_type;
1143 5262         10180 my $gmtoff = unpack 'l>', $c1;
1144 5262         7049 my $isdst = unpack 'C', $c2;
1145 5262         6478 my $abbrind = unpack 'C', $c3;
1146 5262         17048 push @local_time_types,
1147             { gmtoff => $gmtoff, isdst => $isdst, abbrind => $abbrind };
1148             }
1149 974         2841 return \@local_time_types;
1150             }
1151              
1152             sub _read_time_zone_abbreviation_strings {
1153 974     974   1277 my ( $self, $handle, $path, $charcnt ) = @_;
1154 974         1836 my $result = $handle->read( my $time_zone_abbreviation_strings, $charcnt );
1155 974 50       5932 if ( defined $result ) {
1156 974 50       2266 if ( $result != $charcnt ) {
1157 0         0 Carp::croak(
1158             "Failed to read all the time zone abbreviations from $path. $result bytes were read instead of the expected "
1159             . $charcnt );
1160             }
1161             }
1162             else {
1163 0         0 Carp::croak(
1164             "Failed to read time zone abbreviations from $path:$EXTENDED_OS_ERROR"
1165             );
1166             }
1167 974         2874 return $time_zone_abbreviation_strings;
1168             }
1169              
1170             sub _read_leap_seconds {
1171 974     974   1317 my ( $self, $handle, $path, $leapcnt, $sizeof_leap_second ) = @_;
1172 974         1239 my $sizeof_leap_seconds = $leapcnt * _PAIR() * $sizeof_leap_second;
1173 974         1940 my $result = $handle->read( my $buffer, $sizeof_leap_seconds );
1174 974 50       5278 if ( defined $result ) {
1175 974 50       2464 if ( $result != $sizeof_leap_seconds ) {
1176 0         0 Carp::croak(
1177             "Failed to read all the leap seconds from $path. $result bytes were read instead of the expected "
1178             . $sizeof_leap_seconds );
1179             }
1180             }
1181             else {
1182 0         0 Carp::croak(
1183             "Failed to read leap seconds from $path:$EXTENDED_OS_ERROR");
1184             }
1185 974         2346 my @paired_leap_seconds = unpack 'L>' . $leapcnt, $buffer;
1186 974         850 my %leap_seconds;
1187 974         1825 while (@paired_leap_seconds) {
1188 0         0 my $time_leap_second_occurs = shift @paired_leap_seconds;
1189 0         0 my $total_number_of_leap_seconds = shift @paired_leap_seconds;
1190 0         0 $leap_seconds{$time_leap_second_occurs} = $total_number_of_leap_seconds;
1191             }
1192 974         3487 return \%leap_seconds;
1193             }
1194              
1195             sub _read_is_standard_time {
1196 974     974   1313 my ( $self, $handle, $path, $ttisstdcnt ) = @_;
1197 974         1714 my $result = $handle->read( my $buffer, $ttisstdcnt );
1198 974 50       4953 if ( defined $result ) {
1199 974 50       1938 if ( $result != $ttisstdcnt ) {
1200 0         0 Carp::croak(
1201             "Failed to read all the is standard time values from $path. $result bytes were read instead of the expected "
1202             . $ttisstdcnt );
1203             }
1204             }
1205             else {
1206 0         0 Carp::croak(
1207             "Failed to read is standard time values from $path:$EXTENDED_OS_ERROR"
1208             );
1209             }
1210 974         3865 my @is_std_time = unpack 'C' . $ttisstdcnt, $buffer;
1211 974         2961 return \@is_std_time;
1212             }
1213              
1214             sub _read_is_gmt {
1215 974     974   1358 my ( $self, $handle, $path, $ttisgmtcnt ) = @_;
1216 974         1713 my $result = $handle->read( my $buffer, $ttisgmtcnt );
1217 974 50       4737 if ( defined $result ) {
1218 974 50       1966 if ( $result != $ttisgmtcnt ) {
1219 0         0 Carp::croak(
1220             "Failed to read all the is GMT values from $path. $result bytes were read instead of the expected "
1221             . $ttisgmtcnt );
1222             }
1223             }
1224             else {
1225 0         0 Carp::croak(
1226             "Failed to read is GMT values from $path:$EXTENDED_OS_ERROR");
1227             }
1228 974         3440 my @is_gmt_time = unpack 'C' . $ttisgmtcnt, $buffer;
1229 974         2955 return \@is_gmt_time;
1230             }
1231              
1232             sub _read_tz_definition {
1233 487     487   545 my ( $self, $handle, $path ) = @_;
1234 487         672 my $result =
1235             $handle->read( my $buffer, _MAX_LENGTH_FOR_TRAILING_TZ_DEFINITION() );
1236 487 50       4341 if ( defined $result ) {
1237 487 50       558 if ( $result == _MAX_LENGTH_FOR_TRAILING_TZ_DEFINITION() ) {
1238 0         0 Carp::croak(
1239             "The tz defintion at the end of $path could not be read in "
1240             . _MAX_LENGTH_FOR_TRAILING_TZ_DEFINITION()
1241             . ' bytes' );
1242             }
1243             }
1244             else {
1245 0         0 Carp::croak(
1246             "Failed to read tz definition from $path:$EXTENDED_OS_ERROR");
1247             }
1248 487 100       3179 if ( $buffer =~ /^\n([^\n]+)\n*$/smx ) {
1249 486         1602 return $self->_parse_tz_variable( $1, $path );
1250              
1251             }
1252 1         7 return;
1253             }
1254              
1255             sub _parse_tz_variable {
1256 486     486   1627 my ( $self, $tz_variable, $path ) = @_;
1257 486         1874 my $timezone_abbr_name_regex =
1258             qr/(?:[^:\d,+-][^\d,+-]{2,}|[<][+-]?\d+[>])/smx;
1259 486         2466 my $std_name_regex = qr/(?$timezone_abbr_name_regex)/smx
1260             ; # Name for standard offset from GMT
1261 486         1618 my $std_sign_regex = qr/(?[+-])/smx;
1262 486         746 my $std_hours_regex = qr/(?\d+)/smx;
1263 486         998 my $std_minutes_regex = qr/(?::(?\d+))/smx;
1264 486         648 my $std_seconds_regex = qr/(?::(?\d+))/smx;
1265 486         2273 my $std_offset_regex =
1266             qr/$std_sign_regex?$std_hours_regex$std_minutes_regex?$std_seconds_regex?/smx
1267             ; # Standard offset from GMT
1268 486         1330 my $dst_name_regex = qr/(?$timezone_abbr_name_regex)/smx
1269             ; # Name for daylight saving offset from GMT
1270 486         751 my $dst_sign_regex = qr/(?[+-])/smx;
1271 486         661 my $dst_hours_regex = qr/(?\d+)/smx;
1272 486         681 my $dst_minutes_regex = qr/(?::(?\d+))/smx;
1273 486         668 my $dst_seconds_regex = qr/(?::(?\d+))/smx;
1274 486         1939 my $dst_offset_regex =
1275             qr/$dst_sign_regex?$dst_hours_regex$dst_minutes_regex?$dst_seconds_regex?/smx
1276             ; # Standard offset from GMT
1277 486         720 my $start_julian_without_feb29_regex =
1278             qr/(?:J(?\d{1,3}))/smx;
1279 486         638 my $start_julian_with_feb29_regex =
1280             qr/(?\d{1,3})/smx;
1281 486         719 my $start_month_regex = qr/(?\d{1,2})/smx;
1282 486         596 my $start_week_regex = qr/(?[1-5])/smx;
1283 486         615 my $start_day_regex = qr/(?[0-6])/smx;
1284 486         1469 my $start_month_week_day_regex =
1285             qr/(?:M$start_month_regex[.]$start_week_regex[.]$start_day_regex)/smx;
1286 486         1836 my $start_date_regex =
1287             qr/(?:$start_julian_without_feb29_regex|$start_julian_with_feb29_regex|$start_month_week_day_regex)/smx;
1288 486         994 my $start_hour_regex = qr/(?\-?\d+)/smx;
1289 486         967 my $start_minute_regex = qr/(?::(?\d+))/smx;
1290 486         747 my $start_second_regex = qr/(?::(?\d+))/smx;
1291 486         1380 my $start_time_regex =
1292             qr/[\/]$start_hour_regex$start_minute_regex?$start_second_regex?/smx;
1293 486         1594 my $start_datetime_regex = qr/$start_date_regex(?:$start_time_regex)?/smx;
1294 486         1010 my $end_julian_without_feb29_regex =
1295             qr/(?:J(?\d{1,3}))/smx;
1296 486         671 my $end_julian_with_feb29_regex = qr/(?\d{1,3})/smx;
1297 486         600 my $end_month_regex = qr/(?\d{1,2})/smx;
1298 486         621 my $end_week_regex = qr/(?[1-5])/smx;
1299 486         647 my $end_day_regex = qr/(?[0-6])/smx;
1300 486         1552 my $end_month_week_day_regex =
1301             qr/(?:M$end_month_regex[.]$end_week_regex[.]$end_day_regex)/smx;
1302 486         1523 my $end_date_regex =
1303             qr/(?:$end_julian_without_feb29_regex|$end_julian_with_feb29_regex|$end_month_week_day_regex)/smx;
1304 486         659 my $end_hour_regex = qr/(?\-?\d+)/smx;
1305 486         668 my $end_minute_regex = qr/(?::(?\d+))/smx;
1306 486         648 my $end_second_regex = qr/(?::(?\d+))/smx;
1307 486         1801 my $end_time_regex =
1308             qr/[\/]$end_hour_regex$end_minute_regex?$end_second_regex?/smx;
1309 486         1988 my $end_datetime_regex = qr/$end_date_regex(?:$end_time_regex)?/smx;
1310              
1311 486 50       6442 if ( $tz_variable =~
1312             /^$std_name_regex$std_offset_regex(?:$dst_name_regex(?:$dst_offset_regex)?,$start_datetime_regex,$end_datetime_regex)?$/smx
1313             )
1314             {
1315 486         1448 my $tz_definition = { tz => $tz_variable };
1316 486         1168 foreach my $key (
1317             qw(std_name std_sign std_hours std_minutes std_seconds dst_name dst_sign dst_hours dst_minutes dst_seconds start_julian_without_feb29 end_julian_withou_feb29 start_julian_with_feb29 end_julian_with_feb29 start_month end_month start_week end_week start_day end_day start_hour end_hour start_minute end_minute start_second end_second)
1318             )
1319             {
1320 12636 100       32745 if ( defined $LAST_PAREN_MATCH{$key} ) {
1321 3046         11136 $tz_definition->{$key} = $LAST_PAREN_MATCH{$key};
1322             }
1323             }
1324 486         871 $self->_initialise_undefined_tz_definition_values($tz_definition);
1325             $tz_definition->{std_offset_in_seconds} =
1326 486         766 $self->_std_offset_in_seconds($tz_definition);
1327             $tz_definition->{dst_offset_in_seconds} =
1328 486         701 $self->_dst_offset_in_seconds($tz_definition);
1329 486         5674 return $tz_definition;
1330             }
1331             else {
1332 0         0 Carp::croak(
1333             "Failed to parse the tz defintion of $tz_variable from $path");
1334             }
1335             }
1336              
1337             sub _dst_offset_in_seconds {
1338 486     486   428 my ( $self, $tz_definition ) = @_;
1339 486   50     1571 my $dst_offset_in_seconds = $tz_definition->{dst_seconds} || 0;
1340 486 50       802 if ( defined $tz_definition->{dst_minutes} ) {
1341             $dst_offset_in_seconds +=
1342 0         0 $tz_definition->{dst_minutes} * _SECONDS_IN_ONE_MINUTE();
1343             }
1344 486 100       692 if ( defined $tz_definition->{dst_hours} ) {
1345             $dst_offset_in_seconds +=
1346             $tz_definition->{dst_hours} *
1347 2         9 _MINUTES_IN_ONE_HOUR() *
1348             _SECONDS_IN_ONE_MINUTE();
1349             }
1350 486 100 66     912 if ( ( defined $tz_definition->{dst_sign} )
1351             && ( $tz_definition->{dst_sign} eq q[-] ) )
1352             {
1353             }
1354             else {
1355 484         668 $dst_offset_in_seconds *= _NEGATIVE_ONE();
1356             }
1357 486 100       769 if ( $dst_offset_in_seconds == 0 ) {
1358             $dst_offset_in_seconds = $tz_definition->{std_offset_in_seconds} +
1359 484         544 ( _MINUTES_IN_ONE_HOUR() * _SECONDS_IN_ONE_MINUTE() );
1360             }
1361 486         677 return $dst_offset_in_seconds;
1362             }
1363              
1364             sub _std_offset_in_seconds {
1365 486     486   489 my ( $self, $tz_definition ) = @_;
1366 486   50     2152 my $std_offset_in_seconds = $tz_definition->{std_seconds} || 0;
1367              
1368 486 100       1126 if ( defined $tz_definition->{std_minutes} ) {
1369             $std_offset_in_seconds +=
1370 16         30 $tz_definition->{std_minutes} * _SECONDS_IN_ONE_MINUTE();
1371             }
1372 486 50       827 if ( defined $tz_definition->{std_hours} ) {
1373             $std_offset_in_seconds +=
1374             $tz_definition->{std_hours} *
1375 486         745 _MINUTES_IN_ONE_HOUR() *
1376             _SECONDS_IN_ONE_MINUTE();
1377             }
1378 486 100 66     2320 if ( ( defined $tz_definition->{std_sign} )
1379             && ( $tz_definition->{std_sign} eq q[-] ) )
1380             {
1381             }
1382             else {
1383 192         273 $std_offset_in_seconds *= _NEGATIVE_ONE();
1384             }
1385 486         770 return $std_offset_in_seconds;
1386             }
1387              
1388             sub _initialise_undefined_tz_definition_values {
1389 486     486   511 my ( $self, $tz_definition ) = @_;
1390             $tz_definition->{start_hour} =
1391             defined $tz_definition->{start_hour}
1392             ? $tz_definition->{start_hour}
1393 486 100       1193 : _DEFAULT_DST_START_HOUR();
1394             $tz_definition->{start_minute} =
1395             defined $tz_definition->{start_minute}
1396             ? $tz_definition->{start_minute}
1397 486 100       1063 : 0;
1398             $tz_definition->{start_second} =
1399             defined $tz_definition->{start_second}
1400             ? $tz_definition->{start_second}
1401 486 50       811 : 0;
1402             $tz_definition->{end_hour} =
1403             defined $tz_definition->{end_hour}
1404             ? $tz_definition->{end_hour}
1405 486 100       1149 : _DEFAULT_DST_END_HOUR();
1406             $tz_definition->{end_minute} =
1407             defined $tz_definition->{end_minute}
1408             ? $tz_definition->{end_minute}
1409 486 100       957 : 0;
1410             $tz_definition->{end_second} =
1411             defined $tz_definition->{end_second}
1412             ? $tz_definition->{end_second}
1413 486 50       784 : 0;
1414 486         600 return;
1415             }
1416              
1417             sub _set_abbrs {
1418 974     974   957 my ( $self, $tz ) = @_;
1419 974         890 my $index = 0;
1420 974         775 foreach
1421 974         2124 my $local_time_type ( @{ $self->{_tzdata}->{$tz}->{local_time_types} } )
1422             {
1423 5262 100       7404 if ( $self->{_tzdata}->{$tz}->{local_time_types}->[ $index + 1 ] ) {
1424             $local_time_type->{abbr} =
1425             substr $self->{_tzdata}->{$tz}->{time_zone_abbreviation_strings},
1426             $local_time_type->{abbrind},
1427             $self->{_tzdata}->{$tz}->{local_time_types}->[ $index + 1 ]
1428 4288         10159 ->{abbrind};
1429             }
1430             else {
1431             $local_time_type->{abbr} =
1432             substr $self->{_tzdata}->{$tz}->{time_zone_abbreviation_strings},
1433 974         2255 $local_time_type->{abbrind};
1434             }
1435 5262         12943 $local_time_type->{abbr} =~ s/\0+$//smx;
1436 5262         5318 $index += 1;
1437             }
1438 974         1186 return;
1439             }
1440              
1441             sub _read_v1_tzfile {
1442 487     487   899 my ( $self, $handle, $path, $header, $tz ) = @_;
1443             $self->{_tzdata}->{$tz}->{transition_times} =
1444             $self->_read_transition_times( $handle, $path, $header->{timecnt},
1445 487         1250 _SIZE_OF_TRANSITION_TIME_V1() );
1446             $self->{_tzdata}->{$tz}->{local_time_indexes} =
1447 487         1007 $self->_read_local_time_indexes( $handle, $path, $header->{timecnt} );
1448             $self->{_tzdata}->{$tz}->{local_time_types} =
1449 487         1277 $self->_read_local_time_types( $handle, $path, $header->{typecnt} );
1450             $self->{_tzdata}->{$tz}->{time_zone_abbreviation_strings} =
1451             $self->_read_time_zone_abbreviation_strings( $handle, $path,
1452 487         935 $header->{charcnt} );
1453 487         1251 $self->_set_abbrs($tz);
1454             $self->{_tzdata}->{$tz}->{leap_seconds} =
1455             $self->_read_leap_seconds( $handle, $path, $header->{leapcnt},
1456 487         832 _SIZE_OF_LEAP_SECOND_V1() );
1457             $self->{_tzdata}->{$tz}->{is_std} =
1458 487         1198 $self->_read_is_standard_time( $handle, $path, $header->{ttisstdcnt} );
1459             $self->{_tzdata}->{$tz}->{is_gmt} =
1460 487         1133 $self->_read_is_gmt( $handle, $path, $header->{ttisstdcnt} );
1461 487         695 return;
1462             }
1463              
1464             sub _read_v2_tzfile {
1465 487     487   629 my ( $self, $handle, $path, $header, $tz ) = @_;
1466              
1467 487 50 33     13392 if ( ( $header->{version} )
      33        
      33        
1468             && ( $header->{version} >= 2 )
1469             && ( defined $Config{'d_quad'} )
1470             && ( $Config{'d_quad'} eq 'define' ) )
1471             {
1472 487         874 $self->{_tzdata}->{$tz} = {};
1473 487         7145 $header = $self->_read_header( $handle, $path );
1474             $self->{_tzdata}->{$tz}->{transition_times} =
1475             $self->_read_transition_times( $handle, $path, $header->{timecnt},
1476 487         916 _SIZE_OF_TRANSITION_TIME_V2() );
1477             $self->{_tzdata}->{$tz}->{local_time_indexes} =
1478 487         859 $self->_read_local_time_indexes( $handle, $path, $header->{timecnt} );
1479             $self->{_tzdata}->{$tz}->{local_time_types} =
1480 487         760 $self->_read_local_time_types( $handle, $path, $header->{typecnt} );
1481             $self->{_tzdata}->{$tz}->{time_zone_abbreviation_strings} =
1482             $self->_read_time_zone_abbreviation_strings( $handle, $path,
1483 487         782 $header->{charcnt} );
1484 487         889 $self->_set_abbrs($tz);
1485             $self->{_tzdata}->{$tz}->{leap_seconds} =
1486             $self->_read_leap_seconds( $handle, $path, $header->{leapcnt},
1487 487         773 _SIZE_OF_LEAP_SECOND_V2() );
1488             $self->{_tzdata}->{$tz}->{is_std} =
1489             $self->_read_is_standard_time( $handle, $path,
1490 487         731 $header->{ttisstdcnt} );
1491             $self->{_tzdata}->{$tz}->{is_gmt} =
1492 487         721 $self->_read_is_gmt( $handle, $path, $header->{ttisstdcnt} );
1493             $self->{_tzdata}->{$tz}->{tz_definition} =
1494 487         760 $self->_read_tz_definition( $handle, $path );
1495             }
1496 487         1913 return;
1497             }
1498              
1499             sub _read_tzfile {
1500 7129     7129   6824 my ($self) = @_;
1501 7129         8745 my $tz = $self->timezone();
1502 7129         10211 my $path = File::Spec->catfile( $self->directory, $tz );
1503 7129 50       33885 my $handle = FileHandle->new($path)
1504             or Carp::croak("Failed to open $path for reading:$EXTENDED_OS_ERROR");
1505 7129 50       449067 my @stat = stat $handle
1506             or Carp::croak("Failed to stat $path:$EXTENDED_OS_ERROR");
1507 7129         16848 my $last_modified = $stat[ _STAT_MTIME_IDX() ];
1508 7129 100 66     40696 if ( ( $self->{_tzdata}->{$tz}->{last_modified} )
    100 66        
      33        
1509             && ( $self->{_tzdata}->{$tz}->{last_modified} == $last_modified ) )
1510             {
1511             }
1512             elsif (( $_tzdata_cache->{$tz} )
1513             && ( $_tzdata_cache->{$tz}->{last_modified} )
1514             && ( $_tzdata_cache->{$tz}->{last_modified} == $last_modified ) )
1515             {
1516 75         199 $self->{_tzdata}->{$tz} = $_tzdata_cache->{$tz};
1517             }
1518             else {
1519 487         941 binmode $handle;
1520 487         1634 my $header = $self->_read_header( $handle, $path );
1521 487         1711 $self->_read_v1_tzfile( $handle, $path, $header, $tz );
1522 487         1201 $self->_read_v2_tzfile( $handle, $path, $header, $tz );
1523 487         1055 $self->{_tzdata}->{$tz}->{last_modified} = $last_modified;
1524 487         2221 $_tzdata_cache->{$tz} = $self->{_tzdata}->{$tz};
1525             }
1526 7129 50       38749 close $handle
1527             or Carp::croak("Failed to close $path:$EXTENDED_OS_ERROR");
1528 7129         20078 return;
1529             }
1530              
1531             sub reset_cache {
1532 142     142 1 61582 my ($self) = @_;
1533 142 100       882 if ( ref $self ) {
1534 71         220 foreach my $key (qw(_tzdata _zonetab_last_modified _comments _zones)) {
1535 284         936 $self->{$key} = {};
1536             }
1537             }
1538             else {
1539 71         250 $_tzdata_cache = {};
1540 71         358 $_zonetab_cache = {};
1541             }
1542 142         1133 return;
1543             }
1544              
1545             1;
1546             __END__