File Coverage

blib/lib/Time/Local.pm
Criterion Covered Total %
statement 69 82 84.1
branch 32 40 80.0
condition 24 36 66.6
subroutine 18 18 100.0
pod 8 8 100.0
total 151 184 82.0


line stmt bran cond sub pod time code
1             package Time::Local;
2              
3 1     1   64910 use strict;
  1         9  
  1         27  
4              
5 1     1   5 use Carp ();
  1         1  
  1         15  
6 1     1   4 use Exporter;
  1         2  
  1         45  
7              
8             our $VERSION = '1.34';
9              
10 1     1   430 use parent 'Exporter';
  1         297  
  1         5  
11              
12             our @EXPORT = qw( timegm timelocal );
13             our @EXPORT_OK = qw(
14             timegm_modern
15             timelocal_modern
16             timegm_nocheck
17             timelocal_nocheck
18             timegm_posix
19             timelocal_posix
20             );
21              
22             my @MonthDays = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
23              
24             # Determine breakpoint for rolling century
25             my $ThisYear = ( localtime() )[5];
26             my $Breakpoint = ( $ThisYear + 50 ) % 100;
27             my $NextCentury = $ThisYear - $ThisYear % 100;
28             $NextCentury += 100 if $Breakpoint < 50;
29             my $Century = $NextCentury - 100;
30             my $SecOff = 0;
31              
32             my ( %Options, %Cheat );
33              
34 1     1   131 use constant SECS_PER_MINUTE => 60;
  1         1  
  1         87  
35 1     1   6 use constant SECS_PER_HOUR => 3600;
  1         2  
  1         55  
36 1     1   6 use constant SECS_PER_DAY => 86400;
  1         2  
  1         1184  
