File Coverage

blib/lib/Time/Zone/Olsen.pm
Criterion Covered Total %
statement 691 753 91.7
branch 165 224 73.6
condition 33 70 47.1
subroutine 103 106 97.1
pod 10 10 100.0
total 1002 1163 86.1


line stmt bran cond sub pod time code
1             package Time::Zone::Olsen;
2              
3 3     3   48384 use 5.010;
  3         9  
  3         110  
4 3     3   14 use strict;
  3         4  
  3         92  
5 3     3   10 use warnings FATAL => 'all';
  3         7  
  3         137  
6              
7 3     3   1358 use FileHandle();
  3         30815  
  3         90  
8 3     3   27 use File::Spec();
  3         4  
  3         50  
9 3     3   14 use Config;
  3         5  
  3         124  
10 3     3   13 use Carp();
  3         4  
  3         60  
11 3     3   1811 use English qw( -no_match_vars );
  3         11332  
  3         19  
12 3     3   2954 use DirHandle();
  3         1430  
  3         23820  
13              
14             our $VERSION = 0.01;
15              
16 1680     1680   6963 sub _SIZE_OF_TZ_HEADER { return 44 }
17 1260     1260   3940 sub _SIZE_OF_TRANSITION_TIME_V1 { return 4 }
18 840     840   3156 sub _SIZE_OF_TRANSITION_TIME_V2 { return 8 }
19 840     840   2856 sub _SIZE_OF_TTINFO { return 6 }
20 420     420   2078 sub _SIZE_OF_LEAP_SECOND_V1 { return 4 }
21 420     420   2197 sub _SIZE_OF_LEAP_SECOND_V2 { return 8 }
22 840     840   3720 sub _PAIR { return 2 }
23 5499     5499   19439 sub _STAT_MTIME_IDX { return 9 }
24 840     840   2583 sub _MAX_LENGTH_FOR_TRAILING_TZ_DEFINITION { return 256 }
25 81     81   119 sub _MONTHS_IN_ONE_YEAR { return 12 }
26 81     81   140 sub _HOURS_IN_ONE_DAY { return 24 }
27 931     931   2781 sub _MINUTES_IN_ONE_HOUR { return 60 }
28 31121     31121   33812 sub _SECONDS_IN_ONE_MINUTE { return 60 }
29 6950     6950   7949 sub _SECONDS_IN_ONE_HOUR { return 3_600 }
30 132525     132525   147922 sub _SECONDS_IN_ONE_DAY { return 86_400 }
31 609     609   1463 sub _NEGATIVE_ONE { return -1 }
32 843     843   1980 sub _LOCALTIME_ISDST_INDEX { return 8 }
33 0     0   0 sub _LOCALTIME_GMTOFF_INDEX { return 9 }
34 0     0   0 sub _LOCALTIME_TMZONE_INDEX { return 10 }
35 12     12   35 sub _LOCALTIME_DAY_OF_WEEK_INDEX { return 6 }
36 35925     35925   58273 sub _LOCALTIME_YEAR_INDEX { return 5 }
37 3767     3767   7846 sub _LOCALTIME_MONTH_INDEX { return 4 }
38 16996     16996   29036 sub _LOCALTIME_DAY_INDEX { return 3 }
39 6089     6089   10352 sub _LOCALTIME_HOUR_INDEX { return 2 }
40 29328     29328   43843 sub _LOCALTIME_MINUTE_INDEX { return 1 }
41 842     842   2789 sub _LOCALTIME_SECOND_INDEX { return 0 }
42 2551     2551   5303 sub _LOCALTIME_BASE_YEAR { return 1900 }
43 3399     3399   6998 sub _EPOCH_YEAR { return 1970 }
44 2545     2545   4276 sub _EPOCH_WDAY { return 4 }
45 2557     2557   8610 sub _DAYS_IN_JANUARY { return 31 }
46 315     315   790 sub _DAYS_IN_FEBRUARY_LEAP_YEAR { return 29 }
47 2242     2242   5171 sub _DAYS_IN_FEBRUARY_NON_LEAP { return 28 }
48 2557     2557   5712 sub _DAYS_IN_MARCH { return 31 }
49 2557     2557   5153 sub _DAYS_IN_APRIL { return 30 }
50 2557     2557   6817 sub _DAYS_IN_MAY { return 31 }
51 2557     2557   5114 sub _DAYS_IN_JUNE { return 30 }
52 2557     2557   4982 sub _DAYS_IN_JULY { return 31 }
53 2557     2557   4588 sub _DAYS_IN_AUGUST { return 31 }
54 2557     2557   5131 sub _DAYS_IN_SEPTEMBER { return 30 }
55 2557     2557   4599 sub _DAYS_IN_OCTOBER { return 31 }
56 2557     2557   4971 sub _DAYS_IN_NOVEMBER { return 30 }
57 2557     2557   9945 sub _DAYS_IN_DECEMBER { return 31 }
58 25328     25328   40202 sub _DAYS_IN_A_LEAP_YEAR { return 366 }
59 78663     78663   122658 sub _DAYS_IN_A_NON_LEAP_YEAR { return 365 }
60 12     12   39 sub _TZ_ENVIRONMENT_LAST_WEEK_VALUE { return 5 }
61 0     0   0 sub _LOCALTIME_WEEKDAY_HIGHEST_VALUE { return 6 }
62 2599     2599   5101 sub _DAYS_IN_ONE_WEEK { return 7 }
63 103937     103937   270120 sub _EVERY_FOUR_HUNDRED_YEARS { return 400 }
64 101974     101974   243411 sub _EVERY_FOUR_YEARS { return 4 }
65 23473     23473   62440 sub _EVERY_ONE_HUNDRED_YEARS { return 100 }
66 3     3   18 sub _BSD_NUMER_OF_ELEMENTS_IN_LOCALTIME { return 10 }
67 374     374   1812 sub _DEFAULT_DST_START_HOUR { return 2 }
68 337     337   1345 sub _DEFAULT_DST_END_HOUR { return 2 }
69              
70             my @_bsd_test_localtime = localtime;
71             my $_bsd_localtime_extension =
72             ( ( scalar @_bsd_test_localtime ) == _BSD_NUMER_OF_ELEMENTS_IN_LOCALTIME() )
73             ? 1
74             : 0;
75              
76 843     843   2811 sub _BSD_LOCALTIME_EXTENSION { return $_bsd_localtime_extension }
77              
78             sub _TIMEZONE_FULL_NAME_REGEX {
79 11235     11235   24172 return qr/(?\w+)(?:\/(?[\w\-\/]+))?/smx;
80             }
81             my $_default_zoneinfo_directory = '/usr/share/zoneinfo';
82             if ( -d $_default_zoneinfo_directory ) {
83             }
84             else {
85             if ( -d '/usr/lib/zoneinfo' ) {
86             $_default_zoneinfo_directory = '/usr/lib/zoneinfo';
87             }
88             }
89              
90 2     2   11 sub _DEFAULT_ZONEINFO_DIRECTORY { return $_default_zoneinfo_directory }
91              
92             sub new {
93 2     2 1 450 my ( $class, $params ) = @_;
94 2         6 my $self = {};
95 2         6 bless $self, $class;
96 2   33     22 $self->directory( $params->{directory}
97             || $ENV{TZDIR}
98             || _DEFAULT_ZONEINFO_DIRECTORY() );
99 2   33     16 $self->timezone( $params->{timezone} || $ENV{TZ} );
100 2         8 return $self;
101             }
102              
103             sub directory {
104 5922     5922 1 9915 my ( $self, $new ) = @_;
105 5922         13116 my $old = $self->{directory};
106 5922 100       14581 if ( @_ > 1 ) {
107 2         6 $self->{directory} = $new;
108             }
109 5922         98536 return $old;
110             }
111              
112             sub _timezones {
113 28     28   64 my ($self) = @_;
114 28         94 my $path = File::Spec->catfile( $self->directory(), 'zone.tab' );
115 28 50       247 my $handle = FileHandle->new($path)
116             or Carp::croak("Failed to open $path for reading:$EXTENDED_OS_ERROR");
117 28         2696 my $_last_modified = ( stat _ )[ _STAT_MTIME_IDX() ];
118 28 50 33     168 if ( ( $self->{_timezone_cache} )
119             && ( $self->{_timezone_cache} == $_last_modified ) )
120             {
121             }
122             else {
123 28         121 $self->{_zones} = [];
124 28         3702 $self->{_comments} = {};
125 28         4955 while ( my $line = <$handle> ) {
126 12656 100       27267 next if ( $line =~ /^[#]/smx );
127 11648         12609 chomp $line;
128 11648         37857 my ( $country_code, $coordinates, $timezone, $comment ) =
129             split /\t/smx, $line;
130 11648         14315 push @{ $self->{_zones} }, $timezone;
  11648         18798  
131 11648         51387 $self->{_comments}->{$timezone} = $comment;
132             }
133 28 50       360 close $handle
134             or Carp::croak("Failed to close $path:$EXTENDED_OS_ERROR");
135             }
136 28         54 my @sorted_zones = sort { $a cmp $b } @{ $self->{_zones} };
  85064         101295  
  28         371  
137 28         3917 return @sorted_zones;
138             }
139              
140             sub areas {
141 4     4 1 577 my ($self) = @_;
142 4         5 my %areas;
143 4         15 foreach my $timezone ( $self->_timezones() ) {
144 1664         1809 my $timezone_full_name_regex = _TIMEZONE_FULL_NAME_REGEX();
145 1664 50       6200 if ( $timezone =~ /^$timezone_full_name_regex$/smx ) {
146 1664         5928 $areas{ $LAST_PAREN_MATCH{area} } = 1;
147             }
148             else {
149 0         0 Carp::croak(
150             "'$timezone' does not have a valid format for a TZ timezone");
151             }
152             }
153 4         151 my @sorted_areas = sort { $a cmp $b } keys %areas;
  92         88  
154 4         45 return @sorted_areas;
155             }
156              
157             sub locations {
158 22     22 1 6837 my ( $self, $area ) = @_;
159 22 50       87 if ( !length $area ) {
160 0         0 return ();
161             }
162 22         30 my %locations;
163 22         92 foreach my $timezone ( $self->_timezones() ) {
164 9152         10307 my $timezone_full_name_regex = _TIMEZONE_FULL_NAME_REGEX();
165 9152 50       36162 if ( $timezone =~ /^$timezone_full_name_regex$/smx ) {
166 9152 100 66     46314 if ( ( $area eq $LAST_PAREN_MATCH{area} )
167             && ( $LAST_PAREN_MATCH{location} ) )
168             {
169 856         3987 $locations{ $LAST_PAREN_MATCH{location} } = 1;
170             }
171             }
172             else {
173 0         0 Carp::croak(
174             "'$timezone' does not have a valid format for a TZ timezone");
175             }
176             }
177 22         1182 my @sorted_locations = sort { $a cmp $b } keys %locations;
  4125         3343  
178 22         313 return @sorted_locations;
179             }
180              
181             sub comment {
182 2     2 1 5 my ( $self, $tz ) = @_;
183 2   33     9 $tz ||= $self->timezone();
184 2         9 $self->_timezones();
185 2 50       14 if ( defined $self->{_comments}->{$tz} ) {
186 2         22 return $self->{_comments}->{$tz};
187             }
188             else {
189 0         0 return;
190             }
191             }
192              
193             sub timezone {
194 12149     12149 1 1977039 my ( $self, $new ) = @_;
195 12149         21819 my $old = $self->{tz};
196 12149 100       29582 if ( @_ > 1 ) {
197 419 50       1414 if ( defined $new ) {
198 419         2857 my $timezone_full_name_regex = _TIMEZONE_FULL_NAME_REGEX();
199 419 50       10103 if ( $new !~ /^$timezone_full_name_regex$/smx ) {
200 0         0 Carp::croak(
201             "'$new' does not have a valid format for a TZ timezone");
202             }
203 419         2218 my $path = File::Spec->catfile( $self->directory(), $new );
204 419 50       14523 if ( !-f $path ) {
205 0         0 Carp::croak(
206             "'$new' is not an timezone in the existing Olsen database");
207             }
208             }
209 419         1610 $self->{tz} = $new;
210             }
211 12149         28814 return $old;
212             }
213              
214             sub _is_leap_year {
215 103937     103937   103959 my ( $self, $year ) = @_;
216 103937         81042 my $leap_year;
217 103937 100 100     120598 if (
      66        
218             ( $year % _EVERY_FOUR_HUNDRED_YEARS() == 0 )
219             || ( ( $year % _EVERY_FOUR_YEARS() == 0 )
220             && ( $year % _EVERY_ONE_HUNDRED_YEARS() != 0 ) )
221             )
222             {
223 25427         25578 $leap_year = 1;
224             }
225             else {
226 78510         76097 $leap_year = 0;
227             }
228 103937         145956 return $leap_year;
229             }
230              
231             sub _in_dst_according_to_tz {
232 6     6   13 my ( $self, $check_time, $tz_definition ) = @_;
233              
234 6 50 33     128 if ( ( defined $tz_definition->{start_day} )
      33        
      33        
      33        
      33        
235             && ( defined $tz_definition->{end_day} )
236             && ( defined $tz_definition->{start_week} )
237             && ( defined $tz_definition->{end_week} )
238             && ( defined $tz_definition->{start_month} )
239             && ( defined $tz_definition->{end_month} ) )
240             {
241 6         25 my $check_year =
242             ( $self->_gm_time($check_time) )[ _LOCALTIME_YEAR_INDEX() ] +
243             _LOCALTIME_BASE_YEAR();
244 6         35 my $dst_start_time = $self->_get_time_for_wday_week_month_year(
245             $tz_definition->{start_day}, $tz_definition->{start_week},
246             $tz_definition->{start_month}, $check_year
247             ) +
248             ( $tz_definition->{start_hour} *
249             _SECONDS_IN_ONE_MINUTE() *
250             _MINUTES_IN_ONE_HOUR() ) +
251             ( $tz_definition->{start_minute} * _SECONDS_IN_ONE_MINUTE() ) +
252             $tz_definition->{start_second} -
253             $tz_definition->{std_offset_in_seconds};
254 6         22 my $dst_end_time = $self->_get_time_for_wday_week_month_year(
255             $tz_definition->{end_day}, $tz_definition->{end_week},
256             $tz_definition->{end_month}, $check_year
257             ) +
258             ( $tz_definition->{end_hour} *
259             _SECONDS_IN_ONE_MINUTE() *
260             _MINUTES_IN_ONE_HOUR() ) +
261             ( $tz_definition->{end_minute} * _SECONDS_IN_ONE_MINUTE() ) +
262             $tz_definition->{end_second} -
263             $tz_definition->{dst_offset_in_seconds};
264              
265 6 50       27 if ( $dst_start_time < $dst_end_time ) {
266 0 0 0     0 if ( ( $dst_start_time < $check_time )
267             && ( $check_time < $dst_end_time ) )
268             {
269 0         0 return 1;
270             }
271             }
272             else {
273 6 50 33     55 if ( ( $check_time < $dst_start_time )
274             || ( $dst_end_time < $check_time ) )
275             {
276 6         28 return 1;
277             }
278             }
279             }
280              
281 0         0 return 0;
282             }
283              
284             sub _get_time_for_wday_week_month_year {
285 12     12   29 my ( $self, $wday, $week, $month, $year ) = @_;
286              
287 12         18 my $check_year = _EPOCH_YEAR();
288 12         18 my $time = 0;
289 12         13 my $increment = 0;
290 12         11 my $leap_year = 1;
291 12         27 while ( $check_year < $year ) {
292 804         596 $check_year += 1;
293 804 100       946 if ( $self->_is_leap_year($check_year) ) {
294 204         161 $leap_year = 1;
295 204         224 $increment = _DAYS_IN_A_LEAP_YEAR() * _SECONDS_IN_ONE_DAY();
296             }
297             else {
298 600         424 $leap_year = 0;
299 600         594 $increment = _DAYS_IN_A_NON_LEAP_YEAR() * _SECONDS_IN_ONE_DAY();
300             }
301 804         1312 $time += $increment;
302             }
303              
304 12         19 $increment = 0;
305 12         15 my $check_month = 1;
306 12         25 my @days_in_month = $self->_days_in_month($leap_year);
307 12         49 while ( $check_month < $month ) {
308              
309 72         94 $increment = $days_in_month[ $check_month - 1 ] * _SECONDS_IN_ONE_DAY();
310 72         62 $time += $increment;
311 72         108 $check_month += 1;
312             }
313              
314 12 50       25 if ( $week == _TZ_ENVIRONMENT_LAST_WEEK_VALUE() ) {
315 0         0 $time +=
316             ( $days_in_month[ $check_month - 1 ] - 1 ) * _SECONDS_IN_ONE_DAY();
317 0         0 my $check_day_of_week =
318             ( $self->_gm_time($time) )[ _LOCALTIME_DAY_OF_WEEK_INDEX() ];
319              
320 0         0 while ( $check_day_of_week != $wday ) {
321              
322 0         0 $time -= _SECONDS_IN_ONE_DAY;
323 0         0 $check_day_of_week -= 1;
324 0 0       0 if ( $check_day_of_week < 0 ) {
325 0         0 $check_day_of_week = _LOCALTIME_WEEKDAY_HIGHEST_VALUE();
326             }
327             }
328             }
329             else {
330 12         27 my $check_day_of_week =
331             ( $self->_gm_time($time) )[ _LOCALTIME_DAY_OF_WEEK_INDEX() ];
332 12         26 my $check_week = 1;
333 12         20 $increment = _DAYS_IN_ONE_WEEK() * _SECONDS_IN_ONE_DAY();
334 12         29 while ( $check_week < $week ) {
335 0         0 $check_week += 1;
336 0         0 $time += $increment;
337             }
338              
339 12         36 while ( $check_day_of_week != $wday ) {
340              
341 42         48 $time += _SECONDS_IN_ONE_DAY();
342 42         29 $check_day_of_week += 1;
343 42         47 $check_day_of_week = $check_day_of_week % _DAYS_IN_ONE_WEEK();
344             }
345             }
346              
347 12         47 return $time;
348             }
349              
350             sub _get_tz_offset_according_to_v2_tz_rule {
351 786     786   1568 my ( $self, $time ) = @_;
352 786         1721 my $tz = $self->timezone();
353 786         1123 my ( $isdst, $gmtoff, $abbr );
354 786         1866 my $tz_definition = $self->{_tzdata}->{$tz}->{tz_definition};
355 786 50       2241 if ( defined $tz_definition->{std_name} ) {
356 786 100       2281 if ( defined $tz_definition->{dst_name} ) {
357 6 50       24 if ( $self->_in_dst_according_to_tz( $time, $tz_definition ) ) {
358 6         9 $isdst = 1;
359 6         11 $gmtoff = $tz_definition->{dst_offset_in_seconds};
360 6         18 $abbr = $tz_definition->{dst_name};
361             }
362             else {
363 0         0 $isdst = 0;
364 0         0 $gmtoff = $tz_definition->{std_offset_in_seconds};
365 0         0 $abbr = $tz_definition->{std_name};
366             }
367             }
368             else {
369 780         1173 $isdst = 0;
370 780         1173 $gmtoff = $tz_definition->{std_offset_in_seconds};
371 780         1455 $abbr = $tz_definition->{std_name};
372             }
373             }
374 786         3228 return ( $isdst, $gmtoff, $abbr );
375             }
376              
377             sub _negative_gm_time {
378 54     54   101 my ( $self, $time ) = @_;
379 54         189 my $year = _EPOCH_YEAR() - 1;
380 54         211 my $wday = _EPOCH_WDAY() - 1;
381 54         124 my $check_time = 0;
382 54         68 my $number_of_days = 0;
383 54         65 my $leap_year;
384 54         65 YEAR: while (1) {
385 2070         2752 $leap_year = $self->_is_leap_year($year);
386 2070         3106 $number_of_days = $self->_number_of_days_in_a_year($leap_year);
387 2070         2471 my $increment = $number_of_days * _SECONDS_IN_ONE_DAY();
388 2070 100       3785 if ( $check_time - $increment > $time ) {
389 2016         1823 $check_time -= $increment;
390 2016         1496 $wday -= $number_of_days;
391 2016         2156 $year -= 1;
392             }
393             else {
394 54         116 last YEAR;
395             }
396             }
397 54         117 my $yday = $self->_number_of_days_in_a_year($leap_year);
398 54         138 $year -= _LOCALTIME_BASE_YEAR();
399              
400 54         138 my $month = _MONTHS_IN_ONE_YEAR();
401 54         173 my @days_in_month = $self->_days_in_month($leap_year);
402 54         68 MONTH: while (1) {
403              
404 494         549 $number_of_days = $days_in_month[ $month - 1 ];
405 494         570 my $increment = $number_of_days * _SECONDS_IN_ONE_DAY();
406 494 100       823 if ( $check_time - $increment > $time ) {
407 440         391 $check_time -= $increment;
408 440         356 $wday -= $number_of_days;
409 440         328 $yday -= $number_of_days;
410 440         476 $month -= 1;
411             }
412             else {
413 54         94 last MONTH;
414             }
415             }
416 54         79 $month -= 1;
417              
418 54         71 my $day = $days_in_month[$month];
419 54         89 my $increment = _SECONDS_IN_ONE_DAY();
420 54         56 DAY: while (1) {
421 804 100       1259 if ( $check_time - $increment > $time ) {
422 750         650 $check_time -= $increment;
423 750         589 $day -= 1;
424 750         579 $yday -= 1;
425 750         746 $wday -= 1;
426             }
427             else {
428 54         102 last DAY;
429             }
430             }
431              
432 54         132 $wday = abs $wday % _DAYS_IN_ONE_WEEK();
433              
434 54         123 my $hour = _HOURS_IN_ONE_DAY() - 1;
435 54         103 $increment = _SECONDS_IN_ONE_HOUR();
436 54         65 HOUR: while (1) {
437 1180 100       1751 if ( $check_time - $increment > $time ) {
438 1126         960 $check_time -= $increment;
439 1126         1063 $hour -= 1;
440             }
441             else {
442 54         74 last HOUR;
443             }
444             }
445 54         139 my $minute = _MINUTES_IN_ONE_HOUR() - 1;
446 54         128 $increment = _SECONDS_IN_ONE_MINUTE();
447 54         122 MINUTE: while (1) {
448 2212 100       3265 if ( $check_time - $increment > $time ) {
449 2158         1831 $check_time -= $increment;
450 2158         2115 $minute -= 1;
451             }
452             else {
453 54         82 last MINUTE;
454             }
455             }
456 54         209 my $seconds = _SECONDS_IN_ONE_MINUTE() - ( $check_time - $time );
457              
458 54         482 return ( $seconds, $minute, $hour, $day, $month, "$year", $wday, $yday, 0 );
459             }
460              
461             sub _positive_gm_time {
462 1649     1649   4107 my ( $self, $time ) = @_;
463 1649         6625 my $year = _EPOCH_YEAR();
464 1649         4322 my $wday = _EPOCH_WDAY();
465 1649         3331 my $check_time = 0;
466 1649         2474 my $number_of_days = 0;
467 1649         2152 my $leap_year;
468 1649         2285 YEAR: while (1) {
469 67670         95531 $leap_year = $self->_is_leap_year($year);
470 67670         100286 $number_of_days = $self->_number_of_days_in_a_year($leap_year);
471 67670         87545 my $increment = $number_of_days * _SECONDS_IN_ONE_DAY();
472 67670 100       128856 if ( $check_time + $increment <= $time ) {
473 66021         66154 $check_time += $increment;
474 66021         53865 $wday += $number_of_days;
475 66021         76325 $year += 1;
476             }
477             else {
478 1649         4103 last YEAR;
479             }
480             }
481 1649         4676 $year -= _LOCALTIME_BASE_YEAR();
482              
483 1649         2427 my $month = 0;
484 1649         6479 my @days_in_month = $self->_days_in_month($leap_year);
485 1649         3086 my $yday = 0;
486 1649         1986 MONTH: while (1) {
487              
488 7186         7943 $number_of_days = $days_in_month[$month];
489 7186         9399 my $increment = $number_of_days * _SECONDS_IN_ONE_DAY();
490 7186 100       15006 if ( $check_time + $increment <= $time ) {
491 5537         5957 $check_time += $increment;
492 5537         6050 $wday += $number_of_days;
493 5537         4840 $yday += $number_of_days;
494 5537         6943 $month += 1;
495             }
496             else {
497 1649         3362 last MONTH;
498             }
499             }
500 1649         2262 my $day = 1;
501 1649         2639 my $increment = _SECONDS_IN_ONE_DAY();
502 1649         1889 DAY: while (1) {
503 33247 100       52487 if ( $check_time + $increment <= $time ) {
504 31598         29448 $check_time += $increment;
505 31598         23893 $day += 1;
506 31598         25734 $yday += 1;
507 31598         30927 $wday += 1;
508             }
509             else {
510 1649         2704 last DAY;
511             }
512             }
513              
514 1649         3736 $wday = $wday % _DAYS_IN_ONE_WEEK();
515              
516 1649         2227 my $hour = 0;
517 1649         4702 $increment = _SECONDS_IN_ONE_HOUR();
518 1649         1842 HOUR: while (1) {
519 11105 100       18154 if ( $check_time + $increment <= $time ) {
520 9456         10449 $check_time += $increment;
521 9456         9702 $hour += 1;
522             }
523             else {
524 1649         2518 last HOUR;
525             }
526             }
527 1649         1830 my $minute = 0;
528 1649         3183 $increment = _SECONDS_IN_ONE_MINUTE();
529 1649         2861 MINUTE: while (1) {
530 56457 100       85550 if ( $check_time + $increment <= $time ) {
531 54808         50668 $check_time += $increment;
532 54808         52745 $minute += 1;
533             }
534             else {
535 1649         3032 last MINUTE;
536             }
537             }
538 1649         5497 my $seconds = $time - $check_time;
539              
540 1649         17318 return ( $seconds, $minute, $hour, $day, $month, "$year", $wday, $yday, 0 );
541             }
542              
543             sub _gm_time {
544 1703     1703   3720 my ( $self, $time ) = @_;
545 1703         2705 my @gmtime;
546 1703 100       6126 if ( $time < 0 ) {
547 54         269 @gmtime = $self->_negative_gm_time($time);
548             }
549             else {
550 1649         8015 @gmtime = $self->_positive_gm_time($time);
551             }
552 1703 100       5749 if (wantarray) {
553 861         6051 return @gmtime;
554             }
555             else {
556 842         26406 return POSIX::strftime( '%a %b %e %H:%M:%S %Y', @gmtime );
557             }
558             }
559              
560             sub time_local {
561 842     842 1 5272 my ( $self, @localtime ) = @_;
562 842         1633 my $time = 0;
563 842         2639 $localtime[ _LOCALTIME_YEAR_INDEX() ] += _LOCALTIME_BASE_YEAR();
564 842 100       1775 if ( $localtime[ _LOCALTIME_YEAR_INDEX() ] >= _EPOCH_YEAR() ) {
565 815         3959 return $self->_positive_time_local(@localtime);
566             }
567             else {
568 27         148 return $self->_negative_time_local(@localtime);
569             }
570             }
571              
572             sub _positive_time_local {
573 815     815   3331 my ( $self, @localtime ) = @_;
574 815         1420 my $check_year = _EPOCH_YEAR();
575 815         1956 my $wday = _EPOCH_WDAY();
576 815         1632 my $time = 0;
577 815         1225 my $leap_year = 0;
578 815         843 YEAR: while (1) {
579              
580 33200 100       43120 if ( $check_year < $localtime[ _LOCALTIME_YEAR_INDEX() ] ) {
581 32385         43885 $time += $self->_number_of_days_in_a_year($leap_year) *
582             _SECONDS_IN_ONE_DAY();
583 32385         32246 $check_year += 1;
584 32385         41263 $leap_year = $self->_is_leap_year($check_year);
585             }
586             else {
587 815         1575 last YEAR;
588             }
589             }
590              
591 815         1359 my $check_month = 0;
592 815         2049 my @days_in_month = $self->_days_in_month($leap_year);
593 815         1467 MONTH: while (1) {
594              
595 3520 100       5426 if ( $check_month < $localtime[ _LOCALTIME_MONTH_INDEX() ] ) {
596 2705         4235 $time += $days_in_month[$check_month] * _SECONDS_IN_ONE_DAY();
597 2705         4753 $check_month += 1;
598             }
599             else {
600 815         1328 last MONTH;
601             }
602             }
603 815         1287 my $check_day = 1;
604 815         1164 DAY: while (1) {
605 16594 100       20079 if ( $check_day < $localtime[ _LOCALTIME_DAY_INDEX() ] ) {
606 15779         17447 $time += _SECONDS_IN_ONE_DAY();
607 15779         16422 $check_day += 1;
608             }
609             else {
610 815         1565 last DAY;
611             }
612             }
613              
614 815         2159 $wday = $wday % _DAYS_IN_ONE_WEEK();
615              
616 815         1091 my $check_hour = 0;
617 815         1106 HOUR: while (1) {
618 5499 100       7655 if ( $check_hour < $localtime[ _LOCALTIME_HOUR_INDEX() ] ) {
619 4684         5599 $time += _SECONDS_IN_ONE_HOUR();
620 4684         5458 $check_hour += 1;
621             }
622             else {
623 815         1180 last HOUR;
624             }
625             }
626 815         1292 my $check_minute = 0;
627 815         1001 MINUTE: while (1) {
628 28195 100       32502 if ( $check_minute < $localtime[ _LOCALTIME_MINUTE_INDEX() ] ) {
629 27380         29930 $time += _SECONDS_IN_ONE_MINUTE();
630 27380         29269 $check_minute += 1;
631             }
632             else {
633 815         1497 last MINUTE;
634             }
635             }
636 815         2598 $time += $localtime[ _LOCALTIME_SECOND_INDEX() ];
637 815         6841 my ( $isdst, $gmtoff, $abbr ) =
638             $self->_get_isdst_gmtoff_abbr_converted_from_gmt_base($time);
639 815         3080 $time -= $gmtoff;
640              
641 815         7659 return $time;
642             }
643              
644             sub _days_in_month {
645 2557     2557   3751 my ( $self, $leap_year ) = @_;
646             return (
647 2557 100       5249 _DAYS_IN_JANUARY(),
648             (
649             $leap_year
650             ? _DAYS_IN_FEBRUARY_LEAP_YEAR()
651             : _DAYS_IN_FEBRUARY_NON_LEAP()
652             ),
653             _DAYS_IN_MARCH(),
654             _DAYS_IN_APRIL(),
655             _DAYS_IN_MAY(),
656             _DAYS_IN_JUNE(),
657             _DAYS_IN_JULY(),
658             _DAYS_IN_AUGUST(),
659             _DAYS_IN_SEPTEMBER(),
660             _DAYS_IN_OCTOBER(),
661             _DAYS_IN_NOVEMBER(),
662             _DAYS_IN_DECEMBER(),
663             );
664             }
665              
666             sub _number_of_days_in_a_year {
667 103187     103187   106616 my ( $self, $leap_year ) = @_;
668 103187 100       148372 if ($leap_year) {
669 25124         35537 return _DAYS_IN_A_LEAP_YEAR();
670             }
671             else {
672 78063         95107 return _DAYS_IN_A_NON_LEAP_YEAR();
673             }
674             }
675              
676             sub _negative_time_local {
677 27     27   92 my ( $self, @localtime ) = @_;
678 27         54 my $check_year = _EPOCH_YEAR() - 1;
679 27         58 my $wday = _EPOCH_WDAY();
680 27         36 my $time = 0;
681 27         35 my $leap_year;
682 27         30 YEAR: while (1) {
683              
684 1035 100       1272 if ( $check_year > $localtime[ _LOCALTIME_YEAR_INDEX() ] ) {
685 1008         1387 $time -= $self->_number_of_days_in_a_year($leap_year) *
686             _SECONDS_IN_ONE_DAY();
687 1008         1053 $check_year -= 1;
688 1008         1207 $leap_year = $self->_is_leap_year($check_year);
689             }
690             else {
691 27         62 last YEAR;
692             }
693             }
694              
695 27         52 my $check_month = _MONTHS_IN_ONE_YEAR() - 1;
696 27         70 my @days_in_month = $self->_days_in_month($leap_year);
697 27         39 MONTH: while (1) {
698              
699 247 100       315 if ( $check_month > $localtime[ _LOCALTIME_MONTH_INDEX() ] ) {
700 220         286 $time -= $days_in_month[$check_month] * _SECONDS_IN_ONE_DAY();
701 220         243 $check_month -= 1;
702             }
703             else {
704 27         58 last MONTH;
705             }
706             }
707 27         52 my $check_day = $days_in_month[$check_month];
708 27         32 DAY: while (1) {
709 402 100       478 if ( $check_day > $localtime[ _LOCALTIME_DAY_INDEX() ] ) {
710 375         401 $time -= _SECONDS_IN_ONE_DAY();
711 375         497 $check_day -= 1;
712             }
713             else {
714 27         42 last DAY;
715             }
716             }
717              
718 27         71 $wday = $wday % _DAYS_IN_ONE_WEEK();
719              
720 27         55 my $check_hour = _HOURS_IN_ONE_DAY() - 1;
721 27         38 HOUR: while (1) {
722 590 100       674 if ( $check_hour > $localtime[ _LOCALTIME_HOUR_INDEX() ] ) {
723 563         622 $time -= _SECONDS_IN_ONE_HOUR();
724 563         562 $check_hour -= 1;
725             }
726             else {
727 27         43 last HOUR;
728             }
729             }
730 27         47 my $check_minute = _MINUTES_IN_ONE_HOUR();
731 27         36 MINUTE: while (1) {
732 1133 100       1307 if ( $check_minute > $localtime[ _LOCALTIME_MINUTE_INDEX() ] ) {
733 1106         1233 $time -= _SECONDS_IN_ONE_MINUTE();
734 1106         1257 $check_minute -= 1;
735             }
736             else {
737 27         42 last MINUTE;
738             }
739             }
740 27         79 $time += $localtime[ _LOCALTIME_SECOND_INDEX() ];
741 27         178 my ( $isdst, $gmtoff, $abbr ) =
742             $self->_get_isdst_gmtoff_abbr_converted_from_gmt_base($time);
743 27         62 $time -= $gmtoff;
744              
745 27         220 return $time;
746             }
747              
748             sub _get_isdst_gmtoff_abbr_converted_from_gmt_base {
749 842     842   2180 my ( $self, $time, $convert_from_gmt ) = @_;
750 842         1084 my ( $isdst, $gmtoff, $abbr );
751 842         2595 my $tz = $self->timezone();
752 842         2819 $self->_read_tzfile();
753 842         1629 my $transition_index = 0;
754 842         1244 my $transition_time_found;
755             my $first_transition_time;
756 842         3169 TRANSITION_TIME: foreach my $transition_time ( $self->transition_times() ) {
757              
758 50840 100       103794 if ( !defined $first_transition_time ) {
759 842         3563 $first_transition_time = $transition_time;
760             }
761 50840         47830 $transition_index += 1;
762 50840         95873 my $local_time_index = $self->{_tzdata}->{$tz}->{local_time_indexes}
763             ->[ $transition_index - 1 ];
764 50840         74767 my $local_time_type =
765             $self->{_tzdata}->{$tz}->{local_time_types}->[$local_time_index];
766 50840         61974 $transition_time += $local_time_type->{gmtoff};
767 50840 100       145269 if ( $transition_time > $time ) {
768 580         1021 $transition_index -= 1;
769 580         962 $transition_time_found = 1;
770 580         1722 last TRANSITION_TIME;
771             }
772             }
773 842         9870 my $offset_found;
774 842 100 33     19565 if (
    100 66        
775             ( defined $first_transition_time )
776             && ( $self->{_tzdata}->{$tz}->{local_time_types}->[0] )
777             && ( $time < $first_transition_time +
778             $self->{_tzdata}->{$tz}->{local_time_types}->[0]->{gmtoff} )
779             )
780             {
781 1         5 my $local_time_type =
782             $self->{_tzdata}->{$tz}->{local_time_types}->[0];
783 1         4 $gmtoff = $local_time_type->{gmtoff};
784 1         3 $isdst = $local_time_type->{isdst};
785 1         5 $abbr = $local_time_type->{abbr};
786 1         3 $offset_found = 1;
787             }
788             elsif ( !$transition_time_found ) {
789 262         975 ( $isdst, $gmtoff, $abbr ) =
790             $self->_get_tz_offset_according_to_v2_tz_rule($time);
791 262 50       772 if ( defined $gmtoff ) {
792 262         432 $offset_found = 1;
793             }
794             }
795 842 100       5976 if ($offset_found) {
    50          
    0          
796             }
797             elsif (
798             defined $self->{_tzdata}->{$tz}->{local_time_indexes}
799             ->[ $transition_index - 1 ] )
800             {
801 579         2144 my $local_time_index = $self->{_tzdata}->{$tz}->{local_time_indexes}
802             ->[ $transition_index - 1 ];
803 579         2049 my $local_time_type =
804             $self->{_tzdata}->{$tz}->{local_time_types}->[$local_time_index];
805 579         1518 $gmtoff = $local_time_type->{gmtoff};
806 579         1562 $isdst = $local_time_type->{isdst};
807 579         2126 $abbr = $local_time_type->{abbr};
808             }
809             elsif ( my $local_time_type =
810             $self->{_tzdata}->{$tz}->{local_time_types}->[0] )
811             {
812 0         0 my $local_time_type = $self->{_tzdata}->{$tz}->{local_time_types}->[0];
813 0         0 $gmtoff = $local_time_type->{gmtoff};
814 0         0 $isdst = $local_time_type->{isdst};
815 0         0 $abbr = $local_time_type->{abbr};
816             }
817 842         6229 return ( $isdst, $gmtoff, $abbr );
818             }
819              
820             sub _get_isdst_gmtoff_abbr {
821 1685     1685   4220 my ( $self, $time, $convert_from_gmt ) = @_;
822 1685         2381 my ( $isdst, $gmtoff, $abbr );
823 1685         6571 my $tz = $self->timezone();
824 1685         9153 $self->_read_tzfile();
825 1685         3182 my $transition_index = 0;
826 1685         2393 my $transition_time_found;
827             my $first_transition_time;
828 1685         6331 TRANSITION_TIME: foreach my $transition_time ( $self->transition_times() ) {
829              
830 101637 100       204773 if ( !defined $first_transition_time ) {
831 1685         5996 $first_transition_time = $transition_time;
832             }
833 101637         97766 $transition_index += 1;
834 101637 100       233408 if ( $transition_time > $time ) {
835 1161         2265 $transition_index -= 1;
836 1161         1958 $transition_time_found = 1;
837 1161         3126 last TRANSITION_TIME;
838             }
839             }
840 1685         19306 my $offset_found;
841 1685 100 66     22730 if ( ( defined $first_transition_time )
    100          
842             && ( $time < $first_transition_time ) )
843             {
844 2         11 my $local_time_type =
845             $self->{_tzdata}->{$tz}->{local_time_types}->[0];
846 2         10 $gmtoff = $local_time_type->{gmtoff};
847 2         48 $isdst = $local_time_type->{isdst};
848 2         8 $abbr = $local_time_type->{abbr};
849 2         8 $offset_found = 1;
850             }
851             elsif ( !$transition_time_found ) {
852 524         2352 ( $isdst, $gmtoff, $abbr ) =
853             $self->_get_tz_offset_according_to_v2_tz_rule($time);
854 524 50       1392 if ( defined $gmtoff ) {
855 524         1003 $offset_found = 1;
856             }
857             }
858 1685 100       10937 if ($offset_found) {
    50          
    0          
859             }
860             elsif (
861             defined $self->{_tzdata}->{$tz}->{local_time_indexes}
862             ->[ $transition_index - 1 ] )
863             {
864 1159         5018 my $local_time_index = $self->{_tzdata}->{$tz}->{local_time_indexes}
865             ->[ $transition_index - 1 ];
866 1159         4823 my $local_time_type =
867             $self->{_tzdata}->{$tz}->{local_time_types}->[$local_time_index];
868 1159         3521 $gmtoff = $local_time_type->{gmtoff};
869 1159         4272 $isdst = $local_time_type->{isdst};
870 1159         5290 $abbr = $local_time_type->{abbr};
871             }
872             elsif ( my $local_time_type =
873             $self->{_tzdata}->{$tz}->{local_time_types}->[0] )
874             {
875 0         0 my $local_time_type = $self->{_tzdata}->{$tz}->{local_time_types}->[0];
876 0         0 $gmtoff = $local_time_type->{gmtoff};
877 0         0 $isdst = $local_time_type->{isdst};
878 0         0 $abbr = $local_time_type->{abbr};
879             }
880 1685         10770 return ( $isdst, $gmtoff, $abbr );
881             }
882              
883             sub local_time {
884 1685     1685 1 4750281 my ( $self, $time ) = @_;
885 1685 50       8357 if ( !defined $time ) {
886 0         0 $time = time;
887             }
888              
889 1685         7891 my ( $isdst, $gmtoff, $abbr ) = $self->_get_isdst_gmtoff_abbr($time);
890 1685         4803 $time += $gmtoff;
891              
892 1685 100       4928 if (wantarray) {
893 843         3353 my (@local_time) = $self->_gm_time($time);
894 843         3019 $local_time[ _LOCALTIME_ISDST_INDEX() ] = $isdst;
895 843 50       3053 if ( _BSD_LOCALTIME_EXTENSION() ) {
896 0         0 $local_time[ _LOCALTIME_GMTOFF_INDEX() ] = $gmtoff;
897 0         0 $local_time[ _LOCALTIME_TMZONE_INDEX() ] = $abbr;
898             }
899 843         8058 return @local_time;
900             }
901             else {
902 842         4723 return $self->_gm_time($time);
903             }
904             }
905              
906             sub transition_times {
907 2528     2528 1 4237 my ($self) = @_;
908 2528         7690 my $tz = $self->timezone();
909 2528         6189 $self->_read_tzfile();
910 2528         3446 return @{ $self->{_tzdata}->{$tz}->{transition_times} };
  2528         105684  
911             }
912              
913             sub leap_seconds {
914 416     416 1 241677 my ($self) = @_;
915 416         1396 my $tz = $self->timezone();
916 416         1194 $self->_read_tzfile();
917 0         0 my @leap_seconds =
918 416         706 sort { $a <=> $b } keys %{ $self->{_tzdata}->{$tz}->{leap_seconds} };
  416         2734  
919 416         1381 return @leap_seconds;
920             }
921              
922             sub _read_header {
923 840     840   1524 my ( $self, $handle, $path ) = @_;
924 840         2735 my $result = $handle->read( my $buffer, _SIZE_OF_TZ_HEADER() );
925 840 50       13518 if ( defined $result ) {
926 840 50       1532 if ( $result != _SIZE_OF_TZ_HEADER() ) {
927 0         0 Carp::croak(
928             "Failed to read entire header from $path. $result bytes were read instead of the expected "
929             . _SIZE_OF_TZ_HEADER() );
930             }
931             }
932             else {
933 0         0 Carp::croak("Failed to read header from $path:$EXTENDED_OS_ERROR");
934             }
935 840         12389 my ( $magic, $version, $ttisgmtcnt, $ttisstdcnt, $leapcnt, $timecnt,
936             $typecnt, $charcnt )
937             = unpack 'A4A1x15N!N!N!N!N!N!', $buffer;
938 840 50       4794 ( $magic eq 'TZif' ) or Carp::croak("$path is not a TZ file");
939 840         9617 my $header = {
940             magic => $magic,
941             version => $version,
942             ttisgmtcnt => $ttisgmtcnt,
943             ttisstdcnt => $ttisstdcnt,
944             leapcnt => $leapcnt,
945             timecnt => $timecnt,
946             typecnt => $typecnt,
947             charcnt => $charcnt
948             };
949              
950 840         3794 return $header;
951             }
952              
953             sub _read_transition_times {
954 840     840   1893 my ( $self, $handle, $path, $timecnt, $sizeof_transition_time ) = @_;
955 840         2400 my $sizeof_transition_times = $timecnt * $sizeof_transition_time;
956 840         2634 my $result = $handle->read( my $buffer, $sizeof_transition_times );
957 840 50       8678 if ( defined $result ) {
958 840 50       2747 if ( $result != $sizeof_transition_times ) {
959 0         0 Carp::croak(
960             "Failed to read all the transition times from $path. $result bytes were read instead of the expected "
961             . $sizeof_transition_times );
962             }
963             }
964             else {
965 0         0 Carp::croak(
966             "Failed to read transition times from $path:$EXTENDED_OS_ERROR");
967             }
968 840         1373 my @transition_times;
969 840 100       1600 if ( $sizeof_transition_time == _SIZE_OF_TRANSITION_TIME_V1() ) {
    50          
970 420         23528 @transition_times = unpack 'l>' . $timecnt, $buffer;
971             }
972             elsif ( $sizeof_transition_time == _SIZE_OF_TRANSITION_TIME_V2() ) {
973 420 50       1275 eval { @transition_times = unpack 'q>' . $timecnt, $buffer; } or do {
  420         17154  
974 0         0 require Math::Int64;
975 0         0 @transition_times =
976 0         0 map { Math::Int64::net_to_int64($_) } unpack '(a8)' . $timecnt,
977             $buffer;
978             };
979             }
980 840         11809 return \@transition_times;
981             }
982              
983             sub _read_local_time_indexes {
984 840     840   2341 my ( $self, $handle, $path, $timecnt ) = @_;
985 840         3136 my $result = $handle->read( my $buffer, $timecnt );
986 840 50       8128 if ( defined $result ) {
987 840 50       3245 if ( $result != $timecnt ) {
988 0         0 Carp::croak(
989             "Failed to read all the local time indexes from $path. $result bytes were read instead of the expected "
990             . $timecnt );
991             }
992             }
993             else {
994 0         0 Carp::croak(
995             "Failed to read local time indexes from $path:$EXTENDED_OS_ERROR");
996             }
997 840         28390 my @local_time_indexes = unpack 'C' . $timecnt, $buffer;
998 840         9021 return \@local_time_indexes;
999             }
1000              
1001             sub _read_local_time_types {
1002 840     840   2369 my ( $self, $handle, $path, $typecnt ) = @_;
1003 840         2208 my $sizeof_local_time_types = $typecnt * _SIZE_OF_TTINFO();
1004 840         3122 my $result = $handle->read( my $buffer, $sizeof_local_time_types );
1005 840 50       8049 if ( defined $result ) {
1006 840 50       3027 if ( $result != $sizeof_local_time_types ) {
1007 0         0 Carp::croak(
1008             "Failed to read all the local time types from $path. $result bytes were read instead of the expected "
1009             . $sizeof_local_time_types );
1010             }
1011             }
1012             else {
1013 0         0 Carp::croak(
1014             "Failed to read local time types from $path:$EXTENDED_OS_ERROR");
1015             }
1016 840         1168 my @local_time_types;
1017 840         6853 foreach my $local_time_type ( unpack '(a6)' . $typecnt, $buffer ) {
1018 4617         17231 my ( $c1, $c2, $c3 ) = unpack 'a4aa', $local_time_type;
1019 4617         10847 my $gmtoff = unpack 'l>', $c1;
1020 4617         8962 my $isdst = unpack 'C', $c2;
1021 4617         9644 my $abbrind = unpack 'C', $c3;
1022 4617         23763 push @local_time_types,
1023             { gmtoff => $gmtoff, isdst => $isdst, abbrind => $abbrind };
1024             }
1025 840         5397 return \@local_time_types;
1026             }
1027              
1028             sub _read_time_zone_abbreviation_strings {
1029 840     840   1915 my ( $self, $handle, $path, $charcnt ) = @_;
1030 840         2627 my $result = $handle->read( my $time_zone_abbreviation_strings, $charcnt );
1031 840 50       7852 if ( defined $result ) {
1032 840 50       2857 if ( $result != $charcnt ) {
1033 0         0 Carp::croak(
1034             "Failed to read all the time zone abbreviations from $path. $result bytes were read instead of the expected "
1035             . $charcnt );
1036             }
1037             }
1038             else {
1039 0         0 Carp::croak(
1040             "Failed to read time zone abbreviations from $path:$EXTENDED_OS_ERROR"
1041             );
1042             }
1043 840         4217 return $time_zone_abbreviation_strings;
1044             }
1045              
1046             sub _read_leap_seconds {
1047 840     840   1988 my ( $self, $handle, $path, $leapcnt, $sizeof_leap_second ) = @_;
1048 840         2037 my $sizeof_leap_seconds = $leapcnt * _PAIR() * $sizeof_leap_second;
1049 840         3285 my $result = $handle->read( my $buffer, $sizeof_leap_seconds );
1050 840 50       9115 if ( defined $result ) {
1051 840 50       2851 if ( $result != $sizeof_leap_seconds ) {
1052 0         0 Carp::croak(
1053             "Failed to read all the leap seconds from $path. $result bytes were read instead of the expected "
1054             . $sizeof_leap_seconds );
1055             }
1056             }
1057             else {
1058 0         0 Carp::croak(
1059             "Failed to read leap seconds from $path:$EXTENDED_OS_ERROR");
1060             }
1061 840         3213 my @paired_leap_seconds = unpack 'L>' . $leapcnt, $buffer;
1062 840         1395 my %leap_seconds;
1063 840         2276 while (@paired_leap_seconds) {
1064 0         0 my $time_leap_second_occurs = shift @paired_leap_seconds;
1065 0         0 my $total_number_of_leap_seconds = shift @paired_leap_seconds;
1066 0         0 $leap_seconds{$time_leap_second_occurs} = $total_number_of_leap_seconds;
1067             }
1068 840         5143 return \%leap_seconds;
1069             }
1070              
1071             sub _read_is_standard_time {
1072 840     840   2021 my ( $self, $handle, $path, $ttisstdcnt ) = @_;
1073 840         2526 my $result = $handle->read( my $buffer, $ttisstdcnt );
1074 840 50       6699 if ( defined $result ) {
1075 840 50       2859 if ( $result != $ttisstdcnt ) {
1076 0         0 Carp::croak(
1077             "Failed to read all the is standard time values from $path. $result bytes were read instead of the expected "
1078             . $ttisstdcnt );
1079             }
1080             }
1081             else {
1082 0         0 Carp::croak(
1083             "Failed to read is standard time values from $path:$EXTENDED_OS_ERROR"
1084             );
1085             }
1086 840         5925 my @is_std_time = unpack 'C' . $ttisstdcnt, $buffer;
1087 840         5157 return \@is_std_time;
1088             }
1089              
1090             sub _read_is_gmt {
1091 840     840   1937 my ( $self, $handle, $path, $ttisgmtcnt ) = @_;
1092 840         2367 my $result = $handle->read( my $buffer, $ttisgmtcnt );
1093 840 50       7647 if ( defined $result ) {
1094 840 50       2692 if ( $result != $ttisgmtcnt ) {
1095 0         0 Carp::croak(
1096             "Failed to read all the is GMT values from $path. $result bytes were read instead of the expected "
1097             . $ttisgmtcnt );
1098             }
1099             }
1100             else {
1101 0         0 Carp::croak(
1102             "Failed to read is GMT values from $path:$EXTENDED_OS_ERROR");
1103             }
1104 840         5177 my @is_gmt_time = unpack 'C' . $ttisgmtcnt, $buffer;
1105 840         5358 return \@is_gmt_time;
1106             }
1107              
1108             sub _read_tz_definition {
1109 420     420   818 my ( $self, $handle, $path ) = @_;
1110 420         1259 my $result =
1111             $handle->read( my $buffer, _MAX_LENGTH_FOR_TRAILING_TZ_DEFINITION() );
1112 420 50       5922 if ( defined $result ) {
1113 420 50       709 if ( $result == _MAX_LENGTH_FOR_TRAILING_TZ_DEFINITION() ) {
1114 0         0 Carp::croak(
1115             "The tz defintion at the end of $path could not be read in "
1116             . _MAX_LENGTH_FOR_TRAILING_TZ_DEFINITION()
1117             . ' bytes' );
1118             }
1119             }
1120             else {
1121 0         0 Carp::croak(
1122             "Failed to read tz definition from $path:$EXTENDED_OS_ERROR");
1123             }
1124 420 100       5242 if ( $buffer =~ /^\n([^\n]+)\n*$/smx ) {
1125 419         2569 return $self->_parse_tz_variable( $1, $path );
1126              
1127             }
1128 1         13 return;
1129             }
1130              
1131             sub _parse_tz_variable {
1132 419     419   2883 my ( $self, $tz_variable, $path ) = @_;
1133 419         2175 my $timezone_abbr_name_regex = qr/[^:\d,+-][^\d,+-]{2,}/smx;
1134 419         4361 my $std_name_regex = qr/(?$timezone_abbr_name_regex)/smx
1135             ; # Name for standard offset from GMT
1136 419         1619 my $std_sign_regex = qr/(?[+-])/smx;
1137 419         1117 my $std_hours_regex = qr/(?\d+)/smx;
1138 419         1561 my $std_minutes_regex = qr/(?::(?\d+))/smx;
1139 419         1273 my $std_seconds_regex = qr/(?::(?\d+))/smx;
1140 419         3833 my $std_offset_regex =
1141             qr/$std_sign_regex?$std_hours_regex$std_minutes_regex?$std_seconds_regex?/smx
1142             ; # Standard offset from GMT
1143 419         2328 my $dst_name_regex = qr/(?$timezone_abbr_name_regex)/smx
1144             ; # Name for daylight saving offset from GMT
1145 419         1251 my $dst_sign_regex = qr/(?[+-])/smx;
1146 419         1294 my $dst_hours_regex = qr/(?\d+)/smx;
1147 419         1195 my $dst_minutes_regex = qr/(?::(?\d+))/smx;
1148 419         1294 my $dst_seconds_regex = qr/(?::(?\d+))/smx;
1149 419         3487 my $dst_offset_regex =
1150             qr/$dst_sign_regex?$dst_hours_regex$dst_minutes_regex?$dst_seconds_regex?/smx
1151             ; # Standard offset from GMT
1152 419         1809 my $start_julian_without_feb29_regex =
1153             qr/(?:J(?\d{1,3}))/smx;
1154 419         1361 my $start_julian_with_feb29_regex =
1155             qr/(?\d{1,3})/smx;
1156 419         1261 my $start_month_regex = qr/(?\d{1,2})/smx;
1157 419         1638 my $start_week_regex = qr/(?[1-5])/smx;
1158 419         1129 my $start_day_regex = qr/(?[0-6])/smx;
1159 419         2587 my $start_month_week_day_regex =
1160             qr/(?:M$start_month_regex[.]$start_week_regex[.]$start_day_regex)/smx;
1161 419         2996 my $start_date_regex =
1162             qr/(?:$start_julian_without_feb29_regex|$start_julian_with_feb29_regex|$start_month_week_day_regex)/smx;
1163 419         1370 my $start_hour_regex = qr/(?\-?\d+)/smx;
1164 419         1238 my $start_minute_regex = qr/(?::(?\d+))/smx;
1165 419         1938 my $start_second_regex = qr/(?::(?\d+))/smx;
1166 419         2767 my $start_time_regex =
1167             qr/[\/]$start_hour_regex$start_minute_regex?$start_second_regex?/smx;
1168 419         2671 my $start_datetime_regex = qr/$start_date_regex(?:$start_time_regex)?/smx;
1169 419         1385 my $end_julian_without_feb29_regex =
1170             qr/(?:J(?\d{1,3}))/smx;
1171 419         1421 my $end_julian_with_feb29_regex = qr/(?\d{1,3})/smx;
1172 419         1676 my $end_month_regex = qr/(?\d{1,2})/smx;
1173 419         1274 my $end_week_regex = qr/(?[1-5])/smx;
1174 419         1207 my $end_day_regex = qr/(?[0-6])/smx;
1175 419         2530 my $end_month_week_day_regex =
1176             qr/(?:M$end_month_regex[.]$end_week_regex[.]$end_day_regex)/smx;
1177 419         3426 my $end_date_regex =
1178             qr/(?:$end_julian_without_feb29_regex|$end_julian_with_feb29_regex|$end_month_week_day_regex)/smx;
1179 419         1813 my $end_hour_regex = qr/(?\-?\d+)/smx;
1180 419         1237 my $end_minute_regex = qr/(?::(?\d+))/smx;
1181 419         1330 my $end_second_regex = qr/(?::(?\d+))/smx;
1182 419         2336 my $end_time_regex =
1183             qr/[\/]$end_hour_regex$end_minute_regex?$end_second_regex?/smx;
1184 419         2495 my $end_datetime_regex = qr/$end_date_regex(?:$end_time_regex)?/smx;
1185              
1186 419 50       10410 if ( $tz_variable =~
1187             /^$std_name_regex$std_offset_regex(?:$dst_name_regex(?:$dst_offset_regex)?,$start_datetime_regex,$end_datetime_regex)?$/smx
1188             )
1189             {
1190 419         2129 my $tz_definition = { tz => $tz_variable };
1191 419         2779 foreach my $key (
1192             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)
1193             )
1194             {
1195 10894 100       44807 if ( defined $LAST_PAREN_MATCH{$key} ) {
1196 2327         12604 $tz_definition->{$key} = $LAST_PAREN_MATCH{$key};
1197             }
1198             }
1199 419         1861 $self->_initialise_undefined_tz_definition_values($tz_definition);
1200 419         1981 $tz_definition->{std_offset_in_seconds} =
1201             $self->_std_offset_in_seconds($tz_definition);
1202 419         1274 $tz_definition->{dst_offset_in_seconds} =
1203             $self->_dst_offset_in_seconds($tz_definition);
1204 419         7384 return $tz_definition;
1205             }
1206             else {
1207 0         0 Carp::croak(
1208             "Failed to parse the tz defintion of $tz_variable from $path");
1209             }
1210             }
1211              
1212             sub _dst_offset_in_seconds {
1213 419     419   861 my ( $self, $tz_definition ) = @_;
1214 419   50     2568 my $dst_offset_in_seconds = $tz_definition->{dst_seconds} || 0;
1215 419 50       1372 if ( defined $tz_definition->{dst_minutes} ) {
1216 0         0 $dst_offset_in_seconds +=
1217             $tz_definition->{dst_minutes} * _SECONDS_IN_ONE_MINUTE();
1218             }
1219 419 100       1315 if ( defined $tz_definition->{dst_hours} ) {
1220 2         13 $dst_offset_in_seconds +=
1221             $tz_definition->{dst_hours} *
1222             _MINUTES_IN_ONE_HOUR() *
1223             _SECONDS_IN_ONE_MINUTE();
1224             }
1225 419 100 66     1464 if ( ( defined $tz_definition->{dst_sign} )
1226             && ( $tz_definition->{dst_sign} eq q[-] ) )
1227             {
1228             }
1229             else {
1230 417         1056 $dst_offset_in_seconds *= _NEGATIVE_ONE();
1231             }
1232 419 100       1269 if ( $dst_offset_in_seconds == 0 ) {
1233 417         1282 $dst_offset_in_seconds = $tz_definition->{std_offset_in_seconds} +
1234             ( _MINUTES_IN_ONE_HOUR() * _SECONDS_IN_ONE_MINUTE() );
1235             }
1236 419         1110 return $dst_offset_in_seconds;
1237             }
1238              
1239             sub _std_offset_in_seconds {
1240 419     419   850 my ( $self, $tz_definition ) = @_;
1241 419   50     2935 my $std_offset_in_seconds = $tz_definition->{std_seconds} || 0;
1242              
1243 419 100       1222 if ( defined $tz_definition->{std_minutes} ) {
1244 16         98 $std_offset_in_seconds +=
1245             $tz_definition->{std_minutes} * _SECONDS_IN_ONE_MINUTE();
1246             }
1247 419 50       1322 if ( defined $tz_definition->{std_hours} ) {
1248 419         1991 $std_offset_in_seconds +=
1249             $tz_definition->{std_hours} *
1250             _MINUTES_IN_ONE_HOUR() *
1251             _SECONDS_IN_ONE_MINUTE();
1252             }
1253 419 100 66     3096 if ( ( defined $tz_definition->{std_sign} )
1254             && ( $tz_definition->{std_sign} eq q[-] ) )
1255             {
1256             }
1257             else {
1258 192         617 $std_offset_in_seconds *= _NEGATIVE_ONE();
1259             }
1260 419         1372 return $std_offset_in_seconds;
1261             }
1262              
1263             sub _initialise_undefined_tz_definition_values {
1264 419     419   786 my ( $self, $tz_definition ) = @_;
1265 419 100       2042 $tz_definition->{start_hour} =
1266             defined $tz_definition->{start_hour}
1267             ? $tz_definition->{start_hour}
1268             : _DEFAULT_DST_START_HOUR();
1269 419 100       1535 $tz_definition->{start_minute} =
1270             defined $tz_definition->{start_minute}
1271             ? $tz_definition->{start_minute}
1272             : 0;
1273 419 50       1404 $tz_definition->{start_second} =
1274             defined $tz_definition->{start_second}
1275             ? $tz_definition->{start_second}
1276             : 0;
1277 419 100       2216 $tz_definition->{end_hour} =
1278             defined $tz_definition->{end_hour}
1279             ? $tz_definition->{end_hour}
1280             : _DEFAULT_DST_END_HOUR();
1281 419 100       1814 $tz_definition->{end_minute} =
1282             defined $tz_definition->{end_minute}
1283             ? $tz_definition->{end_minute}
1284             : 0;
1285 419 50       1834 $tz_definition->{end_second} =
1286             defined $tz_definition->{end_second}
1287             ? $tz_definition->{end_second}
1288             : 0;
1289 419         1442 return;
1290             }
1291              
1292             sub _set_abbrs {
1293 840     840   2215 my ( $self, $tz ) = @_;
1294 840         1047 my $index = 0;
1295 840         1049 foreach
1296 840         3032 my $local_time_type ( @{ $self->{_tzdata}->{$tz}->{local_time_types} } )
1297             {
1298 4617 100       10327 if ( $self->{_tzdata}->{$tz}->{local_time_types}->[ $index + 1 ] ) {
1299 3777         13761 $local_time_type->{abbr} =
1300             substr $self->{_tzdata}->{$tz}->{time_zone_abbreviation_strings},
1301             $local_time_type->{abbrind},
1302             $self->{_tzdata}->{$tz}->{local_time_types}->[ $index + 1 ]
1303             ->{abbrind};
1304             }
1305             else {
1306 840         3685 $local_time_type->{abbr} =
1307             substr $self->{_tzdata}->{$tz}->{time_zone_abbreviation_strings},
1308             $local_time_type->{abbrind};
1309             }
1310 4617         6644 $index += 1;
1311             }
1312 840         2140 return;
1313             }
1314              
1315             sub _read_v1_tzfile {
1316 420     420   1356 my ( $self, $handle, $path, $header, $tz ) = @_;
1317 420         3348 $self->{_tzdata}->{$tz}->{transition_times} =
1318             $self->_read_transition_times( $handle, $path, $header->{timecnt},
1319             _SIZE_OF_TRANSITION_TIME_V1() );
1320 420         2753 $self->{_tzdata}->{$tz}->{local_time_indexes} =
1321             $self->_read_local_time_indexes( $handle, $path, $header->{timecnt} );
1322 420         2570 $self->{_tzdata}->{$tz}->{local_time_types} =
1323             $self->_read_local_time_types( $handle, $path, $header->{typecnt} );
1324 420         1705 $self->{_tzdata}->{$tz}->{time_zone_abbreviation_strings} =
1325             $self->_read_time_zone_abbreviation_strings( $handle, $path,
1326             $header->{charcnt} );
1327 420         2198 $self->_set_abbrs($tz);
1328 420         1522 $self->{_tzdata}->{$tz}->{leap_seconds} =
1329             $self->_read_leap_seconds( $handle, $path, $header->{leapcnt},
1330             _SIZE_OF_LEAP_SECOND_V1() );
1331 420         1663 $self->{_tzdata}->{$tz}->{is_std} =
1332             $self->_read_is_standard_time( $handle, $path, $header->{ttisstdcnt} );
1333 420         2438 $self->{_tzdata}->{$tz}->{is_gmt} =
1334             $self->_read_is_gmt( $handle, $path, $header->{ttisstdcnt} );
1335 420         902 return;
1336             }
1337              
1338             sub _read_v2_tzfile {
1339 420     420   1851 my ( $self, $handle, $path, $header, $tz ) = @_;
1340              
1341 420 50 33     23310 if ( ( $header->{version} >= 2 )
      33        
1342             && ( defined $Config{'d_quad'} )
1343             && ( $Config{'d_quad'} eq 'define' ) )
1344             {
1345 420         6325 $self->{_tzdata}->{$tz} = {};
1346 420         7886 $header = $self->_read_header( $handle, $path );
1347 420         1655 $self->{_tzdata}->{$tz}->{transition_times} =
1348             $self->_read_transition_times( $handle, $path, $header->{timecnt},
1349             _SIZE_OF_TRANSITION_TIME_V2() );
1350 420         1510 $self->{_tzdata}->{$tz}->{local_time_indexes} =
1351             $self->_read_local_time_indexes( $handle, $path, $header->{timecnt} );
1352 420         1367 $self->{_tzdata}->{$tz}->{local_time_types} =
1353             $self->_read_local_time_types( $handle, $path, $header->{typecnt} );
1354 420         1609 $self->{_tzdata}->{$tz}->{time_zone_abbreviation_strings} =
1355             $self->_read_time_zone_abbreviation_strings( $handle, $path,
1356             $header->{charcnt} );
1357 420         1336 $self->_set_abbrs($tz);
1358 420         1527 $self->{_tzdata}->{$tz}->{leap_seconds} =
1359             $self->_read_leap_seconds( $handle, $path, $header->{leapcnt},
1360             _SIZE_OF_LEAP_SECOND_V2() );
1361 420         1417 $self->{_tzdata}->{$tz}->{is_std} =
1362             $self->_read_is_standard_time( $handle, $path,
1363             $header->{ttisstdcnt} );
1364 420         1428 $self->{_tzdata}->{$tz}->{is_gmt} =
1365             $self->_read_is_gmt( $handle, $path, $header->{ttisstdcnt} );
1366 420         1414 $self->{_tzdata}->{$tz}->{tz_definition} =
1367             $self->_read_tz_definition( $handle, $path );
1368             }
1369 420         2369 return;
1370             }
1371              
1372             sub _read_tzfile {
1373 5471     5471   8160 my ($self) = @_;
1374 5471         10099 my $tz = $self->timezone();
1375 5471         15524 my $path = File::Spec->catfile( $self->directory, $tz );
1376 5471 50       38585 my $handle = FileHandle->new($path)
1377             or Carp::croak("Failed to open $path for reading:$EXTENDED_OS_ERROR");
1378 5471         496888 my $_last_modified = ( stat _ )[ _STAT_MTIME_IDX() ];
1379 5471 100 100     52936 if ( ( $self->{_tzdata}->{$tz}->{mtime} )
1380             && ( $self->{_tzdata}->{$tz}->{mtime} == $_last_modified ) )
1381             {
1382             }
1383             else {
1384 420         1375 binmode $handle;
1385 420         2568 my $header = $self->_read_header( $handle, $path );
1386 420         2593 $self->_read_v1_tzfile( $handle, $path, $header, $tz );
1387 420         2198 $self->_read_v2_tzfile( $handle, $path, $header, $tz );
1388 420         2566 $self->{_tzdata}->{$tz}->{mtime} = $_last_modified;
1389             }
1390 5471 50       47710 close $handle
1391             or Carp::croak("Failed to close $path:$EXTENDED_OS_ERROR");
1392 5471         22780 return;
1393             }
1394              
1395             1;
1396             __END__