home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / lib / zip / Time / Local.pm < prev    next >
Text File  |  1999-01-24  |  4KB  |  141 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
  21. agree with localtime() and gmtime(), the most notable points being
  22. that year is year-1900 and month is 0..11.  We manage this by caching
  23. the start times of any months we've seen before.  If we know the start
  24. time of the month, we can always calculate any time within the month.
  25. The start times themselves are guessed by successive approximation
  26. starting at the current time, since most dates seen in practice are
  27. close to the current date.  Unlike algorithms that do a binary search
  28. (calling gmtime once for each bit of the time value, resulting in 32
  29. calls), this algorithm calls it at most 6 times, and usually only once
  30. or twice.  If you hit the month cache, of course, it doesn't call it
  31. at all.
  32.  
  33. timelocal is implemented using the same cache.  We just assume that we're
  34. translating a GMT time, and then fudge it when we're done for the timezone
  35. and daylight savings arguments.  The timezone is determined by examining
  36. the result of localtime(0) when the package is initialized.  The daylight
  37. savings offset is currently assumed to be one hour.
  38.  
  39. Both routines return -1 if the integer limit is hit. I.e. for dates
  40. after the 1st of January, 2038 on most machines.
  41.  
  42. =cut
  43.  
  44. BEGIN {
  45.     $SEC  = 1;
  46.     $MIN  = 60 * $SEC;
  47.     $HR   = 60 * $MIN;
  48.     $DAY  = 24 * $HR;
  49.     $epoch = (localtime(2*$DAY))[5];    # Allow for bugs near localtime == 0.
  50.  
  51.     $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
  52.  
  53. }
  54.  
  55. sub timegm {
  56.     $ym = pack(C2, @_[5,4]);
  57.     $cheat = $cheat{$ym} || &cheat;
  58.     return -1 if $cheat<0 and $^O ne 'VMS';
  59.     $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAY;
  60. }
  61.  
  62. sub timelocal {
  63.     my $t = &timegm;
  64.     my $tt = $t;
  65.  
  66.     my (@lt) = localtime($t);
  67.     my (@gt) = gmtime($t);
  68.     if ($t < $DAY and ($lt[5] >= 70 or $gt[5] >= 70 )) {
  69.       # Wrap error, too early a date
  70.       # Try a safer date
  71.       $tt = $DAY;
  72.       @lt = localtime($tt);
  73.       @gt = gmtime($tt);
  74.     }
  75.  
  76.     my $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR;
  77.  
  78.     my($lday,$gday) = ($lt[7],$gt[7]);
  79.     if($lt[5] > $gt[5]) {
  80.     $tzsec -= $DAY;
  81.     }
  82.     elsif($gt[5] > $lt[5]) {
  83.     $tzsec += $DAY;
  84.     }
  85.     else {
  86.     $tzsec += ($gt[7] - $lt[7]) * $DAY;
  87.     }
  88.  
  89.     $tzsec += $HR if($lt[8]);
  90.     
  91.     $time = $t + $tzsec;
  92.     return -1 if $cheat<0 and $^O ne 'VMS';
  93.     @test = localtime($time + ($tt - $t));
  94.     $time -= $HR if $test[2] != $_[2];
  95.     $time;
  96. }
  97.  
  98. sub cheat {
  99.     $year = $_[5];
  100.     $year -= 1900
  101.         if $year > 1900;
  102.     $month = $_[4];
  103.     croak "Month '$month' out of range 0..11"    if $month > 11 || $month < 0;
  104.     croak "Day '$_[3]' out of range 1..31"    if $_[3] > 31 || $_[3] < 1;
  105.     croak "Hour '$_[2]' out of range 0..23"    if $_[2] > 23 || $_[2] < 0;
  106.     croak "Minute '$_[1]' out of range 0..59"    if $_[1] > 59 || $_[1] < 0;
  107.     croak "Second '$_[0]' out of range 0..59"    if $_[0] > 59 || $_[0] < 0;
  108.     $guess = $^T;
  109.     @g = gmtime($guess);
  110.     $year += $YearFix if $year < $epoch;
  111.     $lastguess = "";
  112.     $counter = 0;
  113.     while ($diff = $year - $g[5]) {
  114.     croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
  115.     $guess += $diff * (363 * $DAY);
  116.     @g = gmtime($guess);
  117.     if (($thisguess = "@g") eq $lastguess){
  118.         return -1; #date beyond this machine's integer limit
  119.     }
  120.     $lastguess = $thisguess;
  121.     }
  122.     while ($diff = $month - $g[4]) {
  123.     croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
  124.     $guess += $diff * (27 * $DAY);
  125.     @g = gmtime($guess);
  126.     if (($thisguess = "@g") eq $lastguess){
  127.         return -1; #date beyond this machine's integer limit
  128.     }
  129.     $lastguess = $thisguess;
  130.     }
  131.     @gfake = gmtime($guess-1); #still being sceptic
  132.     if ("@gfake" eq $lastguess){
  133.     return -1; #date beyond this machine's integer limit
  134.     }
  135.     $g[3]--;
  136.     $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAY;
  137.     $cheat{$ym} = $guess;
  138. }
  139.  
  140. 1;
  141.