37              
38             my $MaxDay;
39             if ( $] < 5.012000 ) {
40             require Config;
41             ## no critic (Variables::ProhibitPackageVars)
42              
43             my $MaxInt;
44             if ( $^O eq 'MacOS' ) {
45              
46             # time_t is unsigned...
47             $MaxInt = ( 1 << ( 8 * $Config::Config{ivsize} ) )
48             - 1; ## no critic qw(ProhibitPackageVars)
49             }
50             else {
51             $MaxInt
52             = ( ( 1 << ( 8 * $Config::Config{ivsize} - 2 ) ) - 1 ) * 2
53             + 1; ## no critic qw(ProhibitPackageVars)
54             }
55              
56             $MaxDay = int( ( $MaxInt - ( SECS_PER_DAY / 2 ) ) / SECS_PER_DAY ) - 1;
57             }
58             else {
59             # recent localtime()'s limit is the year 2**31
60             $MaxDay = 365 * ( 2**31 );
61              
62             # On (some?) 32-bit platforms this overflows and we end up with a negative
63             # $MaxDay, which totally breaks this module. This is the old calculation
64             # we used from the days before Perl always had 64-bit time_t.
65             if ( $MaxDay < 0 ) {
66             require Config;
67             ## no critic (Variables::ProhibitPackageVars)
68             my $max_int
69             = ( ( 1 << ( 8 * $Config::Config{intsize} - 2 ) ) - 1 ) * 2 + 1;
70             $MaxDay
71             = int( ( $max_int - ( SECS_PER_DAY / 2 ) ) / SECS_PER_DAY ) - 1;
72             }
73             }
74              
75             # Determine the EPOC day for this machine
76             my $Epoc = 0;
77             if ( $^O eq 'vos' ) {
78              
79             # work around posix-977 -- VOS doesn't handle dates in the range
80             # 1970-1980.
81             $Epoc = _daygm( 0, 0, 0, 1, 0, 70, 4, 0 );
82             }
83             elsif ( $^O eq 'MacOS' ) {
84             $MaxDay *= 2; # time_t unsigned ... quick hack?
85             # MacOS time() is seconds since 1 Jan 1904, localtime
86             # so we need to calculate an offset to apply later
87             $Epoc = 693901;
88             $SecOff = timelocal( localtime(0) ) - timelocal( gmtime(0) );
89             $Epoc += _daygm( gmtime(0) );
90             }
91             else {
92             $Epoc = _daygm( gmtime(0) );
93             }
94              
95             %Cheat = (); # clear the cache as epoc has changed
96              
97             sub _daygm {
98              
99             # This is written in such a byzantine way in order to avoid
100             # lexical variables and sub calls, for speed
101             return $_[3] + (
102 19026   66 19026   87581 $Cheat{ pack( 'ss', @_[ 4, 5 ] ) } ||= do {
103 43         81 my $month = ( $_[4] + 10 ) % 12;
104 43         88 my $year = $_[5] + 1900 - int( $month / 10 );
105              
106 43         158 ( ( 365 * $year )
107             + int( $year / 4 )
108             - int( $year / 100 )
109             + int( $year / 400 )
110             + int( ( ( $month * 306 ) + 5 ) / 10 ) )
111             - $Epoc;
112             }
113             );
114             }
115              
116             sub _timegm {
117 6341     6341   17893 my $sec
118             = $SecOff + $_[0]
119             + ( SECS_PER_MINUTE * $_[1] )
120             + ( SECS_PER_HOUR * $_[2] );
121              
122 6341         9523 return $sec + ( SECS_PER_DAY * &_daygm );
123             }
124              
125             sub timegm {
126 12750     12750 1 57230 my ( $sec, $min, $hour, $mday, $month, $year ) = @_;
127 12750         23666 my $subsec = $sec - int($sec);
128 12750         16163 $sec = int($sec);
129              
130 12750 100       36367 if ( $Options{no_year_munging} ) {
    100          
131 71         105 $year -= 1900;
132             }
133             elsif ( !$Options{posix_year} ) {
134 137 100 100     319 if ( $year >= 1000 ) {
    100          
135 105         145 $year -= 1900;
136             }
137             elsif ( $year < 100 and $year >= 0 ) {
138 27 100       61 $year += ( $year > $Breakpoint ) ? $Century : $NextCentury;
139             }
140             }
141              
142 12750 100       23935 unless ( $Options{no_range_check} ) {
143 12684 100 100     47273 Carp::croak("Month '$month' out of range 0..11")
144             if $month > 11
145             or $month < 0;
146              
147 12672         20289 my $md = $MonthDays[$month];
148 12672 100 100     26275 ++$md
149             if $month == 1 && _is_leap_year( $year + 1900 );
150              
151 12672 100 100     37017 Carp::croak("Day '$mday' out of range 1..$md")
152             if $mday > $md or $mday < 1;
153 12654 100 100     34909 Carp::croak("Hour '$hour' out of range 0..23")
154             if $hour > 23 or $hour < 0;
155 12642 100 100     32724 Carp::croak("Minute '$min' out of range 0..59")
156             if $min > 59 or $min < 0;
157 12630 100 100     40720 Carp::croak("Second '$sec' out of range 0..59")
158             if $sec >= 60 or $sec < 0;
159             }
160              
161 12684         25138 my $days = _daygm( undef, undef, undef, $mday, $month, $year );
162              
163 12684 50 33     30409 if ( abs($days) > $MaxDay && !$Options{no_range_check} ) {
164 0         0 my $msg = "Day too big - abs($days) > $MaxDay\n";
165              
166 0         0 $year += 1900;
167 0         0 $msg
168             .= "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)";
169              
170 0         0 Carp::croak($msg);
171             }
172              
173             # Adding in the $subsec value last seems to prevent floating point errors
174             # from creeping in.
175             return (
176             (
177 12684         37181 $sec + $SecOff
178             + ( SECS_PER_MINUTE * $min )
179             + ( SECS_PER_HOUR * $hour )
180             + ( SECS_PER_DAY * $days )
181             ) + $subsec
182             );
183             }
184              
185             sub _is_leap_year {
186 299 100   299   6820 return 0 if $_[0] % 4;
187 45 100       134 return 1 if $_[0] % 100;
188 12 100       38 return 0 if $_[0] % 400;
189              
190 4         13 return 1;
191             }
192              
193             sub timegm_nocheck {
194 34     34 1 27062 local $Options{no_range_check} = 1;
195 34         68 return &timegm;
196             }
197              
198             sub timegm_modern {
199 36     36 1 28733 local $Options{no_year_munging} = 1;
200 36         76 return &timegm;
201             }
202              
203             sub timegm_posix {
204 6273     6273 1 4319206 local $Options{posix_year} = 1;
205 6273         12696 return &timegm;
206             }
207              
208             sub timelocal {
209 6371     6371 1 53077 my $sec = shift;
210 6371         14423 my $subsec = $sec - int($sec);
211 6371         8313 $sec = int($sec);
212 6371         12391 unshift @_, $sec;
213              
214 6371         10072 my $ref_t = &timegm;
215 6341         153514 my $loc_for_ref_t = _timegm( localtime($ref_t) );
216              
217 6341 50       35743 my $zone_off = $loc_for_ref_t - $ref_t
218             or return $loc_for_ref_t + $subsec;
219              
220             # Adjust for timezone
221 0         0 my $loc_t = $ref_t - $zone_off;
222              
223             # Are we close to a DST change or are we done
224 0         0 my $dst_off = $ref_t - _timegm( localtime($loc_t) );
225              
226             # If this evaluates to true, it means that the value in $loc_t is
227             # the _second_ hour after a DST change where the local time moves
228             # backward.
229 0 0 0     0 if (
230             !$dst_off
231             && ( ( $ref_t - SECS_PER_HOUR )
232             - _timegm( localtime( $loc_t - SECS_PER_HOUR ) ) < 0 )
233             ) {
234 0         0 return ( $loc_t - SECS_PER_HOUR ) + $subsec;
235             }
236              
237             # Adjust for DST change
238 0         0 $loc_t += $dst_off;
239              
240 0 0       0 return $loc_t + $subsec if $dst_off > 0;
241              
242             # If the original date was a non-existent gap in a forward DST jump, we
243             # should now have the wrong answer - undo the DST adjustment
244 0         0 my ( $s, $m, $h ) = localtime($loc_t);
245 0 0 0     0 $loc_t -= $dst_off if $s != $_[0] || $m != $_[1] || $h != $_[2];
      0        
246              
247 0         0 return $loc_t + $subsec;
248             }
249              
250             sub timelocal_nocheck {
251 32     32 1 22671 local $Options{no_range_check} = 1;
252 32         58 return &timelocal;
253             }
254              
255             sub timelocal_modern {
256 35     35 1 25656 local $Options{no_year_munging} = 1;
257 35         68 return &timelocal;
258             }
259              
260             sub timelocal_posix {
261 6269     6269 1 4489192 local $Options{posix_year} = 1;
262 6269         12687 return &timelocal;
263             }
264              
265             1;
266              
267             # ABSTRACT: Efficiently compute time from local and GMT time
268              
269             __END__