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