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 Martin Luther King won the Nobel prize, 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
 174 Please note, however, that the range of dates that can be actually be handled
 175 depends on the size of an integer (time_t) on a given platform.
 176 Currently, this is 32 bits for most systems, yielding an approximate range
 177 from Dec 1901 to Jan 2038.
 178
 179 Both timelocal() and timegm() croak if given dates outside the supported
 180 range.
 181
 182 =head1 IMPLEMENTATION
 183
 184 These routines are quite efficient and yet are always guaranteed to agree
 185 with localtime() and gmtime().  We manage this by caching the start times
 186 of any months we've seen before.  If we know the start time of the month,
 187 we can always calculate any time within the month.  The start times
 188 themselves are guessed by successive approximation starting at the
 189 current time, since most dates seen in practice are close to the
 190 current date.  Unlike algorithms that do a binary search (calling gmtime
 191 once for each bit of the time value, resulting in 32 calls), this algorithm
 192 calls it at most 6 times, and usually only once or twice.  If you hit
 193 the month cache, of course, it doesn't call it at all.
 194
 195 timelocal() is implemented using the same cache.  We just assume that we're
 196 translating a GMT time, and then fudge it when we're done for the timezone
 197 and daylight savings arguments.  Note that the timezone is evaluated for
 198 each date because countries occasionally change their official timezones.
 199 Assuming that localtime() corrects for these changes, this routine will
 200 also be correct.  The daylight savings offset is currently assumed
 201 to be one hour.
 202
 203 =head1 BUGS
 204
 205 The whole scheme for interpreting two-digit years can be considered a bug.
 206
 207 Note that the cache currently handles only years from 1900 through 2155.
 208
 209 The proclivity to croak() is probably a bug.
 210
 211 =cut