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   41461 use 5.010;
  3         9  
4 3     3   10 use strict;
  3         4  
  3         46  
5 3     3   8 use warnings;
  3         6  
  3         65  
6              
7 3     3   1153 use FileHandle();
  3         22012  
  3         63  
8 3     3   15 use File::Spec();
  3         5  
  3         44  
9 3     3   12 use Config;
  3         4  
  3         94  
10 3     3   9 use Carp();
  3         3  
  3         45  
11 3     3   1294 use English qw( -no_match_vars );
  3         8264  
  3         12  
12 3     3   2028 use DirHandle();
  3         1015  
  3         55  
13 3     3   1230 use POSIX();
  3         12652  
  3         18971  
14              
15             our $VERSION = '0.10';
16              
17 1948     1948   5496 sub _SIZE_OF_TZ_HEADER { return 44 }
18 1461     1461   3444 sub _SIZE_OF_TRANSITION_TIME_V1 { return 4 }
19 974     974   1910 sub _SIZE_OF_TRANSITION_TIME_V2 { return 8 }
20 974     974   2216 sub _SIZE_OF_TTINFO { return 6 }
21 487     487   1596 sub _SIZE_OF_LEAP_SECOND_V1 { return 4 }
22 487     487   961 sub _SIZE_OF_LEAP_SECOND_V2 { return 8 }
23 974     974   2604 sub _PAIR { return 2 }
24 7175     7175   10260 sub _STAT_MTIME_IDX { return 9 }
25 974     974   2151 sub _MAX_LENGTH_FOR_TRAILING_TZ_DEFINITION { return 256 }
26 108     108   90 sub _MONTHS_IN_ONE_YEAR { return 12 }
27 108     108   96 sub _HOURS_IN_ONE_DAY { return 24 }
28 1106     1106   2172 sub _MINUTES_IN_ONE_HOUR { return 60 }
29 30561     30561   27418 sub _SECONDS_IN_ONE_MINUTE { return 60 }
30 8526     8526   6935 sub _SECONDS_IN_ONE_HOUR { return 3_600 }
31 152021     152021   123177 sub _SECONDS_IN_ONE_DAY { return 86_400 }
32 676     676   811 sub _NEGATIVE_ONE { return -1 }
33 2113     2113   3682 sub _LOCALTIME_ISDST_INDEX { return 8 }
34 26     26   54 sub _LOCALTIME_DAY_OF_WEEK_INDEX { return 6 }
35 36446     36446   42722 sub _LOCALTIME_YEAR_INDEX { return 5 }
36 4607     4607   6128 sub _LOCALTIME_MONTH_INDEX { return 4 }
37 11227     11227   13577 sub _LOCALTIME_DAY_INDEX { return 3 }
38 7215     7215   8345 sub _LOCALTIME_HOUR_INDEX { return 2 }
39 27724     27724   29662 sub _LOCALTIME_MINUTE_INDEX { return 1 }
40 844     844   2028 sub _LOCALTIME_SECOND_INDEX { return 0 }
41 3012     3012   5607 sub _LOCALTIME_BASE_YEAR { return 1900 }
42 3869     3869   5199 sub _EPOCH_YEAR { return 1970 }
43 2999     2999   3820 sub _EPOCH_WDAY { return 4 }
44 3025     3025   8264 sub _DAYS_IN_JANUARY { return 31 }
45 1676     1676   2702 sub _DAYS_IN_FEBRUARY_LEAP_YEAR { return 29 }
46 1349     1349   1923 sub _DAYS_IN_FEBRUARY_NON_LEAP { return 28 }
47 3025     3025   4845 sub _DAYS_IN_MARCH { return 31 }
48 3025     3025   4496 sub _DAYS_IN_APRIL { return 30 }
49 3025     3025   4276 sub _DAYS_IN_MAY { return 31 }
50 3025     3025   4212 sub _DAYS_IN_JUNE { return 30 }
51 3025     3025   3896 sub _DAYS_IN_JULY { return 31 }
52 3025     3025   4488 sub _DAYS_IN_AUGUST { return 31 }
53 3025     3025   4015 sub _DAYS_IN_SEPTEMBER { return 30 }
54 3025     3025   4350 sub _DAYS_IN_OCTOBER { return 31 }
55 3025     3025   3943 sub _DAYS_IN_NOVEMBER { return 30 }
56 3025     3025   8680 sub _DAYS_IN_DECEMBER { return 31 }
57 30567     30567   33432 sub _DAYS_IN_A_LEAP_YEAR { return 366 }
58 92492     92492   97657 sub _DAYS_IN_A_NON_LEAP_YEAR { return 365 }
59 26     26   66 sub _LAST_WEEK_VALUE { return 5 }
60 0     0   0 sub _LOCALTIME_WEEKDAY_HIGHEST_VALUE { return 6 }
61 3116     3116   4189 sub _DAYS_IN_ONE_WEEK { return 7 }
62 122978     122978   233057 sub _EVERY_FOUR_HUNDRED_YEARS { return 400 }
63 120745     120745   212753 sub _EVERY_FOUR_YEARS { return 4 }
64 28860     28860   58877 sub _EVERY_ONE_HUNDRED_YEARS { return 100 }
65 445     445   1228 sub _DEFAULT_DST_START_HOUR { return 2 }
66 337     337   613 sub _DEFAULT_DST_END_HOUR { return 2 }
67              
68             sub _TIMEZONE_FULL_NAME_REGEX {
69 18869     18869   30466 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   325 sub _DEFAULT_ZONEINFO_DIRECTORY { return $_default_zoneinfo_directory }
84              
85             sub new {
86 79     79 1 858287 my ( $class, $params ) = @_;
87 79         298 my $self = {};
88 79         183 bless $self, $class;
89             $self->directory( $params->{directory}
90             || $ENV{TZDIR}
91 79   33     756 || _DEFAULT_ZONEINFO_DIRECTORY() );
92 79 100       168 if ( defined $params->{offset} ) {
93 1         4 $self->offset( $params->{offset} );
94             }
95             else {
96 78   66     330 $self->timezone( $params->{timezone} || $ENV{TZ} );
97             }
98 79         242 return $self;
99             }
100              
101             sub directory {
102 7820     7820 1 11486 my ( $self, $new ) = @_;
103 7820         10736 my $old = $self->{directory};
104 7820 100       14318 if ( @_ > 1 ) {
105 79         217 $self->{directory} = $new;
106             }
107 7820         92706 return $old;
108             }
109              
110             sub offset {
111 4166     4166 1 4532 my ( $self, $new ) = @_;
112 4166         5780 my $old = $self->{offset};
113 4166 100       8635 if ( @_ > 1 ) {
114 2         6 $self->{offset} = $new;
115 2         6 delete $self->{tz};
116             }
117 4166         9893 return $old;
118             }
119              
120             sub equiv {
121 3     3 1 19 my ( $self, $time_zone, $from_time ) = @_;
122 3   66     17 $from_time //= time;
123 3         6 my $class = ref $self;
124 3         22 my $compare = $class->new( { 'timezone' => $time_zone } );
125 3         7 my %offsets_compare;
126 3         9 foreach my $transition_time ( $compare->transition_times() ) {
127 319 100       553 if ( $transition_time >= $from_time ) {
128 179         268 $offsets_compare{$transition_time} =
129             $compare->local_offset($transition_time);
130             }
131             }
132 3         88 my %offsets_self;
133 3         9 foreach my $transition_time ( $self->transition_times() ) {
134 426 100       716 if ( $transition_time >= $from_time ) {
135 219         296 $offsets_self{$transition_time} =
136             $self->local_offset($transition_time);
137             }
138             }
139 3 100       131 if ( scalar keys %offsets_compare == scalar keys %offsets_self ) {
140 1         23 foreach my $transition_time ( sort { $a <=> $b } keys %offsets_compare )
  184         116  
141             {
142 43 50 33     156 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         22 return 1;
154             }
155 2         123 return;
156             }
157              
158             sub _timezones {
159 46     46   58 my ($self) = @_;
160 46         106 my $path = File::Spec->catfile( $self->directory(), 'zone.tab' );
161 46 50       289 my $handle = FileHandle->new($path)
162             or Carp::croak("Failed to open $path for reading:$EXTENDED_OS_ERROR");
163 46 50       3260 my @stat = stat $handle
164             or Carp::croak("Failed to stat $path:$EXTENDED_OS_ERROR");
165 46         149 my $last_modified = $stat[ _STAT_MTIME_IDX() ];
166 46 100 66     293 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         8 foreach my $key (qw(_zonetab_last_modified _comments _zones)) {
175 6         14 $self->{$key} = $_zonetab_cache->{$key};
176             }
177             }
178             else {
179 3         9 $self->{_zones} = [];
180 3         7 $self->{_comments} = {};
181 3         233048 while ( my $line = <$handle> ) {
182 1320 100       2252 next if ( $line =~ /^[#]/smx );
183 1248         1196 chomp $line;
184 1248         3486 my ( $country_code, $coordinates, $timezone, $comment ) =
185             split /\t/smx, $line;
186 1248         1291 push @{ $self->{_zones} }, $timezone;
  1248         1672  
187 1248         4082201 $self->{_comments}->{$timezone} = $comment;
188             }
189 3 50       37 close $handle
190             or Carp::croak("Failed to close $path:$EXTENDED_OS_ERROR");
191 3         8 $self->{_zonetab_last_modified} = $last_modified;
192 3         10 foreach my $key (qw(_zonetab_last_modified _comments _zones)) {
193 9         20 $_zonetab_cache->{$key} = $self->{$key};
194             }
195             }
196 46         66 my @sorted_zones = sort { $a cmp $b } @{ $self->{_zones} };
  139656         136700  
  46         650  
197 46         5255 return @sorted_zones;
198             }
199              
200             sub areas {
201 22     22 1 76924157 my ($self) = @_;
202 22         37 my %areas;
203 22         66 foreach my $timezone ( $self->_timezones() ) {
204 9152         8428 my $timezone_full_name_regex = _TIMEZONE_FULL_NAME_REGEX();
205 9152 50       27624 if ( $timezone =~ /^$timezone_full_name_regex$/smx ) {
206 9152         29702 $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         681 my @sorted_areas = sort { $a cmp $b } keys %areas;
  484         415  
214 22         166 return @sorted_areas;
215             }
216              
217             sub locations {
218 22     22 1 1216 my ( $self, $area ) = @_;
219 22 50       56 if ( !length $area ) {
220 0         0 return ();
221             }
222 22         23 my %locations;
223 22         69 foreach my $timezone ( $self->_timezones() ) {
224 9152         8210 my $timezone_full_name_regex = _TIMEZONE_FULL_NAME_REGEX();
225 9152 50       26819 if ( $timezone =~ /^$timezone_full_name_regex$/smx ) {
226 9152 50 66     33763 if ( ( $area eq $LAST_PAREN_MATCH{area} )
227             && ( $LAST_PAREN_MATCH{location} ) )
228             {
229 856         3129 $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         769 my @sorted_locations = sort { $a cmp $b } keys %locations;
  4107         2759  
238 22         238 return @sorted_locations;
239             }
240              
241             sub comment {
242 2     2 1 8 my ( $self, $tz ) = @_;
243 2   33     7 $tz ||= $self->timezone();
244 2         5 $self->_timezones();
245 2 50       14 if ( defined $self->{_comments}->{$tz} ) {
246 2         15 return $self->{_comments}->{$tz};
247             }
248             else {
249 0         0 return;
250             }
251             }
252              
253             sub area {
254 3     3 1 9 my ($self) = @_;
255 3         11 return $self->{area};
256             }
257              
258             sub location {
259 6     6 1 750 my ($self) = @_;
260 6         24 return $self->{location};
261             }
262              
263             sub timezone {
264 16043     16043 1 1512958 my ( $self, $new ) = @_;
265 16043         20082 my $old = $self->{tz};
266 16043 100       28392 if ( @_ > 1 ) {
267 567 100       1318 if ( defined $new ) {
268 565         1662 my $timezone_full_name_regex = _TIMEZONE_FULL_NAME_REGEX();
269 565 50       9155 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         7651 $self->{area} = $LAST_PAREN_MATCH{area};
274 565         2783 $self->{location} = $LAST_PAREN_MATCH{location};
275 565         2248 my $path = File::Spec->catfile( $self->directory(), $new );
276 565 50       15729 if ( !-f $path ) {
277 0         0 Carp::croak(
278             "'$new' is not an timezone in the existing Olson database");
279             }
280             }
281 567         1356 $self->{tz} = $new;
282 567         750 delete $self->{offset};
283             }
284 16043         24842 return $old;
285             }
286              
287             sub _is_leap_year {
288 122978     122978   97148 my ( $self, $year ) = @_;
289 122978         77510 my $leap_year;
290 122978 100 100     110964 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         25607 $leap_year = 1;
297             }
298             else {
299 91897         68248 $leap_year = 0;
300             }
301 122978         121116 return $leap_year;
302             }
303              
304             sub _in_dst_according_to_tz {
305 13     13   30 my ( $self, $check_time, $tz_definition ) = @_;
306              
307 13 50 33     296 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         55 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         54 $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         41 $tz_definition->{dst_offset_in_seconds};
337              
338 13 50       43 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     118 if ( ( $check_time < $dst_start_time )
347             || ( $dst_end_time < $check_time ) )
348             {
349 13         55 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   55 my ( $self, $wday, $week, $month, $year ) = @_;
359              
360 26         36 my $check_year = _EPOCH_YEAR();
361 26         32 my $time = 0;
362 26         21 my $increment = 0;
363 26         25 my $leap_year = 1;
364 26         53 while ( $check_year < $year ) {
365 1742         1108 $check_year += 1;
366 1742 100       1650 if ( $self->_is_leap_year($check_year) ) {
367 442         299 $leap_year = 1;
368 442         395 $increment = _DAYS_IN_A_LEAP_YEAR() * _SECONDS_IN_ONE_DAY();
369             }
370             else {
371 1300         830 $leap_year = 0;
372 1300         1114 $increment = _DAYS_IN_A_NON_LEAP_YEAR() * _SECONDS_IN_ONE_DAY();
373             }
374 1742         2371 $time += $increment;
375             }
376              
377 26         28 $increment = 0;
378 26         22 my $check_month = 1;
379 26         50 my @days_in_month = $self->_days_in_month($leap_year);
380 26         76 while ( $check_month < $month ) {
381              
382 156         158 $increment = $days_in_month[ $check_month - 1 ] * _SECONDS_IN_ONE_DAY();
383 156         113 $time += $increment;
384 156         209 $check_month += 1;
385             }
386              
387 26 50       48 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         45 my $check_day_of_week =
404             ( $self->_gm_time($time) )[ _LOCALTIME_DAY_OF_WEEK_INDEX() ];
405 26         54 my $check_week = 1;
406 26         40 $increment = _DAYS_IN_ONE_WEEK() * _SECONDS_IN_ONE_DAY();
407 26         56 while ( $check_week < $week ) {
408 0         0 $check_week += 1;
409 0         0 $time += $increment;
410             }
411              
412 26         71 while ( $check_day_of_week != $wday ) {
413              
414 91         93 $time += _SECONDS_IN_ONE_DAY();
415 91         58 $check_day_of_week += 1;
416 91         93 $check_day_of_week = $check_day_of_week % _DAYS_IN_ONE_WEEK();
417             }
418             }
419              
420 26         79 return $time;
421             }
422              
423             sub _get_tz_offset_according_to_v2_tz_rule {
424 799     799   923 my ( $self, $time ) = @_;
425 799 50       1222 if ( defined $self->offset() ) {
426 0         0 return ( 0, $self->offset() * _SECONDS_IN_ONE_MINUTE(), q[] );
427             }
428 799         1354 my $tz = $self->timezone();
429 799         819 my ( $isdst, $gmtoff, $abbr );
430 799         1409 my $tz_definition = $self->{_tzdata}->{$tz}->{tz_definition};
431 799 50       1546 if ( defined $tz_definition->{std_name} ) {
432 799 100       1154 if ( defined $tz_definition->{dst_name} ) {
433 13 50       45 if ( $self->_in_dst_according_to_tz( $time, $tz_definition ) ) {
434 13         16 $isdst = 1;
435 13         27 $gmtoff = $tz_definition->{dst_offset_in_seconds};
436 13         31 $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         689 $isdst = 0;
446 786         720 $gmtoff = $tz_definition->{std_offset_in_seconds};
447 786         914 $abbr = $tz_definition->{std_name};
448             }
449             }
450 799         2376 return ( $isdst, $gmtoff, $abbr );
451             }
452              
453             sub _negative_gm_time {
454 81     81   83 my ( $self, $time ) = @_;
455 81         244 my $year = _EPOCH_YEAR() - 1;
456 81         101 my $wday = _EPOCH_WDAY() - 1;
457 81         89 my $check_time = 0;
458 81         56 my $number_of_days = 0;
459 81         85 my $leap_year;
460 81         63 YEAR: while (1) {
461 3105         2870 $leap_year = $self->_is_leap_year($year);
462 3105         3086 $number_of_days = $self->_number_of_days_in_a_year($leap_year);
463 3105         2824 my $increment = $number_of_days * _SECONDS_IN_ONE_DAY();
464 3105 100       3944 if ( $check_time - $increment > $time ) {
465 3024         2121 $check_time -= $increment;
466 3024         1845 $wday -= $number_of_days;
467 3024         2340 $year -= 1;
468             }
469             else {
470 81         185 last YEAR;
471             }
472             }
473 81         94 my $yday = $self->_number_of_days_in_a_year($leap_year);
474 81         97 $year -= _LOCALTIME_BASE_YEAR();
475              
476 81         93 my $month = _MONTHS_IN_ONE_YEAR();
477 81         106 my @days_in_month = $self->_days_in_month($leap_year);
478 81         71 MONTH: while (1) {
479              
480 741         554 $number_of_days = $days_in_month[ $month - 1 ];
481 741         608 my $increment = $number_of_days * _SECONDS_IN_ONE_DAY();
482 741 100       899 if ( $check_time - $increment > $time ) {
483 660         499 $check_time -= $increment;
484 660         408 $wday -= $number_of_days;
485 660         365 $yday -= $number_of_days;
486 660         492 $month -= 1;
487             }
488             else {
489 81         85 last MONTH;
490             }
491             }
492 81         50 $month -= 1;
493              
494 81         79 my $day = $days_in_month[$month];
495 81         71 my $increment = _SECONDS_IN_ONE_DAY();
496 81         67 DAY: while (1) {
497 1206 100       1407 if ( $check_time - $increment > $time ) {
498 1125         754 $check_time -= $increment;
499 1125         640 $day -= 1;
500 1125         621 $yday -= 1;
501 1125         744 $wday -= 1;
502             }
503             else {
504 81         84 last DAY;
505             }
506             }
507              
508 81         91 $wday = abs $wday % _DAYS_IN_ONE_WEEK();
509              
510 81         88 my $hour = _HOURS_IN_ONE_DAY() - 1;
511 81         102 $increment = _SECONDS_IN_ONE_HOUR();
512 81         53 HOUR: while (1) {
513 1770 100       1881 if ( $check_time - $increment > $time ) {
514 1689         1140 $check_time -= $increment;
515 1689         1074 $hour -= 1;
516             }
517             else {
518 81         78 last HOUR;
519             }
520             }
521 81         77 my $minute = _MINUTES_IN_ONE_HOUR() - 1;
522 81         74 $increment = _SECONDS_IN_ONE_MINUTE();
523 81         85 MINUTE: while (1) {
524 3318 100       3413 if ( $check_time - $increment > $time ) {
525 3237         2128 $check_time -= $increment;
526 3237         2041 $minute -= 1;
527             }
528             else {
529 81         70 last MINUTE;
530             }
531             }
532 81         87 my $seconds = _SECONDS_IN_ONE_MINUTE() - ( $check_time - $time );
533              
534 81         387 return ( $seconds, $minute, $hour, $day, $month, "$year", $wday, $yday, 0 );
535             }
536              
537             sub _positive_gm_time {
538 2074     2074   3105 my ( $self, $time ) = @_;
539 2074         7528 my $year = _EPOCH_YEAR();
540 2074         3789 my $wday = _EPOCH_WDAY();
541 2074         2494 my $check_time = 0;
542 2074         1966 my $number_of_days = 0;
543 2074         1732 my $leap_year;
544 2074         2020 YEAR: while (1) {
545 84230         87111 $leap_year = $self->_is_leap_year($year);
546 84230         92801 $number_of_days = $self->_number_of_days_in_a_year($leap_year);
547 84230         85144 my $increment = $number_of_days * _SECONDS_IN_ONE_DAY();
548 84230 100       122377 if ( $check_time + $increment <= $time ) {
549 82156         62921 $check_time += $increment;
550 82156         53913 $wday += $number_of_days;
551 82156         72520 $year += 1;
552             }
553             else {
554 2074         4810 last YEAR;
555             }
556             }
557 2074         3245 $year -= _LOCALTIME_BASE_YEAR();
558              
559 2074         2055 my $month = 0;
560 2074         4388 my @days_in_month = $self->_days_in_month($leap_year);
561 2074         2591 my $yday = 0;
562 2074         1714 MONTH: while (1) {
563              
564 11728         9542 $number_of_days = $days_in_month[$month];
565 11728         11813 my $increment = $number_of_days * _SECONDS_IN_ONE_DAY();
566 11728 100       18452 if ( $check_time + $increment <= $time ) {
567 9654         8589 $check_time += $increment;
568 9654         6663 $wday += $number_of_days;
569 9654         6993 $yday += $number_of_days;
570 9654         8450 $month += 1;
571             }
572             else {
573 2074         2700 last MONTH;
574             }
575             }
576 2074         1862 my $day = 1;
577 2074         2364 my $increment = _SECONDS_IN_ONE_DAY();
578 2074         1914 DAY: while (1) {
579 27128 100       36332 if ( $check_time + $increment <= $time ) {
580 25054         20074 $check_time += $increment;
581 25054         18013 $day += 1;
582 25054         16615 $yday += 1;
583 25054         18604 $wday += 1;
584             }
585             else {
586 2074         2449 last DAY;
587             }
588             }
589              
590 2074         3513 $wday = $wday % _DAYS_IN_ONE_WEEK();
591              
592 2074         1971 my $hour = 0;
593 2074         3032 $increment = _SECONDS_IN_ONE_HOUR();
594 2074         2725 HOUR: while (1) {
595 14779 100       18891 if ( $check_time + $increment <= $time ) {
596 12705         10019 $check_time += $increment;
597 12705         9538 $hour += 1;
598             }
599             else {
600 2074         2906 last HOUR;
601             }
602             }
603 2074         2143 my $minute = 0;
604 2074         2953 $increment = _SECONDS_IN_ONE_MINUTE();
605 2074         3138 MINUTE: while (1) {
606 61557 100       72177 if ( $check_time + $increment <= $time ) {
607 59483         43005 $check_time += $increment;
608 59483         42397 $minute += 1;
609             }
610             else {
611 2074         2733 last MINUTE;
612             }
613             }
614 2074         12587 my $seconds = $time - $check_time;
615              
616 2074         17559 return ( $seconds, $minute, $hour, $day, $month, "$year", $wday, $yday, 0 );
617             }
618              
619             sub _gm_time {
620 2155     2155   3103 my ( $self, $time ) = @_;
621 2155         2582 my @gmtime;
622 2155 100       5367 if ( $time < 0 ) {
623 81         166 @gmtime = $self->_negative_gm_time($time);
624             }
625             else {
626 2074         6809 @gmtime = $self->_positive_gm_time($time);
627             }
628 2155 100       4547 if (wantarray) {
629 2152         8760 return @gmtime;
630             }
631             else {
632 3         48 return POSIX::strftime( '%a %b %e %H:%M:%S %Y', @gmtime );
633             }
634             }
635              
636             sub time_local {
637 844     844 1 5786 my ( $self, @localtime ) = @_;
638 844         1730 my $time = 0;
639 844         1652 $localtime[ _LOCALTIME_YEAR_INDEX() ] += _LOCALTIME_BASE_YEAR();
640 844 100       1244 if ( $localtime[ _LOCALTIME_YEAR_INDEX() ] >= _EPOCH_YEAR() ) {
641 817         2200 return $self->_positive_time_local(@localtime);
642             }
643             else {
644 27         43 return $self->_negative_time_local(@localtime);
645             }
646             }
647              
648             sub _positive_time_local {
649 817     817   2381 my ( $self, @localtime ) = @_;
650 817         1352 my $check_year = _EPOCH_YEAR();
651 817         1375 my $wday = _EPOCH_WDAY();
652 817         1265 my $time = 0;
653 817         879 my $leap_year = 0;
654 817         718 YEAR: while (1) {
655              
656 33710 100       31546 if ( $check_year < $localtime[ _LOCALTIME_YEAR_INDEX() ] ) {
657 32893         33804 $time += $self->_number_of_days_in_a_year($leap_year) *
658             _SECONDS_IN_ONE_DAY();
659 32893         23950 $check_year += 1;
660 32893         32562 $leap_year = $self->_is_leap_year($check_year);
661             }
662             else {
663 817         1151 last YEAR;
664             }
665             }
666              
667 817         752 my $check_month = 0;
668 817         1267 my @days_in_month = $self->_days_in_month($leap_year);
669 817         1088 MONTH: while (1) {
670              
671 4360 100       4755 if ( $check_month < $localtime[ _LOCALTIME_MONTH_INDEX() ] ) {
672 3543         4190 $time += $days_in_month[$check_month] * _SECONDS_IN_ONE_DAY();
673 3543         3144 $check_month += 1;
674             }
675             else {
676 817         1085 last MONTH;
677             }
678             }
679 817         1261 my $check_day = 1;
680 817         689 DAY: while (1) {
681 10825 100       10656 if ( $check_day < $localtime[ _LOCALTIME_DAY_INDEX() ] ) {
682 10008         9552 $time += _SECONDS_IN_ONE_DAY();
683 10008         8099 $check_day += 1;
684             }
685             else {
686 817         855 last DAY;
687             }
688             }
689              
690 817         1164 $wday = $wday % _DAYS_IN_ONE_WEEK();
691              
692 817         906 my $check_hour = 0;
693 817         724 HOUR: while (1) {
694 6625 100       6413 if ( $check_hour < $localtime[ _LOCALTIME_HOUR_INDEX() ] ) {
695 5808         5502 $time += _SECONDS_IN_ONE_HOUR();
696 5808         4571 $check_hour += 1;
697             }
698             else {
699 817         824 last HOUR;
700             }
701             }
702 817         971 my $check_minute = 0;
703 817         772 MINUTE: while (1) {
704 26591 100       23506 if ( $check_minute < $localtime[ _LOCALTIME_MINUTE_INDEX() ] ) {
705 25774         22026 $time += _SECONDS_IN_ONE_MINUTE();
706 25774         21998 $check_minute += 1;
707             }
708             else {
709 817         914 last MINUTE;
710             }
711             }
712 817         1412 $time += $localtime[ _LOCALTIME_SECOND_INDEX() ];
713 817         3439 my ( $isdst, $gmtoff, $abbr ) =
714             $self->_get_isdst_gmtoff_abbr_calculating_for_time_local($time);
715 817         2199 $time -= $gmtoff;
716              
717 817         5541 return $time;
718             }
719              
720             sub _days_in_month {
721 3025     3025   3095 my ( $self, $leap_year ) = @_;
722             return (
723 3025 100       4541 _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   95844 my ( $self, $leap_year ) = @_;
744 121317 100       123980 if ($leap_year) {
745 30125         30018 return _DAYS_IN_A_LEAP_YEAR();
746             }
747             else {
748 91192         84877 return _DAYS_IN_A_NON_LEAP_YEAR();
749             }
750             }
751              
752             sub _negative_time_local {
753 27     27   54 my ( $self, @localtime ) = @_;
754 27         28 my $check_year = _EPOCH_YEAR() - 1;
755 27         28 my $wday = _EPOCH_WDAY();
756 27         21 my $time = 0;
757 27         20 my $leap_year;
758 27         26 YEAR: while (1) {
759              
760 1035 100       923 if ( $check_year > $localtime[ _LOCALTIME_YEAR_INDEX() ] ) {
761 1008         937 $time -= $self->_number_of_days_in_a_year($leap_year) *
762             _SECONDS_IN_ONE_DAY();
763 1008         641 $check_year -= 1;
764 1008         937 $leap_year = $self->_is_leap_year($check_year);
765             }
766             else {
767 27         31 last YEAR;
768             }
769             }
770              
771 27         36 my $check_month = _MONTHS_IN_ONE_YEAR() - 1;
772 27         32 my @days_in_month = $self->_days_in_month($leap_year);
773 27         44 MONTH: while (1) {
774              
775 247 100       221 if ( $check_month > $localtime[ _LOCALTIME_MONTH_INDEX() ] ) {
776 220         200 $time -= $days_in_month[$check_month] * _SECONDS_IN_ONE_DAY();
777 220         156 $check_month -= 1;
778             }
779             else {
780 27         22 last MONTH;
781             }
782             }
783 27         25 my $check_day = $days_in_month[$check_month];
784 27         17 DAY: while (1) {
785 402 100       337 if ( $check_day > $localtime[ _LOCALTIME_DAY_INDEX() ] ) {
786 375         298 $time -= _SECONDS_IN_ONE_DAY();
787 375         251 $check_day -= 1;
788             }
789             else {
790 27         21 last DAY;
791             }
792             }
793              
794 27         30 $wday = $wday % _DAYS_IN_ONE_WEEK();
795              
796 27         25 my $check_hour = _HOURS_IN_ONE_DAY() - 1;
797 27         21 HOUR: while (1) {
798 590 100       460 if ( $check_hour > $localtime[ _LOCALTIME_HOUR_INDEX() ] ) {
799 563         479 $time -= _SECONDS_IN_ONE_HOUR();
800 563         406 $check_hour -= 1;
801             }
802             else {
803 27         21 last HOUR;
804             }
805             }
806 27         30 my $check_minute = _MINUTES_IN_ONE_HOUR();
807 27         21 MINUTE: while (1) {
808 1133 100       942 if ( $check_minute > $localtime[ _LOCALTIME_MINUTE_INDEX() ] ) {
809 1106         925 $time -= _SECONDS_IN_ONE_MINUTE();
810 1106         897 $check_minute -= 1;
811             }
812             else {
813 27         26 last MINUTE;
814             }
815             }
816 27         43 $time += $localtime[ _LOCALTIME_SECOND_INDEX() ];
817 27         61 my ( $isdst, $gmtoff, $abbr ) =
818             $self->_get_isdst_gmtoff_abbr_calculating_for_time_local($time);
819 27         41 $time -= $gmtoff;
820              
821 27         138 return $time;
822             }
823              
824             sub _get_first_standard_time_type {
825 3353     3353   4826 my ( $self, $tz ) = @_;
826 3353         2694 my $first_standard_time_type;
827 3353 50       9458 if ( defined $self->{_tzdata}->{$tz}->{local_time_types}->[0] ) {
828             $first_standard_time_type =
829 3353         5297 $self->{_tzdata}->{$tz}->{local_time_types}->[0];
830             }
831             FIRST_STANDARD_TIME_TYPE:
832 3353         2863 foreach
833 3353         9698 my $local_time_type ( @{ $self->{_tzdata}->{$tz}->{local_time_types} } )
834             {
835 3353 50       8086 if ( $local_time_type->{isdst} ) {
836             }
837             else {
838 3353         3822 $first_standard_time_type = $local_time_type;
839 3353         4782 last FIRST_STANDARD_TIME_TYPE;
840             }
841             }
842 3353         4971 return $first_standard_time_type;
843             }
844              
845             sub _get_isdst_gmtoff_abbr_calculating_for_time_local {
846 844     844   1597 my ( $self, $time ) = @_;
847 844 100       3020 if ( defined $self->offset() ) {
848 2         4 return ( 0, $self->offset() * _SECONDS_IN_ONE_MINUTE(), q[] );
849             }
850 842         891 my ( $isdst, $gmtoff, $abbr );
851 842         1526 my $tz = $self->timezone();
852 842         1840 $self->_read_tzfile();
853 842         2125 my $first_standard_time_type = $self->_get_first_standard_time_type($tz);
854 842         856 my $transition_index = 0;
855 842         625 my $transition_time_found;
856 842         1905 my $previous_offset = $first_standard_time_type->{gmtoff};
857 842         1618 my $first_transition_time;
858             TRANSITION_TIME:
859              
860 842         1674 foreach my $transition_time_in_gmt ( $self->transition_times() ) {
861              
862 51205 100       74715 if ( !defined $first_transition_time ) {
863 842         3194 $first_transition_time = $transition_time_in_gmt;
864             }
865             my $local_time_index =
866 51205         72296 $self->{_tzdata}->{$tz}->{local_time_indexes}->[$transition_index];
867             my $local_time_type =
868 51205         53293 $self->{_tzdata}->{$tz}->{local_time_types}->[$local_time_index];
869 51205 100       69107 if ( $local_time_type->{gmtoff} < $previous_offset ) {
870 25045 100 100     89074 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         333 $transition_time_found = 1;
877 210         566 last TRANSITION_TIME;
878             }
879             elsif (
880             $transition_time_in_gmt > $time - $local_time_type->{gmtoff} )
881             {
882 276         328 $transition_time_found = 1;
883 276         701 last TRANSITION_TIME;
884             }
885             }
886             else {
887 26160 100       51398 if ( $transition_time_in_gmt > $time - $local_time_type->{gmtoff} )
888             {
889 92         105 $transition_time_found = 1;
890 92         215 last TRANSITION_TIME;
891             }
892             }
893 50627         40639 $transition_index += 1;
894 50627         67459 $previous_offset = $local_time_type->{gmtoff};
895             }
896 842         6709 my $offset_found;
897 842 100 33     11644 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         4 $gmtoff = $first_standard_time_type->{gmtoff};
905 1         2 $isdst = $first_standard_time_type->{isdst};
906 1         2 $abbr = $first_standard_time_type->{abbr};
907 1         3 $offset_found = 1;
908             }
909             elsif ( !$transition_time_found ) {
910 264         683 ( $isdst, $gmtoff, $abbr ) =
911             $self->_get_tz_offset_according_to_v2_tz_rule($time);
912 264 50       563 if ( defined $gmtoff ) {
913 264         349 $offset_found = 1;
914             }
915             }
916 842 100       3442 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         1462 ->[ $transition_index - 1 ];
924             my $local_time_type =
925 577         1204 $self->{_tzdata}->{$tz}->{local_time_types}->[$local_time_index];
926 577         1084 $gmtoff = $local_time_type->{gmtoff};
927 577         1151 $isdst = $local_time_type->{isdst};
928 577         1679 $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         5326 return ( $isdst, $gmtoff, $abbr );
936             }
937              
938             sub _get_isdst_gmtoff_abbr_calculating_for_local_time {
939 2515     2515   4195 my ( $self, $time ) = @_;
940 2515         2698 my ( $isdst, $gmtoff, $abbr );
941 2515 100       7320 if ( defined $self->offset() ) {
942 4         7 return ( 0, $self->offset() * _SECONDS_IN_ONE_MINUTE(), q[] );
943             }
944 2511         6753 my $tz = $self->timezone();
945 2511         9287 $self->_read_tzfile();
946 2511         3017 my $transition_index = 0;
947 2511         2745 my $transition_time_found;
948             my $first_transition_time;
949             TRANSITION_TIME:
950 2511         5803 foreach my $transition_time_in_gmt ( $self->transition_times() ) {
951              
952 171405 100       237018 if ( !defined $first_transition_time ) {
953 2511         12126 $first_transition_time = $transition_time_in_gmt;
954             }
955 171405 100       250648 if ( $transition_time_in_gmt > $time ) {
956 1976         2149 $transition_time_found = 1;
957 1976         4147 last TRANSITION_TIME;
958             }
959 169429         167165 $transition_index += 1;
960             }
961 2511         28416 my $first_standard_time_type = $self->_get_first_standard_time_type($tz);
962 2511         2171 my $offset_found;
963 2511 100 66     19468 if ( ( defined $first_transition_time )
    100          
964             && ( $time < $first_transition_time ) )
965             {
966 3         11 $gmtoff = $first_standard_time_type->{gmtoff};
967 3         15 $isdst = $first_standard_time_type->{isdst};
968 3         6 $abbr = $first_standard_time_type->{abbr};
969 3         6 $offset_found = 1;
970             }
971             elsif ( !$transition_time_found ) {
972 535         1768 ( $isdst, $gmtoff, $abbr ) =
973             $self->_get_tz_offset_according_to_v2_tz_rule($time);
974 535 50       1134 if ( defined $gmtoff ) {
975 535         636 $offset_found = 1;
976             }
977             }
978 2511 100       9602 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         4470 ->[ $transition_index - 1 ];
986             my $local_time_type =
987 1973         3838 $self->{_tzdata}->{$tz}->{local_time_types}->[$local_time_index];
988 1973         3151 $gmtoff = $local_time_type->{gmtoff};
989 1973         3348 $isdst = $local_time_type->{isdst};
990 1973         5506 $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         10796 return ( $isdst, $gmtoff, $abbr );
998             }
999              
1000             sub local_offset {
1001 399     399 1 437 my ( $self, $time ) = @_;
1002 399 50       719 if ( !defined $time ) {
1003 0         0 $time = time;
1004             }
1005 399         469 my ( $isdst, $gmtoff, $abbr ) =
1006             $self->_get_isdst_gmtoff_abbr_calculating_for_local_time($time);
1007 399         649 return int( $gmtoff / _SECONDS_IN_ONE_MINUTE() );
1008             }
1009              
1010             sub local_time {
1011 2116     2116 1 4278733 my ( $self, $time ) = @_;
1012 2116 50       7398 if ( !defined $time ) {
1013 0         0 $time = time;
1014             }
1015              
1016 2116         7928 my ( $isdst, $gmtoff, $abbr ) =
1017             $self->_get_isdst_gmtoff_abbr_calculating_for_local_time($time);
1018 2116         5442 $time += $gmtoff;
1019              
1020 2116 100       3714 if (wantarray) {
1021 2113         6011 my (@local_time) = $self->_gm_time($time);
1022 2113         4418 $local_time[ _LOCALTIME_ISDST_INDEX() ] = $isdst;
1023 2113         23624 return @local_time;
1024             }
1025             else {
1026 3         11 return $self->_gm_time($time);
1027             }
1028             }
1029              
1030             sub transition_times {
1031 3360     3360 1 3947 my ($self) = @_;
1032 3360         6795 my $tz = $self->timezone();
1033 3360         5531 $self->_read_tzfile();
1034 3360         2882 return @{ $self->{_tzdata}->{$tz}->{transition_times} };
  3360         121842  
1035             }
1036              
1037             sub leap_seconds {
1038 416     416 1 132464 my ($self) = @_;
1039 416         892 my $tz = $self->timezone();
1040 416         794 $self->_read_tzfile();
1041             my @leap_seconds =
1042 416         455 sort { $a <=> $b } keys %{ $self->{_tzdata}->{$tz}->{leap_seconds} };
  0         0  
  416         2148  
1043 416         1064 return @leap_seconds;
1044             }
1045              
1046             sub _read_header {
1047 974     974   1312 my ( $self, $handle, $path ) = @_;
1048 974         3003 my $result = $handle->read( my $buffer, _SIZE_OF_TZ_HEADER() );
1049 974 50       11615 if ( defined $result ) {
1050 974 50       1331 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         10242 my ( $magic, $version, $ttisgmtcnt, $ttisstdcnt, $leapcnt, $timecnt,
1060             $typecnt, $charcnt )
1061             = unpack 'A4A1x15N!N!N!N!N!N!', $buffer;
1062 974 50       4884 ( $magic eq 'TZif' ) or Carp::croak("$path is not a TZ file");
1063 974         8938 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         2703 return $header;
1075             }
1076              
1077             sub _read_transition_times {
1078 974     974   1608 my ( $self, $handle, $path, $timecnt, $sizeof_transition_time ) = @_;
1079 974         1880 my $sizeof_transition_times = $timecnt * $sizeof_transition_time;
1080 974         2498 my $result = $handle->read( my $buffer, $sizeof_transition_times );
1081 974 50       7574 if ( defined $result ) {
1082 974 50       2764 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         1381 my @transition_times;
1093 974 100       1303 if ( $sizeof_transition_time == _SIZE_OF_TRANSITION_TIME_V1() ) {
    50          
1094 487         23781 @transition_times = unpack 'l>' . $timecnt, $buffer;
1095             }
1096             elsif ( $sizeof_transition_time == _SIZE_OF_TRANSITION_TIME_V2() ) {
1097 487 50       1568 eval { @transition_times = unpack 'q>' . $timecnt, $buffer; 1; } or do {
  487         15027  
  487         3710  
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         7254 return \@transition_times;
1105             }
1106              
1107             sub _read_local_time_indexes {
1108 974     974   1907 my ( $self, $handle, $path, $timecnt ) = @_;
1109 974         3123 my $result = $handle->read( my $buffer, $timecnt );
1110 974 50       6897 if ( defined $result ) {
1111 974 50       2768 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         26843 my @local_time_indexes = unpack 'C' . $timecnt, $buffer;
1122 974         8108 return \@local_time_indexes;
1123             }
1124              
1125             sub _read_local_time_types {
1126 974     974   1698 my ( $self, $handle, $path, $typecnt ) = @_;
1127 974         2004 my $sizeof_local_time_types = $typecnt * _SIZE_OF_TTINFO();
1128 974         2298 my $result = $handle->read( my $buffer, $sizeof_local_time_types );
1129 974 50       6243 if ( defined $result ) {
1130 974 50       2573 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         897 my @local_time_types;
1141 974         5963 foreach my $local_time_type ( unpack '(a6)' . $typecnt, $buffer ) {
1142 5262         19016 my ( $c1, $c2, $c3 ) = unpack 'a4aa', $local_time_type;
1143 5262         12209 my $gmtoff = unpack 'l>', $c1;
1144 5262         7898 my $isdst = unpack 'C', $c2;
1145 5262         7439 my $abbrind = unpack 'C', $c3;
1146 5262         19037 push @local_time_types,
1147             { gmtoff => $gmtoff, isdst => $isdst, abbrind => $abbrind };
1148             }
1149 974         3469 return \@local_time_types;
1150             }
1151              
1152             sub _read_time_zone_abbreviation_strings {
1153 974     974   1500 my ( $self, $handle, $path, $charcnt ) = @_;
1154 974         2164 my $result = $handle->read( my $time_zone_abbreviation_strings, $charcnt );
1155 974 50       7010 if ( defined $result ) {
1156 974 50       2821 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         3008 return $time_zone_abbreviation_strings;
1168             }
1169              
1170             sub _read_leap_seconds {
1171 974     974   1684 my ( $self, $handle, $path, $leapcnt, $sizeof_leap_second ) = @_;
1172 974         1660 my $sizeof_leap_seconds = $leapcnt * _PAIR() * $sizeof_leap_second;
1173 974         2362 my $result = $handle->read( my $buffer, $sizeof_leap_seconds );
1174 974 50       6405 if ( defined $result ) {
1175 974 50       2517 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         3013 my @paired_leap_seconds = unpack 'L>' . $leapcnt, $buffer;
1186 974         1133 my %leap_seconds;
1187 974         2186 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         4131 return \%leap_seconds;
1193             }
1194              
1195             sub _read_is_standard_time {
1196 974     974   1672 my ( $self, $handle, $path, $ttisstdcnt ) = @_;
1197 974         2550 my $result = $handle->read( my $buffer, $ttisstdcnt );
1198 974 50       5668 if ( defined $result ) {
1199 974 50       2503 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         4679 my @is_std_time = unpack 'C' . $ttisstdcnt, $buffer;
1211 974         3374 return \@is_std_time;
1212             }
1213              
1214             sub _read_is_gmt {
1215 974     974   1628 my ( $self, $handle, $path, $ttisgmtcnt ) = @_;
1216 974         2094 my $result = $handle->read( my $buffer, $ttisgmtcnt );
1217 974 50       5797 if ( defined $result ) {
1218 974 50       2866 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         4228 my @is_gmt_time = unpack 'C' . $ttisgmtcnt, $buffer;
1229 974         3411 return \@is_gmt_time;
1230             }
1231              
1232             sub _read_tz_definition {
1233 487     487   703 my ( $self, $handle, $path ) = @_;
1234 487         1051 my $result =
1235             $handle->read( my $buffer, _MAX_LENGTH_FOR_TRAILING_TZ_DEFINITION() );
1236 487 50       5072 if ( defined $result ) {
1237 487 50       867 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       3801 if ( $buffer =~ /^\n([^\n]+)\n*$/smx ) {
1249 486         2536 return $self->_parse_tz_variable( $1, $path );
1250              
1251             }
1252 1         9 return;
1253             }
1254              
1255             sub _parse_tz_variable {
1256 486     486   2014 my ( $self, $tz_variable, $path ) = @_;
1257 486         2328 my $timezone_abbr_name_regex = qr/(?:[^:\d,+-][^\d,+-]{2,}|[<][+-]?\d+[>])/smx;
1258 486         3173 my $std_name_regex = qr/(?$timezone_abbr_name_regex)/smx
1259             ; # Name for standard offset from GMT
1260 486         2271 my $std_sign_regex = qr/(?[+-])/smx;
1261 486         1179 my $std_hours_regex = qr/(?\d+)/smx;
1262 486         1507 my $std_minutes_regex = qr/(?::(?\d+))/smx;
1263 486         1026 my $std_seconds_regex = qr/(?::(?\d+))/smx;
1264 486         3347 my $std_offset_regex =
1265             qr/$std_sign_regex?$std_hours_regex$std_minutes_regex?$std_seconds_regex?/smx
1266             ; # Standard offset from GMT
1267 486         2078 my $dst_name_regex = qr/(?$timezone_abbr_name_regex)/smx
1268             ; # Name for daylight saving offset from GMT
1269 486         1166 my $dst_sign_regex = qr/(?[+-])/smx;
1270 486         820 my $dst_hours_regex = qr/(?\d+)/smx;
1271 486         915 my $dst_minutes_regex = qr/(?::(?\d+))/smx;
1272 486         1053 my $dst_seconds_regex = qr/(?::(?\d+))/smx;
1273 486         2683 my $dst_offset_regex =
1274             qr/$dst_sign_regex?$dst_hours_regex$dst_minutes_regex?$dst_seconds_regex?/smx
1275             ; # Standard offset from GMT
1276 486         1351 my $start_julian_without_feb29_regex =
1277             qr/(?:J(?\d{1,3}))/smx;
1278 486         926 my $start_julian_with_feb29_regex =
1279             qr/(?\d{1,3})/smx;
1280 486         1045 my $start_month_regex = qr/(?\d{1,2})/smx;
1281 486         945 my $start_week_regex = qr/(?[1-5])/smx;
1282 486         970 my $start_day_regex = qr/(?[0-6])/smx;
1283 486         2085 my $start_month_week_day_regex =
1284             qr/(?:M$start_month_regex[.]$start_week_regex[.]$start_day_regex)/smx;
1285 486         2319 my $start_date_regex =
1286             qr/(?:$start_julian_without_feb29_regex|$start_julian_with_feb29_regex|$start_month_week_day_regex)/smx;
1287 486         1699 my $start_hour_regex = qr/(?\-?\d+)/smx;
1288 486         947 my $start_minute_regex = qr/(?::(?\d+))/smx;
1289 486         881 my $start_second_regex = qr/(?::(?\d+))/smx;
1290 486         2206 my $start_time_regex =
1291             qr/[\/]$start_hour_regex$start_minute_regex?$start_second_regex?/smx;
1292 486         1969 my $start_datetime_regex = qr/$start_date_regex(?:$start_time_regex)?/smx;
1293 486         1784 my $end_julian_without_feb29_regex =
1294             qr/(?:J(?\d{1,3}))/smx;
1295 486         1044 my $end_julian_with_feb29_regex = qr/(?\d{1,3})/smx;
1296 486         960 my $end_month_regex = qr/(?\d{1,2})/smx;
1297 486         985 my $end_week_regex = qr/(?[1-5])/smx;
1298 486         910 my $end_day_regex = qr/(?[0-6])/smx;
1299 486         2173 my $end_month_week_day_regex =
1300             qr/(?:M$end_month_regex[.]$end_week_regex[.]$end_day_regex)/smx;
1301 486         2320 my $end_date_regex =
1302             qr/(?:$end_julian_without_feb29_regex|$end_julian_with_feb29_regex|$end_month_week_day_regex)/smx;
1303 486         1095 my $end_hour_regex = qr/(?\-?\d+)/smx;
1304 486         833 my $end_minute_regex = qr/(?::(?\d+))/smx;
1305 486         953 my $end_second_regex = qr/(?::(?\d+))/smx;
1306 486         2256 my $end_time_regex =
1307             qr/[\/]$end_hour_regex$end_minute_regex?$end_second_regex?/smx;
1308 486         2440 my $end_datetime_regex = qr/$end_date_regex(?:$end_time_regex)?/smx;
1309              
1310 486 50       8459 if ( $tz_variable =~
1311             /^$std_name_regex$std_offset_regex(?:$dst_name_regex(?:$dst_offset_regex)?,$start_datetime_regex,$end_datetime_regex)?$/smx
1312             )
1313             {
1314 486         1806 my $tz_definition = { tz => $tz_variable };
1315 486         1561 foreach my $key (
1316             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)
1317             )
1318             {
1319 12636 100       38068 if ( defined $LAST_PAREN_MATCH{$key} ) {
1320 3046         13108 $tz_definition->{$key} = $LAST_PAREN_MATCH{$key};
1321             }
1322             }
1323 486         1300 $self->_initialise_undefined_tz_definition_values($tz_definition);
1324             $tz_definition->{std_offset_in_seconds} =
1325 486         1162 $self->_std_offset_in_seconds($tz_definition);
1326             $tz_definition->{dst_offset_in_seconds} =
1327 486         990 $self->_dst_offset_in_seconds($tz_definition);
1328 486         6246 return $tz_definition;
1329             }
1330             else {
1331 0         0 Carp::croak(
1332             "Failed to parse the tz defintion of $tz_variable from $path");
1333             }
1334             }
1335              
1336             sub _dst_offset_in_seconds {
1337 486     486   530 my ( $self, $tz_definition ) = @_;
1338 486   50     1685 my $dst_offset_in_seconds = $tz_definition->{dst_seconds} || 0;
1339 486 50       1034 if ( defined $tz_definition->{dst_minutes} ) {
1340             $dst_offset_in_seconds +=
1341 0         0 $tz_definition->{dst_minutes} * _SECONDS_IN_ONE_MINUTE();
1342             }
1343 486 100       890 if ( defined $tz_definition->{dst_hours} ) {
1344             $dst_offset_in_seconds +=
1345             $tz_definition->{dst_hours} *
1346 2         11 _MINUTES_IN_ONE_HOUR() *
1347             _SECONDS_IN_ONE_MINUTE();
1348             }
1349 486 100 66     1268 if ( ( defined $tz_definition->{dst_sign} )
1350             && ( $tz_definition->{dst_sign} eq q[-] ) )
1351             {
1352             }
1353             else {
1354 484         1099 $dst_offset_in_seconds *= _NEGATIVE_ONE();
1355             }
1356 486 100       914 if ( $dst_offset_in_seconds == 0 ) {
1357             $dst_offset_in_seconds = $tz_definition->{std_offset_in_seconds} +
1358 484         846 ( _MINUTES_IN_ONE_HOUR() * _SECONDS_IN_ONE_MINUTE() );
1359             }
1360 486         957 return $dst_offset_in_seconds;
1361             }
1362              
1363             sub _std_offset_in_seconds {
1364 486     486   578 my ( $self, $tz_definition ) = @_;
1365 486   50     2360 my $std_offset_in_seconds = $tz_definition->{std_seconds} || 0;
1366              
1367 486 100       1008 if ( defined $tz_definition->{std_minutes} ) {
1368             $std_offset_in_seconds +=
1369 16         39 $tz_definition->{std_minutes} * _SECONDS_IN_ONE_MINUTE();
1370             }
1371 486 50       1073 if ( defined $tz_definition->{std_hours} ) {
1372             $std_offset_in_seconds +=
1373             $tz_definition->{std_hours} *
1374 486         1615 _MINUTES_IN_ONE_HOUR() *
1375             _SECONDS_IN_ONE_MINUTE();
1376             }
1377 486 100 66     2744 if ( ( defined $tz_definition->{std_sign} )
1378             && ( $tz_definition->{std_sign} eq q[-] ) )
1379             {
1380             }
1381             else {
1382 192         578 $std_offset_in_seconds *= _NEGATIVE_ONE();
1383             }
1384 486         987 return $std_offset_in_seconds;
1385             }
1386              
1387             sub _initialise_undefined_tz_definition_values {
1388 486     486   755 my ( $self, $tz_definition ) = @_;
1389             $tz_definition->{start_hour} =
1390             defined $tz_definition->{start_hour}
1391             ? $tz_definition->{start_hour}
1392 486 100       2122 : _DEFAULT_DST_START_HOUR();
1393             $tz_definition->{start_minute} =
1394             defined $tz_definition->{start_minute}
1395             ? $tz_definition->{start_minute}
1396 486 100       1213 : 0;
1397             $tz_definition->{start_second} =
1398             defined $tz_definition->{start_second}
1399             ? $tz_definition->{start_second}
1400 486 50       1118 : 0;
1401             $tz_definition->{end_hour} =
1402             defined $tz_definition->{end_hour}
1403             ? $tz_definition->{end_hour}
1404 486 100       1574 : _DEFAULT_DST_END_HOUR();
1405             $tz_definition->{end_minute} =
1406             defined $tz_definition->{end_minute}
1407             ? $tz_definition->{end_minute}
1408 486 100       1600 : 0;
1409             $tz_definition->{end_second} =
1410             defined $tz_definition->{end_second}
1411             ? $tz_definition->{end_second}
1412 486 50       1250 : 0;
1413 486         663 return;
1414             }
1415              
1416             sub _set_abbrs {
1417 974     974   1825 my ( $self, $tz ) = @_;
1418 974         925 my $index = 0;
1419 974         929 foreach
1420 974         2990 my $local_time_type ( @{ $self->{_tzdata}->{$tz}->{local_time_types} } )
1421             {
1422 5262 100       8328 if ( $self->{_tzdata}->{$tz}->{local_time_types}->[ $index + 1 ] ) {
1423             $local_time_type->{abbr} =
1424             substr $self->{_tzdata}->{$tz}->{time_zone_abbreviation_strings},
1425             $local_time_type->{abbrind},
1426             $self->{_tzdata}->{$tz}->{local_time_types}->[ $index + 1 ]
1427 4288         12087 ->{abbrind};
1428             }
1429             else {
1430             $local_time_type->{abbr} =
1431             substr $self->{_tzdata}->{$tz}->{time_zone_abbreviation_strings},
1432 974         2770 $local_time_type->{abbrind};
1433             }
1434 5262         14725 $local_time_type->{abbr} =~ s/\0+$//smx;
1435 5262         5968 $index += 1;
1436             }
1437 974         1351 return;
1438             }
1439              
1440             sub _read_v1_tzfile {
1441 487     487   1106 my ( $self, $handle, $path, $header, $tz ) = @_;
1442             $self->{_tzdata}->{$tz}->{transition_times} =
1443             $self->_read_transition_times( $handle, $path, $header->{timecnt},
1444 487         1542 _SIZE_OF_TRANSITION_TIME_V1() );
1445             $self->{_tzdata}->{$tz}->{local_time_indexes} =
1446 487         2030 $self->_read_local_time_indexes( $handle, $path, $header->{timecnt} );
1447             $self->{_tzdata}->{$tz}->{local_time_types} =
1448 487         2292 $self->_read_local_time_types( $handle, $path, $header->{typecnt} );
1449             $self->{_tzdata}->{$tz}->{time_zone_abbreviation_strings} =
1450             $self->_read_time_zone_abbreviation_strings( $handle, $path,
1451 487         1443 $header->{charcnt} );
1452 487         2024 $self->_set_abbrs($tz);
1453             $self->{_tzdata}->{$tz}->{leap_seconds} =
1454             $self->_read_leap_seconds( $handle, $path, $header->{leapcnt},
1455 487         1216 _SIZE_OF_LEAP_SECOND_V1() );
1456             $self->{_tzdata}->{$tz}->{is_std} =
1457 487         1748 $self->_read_is_standard_time( $handle, $path, $header->{ttisstdcnt} );
1458             $self->{_tzdata}->{$tz}->{is_gmt} =
1459 487         1548 $self->_read_is_gmt( $handle, $path, $header->{ttisstdcnt} );
1460 487         780 return;
1461             }
1462              
1463             sub _read_v2_tzfile {
1464 487     487   717 my ( $self, $handle, $path, $header, $tz ) = @_;
1465              
1466 487 50 33     17341 if ( ( $header->{version} )
      33        
      33        
1467             && ( $header->{version} >= 2 )
1468             && ( defined $Config{'d_quad'} )
1469             && ( $Config{'d_quad'} eq 'define' ) )
1470             {
1471 487         1165 $self->{_tzdata}->{$tz} = {};
1472 487         8142 $header = $self->_read_header( $handle, $path );
1473             $self->{_tzdata}->{$tz}->{transition_times} =
1474             $self->_read_transition_times( $handle, $path, $header->{timecnt},
1475 487         1392 _SIZE_OF_TRANSITION_TIME_V2() );
1476             $self->{_tzdata}->{$tz}->{local_time_indexes} =
1477 487         1299 $self->_read_local_time_indexes( $handle, $path, $header->{timecnt} );
1478             $self->{_tzdata}->{$tz}->{local_time_types} =
1479 487         1053 $self->_read_local_time_types( $handle, $path, $header->{typecnt} );
1480             $self->{_tzdata}->{$tz}->{time_zone_abbreviation_strings} =
1481             $self->_read_time_zone_abbreviation_strings( $handle, $path,
1482 487         1135 $header->{charcnt} );
1483 487         1287 $self->_set_abbrs($tz);
1484             $self->{_tzdata}->{$tz}->{leap_seconds} =
1485             $self->_read_leap_seconds( $handle, $path, $header->{leapcnt},
1486 487         1178 _SIZE_OF_LEAP_SECOND_V2() );
1487             $self->{_tzdata}->{$tz}->{is_std} =
1488             $self->_read_is_standard_time( $handle, $path,
1489 487         994 $header->{ttisstdcnt} );
1490             $self->{_tzdata}->{$tz}->{is_gmt} =
1491 487         931 $self->_read_is_gmt( $handle, $path, $header->{ttisstdcnt} );
1492             $self->{_tzdata}->{$tz}->{tz_definition} =
1493 487         1252 $self->_read_tz_definition( $handle, $path );
1494             }
1495 487         2011 return;
1496             }
1497              
1498             sub _read_tzfile {
1499 7129     7129   7647 my ($self) = @_;
1500 7129         9202 my $tz = $self->timezone();
1501 7129         11959 my $path = File::Spec->catfile( $self->directory, $tz );
1502 7129 50       41387 my $handle = FileHandle->new($path)
1503             or Carp::croak("Failed to open $path for reading:$EXTENDED_OS_ERROR");
1504 7129 50       524172 my @stat = stat $handle
1505             or Carp::croak("Failed to stat $path:$EXTENDED_OS_ERROR");
1506 7129         19683 my $last_modified = $stat[ _STAT_MTIME_IDX() ];
1507 7129 100 66     46078 if ( ( $self->{_tzdata}->{$tz}->{last_modified} )
    100 66        
      33        
1508             && ( $self->{_tzdata}->{$tz}->{last_modified} == $last_modified ) )
1509             {
1510             }
1511             elsif (( $_tzdata_cache->{$tz} )
1512             && ( $_tzdata_cache->{$tz}->{last_modified} )
1513             && ( $_tzdata_cache->{$tz}->{last_modified} == $last_modified ) )
1514             {
1515 75         225 $self->{_tzdata}->{$tz} = $_tzdata_cache->{$tz};
1516             }
1517             else {
1518 487         1323 binmode $handle;
1519 487         2273 my $header = $self->_read_header( $handle, $path );
1520 487         2143 $self->_read_v1_tzfile( $handle, $path, $header, $tz );
1521 487         1661 $self->_read_v2_tzfile( $handle, $path, $header, $tz );
1522 487         1342 $self->{_tzdata}->{$tz}->{last_modified} = $last_modified;
1523 487         2626 $_tzdata_cache->{$tz} = $self->{_tzdata}->{$tz};
1524             }
1525 7129 50       46343 close $handle
1526             or Carp::croak("Failed to close $path:$EXTENDED_OS_ERROR");
1527 7129         23802 return;
1528             }
1529              
1530             sub reset_cache {
1531 142     142 1 84190 my ($self) = @_;
1532 142 100       707 if ( ref $self ) {
1533 71         166 foreach my $key (qw(_tzdata _zonetab_last_modified _comments _zones)) {
1534 284         1160 $self->{$key} = {};
1535             }
1536             }
1537             else {
1538 71         184 $_tzdata_cache = {};
1539 71         390 $_zonetab_cache = {};
1540             }
1541 142         1264 return;
1542             }
1543              
1544             1;
1545             __END__