Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | package Time::Local; |
2 | require 5.000; | |
3 | require Exporter; | |
4 | use Carp; | |
5 | ||
ac54365a GS |
6 | @ISA = qw( Exporter ); |
7 | @EXPORT = qw( timegm timelocal ); | |
e36f48eb | 8 | @EXPORT_OK = qw( timegm_nocheck timelocal_nocheck ); |
a0d0e21e | 9 | |
06ef4121 | 10 | # Set up constants |
16bb4654 | 11 | $SEC = 1; |
12 | $MIN = 60 * $SEC; | |
13 | $HR = 60 * $MIN; | |
14 | $DAY = 24 * $HR; | |
06ef4121 PC |
15 | # Determine breakpoint for rolling century |
16 | my $thisYear = (localtime())[5]; | |
17 | $nextCentury = int($thisYear / 100) * 100; | |
18 | $breakpoint = ($thisYear + 50) % 100; | |
19 | $nextCentury += 100 if $breakpoint < 50; | |
9bb8015a | 20 | |
e36f48eb GS |
21 | my %options; |
22 | ||
9bb8015a | 23 | sub timegm { |
06ef4121 PC |
24 | my (@date) = @_; |
25 | if ($date[5] > 999) { | |
26 | $date[5] -= 1900; | |
27 | } | |
28 | elsif ($date[5] >= 0 && $date[5] < 100) { | |
29 | $date[5] -= 100 if $date[5] > $breakpoint; | |
30 | $date[5] += $nextCentury; | |
31 | } | |
32 | $ym = pack(C2, @date[5,4]); | |
33 | $cheat = $cheat{$ym} || &cheat(@date); | |
34 | $cheat | |
35 | + $date[0] * $SEC | |
36 | + $date[1] * $MIN | |
37 | + $date[2] * $HR | |
38 | + ($date[3]-1) * $DAY; | |
9bb8015a MK |
39 | } |
40 | ||
e36f48eb GS |
41 | sub timegm_nocheck { |
42 | local $options{no_range_check} = 1; | |
43 | &timegm; | |
44 | } | |
45 | ||
9bb8015a MK |
46 | sub timelocal { |
47 | my $t = &timegm; | |
84902520 | 48 | my $tt = $t; |
9bb8015a MK |
49 | |
50 | my (@lt) = localtime($t); | |
51 | my (@gt) = gmtime($t); | |
84902520 | 52 | if ($t < $DAY and ($lt[5] >= 70 or $gt[5] >= 70 )) { |
06ef4121 PC |
53 | # Wrap error, too early a date |
54 | # Try a safer date | |
e85ca32b | 55 | $tt += $DAY; |
06ef4121 PC |
56 | @lt = localtime($tt); |
57 | @gt = gmtime($tt); | |
84902520 | 58 | } |
a0d0e21e | 59 | |
9bb8015a | 60 | my $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR; |
16bb4654 | 61 | |
16bb4654 | 62 | if($lt[5] > $gt[5]) { |
63 | $tzsec -= $DAY; | |
64 | } | |
65 | elsif($gt[5] > $lt[5]) { | |
66 | $tzsec += $DAY; | |
67 | } | |
68 | else { | |
69 | $tzsec += ($gt[7] - $lt[7]) * $DAY; | |
70 | } | |
71 | ||
9bb8015a MK |
72 | $tzsec += $HR if($lt[8]); |
73 | ||
74 | $time = $t + $tzsec; | |
84902520 | 75 | @test = localtime($time + ($tt - $t)); |
a0d0e21e LW |
76 | $time -= $HR if $test[2] != $_[2]; |
77 | $time; | |
78 | } | |
79 | ||
e36f48eb GS |
80 | sub timelocal_nocheck { |
81 | local $options{no_range_check} = 1; | |
82 | &timelocal; | |
83 | } | |
84 | ||
a0d0e21e LW |
85 | sub cheat { |
86 | $year = $_[5]; | |
87 | $month = $_[4]; | |
e36f48eb | 88 | unless ($options{no_range_check}) { |
ac54365a GS |
89 | croak "Month '$month' out of range 0..11" if $month > 11 || $month < 0; |
90 | croak "Day '$_[3]' out of range 1..31" if $_[3] > 31 || $_[3] < 1; | |
91 | croak "Hour '$_[2]' out of range 0..23" if $_[2] > 23 || $_[2] < 0; | |
92 | croak "Minute '$_[1]' out of range 0..59" if $_[1] > 59 || $_[1] < 0; | |
93 | croak "Second '$_[0]' out of range 0..59" if $_[0] > 59 || $_[0] < 0; | |
94 | } | |
a0d0e21e LW |
95 | $guess = $^T; |
96 | @g = gmtime($guess); | |
a0d0e21e | 97 | $lastguess = ""; |
390badbd | 98 | $counter = 0; |
a0d0e21e | 99 | while ($diff = $year - $g[5]) { |
390badbd | 100 | croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255; |
16bb4654 | 101 | $guess += $diff * (363 * $DAY); |
a0d0e21e LW |
102 | @g = gmtime($guess); |
103 | if (($thisguess = "@g") eq $lastguess){ | |
06ef4121 PC |
104 | croak "Can't handle date (".join(", ",@_).")"; |
105 | #date beyond this machine's integer limit | |
a0d0e21e LW |
106 | } |
107 | $lastguess = $thisguess; | |
108 | } | |
109 | while ($diff = $month - $g[4]) { | |
390badbd | 110 | croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255; |
16bb4654 | 111 | $guess += $diff * (27 * $DAY); |
a0d0e21e LW |
112 | @g = gmtime($guess); |
113 | if (($thisguess = "@g") eq $lastguess){ | |
06ef4121 PC |
114 | croak "Can't handle date (".join(", ",@_).")"; |
115 | #date beyond this machine's integer limit | |
a0d0e21e LW |
116 | } |
117 | $lastguess = $thisguess; | |
118 | } | |
119 | @gfake = gmtime($guess-1); #still being sceptic | |
120 | if ("@gfake" eq $lastguess){ | |
06ef4121 PC |
121 | croak "Can't handle date (".join(", ",@_).")"; |
122 | #date beyond this machine's integer limit | |
a0d0e21e LW |
123 | } |
124 | $g[3]--; | |
16bb4654 | 125 | $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAY; |
a0d0e21e LW |
126 | $cheat{$ym} = $guess; |
127 | } | |
128 | ||
129 | 1; | |
06ef4121 PC |
130 | |
131 | __END__ | |
132 | ||
133 | =head1 NAME | |
134 | ||
135 | Time::Local - efficiently compute time from local and GMT time | |
136 | ||
137 | =head1 SYNOPSIS | |
138 | ||
139 | $time = timelocal($sec,$min,$hours,$mday,$mon,$year); | |
140 | $time = timegm($sec,$min,$hours,$mday,$mon,$year); | |
141 | ||
142 | =head1 DESCRIPTION | |
143 | ||
144 | These routines are the inverse of built-in perl fuctions localtime() | |
145 | and gmtime(). They accept a date as a six-element array, and return | |
146 | the corresponding time(2) value in seconds since the Epoch (Midnight, | |
147 | January 1, 1970). This value can be positive or negative. | |
148 | ||
149 | It is worth drawing particular attention to the expected ranges for | |
150 | the values provided. While the day of the month is expected to be in | |
151 | the range 1..31, the month should be in the range 0..11. | |
152 | This is consistent with the values returned from localtime() and gmtime(). | |
153 | ||
e36f48eb GS |
154 | The timelocal() and timegm() functions perform range checking on the |
155 | input $sec, $min, $hours, $mday, and $mon values by default. If you'd | |
156 | rather they didn't, you can explicitly import the timelocal_nocheck() | |
157 | and timegm_nocheck() functions. | |
ac54365a | 158 | |
e36f48eb | 159 | use Time::Local 'timelocal_nocheck'; |
3cb6de81 | 160 | |
a1f33342 | 161 | { |
a1f33342 | 162 | # The 365th day of 1999 |
e36f48eb | 163 | print scalar localtime timelocal_nocheck 0,0,0,365,0,99; |
ac54365a | 164 | |
a1f33342 | 165 | # The twenty thousandth day since 1970 |
e36f48eb | 166 | print scalar localtime timelocal_nocheck 0,0,0,20000,0,70; |
ac54365a | 167 | |
a1f33342 | 168 | # And even the 10,000,000th second since 1999! |
e36f48eb | 169 | print scalar localtime timelocal_nocheck 10000000,0,0,1,0,99; |
a1f33342 | 170 | } |
ac54365a | 171 | |
e36f48eb | 172 | Your mileage may vary when trying these with minutes and hours, |
ac54365a GS |
173 | and it doesn't work at all for months. |
174 | ||
06ef4121 PC |
175 | Strictly speaking, the year should also be specified in a form consistent |
176 | with localtime(), i.e. the offset from 1900. | |
177 | In order to make the interpretation of the year easier for humans, | |
178 | however, who are more accustomed to seeing years as two-digit or four-digit | |
179 | values, the following conventions are followed: | |
180 | ||
181 | =over 4 | |
182 | ||
183 | =item * | |
184 | ||
185 | Years greater than 999 are interpreted as being the actual year, | |
186 | rather than the offset from 1900. Thus, 1963 would indicate the year | |
90ca0aaa | 187 | Martin Luther King won the Nobel prize, not the year 2863. |
06ef4121 PC |
188 | |
189 | =item * | |
190 | ||
191 | Years in the range 100..999 are interpreted as offset from 1900, | |
192 | so that 112 indicates 2012. This rule also applies to years less than zero | |
193 | (but see note below regarding date range). | |
194 | ||
195 | =item * | |
196 | ||
197 | Years in the range 0..99 are interpreted as shorthand for years in the | |
198 | rolling "current century," defined as 50 years on either side of the current | |
199 | year. Thus, today, in 1999, 0 would refer to 2000, and 45 to 2045, | |
200 | but 55 would refer to 1955. Twenty years from now, 55 would instead refer | |
201 | to 2055. This is messy, but matches the way people currently think about | |
202 | two digit dates. Whenever possible, use an absolute four digit year instead. | |
203 | ||
204 | =back | |
205 | ||
206 | The scheme above allows interpretation of a wide range of dates, particularly | |
207 | if 4-digit years are used. | |
90ca0aaa | 208 | |
06ef4121 PC |
209 | Please note, however, that the range of dates that can be actually be handled |
210 | depends on the size of an integer (time_t) on a given platform. | |
211 | Currently, this is 32 bits for most systems, yielding an approximate range | |
212 | from Dec 1901 to Jan 2038. | |
213 | ||
214 | Both timelocal() and timegm() croak if given dates outside the supported | |
215 | range. | |
216 | ||
217 | =head1 IMPLEMENTATION | |
218 | ||
219 | These routines are quite efficient and yet are always guaranteed to agree | |
220 | with localtime() and gmtime(). We manage this by caching the start times | |
221 | of any months we've seen before. If we know the start time of the month, | |
222 | we can always calculate any time within the month. The start times | |
223 | themselves are guessed by successive approximation starting at the | |
224 | current time, since most dates seen in practice are close to the | |
225 | current date. Unlike algorithms that do a binary search (calling gmtime | |
226 | once for each bit of the time value, resulting in 32 calls), this algorithm | |
227 | calls it at most 6 times, and usually only once or twice. If you hit | |
228 | the month cache, of course, it doesn't call it at all. | |
229 | ||
230 | timelocal() is implemented using the same cache. We just assume that we're | |
231 | translating a GMT time, and then fudge it when we're done for the timezone | |
232 | and daylight savings arguments. Note that the timezone is evaluated for | |
233 | each date because countries occasionally change their official timezones. | |
234 | Assuming that localtime() corrects for these changes, this routine will | |
235 | also be correct. The daylight savings offset is currently assumed | |
236 | to be one hour. | |
237 | ||
238 | =head1 BUGS | |
239 | ||
240 | The whole scheme for interpreting two-digit years can be considered a bug. | |
241 | ||
242 | Note that the cache currently handles only years from 1900 through 2155. | |
243 | ||
244 | The proclivity to croak() is probably a bug. | |
245 | ||
246 | =cut |