home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_mlb.zip / Time / Local.pm < prev    next >
Text File  |  1997-11-25  |  4KB  |  139 lines
  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. =head1 NAME
  10.  
  11. Time::Local - efficiently compute time 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. BEGIN {
  43.     $SEC  = 1;
  44.     $MIN  = 60 * $SEC;
  45.     $HR   = 60 * $MIN;
  46.     $DAY  = 24 * $HR;
  47.     $epoch = (localtime(2*$DAY))[5];    # Allow for bugs near localtime == 0.
  48.  
  49.     $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
  50.  
  51. }
  52.  
  53. sub timegm {
  54.     $ym = pack(C2, @_[5,4]);
  55.     $cheat = $cheat{$ym} || &cheat;
  56.     return -1 if $cheat<0 and $^O ne 'VMS';
  57.     $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAY;
  58. }
  59.  
  60. sub timelocal {
  61.     my $t = &timegm;
  62.     my $tt = $t;
  63.  
  64.     my (@lt) = localtime($t);
  65.     my (@gt) = gmtime($t);
  66.     if ($t < $DAY and ($lt[5] >= 70 or $gt[5] >= 70 )) {
  67.       # Wrap error, too early a date
  68.       # Try a safer date
  69.       $tt = $DAY;
  70.       @lt = localtime($tt);
  71.       @gt = gmtime($tt);
  72.     }
  73.  
  74.     my $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR;
  75.  
  76.     my($lday,$gday) = ($lt[7],$gt[7]);
  77.     if($lt[5] > $gt[5]) {
  78.     $tzsec -= $DAY;
  79.     }
  80.     elsif($gt[5] > $lt[5]) {
  81.     $tzsec += $DAY;
  82.     }
  83.     else {
  84.     $tzsec += ($gt[7] - $lt[7]) * $DAY;
  85.     }
  86.  
  87.     $tzsec += $HR if($lt[8]);
  88.     
  89.     $time = $t + $tzsec;
  90.     return -1 if $cheat<0 and $^O ne 'VMS';
  91.     @test = localtime($time + ($tt - $t));
  92.     $time -= $HR if $test[2] != $_[2];
  93.     $time;
  94. }
  95.  
  96. sub cheat {
  97.     $year = $_[5];
  98.     $year -= 1900
  99.         if $year > 1900;
  100.     $month = $_[4];
  101.     croak "Month '$month' out of range 0..11"    if $month > 11 || $month < 0;
  102.     croak "Day '$_[3]' out of range 1..31"    if $_[3] > 31 || $_[3] < 1;
  103.     croak "Hour '$_[2]' out of range 0..23"    if $_[2] > 23 || $_[2] < 0;
  104.     croak "Minute '$_[1]' out of range 0..59"    if $_[1] > 59 || $_[1] < 0;
  105.     croak "Second '$_[0]' out of range 0..59"    if $_[0] > 59 || $_[0] < 0;
  106.     $guess = $^T;
  107.     @g = gmtime($guess);
  108.     $year += $YearFix if $year < $epoch;
  109.     $lastguess = "";
  110.     $counter = 0;
  111.     while ($diff = $year - $g[5]) {
  112.     croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
  113.     $guess += $diff * (363 * $DAY);
  114.     @g = gmtime($guess);
  115.     if (($thisguess = "@g") eq $lastguess){
  116.         return -1; #date beyond this machine's integer limit
  117.     }
  118.     $lastguess = $thisguess;
  119.     }
  120.     while ($diff = $month - $g[4]) {
  121.     croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
  122.     $guess += $diff * (27 * $DAY);
  123.     @g = gmtime($guess);
  124.     if (($thisguess = "@g") eq $lastguess){
  125.         return -1; #date beyond this machine's integer limit
  126.     }
  127.     $lastguess = $thisguess;
  128.     }
  129.     @gfake = gmtime($guess-1); #still being sceptic
  130.     if ("@gfake" eq $lastguess){
  131.     return -1; #date beyond this machine's integer limit
  132.     }
  133.     $g[3]--;
  134.     $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAY;
  135.     $cheat{$ym} = $guess;
  136. }
  137.  
  138. 1;
  139.