View of /trunk/webwork/system/lib/TimeLocal.pm

    1 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;