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 | |
1fef88e7 |
11 | Time::Local - efficiently compute time 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 | |
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 |
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 |
76 | } |
77 | |
78 | sub timelocal { |
16bb4654 |
79 | $time = &timegm + $tzsec; |
55497cff |
80 | return -1 if $cheat<0 and $^O ne 'VMS'; |
a0d0e21e |
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 |
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 |
96 | $guess = $^T; |
97 | @g = gmtime($guess); |
55497cff |
98 | $year += $YearFix if $year < $epoch; |
a0d0e21e |
99 | $lastguess = ""; |
100 | while ($diff = $year - $g[5]) { |
16bb4654 |
101 | $guess += $diff * (363 * $DAY); |
a0d0e21e |
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 |
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 |
122 | $cheat{$ym} = $guess; |
123 | } |
124 | |
125 | 1; |