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