summaryrefslogtreecommitdiff
path: root/lib/Time
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2009-09-13 17:11:45 +0100
committerNicholas Clark <nick@ccl4.org>2009-09-13 17:11:45 +0100
commit0c5ae3ee15a49532373833c713da3041b693b8cc (patch)
treedb9e802037a195cebe293f8c3d6df72414c9725e /lib/Time
parentd298f468fca65d287753530a975a3d396dd25e1d (diff)
downloadperl-0c5ae3ee15a49532373833c713da3041b693b8cc.tar.gz
Move Time::Local from lib to ext.
Diffstat (limited to 'lib/Time')
-rw-r--r--lib/Time/Local.pm341
-rw-r--r--lib/Time/Local.t258
2 files changed, 0 insertions, 599 deletions
diff --git a/lib/Time/Local.pm b/lib/Time/Local.pm
deleted file mode 100644
index fe698d44e7..0000000000
--- a/lib/Time/Local.pm
+++ /dev/null
@@ -1,341 +0,0 @@
-package Time::Local;
-
-require Exporter;
-use Carp;
-use Config;
-use strict;
-
-use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK );
-$VERSION = '1.1901';
-
-@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;
-
-# localtime()'s limit is the year 2**31
-my $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 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.
-
-=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/lib/Time/Local.t b/lib/Time/Local.t
deleted file mode 100644
index 3f48404b3c..0000000000
--- a/lib/Time/Local.t
+++ /dev/null
@@ -1,258 +0,0 @@
-#!./perl
-
-BEGIN {
- if ($ENV{PERL_CORE}){
- chdir('t') if -d 't';
- @INC = ('.', '../lib');
- }
-}
-
-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],
- [2038, 1, 17, 23, 59, 59], # last full day in any tz
-
- # more than 2**31 time_t
- [2258, 8, 11, 1, 49, 17],
- );
-
-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--;
-
- # 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" );
-}
-
-{
- 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' );
-}