lib/Time/Local.pm

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