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     if($lt[5] > $gt[5]) {
  55         $tzsec -= $DAY;
  56     }
  57     elsif($gt[5] > $lt[5]) {
  58         $tzsec += $DAY;
  59     }
  60     else {
  61         $tzsec += ($gt[7] - $lt[7]) * $DAY;
  62     }
  63
  64     $tzsec += $HR if($lt[8]);
  65
  66     $time = $t + $tzsec;
  67     @test = localtime($time + ($tt - $t));
  68     $time -= $HR if $test[2] != $_[2];
  69     $time;
  70 }
  71
  72 sub cheat {
  73     $year = $_[5];
  74     $month = $_[4];
  75     unless ($no_range_check) {
  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     }
  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 Also worth noting is the ability to disable the range checking that
 142 would normally occur on the input $sec, $min, $hours, $mday, and $mon
 143 values.  You can do this by localizing $Time::Local::no_range_check
 144 to 1.
 145
 146         use Time::Local;
 147
 148         {
 149             local $Time::Local::no_range_check = 1;
 150
 151             # The 365th day of 1999
 152             print scalar localtime timelocal 0,0,0,365,0,99;
 153
 154             # The twenty thousandth day since 1970
 155             print scalar localtime timelocal 0,0,0,20000,0,70;
 156
 157             # And even the 10,000,000th second since 1999!
 158             print scalar localtime timelocal 10000000,0,0,1,0,99;
 159         }
 160
 161 Your mileage may vary when trying this trick with minutes and hours,
 162 and it doesn't work at all for months.
 163
 164 Strictly speaking, the year should also be specified in a form consistent
 165 with localtime(), i.e. the offset from 1900.
 166 In order to make the interpretation of the year easier for humans,
 167 however, who are more accustomed to seeing years as two-digit or four-digit
 168 values, the following conventions are followed:
 169
 170 =over 4
 171
 172 =item *
 173
 174 Years greater than 999 are interpreted as being the actual year,
 175 rather than the offset from 1900.  Thus, 1963 would indicate the year
 176 Martin Luther King won the Nobel prize, not the year 2863.
 177
 178 =item *
 179
 180 Years in the range 100..999 are interpreted as offset from 1900,
 181 so that 112 indicates 2012.  This rule also applies to years less than zero
 182 (but see note below regarding date range).
 183
 184 =item *
 185
 186 Years in the range 0..99 are interpreted as shorthand for years in the
 187 rolling "current century," defined as 50 years on either side of the current
 188 year.  Thus, today, in 1999, 0 would refer to 2000, and 45 to 2045,
 189 but 55 would refer to 1955.  Twenty years from now, 55 would instead refer
 190 to 2055.  This is messy, but matches the way people currently think about
 191 two digit dates.  Whenever possible, use an absolute four digit year instead.
 192
 193 =back
 194
 195 The scheme above allows interpretation of a wide range of dates, particularly
 196 if 4-digit years are used.
 197
 198 Please note, however, that the range of dates that can be actually be handled
 199 depends on the size of an integer (time_t) on a given platform.
 200 Currently, this is 32 bits for most systems, yielding an approximate range
 201 from Dec 1901 to Jan 2038.
 202
 203 Both timelocal() and timegm() croak if given dates outside the supported
 204 range.
 205
 206 =head1 IMPLEMENTATION
 207
 208 These routines are quite efficient and yet are always guaranteed to agree
 209 with localtime() and gmtime().  We manage this by caching the start times
 210 of any months we've seen before.  If we know the start time of the month,
 211 we can always calculate any time within the month.  The start times
 212 themselves are guessed by successive approximation starting at the
 213 current time, since most dates seen in practice are close to the
 214 current date.  Unlike algorithms that do a binary search (calling gmtime
 215 once for each bit of the time value, resulting in 32 calls), this algorithm
 216 calls it at most 6 times, and usually only once or twice.  If you hit
 217 the month cache, of course, it doesn't call it at all.
 218
 219 timelocal() is implemented using the same cache.  We just assume that we're
 220 translating a GMT time, and then fudge it when we're done for the timezone
 221 and daylight savings arguments.  Note that the timezone is evaluated for
 222 each date because countries occasionally change their official timezones.
 223 Assuming that localtime() corrects for these changes, this routine will
 224 also be correct.  The daylight savings offset is currently assumed
 225 to be one hour.
 226
 227 =head1 BUGS
 228
 229 The whole scheme for interpreting two-digit years can be considered a bug.
 230
 231 Note that the cache currently handles only years from 1900 through 2155.
 232
 233 The proclivity to croak() is probably a bug.
 234
 235 =cut