lib/Time/Local.pm

   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 # Set up constants
  10     $SEC  = 1;
  11     $MIN  = 60 * $SEC;
  12     $HR   = 60 * $MIN;
  13     $DAY  = 24 * $HR;
  14 # Determine breakpoint for rolling century
  15     my $thisYear = (localtime())[5];
  16     $nextCentury = int($thisYear / 100) * 100;
  17     $breakpoint = ($thisYear + 50) % 100;
  18     $nextCentury += 100 if $breakpoint < 50;
  19
  20 sub timegm {
  21     my (@date) = @_;
  22     if ($date[5] > 999) {
  23         $date[5] -= 1900;
  24     }
  25     elsif ($date[5] >= 0 && $date[5] < 100) {
  26         $date[5] -= 100 if $date[5] > $breakpoint;
  27         $date[5] += $nextCentury;
  28     }
  29     $ym = pack(C2, @date[5,4]);
  30     $cheat = $cheat{$ym} || &cheat(@date);
  31     $cheat
  32     + $date[0] * $SEC
  33     + $date[1] * $MIN
  34     + $date[2] * $HR
  35     + ($date[3]-1) * $DAY;
  36 }
  37
  38 sub timelocal {
  39     my $t = &timegm;
  40     my $tt = $t;
  41
  42     my (@lt) = localtime($t);
  43     my (@gt) = gmtime($t);
  44     if ($t < $DAY and ($lt[5] >= 70 or $gt[5] >= 70 )) {
  45         # Wrap error, too early a date
  46         # Try a safer date
  47         $tt = $DAY;
  48         @lt = localtime($tt);
  49         @gt = gmtime($tt);
  50     }
  51
  52     my $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR;
  53
  54     my($lday,$gday) = ($lt[7],$gt[7]);
  55     if($lt[5] > $gt[5]) {
  56         $tzsec -= $DAY;
  57     }
  58     elsif($gt[5] > $lt[5]) {
  59         $tzsec += $DAY;
  60     }
  61     else {
  62         $tzsec += ($gt[7] - $lt[7]) * $DAY;
  63     }
  64
  65     $tzsec += $HR if($lt[8]);
  66
  67     $time = $t + $tzsec;
  68     @test = localtime($time + ($tt - $t));
  69     $time -= $HR if $test[2] != $_[2];
  70     $time;
  71 }
  72
  73 sub cheat {
  74     $year = $_[5];
  75     $month = $_[4];
  76     croak "Month '$month' out of range 0..11"   if $month > 11 || $month < 0;
  77     croak "Day '$_[3]' out of range 1..31"      if $_[3] > 31 || $_[3] < 1;
  78     croak "Hour '$_[2]' out of range 0..23"     if $_[2] > 23 || $_[2] < 0;
  79     croak "Minute '$_[1]' out of range 0..59"   if $_[1] > 59 || $_[1] < 0;
  80     croak "Second '$_[0]' out of range 0..59"   if $_[0] > 59 || $_[0] < 0;
  81     $guess = $^T;
  82     @g = gmtime($guess);
  83     $lastguess = "";
  84     $counter = 0;
  85     while ($diff = $year - $g[5]) {
  86         croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
  87         $guess += $diff * (363 * $DAY);
  88         @g = gmtime($guess);
  89         if (($thisguess = "@g") eq $lastguess){
  90             croak "Can't handle date (".join(", ",@_).")";
  91             #date beyond this machine's integer limit
  92         }
  93         $lastguess = $thisguess;
  94     }
  95     while ($diff = $month - $g[4]) {
  96         croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
  97         $guess += $diff * (27 * $DAY);
  98         @g = gmtime($guess);
  99         if (($thisguess = "@g") eq $lastguess){
 100             croak "Can't handle date (".join(", ",@_).")";
 101             #date beyond this machine's integer limit
 102         }
 103         $lastguess = $thisguess;
 104     }
 105     @gfake = gmtime($guess-1); #still being sceptic
 106     if ("@gfake" eq $lastguess){
 107         croak "Can't handle date (".join(", ",@_).")";
 108         #date beyond this machine's integer limit
 109     }
 110     $g[3]--;
 111     $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAY;
 112     $cheat{$ym} = $guess;
 113 }
 114
 115 1;
 116
 117 __END__
 118
 119 =head1 NAME
 120
 121 Time::Local - efficiently compute time from local and GMT time
 122
 123 =head1 SYNOPSIS
 124
 125     $time = timelocal($sec,$min,$hours,$mday,$mon,$year);
 126     $time = timegm($sec,$min,$hours,$mday,$mon,$year);
 127
 128 =head1 DESCRIPTION
 129
 130 These routines are the inverse of built-in perl fuctions localtime()
 131 and gmtime().  They accept a date as a six-element array, and return
 132 the corresponding time(2) value in seconds since the Epoch (Midnight,
 133 January 1, 1970).  This value can be positive or negative.
 134
 135 It is worth drawing particular attention to the expected ranges for
 136 the values provided.  While the day of the month is expected to be in
 137 the range 1..31, the month should be in the range 0..11.
 138 This is consistent with the values returned from localtime() and gmtime().
 139
 140 Strictly speaking, the year should also be specified in a form consistent
 141 with localtime(), i.e. the offset from 1900.
 142 In order to make the interpretation of the year easier for humans,
 143 however, who are more accustomed to seeing years as two-digit or four-digit
 144 values, the following conventions are followed:
 145
 146 =over 4
 147
 148 =item *
 149
 150 Years greater than 999 are interpreted as being the actual year,
 151 rather than the offset from 1900.  Thus, 1963 would indicate the year
 152 of Martin Luther King's assassination, not the year 2863.
 153
 154 =item *
 155
 156 Years in the range 100..999 are interpreted as offset from 1900,
 157 so that 112 indicates 2012.  This rule also applies to years less than zero
 158 (but see note below regarding date range).
 159
 160 =item *
 161
 162 Years in the range 0..99 are interpreted as shorthand for years in the
 163 rolling "current century," defined as 50 years on either side of the current
 164 year.  Thus, today, in 1999, 0 would refer to 2000, and 45 to 2045,
 165 but 55 would refer to 1955.  Twenty years from now, 55 would instead refer
 166 to 2055.  This is messy, but matches the way people currently think about
 167 two digit dates.  Whenever possible, use an absolute four digit year instead.
 168
 169 =back
 170
 171 The scheme above allows interpretation of a wide range of dates, particularly
 172 if 4-digit years are used.
 173 Please note, however, that the range of dates that can be actually be handled
 174 depends on the size of an integer (time_t) on a given platform.
 175 Currently, this is 32 bits for most systems, yielding an approximate range
 176 from Dec 1901 to Jan 2038.
 177
 178 Both timelocal() and timegm() croak if given dates outside the supported
 179 range.
 180
 181 =head1 IMPLEMENTATION
 182
 183 These routines are quite efficient and yet are always guaranteed to agree
 184 with localtime() and gmtime().  We manage this by caching the start times
 185 of any months we've seen before.  If we know the start time of the month,
 186 we can always calculate any time within the month.  The start times
 187 themselves are guessed by successive approximation starting at the
 188 current time, since most dates seen in practice are close to the
 189 current date.  Unlike algorithms that do a binary search (calling gmtime
 190 once for each bit of the time value, resulting in 32 calls), this algorithm
 191 calls it at most 6 times, and usually only once or twice.  If you hit
 192 the month cache, of course, it doesn't call it at all.
 193
 194 timelocal() is implemented using the same cache.  We just assume that we're
 195 translating a GMT time, and then fudge it when we're done for the timezone
 196 and daylight savings arguments.  Note that the timezone is evaluated for
 197 each date because countries occasionally change their official timezones.
 198 Assuming that localtime() corrects for these changes, this routine will
 199 also be correct.  The daylight savings offset is currently assumed
 200 to be one hour.
 201
 202 =head1 BUGS
 203
 204 The whole scheme for interpreting two-digit years can be considered a bug.
 205
 206 Note that the cache currently handles only years from 1900 through 2155.
 207
 208 The proclivity to croak() is probably a bug.
 209
 210 =cut