Commit | Line | Data |
a0d0e21e |
1 | package Time::Local; |
2 | require 5.000; |
3 | require Exporter; |
4 | use Carp; |
5 | |
6 | @ISA = qw(Exporter); |
7 | @EXPORT = qw(timegm timelocal); |
8 | |
cb1a09d0 |
9 | =head1 NAME |
a0d0e21e |
10 | |
cb1a09d0 |
11 | Time::Local - efficiently compute tome from local and GMT time |
a0d0e21e |
12 | |
cb1a09d0 |
13 | =head1 SYNOPSIS |
a0d0e21e |
14 | |
cb1a09d0 |
15 | $time = timelocal($sec,$min,$hours,$mday,$mon,$year); |
16 | $time = timegm($sec,$min,$hours,$mday,$mon,$year); |
17 | |
18 | =head1 DESCRIPTION |
19 | |
20 | These routines are quite efficient and yet are always guaranteed to agree |
21 | with localtime() and gmtime(). We manage this by caching the start times |
22 | of any months we've seen before. If we know the start time of the month, |
23 | we can always calculate any time within the month. The start times |
24 | themselves are guessed by successive approximation starting at the |
25 | current time, since most dates seen in practice are close to the |
26 | current date. Unlike algorithms that do a binary search (calling gmtime |
27 | once for each bit of the time value, resulting in 32 calls), this algorithm |
28 | calls it at most 6 times, and usually only once or twice. If you hit |
29 | the month cache, of course, it doesn't call it at all. |
30 | |
31 | timelocal is implemented using the same cache. We just assume that we're |
32 | translating a GMT time, and then fudge it when we're done for the timezone |
33 | and daylight savings arguments. The timezone is determined by examining |
34 | the result of localtime(0) when the package is initialized. The daylight |
35 | savings offset is currently assumed to be one hour. |
36 | |
37 | Both routines return -1 if the integer limit is hit. I.e. for dates |
38 | after the 1st of January, 2038 on most machines. |
39 | |
40 | =cut |
a0d0e21e |
41 | |
42 | @epoch = localtime(0); |
43 | $tzmin = $epoch[2] * 60 + $epoch[1]; # minutes east of GMT |
44 | if ($tzmin > 0) { |
45 | $tzmin = 24 * 60 - $tzmin; # minutes west of GMT |
46 | $tzmin -= 24 * 60 if $epoch[5] == 70; # account for the date line |
47 | } |
48 | |
49 | $SEC = 1; |
50 | $MIN = 60 * $SEC; |
51 | $HR = 60 * $MIN; |
52 | $DAYS = 24 * $HR; |
53 | $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0; |
54 | |
55 | sub timegm { |
56 | $ym = pack(C2, @_[5,4]); |
57 | $cheat = $cheat{$ym} || &cheat; |
58 | return -1 if $cheat<0; |
59 | $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS; |
60 | } |
61 | |
62 | sub timelocal { |
63 | $time = &timegm + $tzmin*$MIN; |
64 | return -1 if $cheat<0; |
65 | @test = localtime($time); |
66 | $time -= $HR if $test[2] != $_[2]; |
67 | $time; |
68 | } |
69 | |
70 | sub cheat { |
71 | $year = $_[5]; |
72 | $month = $_[4]; |
73 | croak "Month out of range 0..11 in timelocal.pl" |
74 | if $month > 11 || $month < 0; |
75 | croak "Day out of range 1..31 in timelocal.pl" |
76 | if $_[3] > 31 || $_[3] < 1; |
77 | croak "Hour out of range 0..23 in timelocal.pl" |
78 | if $_[2] > 23 || $_[2] < 0; |
79 | croak "Minute out of range 0..59 in timelocal.pl" |
80 | if $_[1] > 59 || $_[1] < 0; |
81 | croak "Second out of range 0..59 in timelocal.pl" |
82 | if $_[0] > 59 || $_[0] < 0; |
83 | $guess = $^T; |
84 | @g = gmtime($guess); |
85 | $year += $YearFix if $year < $epoch[5]; |
86 | $lastguess = ""; |
87 | while ($diff = $year - $g[5]) { |
88 | $guess += $diff * (363 * $DAYS); |
89 | @g = gmtime($guess); |
90 | if (($thisguess = "@g") eq $lastguess){ |
91 | return -1; #date beyond this machine's integer limit |
92 | } |
93 | $lastguess = $thisguess; |
94 | } |
95 | while ($diff = $month - $g[4]) { |
96 | $guess += $diff * (27 * $DAYS); |
97 | @g = gmtime($guess); |
98 | if (($thisguess = "@g") eq $lastguess){ |
99 | return -1; #date beyond this machine's integer limit |
100 | } |
101 | $lastguess = $thisguess; |
102 | } |
103 | @gfake = gmtime($guess-1); #still being sceptic |
104 | if ("@gfake" eq $lastguess){ |
105 | return -1; #date beyond this machine's integer limit |
106 | } |
107 | $g[3]--; |
108 | $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS; |
109 | $cheat{$ym} = $guess; |
110 | } |
111 | |
112 | 1; |