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