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