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(). 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 { @epoch = localtime(0); $SEC = 1; $MIN = 60 * $SEC; $HR = 60 * $MIN; $DAY = 24 * $HR; $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0; my $t = time; my @lt = localtime($t); my @gt = gmtime($t); $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]); } sub timegm { $ym = pack(C2, @_[5,4]); $cheat = $cheat{$ym} || &cheat; return -1 if $cheat<0; $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAY; } sub timelocal { $time = &timegm + $tzsec; return -1 if $cheat<0; @test = localtime($time); $time -= $HR if $test[2] != $_[2]; $time; } sub cheat { $year = $_[5]; $year -= 1900 if $year > 1900; $month = $_[4]; croak "Month out of range 0..11 in timelocal.pl" if $month > 11 || $month < 0; croak "Day out of range 1..31 in timelocal.pl" if $_[3] > 31 || $_[3] < 1; croak "Hour out of range 0..23 in timelocal.pl" if $_[2] > 23 || $_[2] < 0; croak "Minute out of range 0..59 in timelocal.pl" if $_[1] > 59 || $_[1] < 0; croak "Second out of range 0..59 in timelocal.pl" if $_[0] > 59 || $_[0] < 0; $guess = $^T; @g = gmtime($guess); $year += $YearFix if $year < $epoch[5]; $lastguess = ""; while ($diff = $year - $g[5]) { $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]) { $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;