Parent Directory
| 
Revision Log
Revision 2 - (view) (download) (as text)
| 1 : | sam | 2 | package TimeLocal; |
| 2 : | require 5.000; | ||
| 3 : | require Exporter; | ||
| 4 : | use Carp; | ||
| 5 : | |||
| 6 : | @ISA = qw(Exporter); | ||
| 7 : | @EXPORT = qw(timegm timelocal); | ||
| 8 : | |||
| 9 : | =head1 NAME | ||
| 10 : | |||
| 11 : | Time::Local - efficiently compute tome from local and GMT time | ||
| 12 : | |||
| 13 : | =head1 SYNOPSIS | ||
| 14 : | |||
| 15 : | $time = timelocal($sec,$min,$hours,$mday,$mon,$year); | ||
| 16 : | $time = timegm($sec,$min,$hours,$mday,$mon,$year); | ||
| 17 : | |||
| 18 : | =head1 DESCRIPTION | ||
| 19 : | |||
| 20 : | These routines are quite efficient and yet are always guaranteed to agree | ||
| 21 : | with localtime() and gmtime(). We manage this by caching the start times | ||
| 22 : | of any months we've seen before. If we know the start time of the month, | ||
| 23 : | we can always calculate any time within the month. The start times | ||
| 24 : | themselves are guessed by successive approximation starting at the | ||
| 25 : | current time, since most dates seen in practice are close to the | ||
| 26 : | current date. Unlike algorithms that do a binary search (calling gmtime | ||
| 27 : | once for each bit of the time value, resulting in 32 calls), this algorithm | ||
| 28 : | calls it at most 6 times, and usually only once or twice. If you hit | ||
| 29 : | the month cache, of course, it doesn't call it at all. | ||
| 30 : | |||
| 31 : | timelocal is implemented using the same cache. We just assume that we're | ||
| 32 : | translating a GMT time, and then fudge it when we're done for the timezone | ||
| 33 : | and daylight savings arguments. The timezone is determined by examining | ||
| 34 : | the result of localtime(0) when the package is initialized. The daylight | ||
| 35 : | savings offset is currently assumed to be one hour. | ||
| 36 : | |||
| 37 : | Both routines return -1 if the integer limit is hit. I.e. for dates | ||
| 38 : | after the 1st of January, 2038 on most machines. | ||
| 39 : | |||
| 40 : | =cut | ||
| 41 : | |||
| 42 : | @epoch = localtime(0); | ||
| 43 : | $tzmin = $epoch[2] * 60 + $epoch[1]; # minutes east of GMT | ||
| 44 : | if ($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 : | |||
| 55 : | sub 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 : | |||
| 62 : | sub 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 : | |||
| 70 : | sub 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 : | |||
| 112 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |