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 );
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;
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;
}
+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) = @_;
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;
}
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;
}
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;
# 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];
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
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
}
}
+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],
# 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
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');
}
projects / p5sagit/p5-mst-13.2.git / commitdiff