home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl502b.zip / lib / timelocal.pl < prev    next >
Perl Script  |  1994-10-18  |  4KB  |  110 lines
  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. }
  110.