diff options
Diffstat (limited to 'lib/Time')
| -rw-r--r-- | lib/Time/Local.pm | 94 | ||||
| -rwxr-xr-x | lib/Time/Local.t | 148 |
2 files changed, 165 insertions, 77 deletions
diff --git a/lib/Time/Local.pm b/lib/Time/Local.pm index c38d07ca60..6b38c303ae 100644 --- a/lib/Time/Local.pm +++ b/lib/Time/Local.pm @@ -7,7 +7,8 @@ use strict; use integer; use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK ); -$VERSION = '1.07'; +$VERSION = '1.07_94'; +$VERSION = eval $VERSION; @ISA = qw( Exporter ); @EXPORT = qw( timegm timelocal ); @EXPORT_OK = qw( timegm_nocheck timelocal_nocheck ); @@ -22,10 +23,23 @@ my $NextCentury = $ThisYear - $ThisYear % 100; my $Century = $NextCentury - 100; my $SecOff = 0; -my (%Options, %Cheat); +my (%Options, %Cheat, %Min, %Max); +my ($MinInt, $MaxInt); -my $MaxInt = ((1<<(8 * $Config{intsize} - 2))-1)*2 + 1; -my $MaxDay = int(($MaxInt-43200)/86400)-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; +} + +$Max{Day} = ($MaxInt >> 1) / 43200; +$Min{Day} = ($MinInt)? -($Max{Day}+1) : 0; + +$Max{Sec} = $MaxInt - 86400 * $Max{Day}; +$Min{Sec} = $MinInt - 86400 * $Min{Day}; # Determine the EPOC day for this machine my $Epoc = 0; @@ -37,7 +51,6 @@ if ($^O eq 'vos') { elsif ($^O eq 'MacOS') { no integer; - $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; @@ -68,6 +81,17 @@ sub _timegm { } +sub _zoneadjust { + my ($day, $sec, $time) = @_; + + $sec = $sec + _timegm(localtime($time)) - $time; + if ($sec >= 86400) { $day++; $sec -= 86400; } + if ($sec < 0) { $day--; $sec += 86400; } + + ($day, $sec); +} + + sub timegm { my ($sec,$min,$hour,$mday,$month,$year) = @_; @@ -81,7 +105,7 @@ sub timegm { unless ($Options{no_range_check}) { if (abs($year) >= 0x7fff) { $year += 1900; - croak "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)"; + croak "Cannot handle date ($sec, $min, $hour, $mday, $month, *$year*)"; } croak "Month '$month' out of range 0..11" if $month > 11 or $month < 0; @@ -96,17 +120,23 @@ sub timegm { } my $days = _daygm(undef, undef, undef, $mday, $month, $year); - - unless ($Options{no_range_check} or abs($days) < $MaxDay) { + my $xsec = $sec + $SecOff + 60*$min + 3600*$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}; $year += 1900; croak "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)"; } - $sec += $SecOff + 60*$min + 3600*$hour; - no integer; - $sec + 86400*$days; + $xsec + 86400 * $days; } @@ -117,14 +147,23 @@ sub timegm_nocheck { sub timelocal { - no integer; + # 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)); + + # Calculate first guess with a one-day delta to avoid localtime overflow + my $delta = ($_[5] < 100)? 86400 : -86400; + my $loc_t = _timegm(localtime( $ref_t + $delta )) - $delta; # Is there a timezone offset from GMT or are we done my $zone_off = $ref_t - $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 -= 3600 if ($delta > 0 && $ref_t >= 3600); + # Adjust for timezone $loc_t = $ref_t + $zone_off; @@ -135,12 +174,12 @@ sub timelocal { # Adjust for DST change $loc_t += $dst_off; + return $loc_t if $dst_off >= 0; + # 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; - return $loc_t if $zone_off <= 0; - my ($s,$m,$h) = localtime($loc_t); $loc_t -= $dst_off if $s != $_[0] || $m != $_[1] || $h != $_[2]; @@ -244,6 +283,29 @@ from Dec 1901 to Jan 2038. Both timelocal() and timegm() croak if given dates outside the supported range. +=head2 Ambiguous Local Times (DST) + +Because of DST changes, there are many time zones where the same local +time occurs for two different UTC times on the same day. For example, +in the "Europe/Paris" time zone, the local time of 2001-10-28 02:30:00 +can represent either 2001-10-28 00:30:00 UTC, B<or> 2001-10-28 +01:30:00 UTC. + +When given an ambiguous local time, the timelocal() function should +always return the epoch for the I<earlier> of the two possible UTC +times. + +=head2 Negative Epoch Values + +Negative epoch (time_t) values are not officially supported by the +POSIX standards, so this module's tests do not test them. On some +systems, they are known not to work. These include MacOS (pre-OSX) +and Win32. + +On systems which do support negative epoch values, this module should +be able to cope with dates before the start of the epoch, down the +minimum value of time_t for the system. + =head1 IMPLEMENTATION These routines are quite efficient and yet are always guaranteed to agree @@ -264,8 +326,6 @@ also be correct. The whole scheme for interpreting two-digit years can be considered a bug. -The proclivity to croak() is probably a bug. - =head1 SUPPORT Support for this module is provided via the perl5-porters@perl.org diff --git a/lib/Time/Local.t b/lib/Time/Local.t index 809dd92e1d..c4b7827e66 100755 --- a/lib/Time/Local.t +++ b/lib/Time/Local.t @@ -7,12 +7,15 @@ BEGIN { } } +use strict; + +use Test; use Time::Local; # Set up time values to test -@time = +my @time = ( - #year,mon,day,hour,min,sec + #year,mon,day,hour,min,sec [1970, 1, 2, 00, 00, 00], [1980, 2, 28, 12, 00, 00], [1980, 2, 29, 12, 00, 00], @@ -30,73 +33,57 @@ use Time::Local; # use vmsish 'time' makes for oddness around the Unix epoch if ($^O eq 'VMS') { $time[0][2]++ } -my $tests = @time * 2 + 4; +my $tests = (@time * 12) + 6; $tests += 2 if $ENV{PERL_CORE}; +$tests += 3 if $ENV{MAINTAINER}; -print "1..$tests\n"; +plan tests => $tests; -$count = 1; for (@time) { my($year, $mon, $mday, $hour, $min, $sec) = @$_; $year -= 1900; - $mon --; - if ($^O eq 'vos' && $count == 1) { - print "ok $count -- skipping 1970 test on VOS.\n"; + $mon--; + + if ($^O eq 'vos' && $year == 70) { + skip(1, "skipping 1970 test on VOS.\n") for 1..6; } else { - my $time = timelocal($sec,$min,$hour,$mday,$mon,$year); - # print scalar(localtime($time)), "\n"; - my($s,$m,$h,$D,$M,$Y) = localtime($time); - - if ($s == $sec && - $m == $min && - $h == $hour && - $D == $mday && - $M == $mon && - $Y == $year - ) { - print "ok $count\n"; - } else { - print "not ok $count\n"; - } + my $time = timelocal($sec,$min,$hour,$mday,$mon,$year); + + my($s,$m,$h,$D,$M,$Y) = localtime($time); + + ok($s, $sec, 'second'); + ok($m, $min, 'minute'); + ok($h, $hour, 'hour'); + ok($D, $mday, 'day'); + ok($M, $mon, 'month'); + ok($Y, $year, 'year'); } - $count++; - # Test gmtime function - if ($^O eq 'vos' && $count == 2) { - print "ok $count -- skipping 1970 test on VOS.\n"; + if ($^O eq 'vos' && $year == 70) { + skip(1, "skipping 1970 test on VOS.\n") for 1..6; } else { - $time = timegm($sec,$min,$hour,$mday,$mon,$year); - ($s,$m,$h,$D,$M,$Y) = gmtime($time); - - if ($s == $sec && - $m == $min && - $h == $hour && - $D == $mday && - $M == $mon && - $Y == $year - ) { - print "ok $count\n"; - } else { - print "not ok $count\n"; - } + my $time = timelocal($sec,$min,$hour,$mday,$mon,$year); + + my($s,$m,$h,$D,$M,$Y) = localtime($time); + + ok($s, $sec, 'second'); + ok($m, $min, 'minute'); + ok($h, $hour, 'hour'); + ok($D, $mday, 'day'); + ok($M, $mon, 'month'); + ok($Y, $year, 'year'); } - $count++; } -#print "Testing that the differences between a few dates makes sense...\n"; - -timelocal(0,0,1,1,0,90) - timelocal(0,0,0,1,0,90) == 3600 - or print "not "; -print "ok ", $count++, "\n"; +ok(timelocal(0,0,1,1,0,90) - timelocal(0,0,0,1,0,90), 3600, + 'one hour difference between two calls to timelocal'); -timelocal(1,2,3,1,0,100) - timelocal(1,2,3,31,11,99) == 24 * 3600 - or print "not "; -print "ok ", $count++, "\n"; +ok(timelocal(1,2,3,1,0,100) - timelocal(1,2,3,31,11,99), 24 * 3600, + 'one day difference between two calls to timelocal'); # Diff beween Jan 1, 1980 and Mar 1, 1980 = (31 + 29 = 60 days) -timegm(0,0,0, 1, 2, 80) - timegm(0,0,0, 1, 0, 80) == 60 * 24 * 3600 - or print "not "; -print "ok ", $count++, "\n"; +ok(timegm(0,0,0, 1, 2, 80) - timegm(0,0,0, 1, 0, 80), 60 * 24 * 3600, + '60 day difference between two calls to timegm'); # bugid #19393 # At a DST transition, the clock skips forward, eg from 01:59:59 to @@ -107,17 +94,58 @@ print "ok ", $count++, "\n"; my $hour = (localtime(timelocal(0, 0, 2, 7, 3, 102)))[2]; # testers in US/Pacific should get 3, # other testers should get 2 - print "not " unless $hour == 2 || $hour == 3; - print "ok ", $main::count++, "\n"; + ok($hour == 2 || $hour == 3, 1, 'hour should be 2 or 3'); +} + +# round trip was broken for edge cases +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 ($@) { + skip("Cannot call POSIX::tzset() on this platform\n") for 1..3; + } + else { + local $ENV{TZ} = 'Europe/Vienna'; + POSIX::tzset(); + + # 2001-10-28 02:30:00 - could be either summer or standard time, + # prefer earlier of the two, in this case summer + my $time = timelocal(0, 30, 2, 28, 9, 101); + ok($time, 1004229000, + 'timelocal prefers earlier epoch in the presence of a DST change'); + + local $ENV{TZ} = 'America/Chicago'; + POSIX::tzset(); + + # Same local time in America/Chicago. There is transition here as + # well. + $time = timelocal(0, 30, 1, 28, 9, 101); + ok($time, 1004250600, + 'timelocal prefers earlier epoch in the presence of a DST change'); + + local $ENV{TZ} = 'Australia/Sydney'; + POSIX::tzset(); + + # 2001-03-25 02:30:00 in Australia/Sydney. This is the transition + # _to_ summer time. The southern hemisphere transitions are + # opposite those of the northern. + $time = timelocal(0, 30, 2, 25, 2, 101); + ok($time, 985447800, + 'timelocal prefers earlier epoch in the presence of a DST change'); + } } if ($ENV{PERL_CORE}) { - #print "Testing timelocal.pl module too...\n"; package test; require 'timelocal.pl'; - timegm(0,0,0,1,0,80) == main::timegm(0,0,0,1,0,80) or print "not "; - print "ok ", $main::count++, "\n"; + ::ok(timegm(0,0,0,1,0,80), main::timegm(0,0,0,1,0,80), + 'timegm in timelocal.pl'); - timelocal(1,2,3,4,5,88) == main::timelocal(1,2,3,4,5,88) or print "not "; - print "ok ", $main::count++, "\n"; + ::ok(timelocal(1,2,3,4,5,88), main::timelocal(1,2,3,4,5,88), + 'timelocal in timelocal.pl'); } |