Upgrade to Time::Local 1.12_01

p4raw-id: //depot/perl@27642

2 files changed, 161 insertions, 197 deletions

diff --git a/lib/Time/Local.pm b/lib/Time/Local.pm
index e402a6a070..7f5ceb1753 100644
--- a/lib/Time/Local.pm
+++ b/lib/Time/Local.pm
@@ -7,177 +7,160 @@ use strict;
 use integer;
 
 use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK );
-$VERSION    = '1.12';
-$VERSION    = eval $VERSION;
-@ISA	= qw( Exporter );
-@EXPORT	= qw( timegm timelocal );
-@EXPORT_OK	= qw( timegm_nocheck timelocal_nocheck );
+$VERSION   = '1.12_01';
+$VERSION   = eval $VERSION;
+@ISA       = qw( Exporter );
+@EXPORT    = qw( timegm timelocal );
+@EXPORT_OK = qw( timegm_nocheck timelocal_nocheck );
 
-my @MonthDays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+my @MonthDays = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
 
 # Determine breakpoint for rolling century
-my $ThisYear     = (localtime())[5];
-my $Breakpoint   = ($ThisYear + 50) % 100;
-my $NextCentury  = $ThisYear - $ThisYear % 100;
-   $NextCentury += 100 if $Breakpoint < 50;
-my $Century      = $NextCentury - 100;
-my $SecOff       = 0;
+my $ThisYear    = ( localtime() )[5];
+my $Breakpoint  = ( $ThisYear + 50 ) % 100;
+my $NextCentury = $ThisYear - $ThisYear % 100;
+$NextCentury += 100 if $Breakpoint < 50;
+my $Century = $NextCentury - 100;
+my $SecOff  = 0;
 
-my (%Options, %Cheat, %Min, %Max);
-my ($MinInt, $MaxInt);
+my ( %Options, %Cheat );
 
-use constant ONE_HOUR => 3600;
-use constant ONE_DAY  => 86400;
+use constant SECS_PER_MINUTE => 60;
+use constant SECS_PER_HOUR   => 3600;
+use constant SECS_PER_DAY    => 86400;
 
