lib/Time/Local.pm

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