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