File | /opt/wise/lib/perl5/5.10.0/Time/Local.pm | Statements Executed | 50 | Total Time | 0.002229 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine | |
---|---|---|---|---|---|---|
1 | 1 | 1 | 2.9e-5 | 2.9e-5 | Time::Local:: | _daygm |
0 | 0 | 0 | 0 | 0 | Time::Local:: | BEGIN |
0 | 0 | 0 | 0 | 0 | Time::Local:: | _is_leap_year |
0 | 0 | 0 | 0 | 0 | Time::Local:: | _timegm |
0 | 0 | 0 | 0 | 0 | Time::Local:: | timegm |
0 | 0 | 0 | 0 | 0 | Time::Local:: | timegm_nocheck |
0 | 0 | 0 | 0 | 0 | Time::Local:: | timelocal |
0 | 0 | 0 | 0 | 0 | Time::Local:: | timelocal_nocheck |
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | package Time::Local; | |||
2 | ||||
3 | 1 | 1.0e-6 | 1.0e-6 | require Exporter; |
4 | 3 | 0.00059 | 0.00020 | use Carp; # spent 52µs making 1 call to Exporter::import |
5 | 3 | 2.6e-5 | 8.7e-6 | use Config; # spent 20µs making 1 call to Config::import |
6 | 3 | 2.3e-5 | 7.7e-6 | use strict; # spent 9µs making 1 call to strict::import |
7 | 3 | 0.00026 | 8.7e-5 | use integer; # spent 8µs making 1 call to integer::import |
8 | ||||
9 | 3 | 0.00012 | 3.9e-5 | use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK ); # spent 63µs making 1 call to vars::import |
10 | 1 | 1.0e-6 | 1.0e-6 | $VERSION = '1.18'; |
11 | ||||
12 | 1 | 7.0e-6 | 7.0e-6 | @ISA = qw( Exporter ); |
13 | 1 | 1.0e-6 | 1.0e-6 | @EXPORT = qw( timegm timelocal ); |
14 | 1 | 1.0e-6 | 1.0e-6 | @EXPORT_OK = qw( timegm_nocheck timelocal_nocheck ); |
15 | ||||
16 | 1 | 2.0e-6 | 2.0e-6 | my @MonthDays = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ); |
17 | ||||
18 | # Determine breakpoint for rolling century | |||
19 | 1 | 2.1e-5 | 2.1e-5 | my $ThisYear = ( localtime() )[5]; |
20 | 1 | 2.0e-6 | 2.0e-6 | my $Breakpoint = ( $ThisYear + 50 ) % 100; |
21 | 1 | 1.0e-6 | 1.0e-6 | my $NextCentury = $ThisYear - $ThisYear % 100; |
22 | 1 | 0 | 0 | $NextCentury += 100 if $Breakpoint < 50; |
23 | 1 | 1.0e-6 | 1.0e-6 | my $Century = $NextCentury - 100; |
24 | 1 | 1.0e-6 | 1.0e-6 | my $SecOff = 0; |
25 | ||||
26 | 1 | 0 | 0 | my ( %Options, %Cheat ); |
27 | ||||
28 | 3 | 0.00021 | 7.1e-5 | use constant SECS_PER_MINUTE => 60; # spent 75µs making 1 call to constant::import |
29 | 3 | 2.7e-5 | 9.0e-6 | use constant SECS_PER_HOUR => 3600; # spent 41µs making 1 call to constant::import |
30 | 3 | 0.00084 | 0.00028 | use constant SECS_PER_DAY => 86400; # spent 41µs making 1 call to constant::import |
31 | ||||
32 | 1 | 1.5e-5 | 1.5e-5 | my $MaxInt = ( ( 1 << ( 8 * $Config{intsize} - 2 ) ) -1 ) * 2 + 1; # spent 11µs making 1 call to Config::FETCH |
33 | 1 | 3.0e-6 | 3.0e-6 | my $MaxDay = int( ( $MaxInt - ( SECS_PER_DAY / 2 ) ) / SECS_PER_DAY ) - 1; |
34 | ||||
35 | 1 | 3.0e-6 | 3.0e-6 | if ( $^O eq 'MacOS' ) { |
36 | # time_t is unsigned... | |||
37 | $MaxInt = ( 1 << ( 8 * $Config{intsize} ) ) - 1; | |||
38 | } | |||
39 | else { | |||
40 | 1 | 9.0e-6 | 9.0e-6 | $MaxInt = ( ( 1 << ( 8 * $Config{intsize} - 2 ) ) - 1 ) * 2 + 1; # spent 8µs making 1 call to Config::FETCH |
41 | } | |||
42 | ||||
43 | # Determine the EPOC day for this machine | |||
44 | 1 | 1.0e-6 | 1.0e-6 | my $Epoc = 0; |
45 | 1 | 2.0e-6 | 2.0e-6 | if ( $^O eq 'vos' ) { |
46 | # work around posix-977 -- VOS doesn't handle dates in the range | |||
47 | # 1970-1980. | |||
48 | $Epoc = _daygm( 0, 0, 0, 1, 0, 70, 4, 0 ); | |||
49 | } | |||
50 | elsif ( $^O eq 'MacOS' ) { | |||
51 | $MaxDay *=2 if $^O eq 'MacOS'; # time_t unsigned ... quick hack? | |||
52 | # MacOS time() is seconds since 1 Jan 1904, localtime | |||
53 | # so we need to calculate an offset to apply later | |||
54 | $Epoc = 693901; | |||
55 | $SecOff = timelocal( localtime(0)) - timelocal( gmtime(0) ) ; | |||
56 | $Epoc += _daygm( gmtime(0) ); | |||
57 | } | |||
58 | else { | |||
59 | 1 | 1.5e-5 | 1.5e-5 | $Epoc = _daygm( gmtime(0) ); # spent 29µs making 1 call to Time::Local::_daygm |
60 | } | |||
61 | ||||
62 | 1 | 1.0e-6 | 1.0e-6 | %Cheat = (); # clear the cache as epoc has changed |
63 | ||||
64 | # spent 29µs within Time::Local::_daygm which was called
# once (29µs+0) at line 59 | |||
65 | ||||
66 | # This is written in such a byzantine way in order to avoid | |||
67 | # lexical variables and sub calls, for speed | |||
68 | return $_[3] + ( | |||
69 | 4 | 1.8e-5 | 4.5e-6 | $Cheat{ pack( 'ss', @_[ 4, 5 ] ) } ||= do { |
70 | my $month = ( $_[4] + 10 ) % 12; | |||
71 | my $year = $_[5] + 1900 - $month / 10; | |||
72 | ||||
73 | ( ( 365 * $year ) | |||
74 | + ( $year / 4 ) | |||
75 | - ( $year / 100 ) | |||
76 | + ( $year / 400 ) | |||
77 | + ( ( ( $month * 306 ) + 5 ) / 10 ) | |||
78 | ) | |||
79 | - $Epoc; | |||
80 | } | |||
81 | ); | |||
82 | } | |||
83 | ||||
84 | sub _timegm { | |||
85 | my $sec = | |||
86 | $SecOff + $_[0] + ( SECS_PER_MINUTE * $_[1] ) + ( SECS_PER_HOUR * $_[2] ); | |||
87 | ||||
88 | return $sec + ( SECS_PER_DAY * &_daygm ); | |||
89 | } | |||
90 | ||||
91 | sub timegm { | |||
92 | my ( $sec, $min, $hour, $mday, $month, $year ) = @_; | |||
93 | ||||
94 | if ( $year >= 1000 ) { | |||
95 | $year -= 1900; | |||
96 | } | |||
97 | elsif ( $year < 100 and $year >= 0 ) { | |||
98 | $year += ( $year > $Breakpoint ) ? $Century : $NextCentury; | |||
99 | } | |||
100 | ||||
101 | unless ( $Options{no_range_check} ) { | |||
102 | if ( abs($year) >= 0x7fff ) { | |||
103 | $year += 1900; | |||
104 | croak | |||
105 | "Cannot handle date ($sec, $min, $hour, $mday, $month, *$year*)"; | |||
106 | } | |||
107 | ||||
108 | croak "Month '$month' out of range 0..11" | |||
109 | if $month > 11 | |||
110 | or $month < 0; | |||
111 | ||||
112 | my $md = $MonthDays[$month]; | |||
113 | ++$md | |||
114 | if $month == 1 && _is_leap_year( $year + 1900 ); | |||
115 | ||||
116 | croak "Day '$mday' out of range 1..$md" if $mday > $md or $mday < 1; | |||
117 | croak "Hour '$hour' out of range 0..23" if $hour > 23 or $hour < 0; | |||
118 | croak "Minute '$min' out of range 0..59" if $min > 59 or $min < 0; | |||
119 | croak "Second '$sec' out of range 0..59" if $sec > 59 or $sec < 0; | |||
120 | } | |||
121 | ||||
122 | my $days = _daygm( undef, undef, undef, $mday, $month, $year ); | |||
123 | ||||
124 | unless ($Options{no_range_check} or abs($days) < $MaxDay) { | |||
125 | my $msg = ''; | |||
126 | $msg .= "Day too big - $days > $MaxDay\n" if $days > $MaxDay; | |||
127 | ||||
128 | $year += 1900; | |||
129 | $msg .= "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)"; | |||
130 | ||||
131 | croak $msg; | |||
132 | } | |||
133 | ||||
134 | return $sec | |||
135 | + $SecOff | |||
136 | + ( SECS_PER_MINUTE * $min ) | |||
137 | + ( SECS_PER_HOUR * $hour ) | |||
138 | + ( SECS_PER_DAY * $days ); | |||
139 | } | |||
140 | ||||
141 | sub _is_leap_year { | |||
142 | return 0 if $_[0] % 4; | |||
143 | return 1 if $_[0] % 100; | |||
144 | return 0 if $_[0] % 400; | |||
145 | ||||
146 | return 1; | |||
147 | } | |||
148 | ||||
149 | sub timegm_nocheck { | |||
150 | local $Options{no_range_check} = 1; | |||
151 | return &timegm; | |||
152 | } | |||
153 | ||||
154 | sub timelocal { | |||
155 | my $ref_t = &timegm; | |||
156 | my $loc_for_ref_t = _timegm( localtime($ref_t) ); | |||
157 | ||||
158 | my $zone_off = $loc_for_ref_t - $ref_t | |||
159 | or return $loc_for_ref_t; | |||
160 | ||||
161 | # Adjust for timezone | |||
162 | my $loc_t = $ref_t - $zone_off; | |||
163 | ||||
164 | # Are we close to a DST change or are we done | |||
165 | my $dst_off = $ref_t - _timegm( localtime($loc_t) ); | |||
166 | ||||
167 | # If this evaluates to true, it means that the value in $loc_t is | |||
168 | # the _second_ hour after a DST change where the local time moves | |||
169 | # backward. | |||
170 | if ( ! $dst_off && | |||
171 | ( ( $ref_t - SECS_PER_HOUR ) - _timegm( localtime( $loc_t - SECS_PER_HOUR ) ) < 0 ) | |||
172 | ) { | |||
173 | return $loc_t - SECS_PER_HOUR; | |||
174 | } | |||
175 | ||||
176 | # Adjust for DST change | |||
177 | $loc_t += $dst_off; | |||
178 | ||||
179 | return $loc_t if $dst_off > 0; | |||
180 | ||||
181 | # If the original date was a non-extent gap in a forward DST jump, | |||
182 | # we should now have the wrong answer - undo the DST adjustment | |||
183 | my ( $s, $m, $h ) = localtime($loc_t); | |||
184 | $loc_t -= $dst_off if $s != $_[0] || $m != $_[1] || $h != $_[2]; | |||
185 | ||||
186 | return $loc_t; | |||
187 | } | |||
188 | ||||
189 | sub timelocal_nocheck { | |||
190 | local $Options{no_range_check} = 1; | |||
191 | return &timelocal; | |||
192 | } | |||
193 | ||||
194 | 1 | 2.7e-5 | 2.7e-5 | 1; |
195 | ||||
196 | __END__ | |||
197 | ||||
198 | =head1 NAME | |||
199 | ||||
200 | Time::Local - efficiently compute time from local and GMT time | |||
201 | ||||
202 | =head1 SYNOPSIS | |||
203 | ||||
204 | $time = timelocal($sec,$min,$hour,$mday,$mon,$year); | |||
205 | $time = timegm($sec,$min,$hour,$mday,$mon,$year); | |||
206 | ||||
207 | =head1 DESCRIPTION | |||
208 | ||||
209 | This module provides functions that are the inverse of built-in perl | |||
210 | functions C<localtime()> and C<gmtime()>. They accept a date as a | |||
211 | six-element array, and return the corresponding C<time(2)> value in | |||
212 | seconds since the system epoch (Midnight, January 1, 1970 GMT on Unix, | |||
213 | for example). This value can be positive or negative, though POSIX | |||
214 | only requires support for positive values, so dates before the | |||
215 | system's epoch may not work on all operating systems. | |||
216 | ||||
217 | It is worth drawing particular attention to the expected ranges for | |||
218 | the values provided. The value for the day of the month is the actual | |||
219 | day (ie 1..31), while the month is the number of months since January | |||
220 | (0..11). This is consistent with the values returned from | |||
221 | C<localtime()> and C<gmtime()>. | |||
222 | ||||
223 | =head1 FUNCTIONS | |||
224 | ||||
225 | =head2 C<timelocal()> and C<timegm()> | |||
226 | ||||
227 | This module exports two functions by default, C<timelocal()> and | |||
228 | C<timegm()>. | |||
229 | ||||
230 | The C<timelocal()> and C<timegm()> functions perform range checking on | |||
231 | the input $sec, $min, $hour, $mday, and $mon values by default. | |||
232 | ||||
233 | =head2 C<timelocal_nocheck()> and C<timegm_nocheck()> | |||
234 | ||||
235 | If you are working with data you know to be valid, you can speed your | |||
236 | code up by using the "nocheck" variants, C<timelocal_nocheck()> and | |||
237 | C<timegm_nocheck()>. These variants must be explicitly imported. | |||
238 | ||||
239 | use Time::Local 'timelocal_nocheck'; | |||
240 | ||||
241 | # The 365th day of 1999 | |||
242 | print scalar localtime timelocal_nocheck 0,0,0,365,0,99; | |||
243 | ||||
244 | If you supply data which is not valid (month 27, second 1,000) the | |||
245 | results will be unpredictable (so don't do that). | |||
246 | ||||
247 | =head2 Year Value Interpretation | |||
248 | ||||
249 | Strictly speaking, the year should be specified in a form consistent | |||
250 | with C<localtime()>, i.e. the offset from 1900. In order to make the | |||
251 | interpretation of the year easier for humans, however, who are more | |||
252 | accustomed to seeing years as two-digit or four-digit values, the | |||
253 | following conventions are followed: | |||
254 | ||||
255 | =over 4 | |||
256 | ||||
257 | =item * | |||
258 | ||||
259 | Years greater than 999 are interpreted as being the actual year, | |||
260 | rather than the offset from 1900. Thus, 1964 would indicate the year | |||
261 | Martin Luther King won the Nobel prize, not the year 3864. | |||
262 | ||||
263 | =item * | |||
264 | ||||
265 | Years in the range 100..999 are interpreted as offset from 1900, so | |||
266 | that 112 indicates 2012. This rule also applies to years less than | |||
267 | zero (but see note below regarding date range). | |||
268 | ||||
269 | =item * | |||
270 | ||||
271 | Years in the range 0..99 are interpreted as shorthand for years in the | |||
272 | rolling "current century," defined as 50 years on either side of the | |||
273 | current year. Thus, today, in 1999, 0 would refer to 2000, and 45 to | |||
274 | 2045, but 55 would refer to 1955. Twenty years from now, 55 would | |||
275 | instead refer to 2055. This is messy, but matches the way people | |||
276 | currently think about two digit dates. Whenever possible, use an | |||
277 | absolute four digit year instead. | |||
278 | ||||
279 | =back | |||
280 | ||||
281 | The scheme above allows interpretation of a wide range of dates, | |||
282 | particularly if 4-digit years are used. | |||
283 | ||||
284 | =head2 Limits of time_t | |||
285 | ||||
286 | The range of dates that can be actually be handled depends on the size | |||
287 | of C<time_t> (usually a signed integer) on the given | |||
288 | platform. Currently, this is 32 bits for most systems, yielding an | |||
289 | approximate range from Dec 1901 to Jan 2038. | |||
290 | ||||
291 | Both C<timelocal()> and C<timegm()> croak if given dates outside the | |||
292 | supported range. | |||
293 | ||||
294 | =head2 Ambiguous Local Times (DST) | |||
295 | ||||
296 | Because of DST changes, there are many time zones where the same local | |||
297 | time occurs for two different GMT times on the same day. For example, | |||
298 | in the "Europe/Paris" time zone, the local time of 2001-10-28 02:30:00 | |||
299 | can represent either 2001-10-28 00:30:00 GMT, B<or> 2001-10-28 | |||
300 | 01:30:00 GMT. | |||
301 | ||||
302 | When given an ambiguous local time, the timelocal() function should | |||
303 | always return the epoch for the I<earlier> of the two possible GMT | |||
304 | times. | |||
305 | ||||
306 | =head2 Non-Existent Local Times (DST) | |||
307 | ||||
308 | When a DST change causes a locale clock to skip one hour forward, | |||
309 | there will be an hour's worth of local times that don't exist. Again, | |||
310 | for the "Europe/Paris" time zone, the local clock jumped from | |||
311 | 2001-03-25 01:59:59 to 2001-03-25 03:00:00. | |||
312 | ||||
313 | If the C<timelocal()> function is given a non-existent local time, it | |||
314 | will simply return an epoch value for the time one hour later. | |||
315 | ||||
316 | =head2 Negative Epoch Values | |||
317 | ||||
318 | Negative epoch (C<time_t>) values are not officially supported by the | |||
319 | POSIX standards, so this module's tests do not test them. On some | |||
320 | systems, they are known not to work. These include MacOS (pre-OSX) and | |||
321 | Win32. | |||
322 | ||||
323 | On systems which do support negative epoch values, this module should | |||
324 | be able to cope with dates before the start of the epoch, down the | |||
325 | minimum value of time_t for the system. | |||
326 | ||||
327 | =head1 IMPLEMENTATION | |||
328 | ||||
329 | These routines are quite efficient and yet are always guaranteed to | |||
330 | agree with C<localtime()> and C<gmtime()>. We manage this by caching | |||
331 | the start times of any months we've seen before. If we know the start | |||
332 | time of the month, we can always calculate any time within the month. | |||
333 | The start times are calculated using a mathematical formula. Unlike | |||
334 | other algorithms that do multiple calls to C<gmtime()>. | |||
335 | ||||
336 | The C<timelocal()> function is implemented using the same cache. We | |||
337 | just assume that we're translating a GMT time, and then fudge it when | |||
338 | we're done for the timezone and daylight savings arguments. Note that | |||
339 | the timezone is evaluated for each date because countries occasionally | |||
340 | change their official timezones. Assuming that C<localtime()> corrects | |||
341 | for these changes, this routine will also be correct. | |||
342 | ||||
343 | =head1 BUGS | |||
344 | ||||
345 | The whole scheme for interpreting two-digit years can be considered a | |||
346 | bug. | |||
347 | ||||
348 | =head1 SUPPORT | |||
349 | ||||
350 | Support for this module is provided via the datetime@perl.org email | |||
351 | list. See http://lists.perl.org/ for more details. | |||
352 | ||||
353 | Please submit bugs to the CPAN RT system at | |||
354 | http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Time-Local or via email | |||
355 | at bug-time-local@rt.cpan.org. | |||
356 | ||||
357 | =head1 COPYRIGHT | |||
358 | ||||
359 | Copyright (c) 1997-2003 Graham Barr, 2003-2007 David Rolsky. All | |||
360 | rights reserved. This program is free software; you can redistribute | |||
361 | it and/or modify it under the same terms as Perl itself. | |||
362 | ||||
363 | The full text of the license can be found in the LICENSE file included | |||
364 | with this module. | |||
365 | ||||
366 | =head1 AUTHOR | |||
367 | ||||
368 | This module is based on a Perl 4 library, timelocal.pl, that was | |||
369 | included with Perl 4.036, and was most likely written by Tom | |||
370 | Christiansen. | |||
371 | ||||
372 | The current version was written by Graham Barr. | |||
373 | ||||
374 | It is now being maintained separately from the Perl core by Dave | |||
375 | Rolsky, <autarch@urth.org>. | |||
376 | ||||
377 | =cut |