This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update to version 96.041801
[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
cb1a09d0 11Time::Local - efficiently compute tome 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
20These routines are quite efficient and yet are always guaranteed to agree
21with localtime() and gmtime(). We manage this by caching the start times
22of any months we've seen before. If we know the start time of the month,
23we can always calculate any time within the month. The start times
24themselves are guessed by successive approximation starting at the
25current time, since most dates seen in practice are close to the
26current date. Unlike algorithms that do a binary search (calling gmtime
27once for each bit of the time value, resulting in 32 calls), this algorithm
28calls it at most 6 times, and usually only once or twice. If you hit
29the month cache, of course, it doesn't call it at all.
30
31timelocal is implemented using the same cache. We just assume that we're
32translating a GMT time, and then fudge it when we're done for the timezone
33and daylight savings arguments. The timezone is determined by examining
34the result of localtime(0) when the package is initialized. The daylight
35savings offset is currently assumed to be one hour.
36
37Both routines return -1 if the integer limit is hit. I.e. for dates
38after the 1st of January, 2038 on most machines.
39
40=cut
a0d0e21e
LW
41
42@epoch = localtime(0);
43$tzmin = $epoch[2] * 60 + $epoch[1]; # minutes east of GMT
44if ($tzmin > 0) {
45 $tzmin = 24 * 60 - $tzmin; # minutes west of GMT
46 $tzmin -= 24 * 60 if $epoch[5] == 70; # account for the date line
47}
48
49$SEC = 1;
50$MIN = 60 * $SEC;
51$HR = 60 * $MIN;
52$DAYS = 24 * $HR;
53$YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
54
55sub timegm {
56 $ym = pack(C2, @_[5,4]);
57 $cheat = $cheat{$ym} || &cheat;
58 return -1 if $cheat<0;
59 $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS;
60}
61
62sub timelocal {
63 $time = &timegm + $tzmin*$MIN;
64 return -1 if $cheat<0;
65 @test = localtime($time);
66 $time -= $HR if $test[2] != $_[2];
67 $time;
68}
69
70sub cheat {
71 $year = $_[5];
72 $month = $_[4];
73 croak "Month out of range 0..11 in timelocal.pl"
74 if $month > 11 || $month < 0;
75 croak "Day out of range 1..31 in timelocal.pl"
76 if $_[3] > 31 || $_[3] < 1;
77 croak "Hour out of range 0..23 in timelocal.pl"
78 if $_[2] > 23 || $_[2] < 0;
79 croak "Minute out of range 0..59 in timelocal.pl"
80 if $_[1] > 59 || $_[1] < 0;
81 croak "Second out of range 0..59 in timelocal.pl"
82 if $_[0] > 59 || $_[0] < 0;
83 $guess = $^T;
84 @g = gmtime($guess);
85 $year += $YearFix if $year < $epoch[5];
86 $lastguess = "";
87 while ($diff = $year - $g[5]) {
88 $guess += $diff * (363 * $DAYS);
89 @g = gmtime($guess);
90 if (($thisguess = "@g") eq $lastguess){
91 return -1; #date beyond this machine's integer limit
92 }
93 $lastguess = $thisguess;
94 }
95 while ($diff = $month - $g[4]) {
96 $guess += $diff * (27 * $DAYS);
97 @g = gmtime($guess);
98 if (($thisguess = "@g") eq $lastguess){
99 return -1; #date beyond this machine's integer limit
100 }
101 $lastguess = $thisguess;
102 }
103 @gfake = gmtime($guess-1); #still being sceptic
104 if ("@gfake" eq $lastguess){
105 return -1; #date beyond this machine's integer limit
106 }
107 $g[3]--;
108 $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS;
109 $cheat{$ym} = $guess;
110}
111
1121;