1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
package Time::Local;
require 5.000;
require Exporter;
use Carp;
@ISA = qw(Exporter);
@EXPORT = qw(timegm timelocal);
=head1 NAME
Time::Local - efficiently compute time from local and GMT time
=head1 SYNOPSIS
$time = timelocal($sec,$min,$hours,$mday,$mon,$year);
$time = timegm($sec,$min,$hours,$mday,$mon,$year);
=head1 DESCRIPTION
These routines are quite efficient and yet are always guaranteed to
agree with localtime() and gmtime(), the most notable points being
that year is year-1900 and month is 0..11. We manage this by caching
the start times of any months we've seen before. If we know the start
time of the month, we can always calculate any time within the month.
The start times themselves are guessed by successive approximation
starting at the current time, since most dates seen in practice are
close to the current date. Unlike algorithms that do a binary search
(calling gmtime once for each bit of the time value, resulting in 32
calls), this algorithm calls it at most 6 times, and usually only once
or twice. If you hit the month cache, of course, it doesn't call it
at all.
timelocal is implemented using the same cache. We just assume that we're
translating a GMT time, and then fudge it when we're done for the timezone
and daylight savings arguments. The timezone is determined by examining
the result of localtime(0) when the package is initialized. The daylight
savings offset is currently assumed to be one hour.
Both routines return -1 if the integer limit is hit. I.e. for dates
after the 1st of January, 2038 on most machines.
=cut
BEGIN {
$SEC = 1;
$MIN = 60 * $SEC;
$HR = 60 * $MIN;
$DAY = 24 * $HR;
$epoch = (localtime(2*$DAY))[5]; # Allow for bugs near localtime == 0.
$YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
}
sub timegm {
$ym = pack(C2, @_[5,4]);
$cheat = $cheat{$ym} || &cheat;
return -1 if $cheat<0 and $^O ne 'VMS';
$cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAY;
}
sub timelocal {
my $t = &timegm;
my $tt = $t;
my (@lt) = localtime($t);
my (@gt) = gmtime($t);
if ($t < $DAY and ($lt[5] >= 70 or $gt[5] >= 70 )) {
# Wrap error, too early a date
# Try a safer date
$tt = $DAY;
@lt = localtime($tt);
@gt = gmtime($tt);
}
my $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR;
my($lday,$gday) = ($lt[7],$gt[7]);
if($lt[5] > $gt[5]) {
$tzsec -= $DAY;
}
elsif($gt[5] > $lt[5]) {
$tzsec += $DAY;
}
else {
$tzsec += ($gt[7] - $lt[7]) * $DAY;
}
$tzsec += $HR if($lt[8]);
$time = $t + $tzsec;
return -1 if $cheat<0 and $^O ne 'VMS';
@test = localtime($time + ($tt - $t));
$time -= $HR if $test[2] != $_[2];
$time;
}
sub cheat {
$year = $_[5];
$year -= 1900
if $year > 1900;
$month = $_[4];
croak "Month '$month' out of range 0..11" if $month > 11 || $month < 0;
croak "Day '$_[3]' out of range 1..31" if $_[3] > 31 || $_[3] < 1;
croak "Hour '$_[2]' out of range 0..23" if $_[2] > 23 || $_[2] < 0;
croak "Minute '$_[1]' out of range 0..59" if $_[1] > 59 || $_[1] < 0;
croak "Second '$_[0]' out of range 0..59" if $_[0] > 59 || $_[0] < 0;
$guess = $^T;
@g = gmtime($guess);
$year += $YearFix if $year < $epoch;
$lastguess = "";
$counter = 0;
while ($diff = $year - $g[5]) {
croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
$guess += $diff * (363 * $DAY);
@g = gmtime($guess);
if (($thisguess = "@g") eq $lastguess){
return -1; #date beyond this machine's integer limit
}
$lastguess = $thisguess;
}
while ($diff = $month - $g[4]) {
croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
$guess += $diff * (27 * $DAY);
@g = gmtime($guess);
if (($thisguess = "@g") eq $lastguess){
return -1; #date beyond this machine's integer limit
}
$lastguess = $thisguess;
}
@gfake = gmtime($guess-1); #still being sceptic
if ("@gfake" eq $lastguess){
return -1; #date beyond this machine's integer limit
}
$g[3]--;
$guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAY;
$cheat{$ym} = $guess;
}
1;
|
