lib/timelocal.pl

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