This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove 'use UNIVERSAL;', switch to UNIVERSAL::isa()
[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
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 41
16bb4654 42BEGIN {
16bb4654 43 $SEC = 1;
44 $MIN = 60 * $SEC;
45 $HR = 60 * $MIN;
46 $DAY = 24 * $HR;
55497cff 47 $epoch = (localtime(2*$DAY))[5]; # Allow for bugs near localtime == 0.
48
16bb4654 49 $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
50
51 my $t = time;
52 my @lt = localtime($t);
53 my @gt = gmtime($t);
a0d0e21e 54
16bb4654 55 $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR;
56
57 my($lday,$gday) = ($lt[7],$gt[7]);
58 if($lt[5] > $gt[5]) {
59 $tzsec -= $DAY;
60 }
61 elsif($gt[5] > $lt[5]) {
62 $tzsec += $DAY;
63 }
64 else {
65 $tzsec += ($gt[7] - $lt[7]) * $DAY;
66 }
67
68 $tzsec += $HR if($lt[8]);
69}
a0d0e21e
LW
70
71sub timegm {
72 $ym = pack(C2, @_[5,4]);
73 $cheat = $cheat{$ym} || &cheat;
55497cff 74 return -1 if $cheat<0 and $^O ne 'VMS';
16bb4654 75 $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAY;
a0d0e21e
LW
76}
77
78sub timelocal {
16bb4654 79 $time = &timegm + $tzsec;
55497cff 80 return -1 if $cheat<0 and $^O ne 'VMS';
a0d0e21e
LW
81 @test = localtime($time);
82 $time -= $HR if $test[2] != $_[2];
83 $time;
84}
85
86sub cheat {
87 $year = $_[5];
16bb4654 88 $year -= 1900
89 if $year > 1900;
a0d0e21e 90 $month = $_[4];
0c160758
AB
91 croak "Month '$month' out of range 0..11" if $month > 11 || $month < 0;
92 croak "Day '$_[3]' out of range 1..31" if $_[3] > 31 || $_[3] < 1;
93 croak "Hour '$_[2]' out of range 0..23" if $_[2] > 23 || $_[2] < 0;
94 croak "Minute '$_[1]' out of range 0..59" if $_[1] > 59 || $_[1] < 0;
95 croak "Second '$_[0]' out of range 0..59" if $_[0] > 59 || $_[0] < 0;
a0d0e21e
LW
96 $guess = $^T;
97 @g = gmtime($guess);
55497cff 98 $year += $YearFix if $year < $epoch;
a0d0e21e
LW
99 $lastguess = "";
100 while ($diff = $year - $g[5]) {
16bb4654 101 $guess += $diff * (363 * $DAY);
a0d0e21e
LW
102 @g = gmtime($guess);
103 if (($thisguess = "@g") eq $lastguess){
104 return -1; #date beyond this machine's integer limit
105 }
106 $lastguess = $thisguess;
107 }
108 while ($diff = $month - $g[4]) {
16bb4654 109 $guess += $diff * (27 * $DAY);
a0d0e21e
LW
110 @g = gmtime($guess);
111 if (($thisguess = "@g") eq $lastguess){
112 return -1; #date beyond this machine's integer limit
113 }
114 $lastguess = $thisguess;
115 }
116 @gfake = gmtime($guess-1); #still being sceptic
117 if ("@gfake" eq $lastguess){
118 return -1; #date beyond this machine's integer limit
119 }
120 $g[3]--;
16bb4654 121 $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAY;
a0d0e21e
LW
122 $cheat{$ym} = $guess;
123}
124
1251;