-if ($^O eq 'MacOS') {
+my $MaxInt = ( ( 1 << ( 8 * $Config{intsize} - 2 ) ) -1 ) * 2 + 1;
+my $MaxDay = int( ( $MaxInt - ( SECS_PER_DAY / 2 ) ) / SECS_PER_DAY ) - 1;
+
+if ( $^O eq 'MacOS' ) {
     # time_t is unsigned...
-    $MaxInt = (1 << (8 * $Config{intsize})) - 1;
-    $MinInt = 0;
-} else {
-    $MaxInt = ((1 << (8 * $Config{intsize} - 2))-1)*2 + 1;
-    $MinInt = -$MaxInt - 1;
-
-    # On Win32 (and others?) time_t appears to be signed, but negative
-    # epochs still don't work. - XXX - this is experimental
-    $MinInt = 0
-        unless defined ((localtime(-1))[0]);
+    $MaxInt = ( 1 << ( 8 * $Config{intsize} ) ) - 1;
+}
+else {
+    $MaxInt = ( ( 1 << ( 8 * $Config{intsize} - 2 ) ) - 1 ) * 2 + 1;
 }
-
-$Max{Day} = ($MaxInt >> 1) / 43200;
-$Min{Day} = $MinInt ? -($Max{Day} + 1) : 0;
-
-$Max{Sec} = $MaxInt - ONE_DAY * $Max{Day};
-$Min{Sec} = $MinInt - ONE_DAY * $Min{Day};
 
 # Determine the EPOC day for this machine
 my $Epoc = 0;
-if ($^O eq 'vos') {
-# work around posix-977 -- VOS doesn't handle dates in
-# the range 1970-1980.
-  $Epoc = _daygm((0, 0, 0, 1, 0, 70, 4, 0));
+if ( $^O eq 'vos' ) {
+    # work around posix-977 -- VOS doesn't handle dates in the range
+    # 1970-1980.
+    $Epoc = _daygm( 0, 0, 0, 1, 0, 70, 4, 0 );
 }
-elsif ($^O eq 'MacOS') {
-  no integer;
-
-  # MacOS time() is seconds since 1 Jan 1904, localtime
-  # so we need to calculate an offset to apply later
-  $Epoc = 693901;
-  $SecOff = timelocal(localtime(0)) - timelocal(gmtime(0));
-  $Epoc += _daygm(gmtime(0));
+elsif ( $^O eq 'MacOS' ) {
+    $MaxDay *=2 if $^O eq 'MacOS';  # time_t unsigned ... quick hack?
+    # MacOS time() is seconds since 1 Jan 1904, localtime
+    # so we need to calculate an offset to apply later
+    $Epoc = 693901;
+    $SecOff = timelocal( localtime(0)) - timelocal( gmtime(0) ) ;
+    $Epoc += _daygm( gmtime(0) );
 }
 else {
-  $Epoc = _daygm(gmtime(0));
+    $Epoc = _daygm( gmtime(0) );
 }
 
-%Cheat=(); # clear the cache as epoc has changed
+%Cheat = ();    # clear the cache as epoc has changed
 
 sub _daygm {
-    $_[3] + ($Cheat{pack("ss",@_[4,5])} ||= do {
-	my $month = ($_[4] + 10) % 12;
-	my $year = $_[5] + 1900 - $month/10;
-	365*$year + $year/4 - $year/100 + $year/400 + ($month*306 + 5)/10 - $Epoc
-    });
-}
-
 
-sub _timegm {
-    my $sec = $SecOff + $_[0]  +  60 * $_[1]  +  ONE_HOUR * $_[2];
-
-    no integer;
-
-    $sec +  ONE_DAY * &_daygm;
+    # This is written in such a byzantine way in order to avoid
+    # lexical variables and sub calls, for speed
+    return $_[3] + (
+        $Cheat{ pack( 'ss', @_[ 4, 5 ] ) } ||= do {
+            my $month = ( $_[4] + 10 ) % 12;
+            my $year  = $_[5] + 1900 - $month / 10;
+
+            ( ( 365 * $year )
+              + ( $year / 4 )
+              - ( $year / 100 )
+              + ( $year / 400 )
+              + ( ( ( $month * 306 ) + 5 ) / 10 )
+            )
+            - $Epoc;
+        }
+    );
 }
 
+sub _timegm {
+    my $sec =
+        $SecOff + $_[0] + ( SECS_PER_MINUTE * $_[1] ) + ( SECS_PER_HOUR * $_[2] );
 
-sub _zoneadjust {
-    my ($day, $sec, $time) = @_;
-
-    $sec = $sec + _timegm(localtime($time)) - $time;
-    if ($sec >= ONE_DAY) { $day++; $sec -= ONE_DAY; }
-    if ($sec <  0)     { $day--; $sec += ONE_DAY; }
-
-    ($day, $sec);
+    return $sec + ( SECS_PER_DAY * &_daygm );
 }
 
-
 sub timegm {
-    my ($sec,$min,$hour,$mday,$month,$year) = @_;
+    my ( $sec, $min, $hour, $mday, $month, $year ) = @_;
 
-    if ($year >= 1000) {
-	$year -= 1900;
+    if ( $year >= 1000 ) {
+        $year -= 1900;
     }
-    elsif ($year < 100 and $year >= 0) {
-	$year += ($year > $Breakpoint) ? $Century : $NextCentury;
+    elsif ( $year < 100 and $year >= 0 ) {
+        $year += ( $year > $Breakpoint ) ? $Century : $NextCentury;
     }
 
-    unless ($Options{no_range_check}) {
-	if (abs($year) >= 0x7fff) {
-	    $year += 1900;
-	    croak "Cannot handle date ($sec, $min, $hour, $mday, $month, *$year*)";
-	}
+    unless ( $Options{no_range_check} ) {
+        if ( abs($year) >= 0x7fff ) {
+            $year += 1900;
+            croak
+                "Cannot handle date ($sec, $min, $hour, $mday, $month, *$year*)";
+        }
 
-	croak "Month '$month' out of range 0..11" if $month > 11 or $month < 0;
+        croak "Month '$month' out of range 0..11"
+            if $month > 11
+            or $month < 0;
 
 	my $md = $MonthDays[$month];
-#        ++$md if $month == 1 and $year % 4 == 0 and
-#            ($year % 100 != 0 or ($year + 1900) % 400 == 0);
-	++$md unless $month != 1 or $year % 4 or !($year % 400);
-
-	croak "Day '$mday' out of range 1..$md"   if $mday  > $md  or $mday  < 1;
-	croak "Hour '$hour' out of range 0..23"   if $hour  > 23   or $hour  < 0;
-	croak "Minute '$min' out of range 0..59"  if $min   > 59   or $min   < 0;
-	croak "Second '$sec' out of range 0..59"  if $sec   > 59   or $sec   < 0;
+        ++$md
+            unless $month != 1 or $year % 4 or !( $year % 400 );
+
+        croak "Day '$mday' out of range 1..$md"  if $mday > $md or $mday < 1;
+        croak "Hour '$hour' out of range 0..23"  if $hour > 23  or $hour < 0;
+        croak "Minute '$min' out of range 0..59" if $min > 59   or $min < 0;
+        croak "Second '$sec' out of range 0..59" if $sec > 59   or $sec < 0;
     }
 
-    my $days = _daygm(undef, undef, undef, $mday, $month, $year);
-    my $xsec = $sec + $SecOff + 60*$min + ONE_HOUR*$hour;
-
-    unless ($Options{no_range_check}
-        or  ($days > $Min{Day} or $days == $Min{Day} and $xsec >= $Min{Sec})
-       and  ($days < $Max{Day} or $days == $Max{Day} and $xsec <= $Max{Sec}))
-    {
-        warn "Day too small - $days > $Min{Day}\n" if $days < $Min{Day};
-        warn "Day too big - $days > $Max{Day}\n" if $days > $Max{Day};
-        warn "Sec too small - $days < $Min{Sec}\n" if $days < $Min{Sec};
-        warn "Sec too big - $days > $Max{Sec}\n" if $days > $Max{Sec};
+    my $days = _daygm( undef, undef, undef, $mday, $month, $year );
+
+    unless ($Options{no_range_check} or abs($days) < $MaxDay) {
+        my $msg = '';
+        $msg .= "Day too big - $days > $MaxDay\n" if $days > $MaxDay;
+
 	$year += 1900;
-	croak "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)";
-    }
+        $msg .=  "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)";
 
-    no integer;
+	croak $msg;
+    }
 
-    $xsec + ONE_DAY * $days;
+    return $sec
+           + $SecOff
+           + ( SECS_PER_MINUTE * $min )
+           + ( SECS_PER_HOUR * $hour )
+           + ( SECS_PER_DAY * $days );
 }
 
-
 sub timegm_nocheck {
     local $Options{no_range_check} = 1;
-    &timegm;
+    return &timegm;
 }
 
-
 sub timelocal {
-    # Adjust Max/Min allowed times to fit local time zone and call timegm
-    local ($Max{Day}, $Max{Sec}) = _zoneadjust($Max{Day}, $Max{Sec}, $MaxInt);
-    local ($Min{Day}, $Min{Sec}) = _zoneadjust($Min{Day}, $Min{Sec}, $MinInt);
     my $ref_t = &timegm;
+    my $loc_t = _timegm( localtime($ref_t) );
 
-    my $loc_t = _timegm(localtime($ref_t));
-
-    # Is there a timezone offset from GMT or are we done
+    # Is there a timezone offset from GMT or are we done?
     my $zone_off = $ref_t - $loc_t
-	or return $loc_t;
+        or return $loc_t;
 
     # This hack is needed to always pick the first matching time
     # during a DST change when time would otherwise be ambiguous
-    $zone_off -= ONE_HOUR if $ref_t >= ONE_HOUR;
+    $zone_off -= SECS_PER_HOUR if $ref_t >= SECS_PER_HOUR;
 
     # Adjust for timezone
     $loc_t = $ref_t + $zone_off;
 
     # Are we close to a DST change or are we done
-    my $dst_off = $ref_t - _timegm(localtime($loc_t))
-	or return $loc_t;
+    my $dst_off = $ref_t - _timegm( localtime($loc_t) )
+        or return $loc_t;
 
     # Adjust for DST change
     $loc_t += $dst_off;
@@ -187,16 +170,15 @@ sub timelocal {
     # for a negative offset from GMT, and if the original date
     # was a non-extent gap in a forward DST jump, we should
     # now have the wrong answer - undo the DST adjust;
-    my ($s,$m,$h) = localtime($loc_t);
+    my ( $s, $m, $h ) = localtime($loc_t);
     $loc_t -= $dst_off if $s != $_[0] || $m != $_[1] || $h != $_[2];
 
-    $loc_t;
+    return $loc_t;
 }
 
-
 sub timelocal_nocheck {
     local $Options{no_range_check} = 1;
-    &timelocal;
+    return &timelocal;
 }
 
 1;
@@ -223,36 +205,27 @@ positive values, so dates before the system's epoch may not work on
 all operating systems.
 
 It is worth drawing particular attention to the expected ranges for
-the values provided.  The value for the day of the month is the actual day
-(ie 1..31), while the month is the number of months since January (0..11).
-This is consistent with the values returned from localtime() and gmtime().
+the values provided.  The value for the day of the month is the actual
+day (ie 1..31), while the month is the number of months since January
+(0..11).  This is consistent with the values returned from localtime()
+and gmtime().
 
 The timelocal() and timegm() functions perform range checking on the
-input $sec, $min, $hour, $mday, and $mon values by default.  If you'd
-rather they didn't, you can explicitly import the timelocal_nocheck()
-and timegm_nocheck() functions.
-
-	use Time::Local 'timelocal_nocheck';
-
-	{
-	    # The 365th day of 1999
-	    print scalar localtime timelocal_nocheck 0,0,0,365,0,99;
-
-	    # The twenty thousandth day since 1970
-	    print scalar localtime timelocal_nocheck 0,0,0,20000,0,70;
+input $sec, $min, $hour, $mday, and $mon values by default.  If you
+are confident that your data is good, you can explicitly import the
+timelocal_nocheck() and timegm_nocheck() functions, which may provide
+a small performance improvement.
 
-	    # And even the 10,000,000th second since 1999!
-	    print scalar localtime timelocal_nocheck 10000000,0,0,1,0,99;
-	}
+    use Time::Local 'timelocal_nocheck';
 
-Your mileage may vary when trying these with minutes and hours,
-and it doesn't work at all for months.
+    # The 365th day of 1999
+    print scalar localtime timelocal_nocheck 0,0,0,365,0,99;
 
-Strictly speaking, the year should also be specified in a form consistent
-with localtime(), i.e. the offset from 1900.
-In order to make the interpretation of the year easier for humans,
-however, who are more accustomed to seeing years as two-digit or four-digit
-values, the following conventions are followed:
+Strictly speaking, the year should also be specified in a form
+consistent with localtime(), i.e. the offset from 1900.  In order to
+make the interpretation of the year easier for humans, however, who
+are more accustomed to seeing years as two-digit or four-digit values,
+the following conventions are followed:
 
 =over 4
 
@@ -271,24 +244,25 @@ so that 112 indicates 2012.  This rule also applies to years less than zero
 =item *
 
 Years in the range 0..99 are interpreted as shorthand for years in the
-rolling "current century," defined as 50 years on either side of the current
-year.  Thus, today, in 1999, 0 would refer to 2000, and 45 to 2045,
-but 55 would refer to 1955.  Twenty years from now, 55 would instead refer
-to 2055.  This is messy, but matches the way people currently think about
-two digit dates.  Whenever possible, use an absolute four digit year instead.
+rolling "current century," defined as 50 years on either side of the
+current year.  Thus, today, in 1999, 0 would refer to 2000, and 45 to
+2045, but 55 would refer to 1955.  Twenty years from now, 55 would
+instead refer to 2055.  This is messy, but matches the way people
+currently think about two digit dates.  Whenever possible, use an
+absolute four digit year instead.
 
 =back
 
-The scheme above allows interpretation of a wide range of dates, particularly
-if 4-digit years are used.  
+The scheme above allows interpretation of a wide range of dates,
+particularly if 4-digit years are used.
 
-Please note, however, that the range of dates that can be actually be handled
-depends on the size of an integer (time_t) on a given platform.  
-Currently, this is 32 bits for most systems, yielding an approximate range 
-from Dec 1901 to Jan 2038.
+Please note, however, that the range of dates that can be actually be
+handled depends on the size of an integer (time_t) on a given
+platform. Currently, this is 32 bits for most systems, yielding an
+approximate range from Dec 1901 to Jan 2038.
 
-Both timelocal() and timegm() croak if given dates outside the supported
-range.
+Both timelocal() and timegm() croak if given dates outside the
+supported range.
 
 =head2 Ambiguous Local Times (DST)
 
@@ -325,28 +299,29 @@ minimum value of time_t for the system.
 
 =head1 IMPLEMENTATION
 
-These routines are quite efficient and yet are always guaranteed to agree
-with localtime() and gmtime().  We manage this by caching the start times
-of any months we've seen before.  If we know the start time of the month,
-we can always calculate any time within the month.  The start times
-are calculated using a mathematical formula. Unlike other algorithms
-that do multiple calls to gmtime().
+These routines are quite efficient and yet are always guaranteed to
+agree with localtime() and gmtime().  We manage this by caching the
+start times of any months we've seen before.  If we know the start
+time of the month, we can always calculate any time within the month.
+The start times are calculated using a mathematical formula. Unlike
+other algorithms that do multiple calls to gmtime().
 
-timelocal() is implemented using the same cache.  We just assume that we're
-translating a GMT time, and then fudge it when we're done for the timezone
-and daylight savings arguments.  Note that the timezone is evaluated for
-each date because countries occasionally change their official timezones.
-Assuming that localtime() corrects for these changes, this routine will
-also be correct.
+timelocal() is implemented using the same cache.  We just assume that
+we're translating a GMT time, and then fudge it when we're done for
+the timezone and daylight savings arguments.  Note that the timezone
+is evaluated for each date because countries occasionally change their
+official timezones.  Assuming that localtime() corrects for these
+changes, this routine will also be correct.
 
 =head1 BUGS
 
-The whole scheme for interpreting two-digit years can be considered a bug.
+The whole scheme for interpreting two-digit years can be considered a
+bug.
 
 =head1 SUPPORT
 
-Support for this module is provided via the datetime@perl.org
-email list.  See http://lists.perl.org/ for more details.
+Support for this module is provided via the datetime@perl.org email
+list.  See http://lists.perl.org/ for more details.
 
 Please submit bugs using the RT system at rt.cpan.org, or as a last
 resort, to the datetime@perl.org list.
diff --git a/lib/Time/Local.t b/lib/Time/Local.t
index eb48432c14..39c99a090b 100755
--- a/lib/Time/Local.t
+++ b/lib/Time/Local.t
@@ -67,7 +67,7 @@ if ($^O eq 'VMS') {
 my $tests = (@time * 12);
 $tests += @neg_time * 12;
 $tests += @bad_time;
-$tests += 8;
+$tests += 6;
 $tests += 2 if $ENV{PERL_CORE};
 $tests += 6 if $ENV{MAINTAINER};
 
@@ -88,12 +88,12 @@ for (@time, @neg_time) {
 
         my($s,$m,$h,$D,$M,$Y) = localtime($time);
 
-        ok($s, $sec, 'timelocal second');
-        ok($m, $min, 'timelocal minute');
-        ok($h, $hour, 'timelocal hour');
-        ok($D, $mday, 'timelocal day');
-        ok($M, $mon, 'timelocal month');
-        ok($Y, $year, 'timelocal year');
+        ok($s, $sec, "timelocal second for @$_");
+        ok($m, $min, "timelocal minute for @$_");
+        ok($h, $hour, "timelocal hour for @$_");
+        ok($D, $mday, "timelocal day for @$_");
+        ok($M, $mon, "timelocal month for @$_");
+        ok($Y, $year, "timelocal year for @$_");
     }
 
     if ($^O eq 'vos' && $year == 70) {
@@ -106,12 +106,12 @@ for (@time, @neg_time) {
 
         my($s,$m,$h,$D,$M,$Y) = gmtime($time);
 
-        ok($s, $sec, 'timegm second');
-        ok($m, $min, 'timegm minute');
-        ok($h, $hour, 'timegm hour');
-        ok($D, $mday, 'timegm day');
-        ok($M, $mon, 'timegm month');
-        ok($Y, $year, 'timegm year');
+        ok($s, $sec, "timegm second for @$_");
+        ok($m, $min, "timegm minute for @$_");
+        ok($h, $hour, "timegm hour for @$_");
+        ok($D, $mday, "timegm day for @$_");
+        ok($M, $mon, "timegm month for @$_");
+        ok($Y, $year, "timegm year for @$_");
     }
 }
 
@@ -157,17 +157,6 @@ if ($neg_epoch_ok) {
     skip(1, "skipping negative epoch.\n") for 1..2;
 }
 
-# round trip was broken for edge cases
-if ($^O eq "aix" && $Config{osvers} =~ m/^4\.3\./) {
-    skip( 1, "No fix expected for edge case test for $_ on AIX 4.3") for qw( timegm timelocal );
-} else {
-    ok(sprintf('%x', timegm(gmtime(0x7fffffff))), sprintf('%x', 0x7fffffff),
-       '0x7fffffff round trip through gmtime then timegm');
-
-    ok(sprintf('%x', timelocal(localtime(0x7fffffff))), sprintf('%x', 0x7fffffff),
-       '0x7fffffff round trip through localtime then timelocal');
-}
-
 if ($ENV{MAINTAINER}) {
     eval { require POSIX; POSIX::tzset() };
     if ($@) {