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