Commit | Line | Data |
---|---|---|
a0d0e21e LW |
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 | |
1fef88e7 | 11 | Time::Local - efficiently compute time from local and GMT time |
a0d0e21e | 12 | |
cb1a09d0 | 13 | =head1 SYNOPSIS |
a0d0e21e | 14 | |
cb1a09d0 AD |
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 | |
16bb4654 | 42 | BEGIN { |
16bb4654 | 43 | $SEC = 1; |
44 | $MIN = 60 * $SEC; | |
45 | $HR = 60 * $MIN; | |
46 | $DAY = 24 * $HR; | |
55497cff | 47 | $epoch = (localtime(2*$DAY))[5]; # Allow for bugs near localtime == 0. |
48 | ||
16bb4654 | 49 | $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0; |
50 | ||
51 | my $t = time; | |
52 | my @lt = localtime($t); | |
53 | my @gt = gmtime($t); | |
a0d0e21e | 54 | |
16bb4654 | 55 | $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR; |
56 | ||
57 | my($lday,$gday) = ($lt[7],$gt[7]); | |
58 | if($lt[5] > $gt[5]) { | |
59 | $tzsec -= $DAY; | |
60 | } | |
61 | elsif($gt[5] > $lt[5]) { | |
62 | $tzsec += $DAY; | |
63 | } | |
64 | else { | |
65 | $tzsec += ($gt[7] - $lt[7]) * $DAY; | |
66 | } | |
67 | ||
68 | $tzsec += $HR if($lt[8]); | |
69 | } | |
a0d0e21e LW |
70 | |
71 | sub timegm { | |
72 | $ym = pack(C2, @_[5,4]); | |
73 | $cheat = $cheat{$ym} || &cheat; | |
55497cff | 74 | return -1 if $cheat<0 and $^O ne 'VMS'; |
16bb4654 | 75 | $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAY; |
a0d0e21e LW |
76 | } |
77 | ||
78 | sub timelocal { | |
16bb4654 | 79 | $time = &timegm + $tzsec; |
55497cff | 80 | return -1 if $cheat<0 and $^O ne 'VMS'; |
a0d0e21e LW |
81 | @test = localtime($time); |
82 | $time -= $HR if $test[2] != $_[2]; | |
83 | $time; | |
84 | } | |
85 | ||
86 | sub cheat { | |
87 | $year = $_[5]; | |
16bb4654 | 88 | $year -= 1900 |
89 | if $year > 1900; | |
a0d0e21e | 90 | $month = $_[4]; |
0c160758 AB |
91 | croak "Month '$month' out of range 0..11" if $month > 11 || $month < 0; |
92 | croak "Day '$_[3]' out of range 1..31" if $_[3] > 31 || $_[3] < 1; | |
93 | croak "Hour '$_[2]' out of range 0..23" if $_[2] > 23 || $_[2] < 0; | |
94 | croak "Minute '$_[1]' out of range 0..59" if $_[1] > 59 || $_[1] < 0; | |
95 | croak "Second '$_[0]' out of range 0..59" if $_[0] > 59 || $_[0] < 0; | |
a0d0e21e LW |
96 | $guess = $^T; |
97 | @g = gmtime($guess); | |
55497cff | 98 | $year += $YearFix if $year < $epoch; |
a0d0e21e LW |
99 | $lastguess = ""; |
100 | while ($diff = $year - $g[5]) { | |
16bb4654 | 101 | $guess += $diff * (363 * $DAY); |
a0d0e21e LW |
102 | @g = gmtime($guess); |
103 | if (($thisguess = "@g") eq $lastguess){ | |
104 | return -1; #date beyond this machine's integer limit | |
105 | } | |
106 | $lastguess = $thisguess; | |
107 | } | |
108 | while ($diff = $month - $g[4]) { | |
16bb4654 | 109 | $guess += $diff * (27 * $DAY); |
a0d0e21e LW |
110 | @g = gmtime($guess); |
111 | if (($thisguess = "@g") eq $lastguess){ | |
112 | return -1; #date beyond this machine's integer limit | |
113 | } | |
114 | $lastguess = $thisguess; | |
115 | } | |
116 | @gfake = gmtime($guess-1); #still being sceptic | |
117 | if ("@gfake" eq $lastguess){ | |
118 | return -1; #date beyond this machine's integer limit | |
119 | } | |
120 | $g[3]--; | |
16bb4654 | 121 | $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAY; |
a0d0e21e LW |
122 | $cheat{$ym} = $guess; |
123 | } | |
124 | ||
125 | 1; |