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