CPAN is upstream for Time::Local again

2 files changed, 651 insertions, 0 deletions

diff --git a/cpan/Time-Local/lib/Time/Local.pm b/cpan/Time-Local/lib/Time/Local.pm
new file mode 100644
index 0000000000..0e9c4ac467
--- /dev/null
+++ b/cpan/Time-Local/lib/Time/Local.pm
@@ -0,0 +1,384 @@
+package Time::Local;
+
+require Exporter;
+use Carp;
+use Config;
+use strict;
+
+use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK );
+$VERSION   = '1.2000';
+
+@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 );
+
+# 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 ( %Options, %Cheat );
+
+use constant SECS_PER_MINUTE => 60;
+use constant SECS_PER_HOUR   => 3600;
+use constant SECS_PER_DAY    => 86400;
+
+my $MaxDay;
+if ($] < 5.012000) {
+    my $MaxInt;
+    if ( $^O eq 'MacOS' ) {
+        # time_t is unsigned...
+        $MaxInt = ( 1 << ( 8 * $Config{ivsize} ) ) - 1;
+    }
+    else {
+        $MaxInt = ( ( 1 << ( 8 * $Config{ivsize} - 2 ) ) - 1 ) * 2 + 1;
+    }
+
+    $MaxDay = int( ( $MaxInt - ( SECS_PER_DAY / 2 ) ) / SECS_PER_DAY ) - 1;
+}
+else {
+    # recent localtime()'s limit is the year 2**31
+    $MaxDay = 365 * (2**31);
+}
+
+# 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 );
+}
+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) );
+}
+
+%Cheat = ();    # clear the cache as epoc has changed
+
+sub _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 - int($month / 10);
+
+            ( ( 365 * $year )
+              + int( $year / 4 )
+              - int( $year / 100 )
+              + int( $year / 400 )
+              + int( ( ( $month * 306 ) + 5 ) / 10 )
+            )
+            - $Epoc;
+        }
+    );
+}
+
+sub _timegm {
+    my $sec =
+        $SecOff + $_[0] + ( SECS_PER_MINUTE * $_[1] ) + ( SECS_PER_HOUR * $_[2] );
+
+    return $sec + ( SECS_PER_DAY * &_daygm );
+}
+
+sub timegm {
+    my ( $sec, $min, $hour, $mday, $month, $year ) = @_;
+
+    if ( $year >= 1000 ) {
+        $year -= 1900;
+    }
+    elsif ( $year < 100 and $year >= 0 ) {
+        $year += ( $year > $Breakpoint ) ? $Century : $NextCentury;
+    }
+
+    unless ( $Options{no_range_check} ) {
+        croak "Month '$month' out of range 0..11"
+            if $month > 11
+            or $month < 0;
+
+	my $md = $MonthDays[$month];
+        ++$md
+            if $month == 1 && _is_leap_year( $year + 1900 );
+
+        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 );
+
+    unless ($Options{no_range_check} or abs($days) < $MaxDay) {
+        my $msg = '';
+        $msg .= "Day too big - $days > $MaxDay\n" if $days > $MaxDay;
+
+	$year += 1900;
+        $msg .=  "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)";
+
+	croak $msg;
+    }
+
+    return $sec
+           + $SecOff
+           + ( SECS_PER_MINUTE * $min )
+           + ( SECS_PER_HOUR * $hour )
+           + ( SECS_PER_DAY * $days );
+}
+
+sub _is_leap_year {
+    return 0 if $_[0] % 4;
+    return 1 if $_[0] % 100;
+    return 0 if $_[0] % 400;
+
+    return 1;
+}
+
+sub timegm_nocheck {
+    local $Options{no_range_check} = 1;
+    return &timegm;
+}
+
+sub timelocal {
+    my $ref_t = &timegm;
+    my $loc_for_ref_t = _timegm( localtime($ref_t) );
+
+    my $zone_off = $loc_for_ref_t - $ref_t
+        or return $loc_for_ref_t;
+
+    # Adjust for timezone
+    my $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) );
+
+    # If this evaluates to true, it means that the value in $loc_t is
+    # the _second_ hour after a DST change where the local time moves
+    # backward.
+    if ( ! $dst_off &&
+         ( ( $ref_t - SECS_PER_HOUR ) - _timegm( localtime( $loc_t - SECS_PER_HOUR ) ) < 0 )
+       ) {
+        return $loc_t - SECS_PER_HOUR;
+    }
+
+    # Adjust for DST change
+    $loc_t += $dst_off;
+
+    return $loc_t if $dst_off > 0;
+
+    # If the original date was a non-extent gap in a forward DST jump,
+    # we should now have the wrong answer - undo the DST adjustment
+    my ( $s, $m, $h ) = localtime($loc_t);
+    $loc_t -= $dst_off if $s != $_[0] || $m != $_[1] || $h != $_[2];
+
+    return $loc_t;
+}
+
+sub timelocal_nocheck {
+    local $Options{no_range_check} = 1;
+    return &timelocal;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Time::Local - efficiently compute time from local and GMT time
+
+=head1 SYNOPSIS
+
+    $time = timelocal($sec,$min,$hour,$mday,$mon,$year);
+    $time = timegm($sec,$min,$hour,$mday,$mon,$year);
+
+=head1 DESCRIPTION
+
+This module provides functions that are the inverse of built-in perl
+functions C<localtime()> and C<gmtime()>. They accept a date as a
+six-element array, and return the corresponding C<time(2)> value in
+seconds since the system epoch (Midnight, January 1, 1970 GMT on Unix,
+for example). This value can be positive or negative, though POSIX
+only requires support for 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
+C<localtime()> and C<gmtime()>.
+
+=head1 FUNCTIONS
+
+=head2 C<timelocal()> and C<timegm()>
+
+This module exports two functions by default, C<timelocal()> and
+C<timegm()>.
+
+The C<timelocal()> and C<timegm()> functions perform range checking on
+the input $sec, $min, $hour, $mday, and $mon values by default.
+
+=head2 C<timelocal_nocheck()> and C<timegm_nocheck()>
+
+If you are working with data you know to be valid, you can speed your
+code up by using the "nocheck" variants, C<timelocal_nocheck()> and
+C<timegm_nocheck()>. These variants must be explicitly imported.
+
+    use Time::Local 'timelocal_nocheck';
+
+    # The 365th day of 1999
+    print scalar localtime timelocal_nocheck 0,0,0,365,0,99;
+
+If you supply data which is not valid (month 27, second 1,000) the
+results will be unpredictable (so don't do that).
+
+=head2 Year Value Interpretation
+
+Strictly speaking, the year should be specified in a form consistent
+with C<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
+
+=item *
+
+Years greater than 999 are interpreted as being the actual year,
+rather than the offset from 1900. Thus, 1964 would indicate the year
+Martin Luther King won the Nobel prize, not the year 3864.
+
+=item *
+
+Years in the range 100..999 are interpreted as offset from 1900, so
+that 112 indicates 2012. This rule also applies to years less than
+zero (but see note below regarding date range).
+
+=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.
+
+=back
+
+The scheme above allows interpretation of a wide range of dates,
+particularly if 4-digit years are used.
+
+=head2 Limits of time_t
+
+On perl versions older than 5.12.0, the range of dates that can be
+actually be handled depends on the size of C<time_t> (usually a signed
+integer) on the given platform. Currently, this is 32 bits for most
+systems, yielding an approximate range from Dec 1901 to Jan 2038.
+
+Both C<timelocal()> and C<timegm()> croak if given dates outside the
+supported range.
+
+As of version 5.12.0, perl has stopped using the underlying time
+library of the operating system it's running on and has its own
+implementation of those routines with a safe range of at least
++/ 2**52 (about 142 million years).
+
+=head2 Ambiguous Local Times (DST)
+
+Because of DST changes, there are many time zones where the same local
+time occurs for two different GMT 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 GMT, B<or> 2001-10-28
+01:30:00 GMT.
+
+When given an ambiguous local time, the timelocal() function should
+always return the epoch for the I<earlier> of the two possible GMT
+times.
+
+=head2 Non-Existent Local Times (DST)
+
+When a DST change causes a locale clock to skip one hour forward,
+there will be an hour's worth of local times that don't exist. Again,
+for the "Europe/Paris" time zone, the local clock jumped from
+2001-03-25 01:59:59 to 2001-03-25 03:00:00.
+
+If the C<timelocal()> function is given a non-existent local time, it
+will simply return an epoch value for the time one hour later.
+
+=head2 Negative Epoch Values
+
+On perl version 5.12.0 and newer, negative epoch values are fully
+supported.
+
+On older versions of perl, negative epoch (C<time_t>) values, which
+are not officially supported by the POSIX standards, are known not to
+work on some systems. 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 with C<localtime()> and C<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 C<gmtime()>.
+
+The C<timelocal()> function 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 C<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.
+
+=head1 SUPPORT
+
+Support for this module is provided via the datetime@perl.org email
+list. See http://lists.perl.org/ for more details.
+
+Please submit bugs to the CPAN RT system at
+http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Time-Local or via email
+at bug-time-local@rt.cpan.org.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997-2003 Graham Barr, 2003-2007 David Rolsky.  All
+rights reserved.  This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the LICENSE file included
+with this module.
+
+=head1 AUTHOR
+
+This module is based on a Perl 4 library, timelocal.pl, that was
+included with Perl 4.036, and was most likely written by Tom
+Christiansen.
+
+The current version was written by Graham Barr.
+
+It is now being maintained separately from the Perl core by Dave
+Rolsky, <autarch@urth.org>.
+
+=cut
diff --git a/cpan/Time-Local/t/Local.t b/cpan/Time-Local/t/Local.t
new file mode 100644
index 0000000000..521cac0bb3
--- /dev/null
+++ b/cpan/Time-Local/t/Local.t
@@ -0,0 +1,267 @@
+#!./perl
+
+use strict;
+
+use Config;
+use Test::More;
+use Time::Local;
+
+# Set up time values to test
+my @time =
+  (
+   #year,mon,day,hour,min,sec
+   [1970,  1,  2, 00, 00, 00],
+   [1980,  2, 28, 12, 00, 00],
+   [1980,  2, 29, 12, 00, 00],
+   [1999, 12, 31, 23, 59, 59],
+   [2000,  1,  1, 00, 00, 00],
+   [2010, 10, 12, 14, 13, 12],
+   # leap day
+   [2020,  2, 29, 12, 59, 59],
+   [2030,  7,  4, 17, 07, 06],
+
+# The following test fails on a surprising number of systems
+# so it is commented out. The end of the Epoch for a 32-bit signed
+# implementation of time_t should be Jan 19, 2038  03:14:07 UTC.
+#  [2038,  1, 17, 23, 59, 59],     # last full day in any tz
+  );
+
+# more than 2**31 time_t - requires a 64bit safe localtime/gmtime
+push @time, [2258,  8, 11,  1, 49, 17]
+    if $] >= 5.012000;
+
+my @bad_time =
+    (
+     # month too large
+     [1995, 13, 01, 01, 01, 01],
+     # day too large
+     [1995, 02, 30, 01, 01, 01],
+     # hour too large
+     [1995, 02, 10, 25, 01, 01],
+     # minute too large
+     [1995, 02, 10, 01, 60, 01],
+     # second too large
+     [1995, 02, 10, 01, 01, 60],
+    );
+
+my @neg_time =
+    (
+     # test negative epochs for systems that handle it
+     [ 1969, 12, 31, 16, 59, 59 ],
+     [ 1950, 04, 12, 9, 30, 31 ],
+    );
+
+# Leap year tests
+my @years =
+    (
+     [ 1900 => 0 ],
+     [ 1947 => 0 ],
+     [ 1996 => 1 ],
+     [ 2000 => 1 ],
+     [ 2100 => 0 ],
+    );
+
+# Use 3 days before the start of the epoch because with Borland on
+# Win32 it will work for -3600 _if_ your time zone is +01:00 (or
+# greater).
+my $neg_epoch_ok = defined ((localtime(-259200))[0]) ? 1 : 0;
+
+# use vmsish 'time' makes for oddness around the Unix epoch
+if ($^O eq 'VMS') {
+    $time[0][2]++;
+    $neg_epoch_ok = 0; # time_t is unsigned
+}
+
+my $epoch_is_64 = eval { $Config{ivsize} == 8 && ( gmtime 2**40 )[5] == 34912 };
+
+my $tests = (@time * 12);
+$tests += @neg_time * 12;
+$tests += @bad_time;
+$tests += @years;
+$tests += 21;
+
+plan tests => $tests;
+
+for (@time, @neg_time) {
+    my($year, $mon, $mday, $hour, $min, $sec) = @$_;
+    $year -= 1900;
+    $mon--;
+
+    SKIP: {
+        skip '1970 test on VOS fails.', 12
+            if $^O eq 'vos' && $year == 70;
+        skip 'this platform does not support negative epochs.', 12
+            if $year < 70 && ! $neg_epoch_ok;
+
+        # Test timelocal()
+        {
+            my $year_in = $year < 70 ? $year + 1900 : $year;
+            my $time = timelocal($sec,$min,$hour,$mday,$mon,$year_in);
+
+            my($s,$m,$h,$D,$M,$Y) = localtime($time);
+
+            is($s, $sec, "timelocal second for @$_");
+            is($m, $min, "timelocal minute for @$_");
+            is($h, $hour, "timelocal hour for @$_");
+            is($D, $mday, "timelocal day for @$_");
+            is($M, $mon, "timelocal month for @$_");
+            is($Y, $year, "timelocal year for @$_");
+        }
+
+
+        # Test timegm()
+        {
+            my $year_in = $year < 70 ? $year + 1900 : $year;
+            my $time = timegm($sec,$min,$hour,$mday,$mon,$year_in);
+
+            my($s,$m,$h,$D,$M,$Y) = gmtime($time);
+
+            is($s, $sec, "timegm second for @$_");
+            is($m, $min, "timegm minute for @$_");
+            is($h, $hour, "timegm hour for @$_");
+            is($D, $mday, "timegm day for @$_");
+            is($M, $mon, "timegm month for @$_");
+            is($Y, $year, "timegm year for @$_");
+        }
+    }
+}
+
+
+for (@bad_time) {
+    my($year, $mon, $mday, $hour, $min, $sec) = @$_;
+    $year -= 1900;
+    $mon--;
+
+    eval { timegm($sec,$min,$hour,$mday,$mon,$year) };
+
+    like($@, qr/.*out of range.*/, 'invalid time caused an error');
+}
+
+{
+    is(timelocal(0,0,1,1,0,90) - timelocal(0,0,0,1,0,90), 3600,
+       'one hour difference between two calls to timelocal');
+
+    is(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)
+    is(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
+# 03:00:00. In this case, 02:00:00 is an invalid time, and should be
+# treated like 03:00:00 rather than 01:00:00 - negative zone offsets used
+# to do the latter
+{
+    my $hour = (localtime(timelocal(0, 0, 2, 7, 3, 102)))[2];
+    # testers in US/Pacific should get 3,
+    # other testers should get 2
+    ok($hour == 2 || $hour == 3, 'hour should be 2 or 3');
+}
+
+for my $p (@years) {
+    my ( $year, $is_leap_year ) = @$p;
+
+    my $string = $is_leap_year ? 'is' : 'is not';
+    is( Time::Local::_is_leap_year($year), $is_leap_year,
+        "$year $string a leap year" );
+}
+
+SKIP:
+{
+    skip 'this platform does not support negative epochs.', 6
+        unless $neg_epoch_ok;
+
+    eval { timegm(0,0,0,29,1,1900) };
+    like($@, qr/Day '29' out of range 1\.\.28/,
+         'does not accept leap day in 1900');
+
+    eval { timegm(0,0,0,29,1,200) };
+    like($@, qr/Day '29' out of range 1\.\.28/,
+         'does not accept leap day in 2100 (year passed as 200)');
+
+    eval { timegm(0,0,0,29,1,0) };
+    is($@, '', 'no error with leap day of 2000 (year passed as 0)');
+
+    eval { timegm(0,0,0,29,1,1904) };
+    is($@, '', 'no error with leap day of 1904');
+
+    eval { timegm(0,0,0,29,1,4) };
+    is($@, '', 'no error with leap day of 2004 (year passed as 4)');
+
+    eval { timegm(0,0,0,29,1,96) };
+    is($@, '', 'no error with leap day of 1996 (year passed as 96)');
+}
+
+SKIP:
+{
+    skip 'These tests require a system with 64-bit time_t.', 3
+        unless $epoch_is_64;
+
+    is( timegm( 8, 14, 3, 19, 0, ( 1900 + 138 ) ), 2**31,
+        'can call timegm for 2**31 epoch seconds' );
+    is( timegm( 16, 28, 6, 7, 1, ( 1900 + 206 ) ), 2**32,
+        'can call timegm for 2**32 epoch seconds (on a 64-bit system)' );
+    is( timegm( 16, 36, 0, 20, 1, ( 34912 + 1900 ) ), 2**40,
+        'can call timegm for 2**40 epoch seconds (on a 64-bit system)' );
+}
+
+SKIP:
+{
+    skip 'These tests only run for the package maintainer.', 8
+        unless $ENV{MAINTAINER};
+
+    require POSIX;
+
+    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);
+    is($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 a transition here
+    # as well.
+    $time = timelocal(0, 30, 1, 28, 9, 101);
+    is($time, 1004250600,
+       'timelocal prefers earlier epoch in the presence of a DST change');
+
+    $time = timelocal(0, 30, 2, 1, 3, 101);
+    is($time, 986113800,
+       'timelocal for non-existent time gives you the time one hour later');
+
+    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);
+    is($time, 985447800,
+       'timelocal prefers earlier epoch in the presence of a DST change');
+
+    $time = timelocal(0, 30, 2, 28, 9, 101);
+    is($time, 1004200200,
+       'timelocal for non-existent time gives you the time one hour later');
+
+    local $ENV{TZ} = 'Europe/London';
+    POSIX::tzset();
+    $time = timelocal( localtime(1111917720) );
+    is($time, 1111917720,
+       'timelocal for round trip bug on date of DST change for Europe/London');
+
+    # There is no 1:00 AM on this date, as it leaps forward to
+    # 2:00 on the DST change - this should return 2:00 per the
+    # docs.
+    is( ( localtime( timelocal( 0, 0, 1, 27, 2, 2005 ) ) )[2], 2,
+        'hour is 2 when given 1:00 AM on Europe/London date change' );
+
+    is( ( localtime( timelocal( 0, 0, 2, 27, 2, 2005 ) ) )[2], 2,
+        'hour is 2 when given 2:00 AM on Europe/London date change' );
+}