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