diff options
author | Nicholas Clark <nick@ccl4.org> | 2009-10-02 17:21:16 +0100 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2009-10-02 17:21:16 +0100 |
commit | 2f94c979cb4eba6cfd7929c6ee378478f91fb550 (patch) | |
tree | 59db8334f4123b827c5942ab50007441b48cd40a /ext/Time-Piece | |
parent | a9ddcb5ded01c01d3a9c527d5ad650f8a5a0c91a (diff) | |
download | perl-2f94c979cb4eba6cfd7929c6ee378478f91fb550.tar.gz |
Move Time::Piece from ext/ to cpan/
Diffstat (limited to 'ext/Time-Piece')
-rw-r--r-- | ext/Time-Piece/Changes | 71 | ||||
-rw-r--r-- | ext/Time-Piece/Makefile.PL | 10 | ||||
-rw-r--r-- | ext/Time-Piece/Piece.pm | 859 | ||||
-rw-r--r-- | ext/Time-Piece/Piece.xs | 1078 | ||||
-rw-r--r-- | ext/Time-Piece/README | 39 | ||||
-rw-r--r-- | ext/Time-Piece/Seconds.pm | 230 | ||||
-rw-r--r-- | ext/Time-Piece/t/01base.t | 19 | ||||
-rw-r--r-- | ext/Time-Piece/t/02core.t | 221 | ||||
-rw-r--r-- | ext/Time-Piece/t/03compare.t | 19 | ||||
-rw-r--r-- | ext/Time-Piece/t/04mjd.t | 33 | ||||
-rw-r--r-- | ext/Time-Piece/t/05overload.t | 9 | ||||
-rw-r--r-- | ext/Time-Piece/t/06subclass.t | 66 | ||||
-rw-r--r-- | ext/Time-Piece/t/07arith.t | 26 |
13 files changed, 0 insertions, 2680 deletions
diff --git a/ext/Time-Piece/Changes b/ext/Time-Piece/Changes deleted file mode 100644 index 5eeb54b350..0000000000 --- a/ext/Time-Piece/Changes +++ /dev/null @@ -1,71 +0,0 @@ - -Time::Piece Changes - -1.15 - - Skip a test on Win32 that there's just no way of passing - - Document the above failure - -1.14 - - rework add_months() to not rely on strptime being able to parse illegal - dates (Gisle Aas). - - Various win32 TZ fixes from p5p core perl version - -1.13 - - More QNX fixes (kraai@ftbfs.org) - - Restore freebsd copyright on strptime. - - Added add_months and add_years methods. - -1.12 - - QNX fixes - - Merge with perl core version - -1.11 - - Skip %V test on Win32 - -1.10 - - Number of bug fixes from RT - - (maintenance by Ricardo SIGNES) - - avoid warning in _mktime (bug #19677) - -1.09 - - (patches from Ricardo SIGNES) - - Tests largely moved to Test::More (from Test.pm) - - Time::Piece should now be safely subclassable - -1.08 - - A number of fixes for strptime - - Fixed docs wrt Time::Object references - - Fixed docs wrt ->month returning short month name - - Added ->fullmonth and ->fullday to get full day names - -1.07 - - Fix for ->week method - -1.06 - - Fix for Solaris pre-2.8 - - Compilation checked on: - sparc solaris 2.7 - sparc solaris 2.8 - i686 linux - ia64 linux - pa-risc1.1 hpux 10.20 - pa-risc2.0 hpux 11.00 - alpha dec_osf 4.0 - - Fixes for Win32 (Randy Kobes) - -1.05 - - Fix for Solaris (again) - -1.04 - - Slight fixes to strptime for Solaris and MacOSX - - Bug in strptime with daylight savings fixed. - -1.03 - - Updated MJD stuff (Tim Jeness) - - Added compare tests - - Ported test suite to Test.pm finally - -1.01 - - Added cs_sec and cs_mon to Time::Seconds so that - old Time::Object installs still work (except for add()) - diff --git a/ext/Time-Piece/Makefile.PL b/ext/Time-Piece/Makefile.PL deleted file mode 100644 index a69cf550c9..0000000000 --- a/ext/Time-Piece/Makefile.PL +++ /dev/null @@ -1,10 +0,0 @@ -use ExtUtils::MakeMaker; - -require 5.006; - -WriteMakefile( - 'NAME' => 'Time::Piece', - 'VERSION_FROM' => 'Piece.pm', # finds $VERSION - 'AUTHOR' => 'Matt Sergeant', - 'ABSTRACT_FROM' => 'Piece.pm', -); diff --git a/ext/Time-Piece/Piece.pm b/ext/Time-Piece/Piece.pm deleted file mode 100644 index a42eb6a1e4..0000000000 --- a/ext/Time-Piece/Piece.pm +++ /dev/null @@ -1,859 +0,0 @@ -# $Id: Piece.pm 82 2009-06-27 13:20:23Z matt $ - -package Time::Piece; - -use strict; - -require Exporter; -require DynaLoader; -use Time::Seconds; -use Carp; -use Time::Local; -use UNIVERSAL qw(isa); - -our @ISA = qw(Exporter DynaLoader); - -our @EXPORT = qw( - localtime - gmtime -); - -our %EXPORT_TAGS = ( - ':override' => 'internal', - ); - -our $VERSION = '1.15'; - -bootstrap Time::Piece $VERSION; - -my $DATE_SEP = '-'; -my $TIME_SEP = ':'; -my @MON_LIST = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); -my @FULLMON_LIST = qw(January February March April May June July - August September October November December); -my @DAY_LIST = qw(Sun Mon Tue Wed Thu Fri Sat); -my @FULLDAY_LIST = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); - -use constant 'c_sec' => 0; -use constant 'c_min' => 1; -use constant 'c_hour' => 2; -use constant 'c_mday' => 3; -use constant 'c_mon' => 4; -use constant 'c_year' => 5; -use constant 'c_wday' => 6; -use constant 'c_yday' => 7; -use constant 'c_isdst' => 8; -use constant 'c_epoch' => 9; -use constant 'c_islocal' => 10; - -sub localtime { - unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') }; - my $class = shift; - my $time = shift; - $time = time if (!defined $time); - $class->_mktime($time, 1); -} - -sub gmtime { - unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') }; - my $class = shift; - my $time = shift; - $time = time if (!defined $time); - $class->_mktime($time, 0); -} - -sub new { - my $class = shift; - my ($time) = @_; - - my $self; - - if (defined($time)) { - $self = $class->localtime($time); - } - elsif (ref($class) && $class->isa(__PACKAGE__)) { - $self = $class->_mktime($class->epoch, $class->[c_islocal]); - } - else { - $self = $class->localtime(); - } - - return bless $self, $class; -} - -sub parse { - my $proto = shift; - my $class = ref($proto) || $proto; - my @components; - if (@_ > 1) { - @components = @_; - } - else { - @components = shift =~ /(\d+)$DATE_SEP(\d+)$DATE_SEP(\d+)(?:(?:T|\s+)(\d+)$TIME_SEP(\d+)(?:$TIME_SEP(\d+)))/; - @components = reverse(@components[0..5]); - } - return $class->new(_strftime("%s", @components)); -} - -sub _mktime { - my ($class, $time, $islocal) = @_; - $class = eval { (ref $class) && (ref $class)->isa('Time::Piece') } - ? ref $class - : $class; - if (ref($time)) { - $time->[c_epoch] = undef; - return wantarray ? @$time : bless [@$time, $islocal], $class; - } - _tzset(); - my @time = $islocal ? - CORE::localtime($time) - : - CORE::gmtime($time); - wantarray ? @time : bless [@time, $time, $islocal], $class; -} - -my %_special_exports = ( - localtime => sub { my $c = $_[0]; sub { $c->localtime(@_) } }, - gmtime => sub { my $c = $_[0]; sub { $c->gmtime(@_) } }, -); - -sub export { - my ($class, $to, @methods) = @_; - for my $method (@methods) { - if (exists $_special_exports{$method}) { - no strict 'refs'; - no warnings 'redefine'; - *{$to . "::$method"} = $_special_exports{$method}->($class); - } else { - $class->SUPER::export($to, $method); - } - } -} - -sub import { - # replace CORE::GLOBAL localtime and gmtime if required - my $class = shift; - my %params; - map($params{$_}++,@_,@EXPORT); - if (delete $params{':override'}) { - $class->export('CORE::GLOBAL', keys %params); - } - else { - $class->export((caller)[0], keys %params); - } -} - -## Methods ## - -sub sec { - my $time = shift; - $time->[c_sec]; -} - -*second = \&sec; - -sub min { - my $time = shift; - $time->[c_min]; -} - -*minute = \&min; - -sub hour { - my $time = shift; - $time->[c_hour]; -} - -sub mday { - my $time = shift; - $time->[c_mday]; -} - -*day_of_month = \&mday; - -sub mon { - my $time = shift; - $time->[c_mon] + 1; -} - -sub _mon { - my $time = shift; - $time->[c_mon]; -} - -sub month { - my $time = shift; - if (@_) { - return $_[$time->[c_mon]]; - } - elsif (@MON_LIST) { - return $MON_LIST[$time->[c_mon]]; - } - else { - return $time->strftime('%b'); - } -} - -*monname = \&month; - -sub fullmonth { - my $time = shift; - if (@_) { - return $_[$time->[c_mon]]; - } - elsif (@FULLMON_LIST) { - return $FULLMON_LIST[$time->[c_mon]]; - } - else { - return $time->strftime('%B'); - } -} - -sub year { - my $time = shift; - $time->[c_year] + 1900; -} - -sub _year { - my $time = shift; - $time->[c_year]; -} - -sub yy { - my $time = shift; - my $res = $time->[c_year] % 100; - return $res > 9 ? $res : "0$res"; -} - -sub wday { - my $time = shift; - $time->[c_wday] + 1; -} - -sub _wday { - my $time = shift; - $time->[c_wday]; -} - -*day_of_week = \&_wday; - -sub wdayname { - my $time = shift; - if (@_) { - return $_[$time->[c_wday]]; - } - elsif (@DAY_LIST) { - return $DAY_LIST[$time->[c_wday]]; - } - else { - return $time->strftime('%a'); - } -} - -*day = \&wdayname; - -sub fullday { - my $time = shift; - if (@_) { - return $_[$time->[c_wday]]; - } - elsif (@FULLDAY_LIST) { - return $FULLDAY_LIST[$time->[c_wday]]; - } - else { - return $time->strftime('%A'); - } -} - -sub yday { - my $time = shift; - $time->[c_yday]; -} - -*day_of_year = \&yday; - -sub isdst { - my $time = shift; - $time->[c_isdst]; -} - -*daylight_savings = \&isdst; - -# Thanks to Tony Olekshy <olekshy@cs.ualberta.ca> for this algorithm -sub tzoffset { - my $time = shift; - - return Time::Seconds->new(0) unless $time->[c_islocal]; - - my $epoch = $time->epoch; - - my $j = sub { - - my ($s,$n,$h,$d,$m,$y) = @_; $m += 1; $y += 1900; - - $time->_jd($y, $m, $d, $h, $n, $s); - - }; - - # Compute floating offset in hours. - # - my $delta = 24 * (&$j(CORE::localtime $epoch) - &$j(CORE::gmtime $epoch)); - - # Return value in seconds rounded to nearest minute. - return Time::Seconds->new( int($delta * 60 + ($delta >= 0 ? 0.5 : -0.5)) * 60 ); -} - -sub epoch { - my $time = shift; - if (defined($time->[c_epoch])) { - return $time->[c_epoch]; - } - else { - my $epoch = $time->[c_islocal] ? - timelocal(@{$time}[c_sec .. c_mon], $time->[c_year]+1900) - : - timegm(@{$time}[c_sec .. c_mon], $time->[c_year]+1900); - $time->[c_epoch] = $epoch; - return $epoch; - } -} - -sub hms { - my $time = shift; - my $sep = @_ ? shift(@_) : $TIME_SEP; - sprintf("%02d$sep%02d$sep%02d", $time->[c_hour], $time->[c_min], $time->[c_sec]); -} - -*time = \&hms; - -sub ymd { - my $time = shift; - my $sep = @_ ? shift(@_) : $DATE_SEP; - sprintf("%d$sep%02d$sep%02d", $time->year, $time->mon, $time->[c_mday]); -} - -*date = \&ymd; - -sub mdy { - my $time = shift; - my $sep = @_ ? shift(@_) : $DATE_SEP; - sprintf("%02d$sep%02d$sep%d", $time->mon, $time->[c_mday], $time->year); -} - -sub dmy { - my $time = shift; - my $sep = @_ ? shift(@_) : $DATE_SEP; - sprintf("%02d$sep%02d$sep%d", $time->[c_mday], $time->mon, $time->year); -} - -sub datetime { - my $time = shift; - my %seps = (date => $DATE_SEP, T => 'T', time => $TIME_SEP, @_); - return join($seps{T}, $time->date($seps{date}), $time->time($seps{time})); -} - - - -# Julian Day is always calculated for UT regardless -# of local time -sub julian_day { - my $time = shift; - # Correct for localtime - $time = $time->gmtime( $time->epoch ) if $time->[c_islocal]; - - # Calculate the Julian day itself - my $jd = $time->_jd( $time->year, $time->mon, $time->mday, - $time->hour, $time->min, $time->sec); - - return $jd; -} - -# MJD is defined as JD - 2400000.5 days -sub mjd { - return shift->julian_day - 2_400_000.5; -} - -# Internal calculation of Julian date. Needed here so that -# both tzoffset and mjd/jd methods can share the code -# Algorithm from Hatcher 1984 (QJRAS 25, 53-55), and -# Hughes et al, 1989, MNRAS, 238, 15 -# See: http://adsabs.harvard.edu/cgi-bin/nph-bib_query?bibcode=1989MNRAS.238.1529H&db_key=AST -# for more details - -sub _jd { - my $self = shift; - my ($y, $m, $d, $h, $n, $s) = @_; - - # Adjust input parameters according to the month - $y = ( $m > 2 ? $y : $y - 1); - $m = ( $m > 2 ? $m - 3 : $m + 9); - - # Calculate the Julian Date (assuming Julian calendar) - my $J = int( 365.25 *( $y + 4712) ) - + int( (30.6 * $m) + 0.5) - + 59 - + $d - - 0.5; - - # Calculate the Gregorian Correction (since we have Gregorian dates) - my $G = 38 - int( 0.75 * int(49+($y/100))); - - # Calculate the actual Julian Date - my $JD = $J + $G; - - # Modify to include hours/mins/secs in floating portion. - return $JD + ($h + ($n + $s / 60) / 60) / 24; -} - -sub week { - my $self = shift; - - my $J = $self->julian_day; - # Julian day is independent of time zone so add on tzoffset - # if we are using local time here since we want the week day - # to reflect the local time rather than UTC - $J += ($self->tzoffset/(24*3600)) if $self->[c_islocal]; - - # Now that we have the Julian day including fractions - # convert it to an integer Julian Day Number using nearest - # int (since the day changes at midday we oconvert all Julian - # dates to following midnight). - $J = int($J+0.5); - - use integer; - my $d4 = ((($J + 31741 - ($J % 7)) % 146097) % 36524) % 1461; - my $L = $d4 / 1460; - my $d1 = (($d4 - $L) % 365) + $L; - return $d1 / 7 + 1; -} - -sub _is_leap_year { - my $year = shift; - return (($year %4 == 0) && !($year % 100 == 0)) || ($year % 400 == 0) - ? 1 : 0; -} - -sub is_leap_year { - my $time = shift; - my $year = $time->year; - return _is_leap_year($year); -} - -my @MON_LAST = qw(31 28 31 30 31 30 31 31 30 31 30 31); - -sub month_last_day { - my $time = shift; - my $year = $time->year; - my $_mon = $time->_mon; - return $MON_LAST[$_mon] + ($_mon == 1 ? _is_leap_year($year) : 0); -} - -sub strftime { - my $time = shift; - my $tzname = $time->[c_islocal] ? '%Z' : 'UTC'; - my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S $tzname"; - if (!defined $time->[c_wday]) { - if ($time->[c_islocal]) { - return _strftime($format, CORE::localtime($time->epoch)); - } - else { - return _strftime($format, CORE::gmtime($time->epoch)); - } - } - return _strftime($format, (@$time)[c_sec..c_isdst]); -} - -sub strptime { - my $time = shift; - my $string = shift; - my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z"; - my @vals = _strptime($string, $format); -# warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals))); - return scalar $time->_mktime(\@vals, (ref($time) ? $time->[c_islocal] : 0)); -} - -sub day_list { - shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method - my @old = @DAY_LIST; - if (@_) { - @DAY_LIST = @_; - } - return @old; -} - -sub mon_list { - shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method - my @old = @MON_LIST; - if (@_) { - @MON_LIST = @_; - } - return @old; -} - -sub time_separator { - shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); - my $old = $TIME_SEP; - if (@_) { - $TIME_SEP = $_[0]; - } - return $old; -} - -sub date_separator { - shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); - my $old = $DATE_SEP; - if (@_) { - $DATE_SEP = $_[0]; - } - return $old; -} - -use overload '""' => \&cdate, - 'cmp' => \&str_compare, - 'fallback' => undef; - -sub cdate { - my $time = shift; - if ($time->[c_islocal]) { - return scalar(CORE::localtime($time->epoch)); - } - else { - return scalar(CORE::gmtime($time->epoch)); - } -} - -sub str_compare { - my ($lhs, $rhs, $reverse) = @_; - if (UNIVERSAL::isa($rhs, 'Time::Piece')) { - $rhs = "$rhs"; - } - return $reverse ? $rhs cmp $lhs->cdate : $lhs->cdate cmp $rhs; -} - -use overload - '-' => \&subtract, - '+' => \&add; - -sub subtract { - my $time = shift; - my $rhs = shift; - if (UNIVERSAL::isa($rhs, 'Time::Seconds')) { - $rhs = $rhs->seconds; - } - - if (shift) - { - # SWAPED is set (so someone tried an expression like NOTDATE - DATE). - # Imitate Perl's standard behavior and return the result as if the - # string $time resolves to was subtracted from NOTDATE. This way, - # classes which override this one and which have a stringify function - # that resolves to something that looks more like a number don't need - # to override this function. - return $rhs - "$time"; - } - - if (UNIVERSAL::isa($rhs, 'Time::Piece')) { - return Time::Seconds->new($time->epoch - $rhs->epoch); - } - else { - # rhs is seconds. - return $time->_mktime(($time->epoch - $rhs), $time->[c_islocal]); - } -} - -sub add { - my $time = shift; - my $rhs = shift; - if (UNIVERSAL::isa($rhs, 'Time::Seconds')) { - $rhs = $rhs->seconds; - } - croak "Invalid rhs of addition: $rhs" if ref($rhs); - - return $time->_mktime(($time->epoch + $rhs), $time->[c_islocal]); -} - -use overload - '<=>' => \&compare; - -sub get_epochs { - my ($lhs, $rhs, $reverse) = @_; - if (!UNIVERSAL::isa($rhs, 'Time::Piece')) { - $rhs = $lhs->new($rhs); - } - if ($reverse) { - return $rhs->epoch, $lhs->epoch; - } - return $lhs->epoch, $rhs->epoch; -} - -sub compare { - my ($lhs, $rhs) = get_epochs(@_); - return $lhs <=> $rhs; -} - -sub add_months { - my ($time, $num_months) = @_; - - croak("add_months requires a number of months") unless defined($num_months); - - my $final_month = $time->_mon + $num_months; - my $num_years = 0; - if ($final_month > 11 || $final_month < 0) { - # these two ops required because we have no POSIX::floor and don't - # want to load POSIX.pm - $num_years = int($final_month / 12); - $num_years-- if ($final_month < 0); - - $final_month = $final_month % 12; - } - - my @vals = _mini_mktime($time->sec, $time->min, $time->hour, - $time->mday, $final_month, $time->year - 1900 + $num_years); -# warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals))); - return scalar $time->_mktime(\@vals, $time->[c_islocal]); -} - -sub add_years { - my ($time, $years) = @_; - $time->add_months($years * 12); -} - -1; -__END__ - -=head1 NAME - -Time::Piece - Object Oriented time objects - -=head1 SYNOPSIS - - use Time::Piece; - - my $t = localtime; - print "Time is $t\n"; - print "Year is ", $t->year, "\n"; - -=head1 DESCRIPTION - -This module replaces the standard localtime and gmtime functions with -implementations that return objects. It does so in a backwards -compatible manner, so that using localtime/gmtime in the way documented -in perlfunc will still return what you expect. - -The module actually implements most of an interface described by -Larry Wall on the perl5-porters mailing list here: -http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2000-01/msg00241.html - -=head1 USAGE - -After importing this module, when you use localtime or gmtime in a scalar -context, rather than getting an ordinary scalar string representing the -date and time, you get a Time::Piece object, whose stringification happens -to produce the same effect as the localtime and gmtime functions. There is -also a new() constructor provided, which is the same as localtime(), except -when passed a Time::Piece object, in which case it's a copy constructor. The -following methods are available on the object: - - $t->sec # also available as $t->second - $t->min # also available as $t->minute - $t->hour # 24 hour - $t->mday # also available as $t->day_of_month - $t->mon # 1 = January - $t->_mon # 0 = January - $t->monname # Feb - $t->month # same as $t->monname - $t->fullmonth # February - $t->year # based at 0 (year 0 AD is, of course 1 BC) - $t->_year # year minus 1900 - $t->yy # 2 digit year - $t->wday # 1 = Sunday - $t->_wday # 0 = Sunday - $t->day_of_week # 0 = Sunday - $t->wdayname # Tue - $t->day # same as wdayname - $t->fullday # Tuesday - $t->yday # also available as $t->day_of_year, 0 = Jan 01 - $t->isdst # also available as $t->daylight_savings - - $t->hms # 12:34:56 - $t->hms(".") # 12.34.56 - $t->time # same as $t->hms - - $t->ymd # 2000-02-29 - $t->date # same as $t->ymd - $t->mdy # 02-29-2000 - $t->mdy("/") # 02/29/2000 - $t->dmy # 29-02-2000 - $t->dmy(".") # 29.02.2000 - $t->datetime # 2000-02-29T12:34:56 (ISO 8601) - $t->cdate # Tue Feb 29 12:34:56 2000 - "$t" # same as $t->cdate - - $t->epoch # seconds since the epoch - $t->tzoffset # timezone offset in a Time::Seconds object - - $t->julian_day # number of days since Julian period began - $t->mjd # modified Julian date (JD-2400000.5 days) - - $t->week # week number (ISO 8601) - - $t->is_leap_year # true if it its - $t->month_last_day # 28-31 - - $t->time_separator($s) # set the default separator (default ":") - $t->date_separator($s) # set the default separator (default "-") - $t->day_list(@days) # set the default weekdays - $t->mon_list(@days) # set the default months - - $t->strftime(FORMAT) # same as POSIX::strftime (without the overhead - # of the full POSIX extension) - $t->strftime() # "Tue, 29 Feb 2000 12:34:56 GMT" - - Time::Piece->strptime(STRING, FORMAT) - # see strptime man page. Creates a new - # Time::Piece object - -=head2 Local Locales - -Both wdayname (day) and monname (month) allow passing in a list to use -to index the name of the days against. This can be useful if you need -to implement some form of localisation without actually installing or -using locales. - - my @days = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi ); - - my $french_day = localtime->day(@days); - -These settings can be overriden globally too: - - Time::Piece::day_list(@days); - -Or for months: - - Time::Piece::mon_list(@months); - -And locally for months: - - print localtime->month(@months); - -=head2 Date Calculations - -It's possible to use simple addition and subtraction of objects: - - use Time::Seconds; - - my $seconds = $t1 - $t2; - $t1 += ONE_DAY; # add 1 day (constant from Time::Seconds) - -The following are valid ($t1 and $t2 are Time::Piece objects): - - $t1 - $t2; # returns Time::Seconds object - $t1 - 42; # returns Time::Piece object - $t1 + 533; # returns Time::Piece object - -However adding a Time::Piece object to another Time::Piece object -will cause a runtime error. - -Note that the first of the above returns a Time::Seconds object, so -while examining the object will print the number of seconds (because -of the overloading), you can also get the number of minutes, hours, -days, weeks and years in that delta, using the Time::Seconds API. - -In addition to adding seconds, there are two APIs for adding months and -years: - - $t->add_months(6); - $t->add_years(5); - -The months and years can be negative for subtractions. Note that there -is some "strange" behaviour when adding and subtracting months at the -ends of months. Generally when the resulting month is shorter than the -starting month then the number of overlap days is added. For example -subtracting a month from 2008-03-31 will not result in 2008-02-31 as this -is an impossible date. Instead you will get 2008-03-02. This appears to -be consistent with other date manipulation tools. - -=head2 Date Comparisons - -Date comparisons are also possible, using the full suite of "<", ">", -"<=", ">=", "<=>", "==" and "!=". - -=head2 Date Parsing - -Time::Piece links to your C library's strptime() function, allowing -you incredibly flexible date parsing routines. For example: - - my $t = Time::Piece->strptime("Sun 3rd Nov, 1943", - "%A %drd %b, %Y"); - - print $t->strftime("%a, %d %b %Y"); - -Outputs: - - Wed, 03 Nov 1943 - -(see, it's even smart enough to fix my obvious date bug) - -For more information see "man strptime", which should be on all unix -systems. - -=head2 YYYY-MM-DDThh:mm:ss - -The ISO 8601 standard defines the date format to be YYYY-MM-DD, and -the time format to be hh:mm:ss (24 hour clock), and if combined, they -should be concatenated with date first and with a capital 'T' in front -of the time. - -=head2 Week Number - -The I<week number> may be an unknown concept to some readers. The ISO -8601 standard defines that weeks begin on a Monday and week 1 of the -year is the week that includes both January 4th and the first Thursday -of the year. In other words, if the first Monday of January is the -2nd, 3rd, or 4th, the preceding days of the January are part of the -last week of the preceding year. Week numbers range from 1 to 53. - -=head2 Global Overriding - -Finally, it's possible to override localtime and gmtime everywhere, by -including the ':override' tag in the import list: - - use Time::Piece ':override'; - -=head1 CAVEATS - -=head2 Setting $ENV{TZ} in Threads on Win32 - -Note that when using perl in the default build configuration on Win32 -(specifically, when perl is built with PERL_IMPLICIT_SYS), each perl -interpreter maintains its own copy of the environment and only the main -interpreter will update the process environment seen by strftime. - -Therefore, if you make changes to $ENV{TZ} from inside a thread other than -the main thread then those changes will not be seen by strftime if you -subsequently call that with the %Z formatting code. You must change $ENV{TZ} -in the main thread to have the desired effect in this case (and you must -also call _tzset() in the main thread to register the environment change). - -Furthermore, remember that this caveat also applies to fork(), which is -emulated by threads on Win32. - -=head1 AUTHOR - -Matt Sergeant, matt@sergeant.org -Jarkko Hietaniemi, jhi@iki.fi (while creating Time::Piece for core perl) - -=head1 License - -This module is free software, you may distribute it under the same terms -as Perl. - -=head1 SEE ALSO - -The excellent Calendar FAQ at http://www.tondering.dk/claus/calendar.html - -=head1 BUGS - -The test harness leaves much to be desired. Patches welcome. - -=cut diff --git a/ext/Time-Piece/Piece.xs b/ext/Time-Piece/Piece.xs deleted file mode 100644 index 772ed9c23a..0000000000 --- a/ext/Time-Piece/Piece.xs +++ /dev/null @@ -1,1078 +0,0 @@ -#ifdef __cplusplus -extern "C" { -#endif -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include <time.h> -#ifdef __cplusplus -} -#endif - -/* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX) - * fields for which we don't have Configure support prior to Perl 5.8.0: - * char *tm_zone; -- abbreviation of timezone name - * long tm_gmtoff; -- offset from GMT in seconds - * To workaround core dumps from the uninitialised tm_zone we get the - * system to give us a reasonable struct to copy. This fix means that - * strftime uses the tm_zone and tm_gmtoff values returned by - * localtime(time()). That should give the desired result most of the - * time. But probably not always! - * - * This is a vestigial workaround for Perls prior to 5.8.0. We now - * rely on the initialization (still likely a workaround) in util.c. - */ -#if !defined(PERL_VERSION) || PERL_VERSION < 8 - -#if defined(HAS_GNULIBC) -# ifndef STRUCT_TM_HASZONE -# define STRUCT_TM_HASZONE -# else -# define USE_TM_GMTOFF -# endif -#endif - -#endif /* end of pre-5.8 */ - -#define DAYS_PER_YEAR 365 -#define DAYS_PER_QYEAR (4*DAYS_PER_YEAR+1) -#define DAYS_PER_CENT (25*DAYS_PER_QYEAR-1) -#define DAYS_PER_QCENT (4*DAYS_PER_CENT+1) -#define SECS_PER_HOUR (60*60) -#define SECS_PER_DAY (24*SECS_PER_HOUR) -/* parentheses deliberately absent on these two, otherwise they don't work */ -#define MONTH_TO_DAYS 153/5 -#define DAYS_TO_MONTH 5/153 -/* offset to bias by March (month 4) 1st between month/mday & year finding */ -#define YEAR_ADJUST (4*MONTH_TO_DAYS+1) -/* as used here, the algorithm leaves Sunday as day 1 unless we adjust it */ -#define WEEKDAY_BIAS 6 /* (1+6)%7 makes Sunday 0 again */ - -#if !defined(PERL_VERSION) || PERL_VERSION < 8 - -#ifdef STRUCT_TM_HASZONE -static void -my_init_tm(struct tm *ptm) /* see mktime, strftime and asctime */ -{ - Time_t now; - (void)time(&now); - Copy(localtime(&now), ptm, 1, struct tm); -} - -#else -# define my_init_tm(ptm) -#endif - -#else -/* use core version from util.c in 5.8.0 and later */ -# define my_init_tm init_tm -#endif - -#ifdef WIN32 - -/* - * (1) The CRT maintains its own copy of the environment, separate from - * the Win32API copy. - * - * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this - * copy, and then calls SetEnvironmentVariableA() to update the Win32API - * copy. - * - * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and - * SetEnvironmentVariableA() directly, bypassing the CRT copy of the - * environment. - * - * (4) The CRT strftime() "%Z" implementation calls __tzset(). That - * calls CRT tzset(), but only the first time it is called, and in turn - * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT - * local copy of the environment and hence gets the original setting as - * perl never updates the CRT copy when assigning to $ENV{TZ}. - * - * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT - * putenv() to update the CRT copy of the environment (if it is different) - * whenever we're about to call tzset(). - * - * In addition to all that, when perl is built with PERL_IMPLICIT_SYS - * defined: - * - * (a) Each interpreter has its own copy of the environment inside the - * perlhost structure. That allows applications that host multiple - * independent Perl interpreters to isolate environment changes from - * each other. (This is similar to how the perlhost mechanism keeps a - * separate working directory for each Perl interpreter, so that calling - * chdir() will not affect other interpreters.) - * - * (b) Only the first Perl interpreter instantiated within a process will - * "write through" environment changes to the process environment. - * - * (c) Even the primary Perl interpreter won't update the CRT copy of the - * the environment, only the Win32API copy (it calls win32_putenv()). - * - * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes - * sense to only update the process environment when inside the main - * interpreter, but we don't have access to CPerlHost's m_bTopLevel member - * from here so we'll just have to check PL_curinterp instead. - * - * Therefore, we can simply #undef getenv() and putenv() so that those names - * always refer to the CRT functions, and explicitly call win32_getenv() to - * access perl's %ENV. - * - * We also #undef malloc() and free() to be sure we are using the CRT - * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls - * into VMem::Malloc() and VMem::Free() and all allocations will be freed - * when the Perl interpreter is being destroyed so we'd end up with a pointer - * into deallocated memory in environ[] if a program embedding a Perl - * interpreter continues to operate even after the main Perl interpreter has - * been destroyed. - * - * Note that we don't free() the malloc()ed memory unless and until we call - * malloc() again ourselves because the CRT putenv() function simply puts its - * pointer argument into the environ[] arrary (it doesn't make a copy of it) - * so this memory must otherwise be leaked. - */ - -#undef getenv -#undef putenv -#undef malloc -#undef free - -static void -fix_win32_tzenv(void) -{ - static char* oldenv = NULL; - char* newenv; - const char* perl_tz_env = win32_getenv("TZ"); - const char* crt_tz_env = getenv("TZ"); - if (perl_tz_env == NULL) - perl_tz_env = ""; - if (crt_tz_env == NULL) - crt_tz_env = ""; - if (strcmp(perl_tz_env, crt_tz_env) != 0) { - newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char)); - if (newenv != NULL) { - sprintf(newenv, "TZ=%s", perl_tz_env); - putenv(newenv); - if (oldenv != NULL) - free(oldenv); - oldenv = newenv; - } - } -} - -#endif - -/* - * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32. - * This code is duplicated in the POSIX module, so any changes made here - * should be made there too. - */ -static void -my_tzset(pTHX) -{ -#ifdef WIN32 -#if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS) - if (PL_curinterp == aTHX) -#endif - fix_win32_tzenv(); -#endif - tzset(); -} - -/* - * my_mini_mktime - normalise struct tm values without the localtime() - * semantics (and overhead) of mktime(). Stolen shamelessly from Perl's - * Perl_mini_mktime() in util.c - for details on the algorithm, see that - * file. - */ -static void -my_mini_mktime(struct tm *ptm) -{ - int yearday; - int secs; - int month, mday, year, jday; - int odd_cent, odd_year; - - year = 1900 + ptm->tm_year; - month = ptm->tm_mon; - mday = ptm->tm_mday; - /* allow given yday with no month & mday to dominate the result */ - if (ptm->tm_yday >= 0 && mday <= 0 && month <= 0) { - month = 0; - mday = 0; - jday = 1 + ptm->tm_yday; - } - else { - jday = 0; - } - if (month >= 2) - month+=2; - else - month+=14, year--; - - yearday = DAYS_PER_YEAR * year + year/4 - year/100 + year/400; - yearday += month*MONTH_TO_DAYS + mday + jday; - /* - * Note that we don't know when leap-seconds were or will be, - * so we have to trust the user if we get something which looks - * like a sensible leap-second. Wild values for seconds will - * be rationalised, however. - */ - if ((unsigned) ptm->tm_sec <= 60) { - secs = 0; - } - else { - secs = ptm->tm_sec; - ptm->tm_sec = 0; - } - secs += 60 * ptm->tm_min; - secs += SECS_PER_HOUR * ptm->tm_hour; - if (secs < 0) { - if (secs-(secs/SECS_PER_DAY*SECS_PER_DAY) < 0) { - /* got negative remainder, but need positive time */ - /* back off an extra day to compensate */ - yearday += (secs/SECS_PER_DAY)-1; - secs -= SECS_PER_DAY * (secs/SECS_PER_DAY - 1); - } - else { - yearday += (secs/SECS_PER_DAY); - secs -= SECS_PER_DAY * (secs/SECS_PER_DAY); - } - } - else if (secs >= SECS_PER_DAY) { - yearday += (secs/SECS_PER_DAY); - secs %= SECS_PER_DAY; - } - ptm->tm_hour = secs/SECS_PER_HOUR; - secs %= SECS_PER_HOUR; - ptm->tm_min = secs/60; - secs %= 60; - ptm->tm_sec += secs; - /* done with time of day effects */ - /* - * The algorithm for yearday has (so far) left it high by 428. - * To avoid mistaking a legitimate Feb 29 as Mar 1, we need to - * bias it by 123 while trying to figure out what year it - * really represents. Even with this tweak, the reverse - * translation fails for years before A.D. 0001. - * It would still fail for Feb 29, but we catch that one below. - */ - jday = yearday; /* save for later fixup vis-a-vis Jan 1 */ - yearday -= YEAR_ADJUST; - year = (yearday / DAYS_PER_QCENT) * 400; - yearday %= DAYS_PER_QCENT; - odd_cent = yearday / DAYS_PER_CENT; - year += odd_cent * 100; - yearday %= DAYS_PER_CENT; - year += (yearday / DAYS_PER_QYEAR) * 4; - yearday %= DAYS_PER_QYEAR; - odd_year = yearday / DAYS_PER_YEAR; - year += odd_year; - yearday %= DAYS_PER_YEAR; - if (!yearday && (odd_cent==4 || odd_year==4)) { /* catch Feb 29 */ - month = 1; - yearday = 29; - } - else { - yearday += YEAR_ADJUST; /* recover March 1st crock */ - month = yearday*DAYS_TO_MONTH; - yearday -= month*MONTH_TO_DAYS; - /* recover other leap-year adjustment */ - if (month > 13) { - month-=14; - year++; - } - else { - month-=2; - } - } - ptm->tm_year = year - 1900; - if (yearday) { - ptm->tm_mday = yearday; - ptm->tm_mon = month; - } - else { - ptm->tm_mday = 31; - ptm->tm_mon = month - 1; - } - /* re-build yearday based on Jan 1 to get tm_yday */ - year--; - yearday = year*DAYS_PER_YEAR + year/4 - year/100 + year/400; - yearday += 14*MONTH_TO_DAYS + 1; - ptm->tm_yday = jday - yearday; - /* fix tm_wday if not overridden by caller */ - ptm->tm_wday = (jday + WEEKDAY_BIAS) % 7; -} - -#ifndef HAS_STRPTIME - /* Assume everyone has strptime except Win32 and QNX4 */ -# define HAS_STRPTIME 1 -# if defined(WIN32) || (defined(__QNX__) && defined(__WATCOMC__)) -# undef HAS_STRPTIME -# endif -#endif - -#ifndef HAS_STRPTIME -#define strncasecmp(x,y,n) strnicmp(x,y,n) - -#if defined(WIN32) -#if defined(__BORLANDC__) -void * __cdecl _EXPFUNC alloca(_SIZE_T __size); -#else -#define alloca _alloca -#endif -#endif - -/* strptime copied from freebsd with the following copyright: */ -/* - * Copyright (c) 1994 Powerdog Industries. All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer - * in the documentation and/or other materials provided with the - * distribution. - * 3. All advertising materials mentioning features or use of this - * software must display the following acknowledgement: - * This product includes software developed by Powerdog Industries. - * 4. The name of Powerdog Industries may not be used to endorse or - * promote products derived from this software without specific prior - * written permission. - * - * THIS SOFTWARE IS PROVIDED BY POWERDOG INDUSTRIES ``AS IS'' AND ANY - * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR - * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE POWERDOG INDUSTRIES BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR - * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE - * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, - * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - */ - -#ifndef lint -#ifndef NOID -static char copyright[] = -"@(#) Copyright (c) 1994 Powerdog Industries. All rights reserved."; -static char sccsid[] = "@(#)strptime.c 0.1 (Powerdog) 94/03/27"; -#endif /* !defined NOID */ -#endif /* not lint */ - -#include <time.h> -#include <ctype.h> -#include <string.h> -#ifdef _THREAD_SAFE -#include <pthread.h> -#include "pthread_private.h" -#endif /* _THREAD_SAFE */ - -static char * _strptime(pTHX_ const char *, const char *, struct tm *); - -#ifdef _THREAD_SAFE -static struct pthread_mutex _gotgmt_mutexd = PTHREAD_MUTEX_STATIC_INITIALIZER; -static pthread_mutex_t gotgmt_mutex = &_gotgmt_mutexd; -#endif -static int got_GMT; - -#define asizeof(a) (sizeof (a) / sizeof ((a)[0])) - -struct lc_time_T { - const char * mon[12]; - const char * month[12]; - const char * wday[7]; - const char * weekday[7]; - const char * X_fmt; - const char * x_fmt; - const char * c_fmt; - const char * am; - const char * pm; - const char * date_fmt; - const char * alt_month[12]; - const char * Ef_fmt; - const char * EF_fmt; -}; - -struct lc_time_T _time_localebuf; -int _time_using_locale; - -const struct lc_time_T _C_time_locale = { - { - "Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" - }, { - "January", "February", "March", "April", "May", "June", - "July", "August", "September", "October", "November", "December" - }, { - "Sun", "Mon", "Tue", "Wed", - "Thu", "Fri", "Sat" - }, { - "Sunday", "Monday", "Tuesday", "Wednesday", - "Thursday", "Friday", "Saturday" - }, - - /* X_fmt */ - "%H:%M:%S", - - /* - ** x_fmt - ** Since the C language standard calls for - ** "date, using locale's date format," anything goes. - ** Using just numbers (as here) makes Quakers happier; - ** it's also compatible with SVR4. - */ - "%m/%d/%y", - - /* - ** c_fmt (ctime-compatible) - ** Not used, just compatibility placeholder. - */ - NULL, - - /* am */ - "AM", - - /* pm */ - "PM", - - /* date_fmt */ - "%a %Ef %X %Z %Y", - - { - "January", "February", "March", "April", "May", "June", - "July", "August", "September", "October", "November", "December" - }, - - /* Ef_fmt - ** To determine short months / day order - */ - "%b %e", - - /* EF_fmt - ** To determine long months / day order - */ - "%B %e" -}; - -#define Locale (&_C_time_locale) - -static char * -_strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm) -{ - char c; - const char *ptr; - int i, - len; - int Ealternative, Oalternative; - - ptr = fmt; - while (*ptr != 0) { - if (*buf == 0) - break; - - c = *ptr++; - - if (c != '%') { - if (isspace((unsigned char)c)) - while (*buf != 0 && isspace((unsigned char)*buf)) - buf++; - else if (c != *buf++) - return 0; - continue; - } - - Ealternative = 0; - Oalternative = 0; -label: - c = *ptr++; - switch (c) { - case 0: - case '%': - if (*buf++ != '%') - return 0; - break; - - case '+': - buf = _strptime(aTHX_ buf, Locale->date_fmt, tm); - if (buf == 0) - return 0; - break; - - case 'C': - if (!isdigit((unsigned char)*buf)) - return 0; - - /* XXX This will break for 3-digit centuries. */ - len = 2; - for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { - i *= 10; - i += *buf - '0'; - len--; - } - if (i < 19) - return 0; - - tm->tm_year = i * 100 - 1900; - break; - - case 'c': - /* NOTE: c_fmt is intentionally ignored */ - buf = _strptime(aTHX_ buf, "%a %Ef %T %Y", tm); - if (buf == 0) - return 0; - break; - - case 'D': - buf = _strptime(aTHX_ buf, "%m/%d/%y", tm); - if (buf == 0) - return 0; - break; - - case 'E': - if (Ealternative || Oalternative) - break; - Ealternative++; - goto label; - - case 'O': - if (Ealternative || Oalternative) - break; - Oalternative++; - goto label; - - case 'F': - case 'f': - if (!Ealternative) - break; - buf = _strptime(aTHX_ buf, (c == 'f') ? Locale->Ef_fmt : Locale->EF_fmt, tm); - if (buf == 0) - return 0; - break; - - case 'R': - buf = _strptime(aTHX_ buf, "%H:%M", tm); - if (buf == 0) - return 0; - break; - - case 'r': - buf = _strptime(aTHX_ buf, "%I:%M:%S %p", tm); - if (buf == 0) - return 0; - break; - - case 'T': - buf = _strptime(aTHX_ buf, "%H:%M:%S", tm); - if (buf == 0) - return 0; - break; - - case 'X': - buf = _strptime(aTHX_ buf, Locale->X_fmt, tm); - if (buf == 0) - return 0; - break; - - case 'x': - buf = _strptime(aTHX_ buf, Locale->x_fmt, tm); - if (buf == 0) - return 0; - break; - - case 'j': - if (!isdigit((unsigned char)*buf)) - return 0; - - len = 3; - for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { - i *= 10; - i += *buf - '0'; - len--; - } - if (i < 1 || i > 366) - return 0; - - tm->tm_yday = i - 1; - break; - - case 'M': - case 'S': - if (*buf == 0 || isspace((unsigned char)*buf)) - break; - - if (!isdigit((unsigned char)*buf)) - return 0; - - len = 2; - for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { - i *= 10; - i += *buf - '0'; - len--; - } - - if (c == 'M') { - if (i > 59) - return 0; - tm->tm_min = i; - } else { - if (i > 60) - return 0; - tm->tm_sec = i; - } - - if (*buf != 0 && isspace((unsigned char)*buf)) - while (*ptr != 0 && !isspace((unsigned char)*ptr)) - ptr++; - break; - - case 'H': - case 'I': - case 'k': - case 'l': - /* - * Of these, %l is the only specifier explicitly - * documented as not being zero-padded. However, - * there is no harm in allowing zero-padding. - * - * XXX The %l specifier may gobble one too many - * digits if used incorrectly. - */ - if (!isdigit((unsigned char)*buf)) - return 0; - - len = 2; - for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { - i *= 10; - i += *buf - '0'; - len--; - } - if (c == 'H' || c == 'k') { - if (i > 23) - return 0; - } else if (i > 12) - return 0; - - tm->tm_hour = i; - - if (*buf != 0 && isspace((unsigned char)*buf)) - while (*ptr != 0 && !isspace((unsigned char)*ptr)) - ptr++; - break; - - case 'p': - /* - * XXX This is bogus if parsed before hour-related - * specifiers. - */ - len = strlen(Locale->am); - if (strncasecmp(buf, Locale->am, len) == 0) { - if (tm->tm_hour > 12) - return 0; - if (tm->tm_hour == 12) - tm->tm_hour = 0; - buf += len; - break; - } - - len = strlen(Locale->pm); - if (strncasecmp(buf, Locale->pm, len) == 0) { - if (tm->tm_hour > 12) - return 0; - if (tm->tm_hour != 12) - tm->tm_hour += 12; - buf += len; - break; - } - - return 0; - - case 'A': - case 'a': - for (i = 0; i < asizeof(Locale->weekday); i++) { - if (c == 'A') { - len = strlen(Locale->weekday[i]); - if (strncasecmp(buf, - Locale->weekday[i], - len) == 0) - break; - } else { - len = strlen(Locale->wday[i]); - if (strncasecmp(buf, - Locale->wday[i], - len) == 0) - break; - } - } - if (i == asizeof(Locale->weekday)) - return 0; - - tm->tm_wday = i; - buf += len; - break; - - case 'U': - case 'W': - /* - * XXX This is bogus, as we can not assume any valid - * information present in the tm structure at this - * point to calculate a real value, so just check the - * range for now. - */ - if (!isdigit((unsigned char)*buf)) - return 0; - - len = 2; - for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { - i *= 10; - i += *buf - '0'; - len--; - } - if (i > 53) - return 0; - - if (*buf != 0 && isspace((unsigned char)*buf)) - while (*ptr != 0 && !isspace((unsigned char)*ptr)) - ptr++; - break; - - case 'w': - if (!isdigit((unsigned char)*buf)) - return 0; - - i = *buf - '0'; - if (i > 6) - return 0; - - tm->tm_wday = i; - - if (*buf != 0 && isspace((unsigned char)*buf)) - while (*ptr != 0 && !isspace((unsigned char)*ptr)) - ptr++; - break; - - case 'd': - case 'e': - /* - * The %e specifier is explicitly documented as not - * being zero-padded but there is no harm in allowing - * such padding. - * - * XXX The %e specifier may gobble one too many - * digits if used incorrectly. - */ - if (!isdigit((unsigned char)*buf)) - return 0; - - len = 2; - for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { - i *= 10; - i += *buf - '0'; - len--; - } - if (i > 31) - return 0; - - tm->tm_mday = i; - - if (*buf != 0 && isspace((unsigned char)*buf)) - while (*ptr != 0 && !isspace((unsigned char)*ptr)) - ptr++; - break; - - case 'B': - case 'b': - case 'h': - for (i = 0; i < asizeof(Locale->month); i++) { - if (Oalternative) { - if (c == 'B') { - len = strlen(Locale->alt_month[i]); - if (strncasecmp(buf, - Locale->alt_month[i], - len) == 0) - break; - } - } else { - if (c == 'B') { - len = strlen(Locale->month[i]); - if (strncasecmp(buf, - Locale->month[i], - len) == 0) - break; - } else { - len = strlen(Locale->mon[i]); - if (strncasecmp(buf, - Locale->mon[i], - len) == 0) - break; - } - } - } - if (i == asizeof(Locale->month)) - return 0; - - tm->tm_mon = i; - buf += len; - break; - - case 'm': - if (!isdigit((unsigned char)*buf)) - return 0; - - len = 2; - for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { - i *= 10; - i += *buf - '0'; - len--; - } - if (i < 1 || i > 12) - return 0; - - tm->tm_mon = i - 1; - - if (*buf != 0 && isspace((unsigned char)*buf)) - while (*ptr != 0 && !isspace((unsigned char)*ptr)) - ptr++; - break; - - case 'Y': - case 'y': - if (*buf == 0 || isspace((unsigned char)*buf)) - break; - - if (!isdigit((unsigned char)*buf)) - return 0; - - len = (c == 'Y') ? 4 : 2; - for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { - i *= 10; - i += *buf - '0'; - len--; - } - if (c == 'Y') - i -= 1900; - if (c == 'y' && i < 69) - i += 100; - if (i < 0) - return 0; - - tm->tm_year = i; - - if (*buf != 0 && isspace((unsigned char)*buf)) - while (*ptr != 0 && !isspace((unsigned char)*ptr)) - ptr++; - break; - - case 'Z': - { - const char *cp; - char *zonestr; - - for (cp = buf; *cp && isupper((unsigned char)*cp); ++cp) - {/*empty*/} - if (cp - buf) { - zonestr = (char *)alloca(cp - buf + 1); - strncpy(zonestr, buf, cp - buf); - zonestr[cp - buf] = '\0'; - my_tzset(aTHX); - if (0 == strcmp(zonestr, "GMT")) { - got_GMT = 1; - } else { - return 0; - } - buf += cp - buf; - } - } - break; - } - } - return (char *)buf; -} - - -char * -strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm) -{ - char *ret; - -#ifdef _THREAD_SAFE -pthread_mutex_lock(&gotgmt_mutex); -#endif - - got_GMT = 0; - ret = _strptime(aTHX_ buf, fmt, tm); - -#ifdef _THREAD_SAFE - pthread_mutex_unlock(&gotgmt_mutex); -#endif - - return ret; -} - -#endif /* !HAS_STRPTIME */ - -MODULE = Time::Piece PACKAGE = Time::Piece - -PROTOTYPES: ENABLE - -void -_strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) - char * fmt - int sec - int min - int hour - int mday - int mon - int year - int wday - int yday - int isdst - CODE: - { - char tmpbuf[128]; - struct tm mytm; - int len; - memset(&mytm, 0, sizeof(mytm)); - my_init_tm(&mytm); /* XXX workaround - see my_init_tm() above */ - mytm.tm_sec = sec; - mytm.tm_min = min; - mytm.tm_hour = hour; - mytm.tm_mday = mday; - mytm.tm_mon = mon; - mytm.tm_year = year; - mytm.tm_wday = wday; - mytm.tm_yday = yday; - mytm.tm_isdst = isdst; - my_mini_mktime(&mytm); - len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm); - /* - ** The following is needed to handle to the situation where - ** tmpbuf overflows. Basically we want to allocate a buffer - ** and try repeatedly. The reason why it is so complicated - ** is that getting a return value of 0 from strftime can indicate - ** one of the following: - ** 1. buffer overflowed, - ** 2. illegal conversion specifier, or - ** 3. the format string specifies nothing to be returned(not - ** an error). This could be because format is an empty string - ** or it specifies %p that yields an empty string in some locale. - ** If there is a better way to make it portable, go ahead by - ** all means. - */ - if ((len > 0 && len < sizeof(tmpbuf)) || (len == 0 && *fmt == '\0')) - ST(0) = sv_2mortal(newSVpv(tmpbuf, len)); - else { - /* Possibly buf overflowed - try again with a bigger buf */ - int fmtlen = strlen(fmt); - int bufsize = fmtlen + sizeof(tmpbuf); - char* buf; - int buflen; - - New(0, buf, bufsize, char); - while (buf) { - buflen = strftime(buf, bufsize, fmt, &mytm); - if (buflen > 0 && buflen < bufsize) - break; - /* heuristic to prevent out-of-memory errors */ - if (bufsize > 100*fmtlen) { - Safefree(buf); - buf = NULL; - break; - } - bufsize *= 2; - Renew(buf, bufsize, char); - } - if (buf) { - ST(0) = sv_2mortal(newSVpv(buf, buflen)); - Safefree(buf); - } - else - ST(0) = sv_2mortal(newSVpv(tmpbuf, len)); - } - } - -void -_tzset() - PPCODE: - my_tzset(aTHX); - - -void -_strptime ( string, format ) - char * string - char * format - PREINIT: - struct tm mytm; - time_t t; - char * remainder; - PPCODE: - t = 0; - mytm = *gmtime(&t); -#ifdef HAS_STRPTIME - remainder = (char *)strptime(string, format, &mytm); -#else - remainder = (char *)strptime(aTHX_ string, format, &mytm); -#endif - if (remainder == NULL) { - croak("Error parsing time"); - } - if (*remainder != '\0') { - warn("garbage at end of string in strptime: %s", remainder); - } - - my_mini_mktime(&mytm); - - /* warn("tm: %d-%d-%d %d:%d:%d\n", mytm.tm_year, mytm.tm_mon, mytm.tm_mday, mytm.tm_hour, mytm.tm_min, mytm.tm_sec); */ - - EXTEND(SP, 11); - PUSHs(sv_2mortal(newSViv(mytm.tm_sec))); - PUSHs(sv_2mortal(newSViv(mytm.tm_min))); - PUSHs(sv_2mortal(newSViv(mytm.tm_hour))); - PUSHs(sv_2mortal(newSViv(mytm.tm_mday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_mon))); - PUSHs(sv_2mortal(newSViv(mytm.tm_year))); - PUSHs(sv_2mortal(newSViv(mytm.tm_wday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_yday))); - /* isdst */ - PUSHs(sv_2mortal(newSViv(0))); - /* epoch */ - PUSHs(sv_2mortal(newSViv(0))); - /* islocal */ - PUSHs(sv_2mortal(newSViv(0))); - -void -_mini_mktime(int sec, int min, int hour, int mday, int mon, int year) - PREINIT: - struct tm mytm; - time_t t; - PPCODE: - t = 0; - mytm = *gmtime(&t); - - mytm.tm_sec = sec; - mytm.tm_min = min; - mytm.tm_hour = hour; - mytm.tm_mday = mday; - mytm.tm_mon = mon; - mytm.tm_year = year; - - my_mini_mktime(&mytm); - - EXTEND(SP, 11); - PUSHs(sv_2mortal(newSViv(mytm.tm_sec))); - PUSHs(sv_2mortal(newSViv(mytm.tm_min))); - PUSHs(sv_2mortal(newSViv(mytm.tm_hour))); - PUSHs(sv_2mortal(newSViv(mytm.tm_mday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_mon))); - PUSHs(sv_2mortal(newSViv(mytm.tm_year))); - PUSHs(sv_2mortal(newSViv(mytm.tm_wday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_yday))); - /* isdst */ - PUSHs(sv_2mortal(newSViv(0))); - /* epoch */ - PUSHs(sv_2mortal(newSViv(0))); - /* islocal */ - PUSHs(sv_2mortal(newSViv(0))); diff --git a/ext/Time-Piece/README b/ext/Time-Piece/README deleted file mode 100644 index b7713f925d..0000000000 --- a/ext/Time-Piece/README +++ /dev/null @@ -1,39 +0,0 @@ -Time::Piece -=========== - -This module supercedes Time::Object (and has a better name). - -At this time the module is almost identical to Time::Object, with -the exception of strptime support. People using Time::Object should -migrate over to Time::Piece as they are able to do so. No further -development will occur to Time::Object. - -DESCRIPTION - -Have you ever thought you time was thoroughly wasted by doing: - - $ perldoc -f localtime - -just to recall the position of wday or some other item in the returned -list of values from localtime (or gmtime) ? - -Well Time::Piece is the answer to your prayers. - -Time::Piece does the right thing with the return value from localtime: - - - in list context it returns a list of values - - - in scalar context it returns a Time::Piece object - - - when stringified (or printed), Time::Piece objects look like - the output from scalar(localtime) - -Beyond that, Time::Piece objects allow you to get any part of the -date/time via method calls, plus they allow you to get at the string -form of the week day and month. It has methods for julian days, and -some simple date arithmetic options. - -Time::Piece also gives you easy access to your C library's strftime -and strptime functions, so you can parse and output locale sensitive -dates to your heart's content :-) - diff --git a/ext/Time-Piece/Seconds.pm b/ext/Time-Piece/Seconds.pm deleted file mode 100644 index 20883fc8ed..0000000000 --- a/ext/Time-Piece/Seconds.pm +++ /dev/null @@ -1,230 +0,0 @@ -# $Id: Seconds.pm 44 2002-09-08 20:51:38Z matt $ - -package Time::Seconds; -use strict; -use vars qw/@EXPORT @EXPORT_OK @ISA/; -use UNIVERSAL qw(isa); - -@ISA = 'Exporter'; - -@EXPORT = qw( - ONE_MINUTE - ONE_HOUR - ONE_DAY - ONE_WEEK - ONE_MONTH - ONE_REAL_MONTH - ONE_YEAR - ONE_REAL_YEAR - ONE_FINANCIAL_MONTH - LEAP_YEAR - NON_LEAP_YEAR - ); - -@EXPORT_OK = qw(cs_sec cs_mon); - -use constant ONE_MINUTE => 60; -use constant ONE_HOUR => 3_600; -use constant ONE_DAY => 86_400; -use constant ONE_WEEK => 604_800; -use constant ONE_MONTH => 2_629_744; # ONE_YEAR / 12 -use constant ONE_REAL_MONTH => '1M'; -use constant ONE_YEAR => 31_556_930; # 365.24225 days -use constant ONE_REAL_YEAR => '1Y'; -use constant ONE_FINANCIAL_MONTH => 2_592_000; # 30 days -use constant LEAP_YEAR => 31_622_400; # 366 * ONE_DAY -use constant NON_LEAP_YEAR => 31_536_000; # 365 * ONE_DAY - -# hacks to make Time::Piece compile once again -use constant cs_sec => 0; -use constant cs_mon => 1; - -use overload - 'fallback' => 'undef', - '0+' => \&seconds, - '""' => \&seconds, - '<=>' => \&compare, - '+' => \&add, - '-' => \&subtract, - '-=' => \&subtract_from, - '+=' => \&add_to, - '=' => \© - -sub new { - my $class = shift; - my ($val) = @_; - $val = 0 unless defined $val; - bless \$val, $class; -} - -sub _get_ovlvals { - my ($lhs, $rhs, $reverse) = @_; - $lhs = $lhs->seconds; - - if (UNIVERSAL::isa($rhs, 'Time::Seconds')) { - $rhs = $rhs->seconds; - } - elsif (ref($rhs)) { - die "Can't use non Seconds object in operator overload"; - } - - if ($reverse) { - return $rhs, $lhs; - } - - return $lhs, $rhs; -} - -sub compare { - my ($lhs, $rhs) = _get_ovlvals(@_); - return $lhs <=> $rhs; -} - -sub add { - my ($lhs, $rhs) = _get_ovlvals(@_); - return Time::Seconds->new($lhs + $rhs); -} - -sub add_to { - my $lhs = shift; - my $rhs = shift; - $rhs = $rhs->seconds if UNIVERSAL::isa($rhs, 'Time::Seconds'); - $$lhs += $rhs; - return $lhs; -} - -sub subtract { - my ($lhs, $rhs) = _get_ovlvals(@_); - return Time::Seconds->new($lhs - $rhs); -} - -sub subtract_from { - my $lhs = shift; - my $rhs = shift; - $rhs = $rhs->seconds if UNIVERSAL::isa($rhs, 'Time::Seconds'); - $$lhs -= $rhs; - return $lhs; -} - -sub copy { - Time::Seconds->new(${$_[0]}); -} - -sub seconds { - my $s = shift; - return $$s; -} - -sub minutes { - my $s = shift; - return $$s / 60; -} - -sub hours { - my $s = shift; - $s->minutes / 60; -} - -sub days { - my $s = shift; - $s->hours / 24; -} - -sub weeks { - my $s = shift; - $s->days / 7; -} - -sub months { - my $s = shift; - $s->days / 30.4368541; -} - -sub financial_months { - my $s = shift; - $s->days / 30; -} - -sub years { - my $s = shift; - $s->days / 365.24225; -} - -1; -__END__ - -=head1 NAME - -Time::Seconds - a simple API to convert seconds to other date values - -=head1 SYNOPSIS - - use Time::Piece; - use Time::Seconds; - - my $t = localtime; - $t += ONE_DAY; - - my $t2 = localtime; - my $s = $t - $t2; - - print "Difference is: ", $s->days, "\n"; - -=head1 DESCRIPTION - -This module is part of the Time::Piece distribution. It allows the user -to find out the number of minutes, hours, days, weeks or years in a given -number of seconds. It is returned by Time::Piece when you delta two -Time::Piece objects. - -Time::Seconds also exports the following constants: - - ONE_DAY - ONE_WEEK - ONE_HOUR - ONE_MINUTE - ONE_MONTH - ONE_YEAR - ONE_FINANCIAL_MONTH - LEAP_YEAR - NON_LEAP_YEAR - -Since perl does not (yet?) support constant objects, these constants are in -seconds only, so you cannot, for example, do this: C<print ONE_WEEK-E<gt>minutes;> - -=head1 METHODS - -The following methods are available: - - my $val = Time::Seconds->new(SECONDS) - $val->seconds; - $val->minutes; - $val->hours; - $val->days; - $val->weeks; - $val->months; - $val->financial_months; # 30 days - $val->years; - -The methods make the assumption that there are 24 hours in a day, 7 days in -a week, 365.24225 days in a year and 12 months in a year. -(from The Calendar FAQ at http://www.tondering.dk/claus/calendar.html) - -=head1 AUTHOR - -Matt Sergeant, matt@sergeant.org - -Tobias Brox, tobiasb@tobiasb.funcom.com - -Bal�zs Szab� (dLux), dlux@kapu.hu - -=head1 LICENSE - -Please see Time::Piece for the license. - -=head1 Bugs - -Currently the methods aren't as efficient as they could be, for reasons of -clarity. This is probably a bad idea. - -=cut diff --git a/ext/Time-Piece/t/01base.t b/ext/Time-Piece/t/01base.t deleted file mode 100644 index 530cd3d502..0000000000 --- a/ext/Time-Piece/t/01base.t +++ /dev/null @@ -1,19 +0,0 @@ -use Test::More tests => 7; - -BEGIN { use_ok('Time::Piece'); } - -my $t = gmtime(315532800); # 00:00:00 1/1/1980 - -isa_ok($t, 'Time::Piece', 'specific gmtime'); - -cmp_ok($t->year, '==', 1980, 'correct year'); - -cmp_ok($t->hour, '==', 0, 'correct hour'); - -cmp_ok($t->mon, '==', 1, 'correct mon'); - -my $g = gmtime; -isa_ok($g, 'Time::Piece', 'current gmtime'); - -my $l = localtime; -isa_ok($l, 'Time::Piece', 'current localtime'); diff --git a/ext/Time-Piece/t/02core.t b/ext/Time-Piece/t/02core.t deleted file mode 100644 index 5610bcb74d..0000000000 --- a/ext/Time-Piece/t/02core.t +++ /dev/null @@ -1,221 +0,0 @@ -use Test::More tests => 95; - -my $is_win32 = ($^O =~ /Win32/); -my $is_qnx = ($^O eq 'qnx'); -BEGIN { use_ok('Time::Piece'); } -ok(1); - -my $t = gmtime(951827696); # 2000-02-29T12:34:56 - -is($t->sec, 56); -is($t->second, 56); -is($t->min, 34); -is($t->minute, 34); -is($t->hour, 12); -is($t->mday, 29); -is($t->day_of_month, 29); -is($t->mon, 2); -is($t->_mon, 1); -is($t->monname, 'Feb'); -is($t->month, 'Feb'); -is($t->fullmonth, 'February'); -is($t->year, 2000); -is($t->_year, 100); -is($t->yy, '00'); - -cmp_ok($t->wday, '==', 3); -cmp_ok($t->_wday, '==', 2); -cmp_ok($t->day_of_week, '==', 2); -cmp_ok($t->wdayname, 'eq', 'Tue'); -cmp_ok($t->day, 'eq', 'Tue'); -cmp_ok($t->fullday, 'eq', 'Tuesday'); -cmp_ok($t->yday, '==', 59); -cmp_ok($t->day_of_year, '==', 59); - -# In GMT there should be no daylight savings ever. -cmp_ok($t->isdst, '==', 0); -cmp_ok($t->epoch, '==', 951827696); -cmp_ok($t->hms, 'eq', '12:34:56'); -cmp_ok($t->time, 'eq', '12:34:56'); -cmp_ok($t->ymd, 'eq', '2000-02-29'); -cmp_ok($t->date, 'eq', '2000-02-29'); -cmp_ok($t->mdy, 'eq', '02-29-2000'); -cmp_ok($t->dmy, 'eq', '29-02-2000'); -cmp_ok($t->cdate, 'eq', 'Tue Feb 29 12:34:56 2000'); -cmp_ok("$t", 'eq', 'Tue Feb 29 12:34:56 2000'); -cmp_ok($t->datetime, 'eq','2000-02-29T12:34:56'); -cmp_ok($t->daylight_savings, '==', 0); - -# ->tzoffset? -my $is_pseudo_fork = 0; -if (defined &Win32::GetCurrentProcessId - ? $$ != Win32::GetCurrentProcessId() : $^O eq "MSWin32" && $$ < 0) { - $is_pseudo_fork = 1; -} -SKIP: { - skip "can't register TZ changes in a pseudo-fork", 2 if $is_pseudo_fork; - local $ENV{TZ} = "EST5"; - Time::Piece::_tzset(); # register the environment change - my $lt = localtime; - cmp_ok(scalar($lt->tzoffset), 'eq', '-18000'); - cmp_ok($lt->strftime("%Z"), 'eq', 'EST'); -} - -cmp_ok(($t->julian_day / 2451604.0243 ) - 1, '<', 0.001); -cmp_ok(($t->mjd / 51603.52426) - 1, '<', 0.001); -cmp_ok($t->week, '==', 9); - -# strftime tests - -# %a, %A, %b, %B, %c are locale-dependent - -# %C is unportable: sometimes its like asctime(3) or date(1), -# sometimes it's the century (and whether for 2000 the century is -# 20 or 19, is fun, too..as far as I can read SUSv2 it should be 20.) -cmp_ok($t->strftime('%d'), '==', 29); - -SKIP: { - skip "can't strftime %D, %R, %T or %e on Win32", 1 if $is_win32; - cmp_ok($t->strftime('%D'), 'eq', '02/29/00'); # Yech! -} -SKIP:{ - skip "can't strftime %D, %R, %T or %e on Win32", 1 if $is_win32; - skip "can't strftime %e on QNX", 1 if $is_qnx; - cmp_ok($t->strftime('%e'), 'eq', '29'); # should test with < 10 -} - -# %h is locale-dependent -cmp_ok($t->strftime('%H'), 'eq', '12'); # should test with < 10 - -cmp_ok($t->strftime('%I'), 'eq', '12'); # should test with < 10 -cmp_ok($t->strftime('%j'), '==', 60 ); # why ->yday+1 ? -cmp_ok($t->strftime('%M'), 'eq', '34'); # should test with < 10 - -# %p, %P, and %r are not widely implemented, -# and are possibly unportable (am or AM or a.m., and so on) - -SKIP: { - skip "can't strftime %R on Win32 or QNX", 1 if $is_win32 or $is_qnx; - cmp_ok($t->strftime('%R'), 'eq', '12:34'); # should test with > 12 -} - -ok($t->strftime('%S') eq '56'); # should test with < 10 - -SKIP: { - skip "can't strftime %T on Win32", 1 if $is_win32; - cmp_ok($t->strftime('%T'), 'eq', '12:34:56'); # < 12 and > 12 -} - -# There are bugs in the implementation of %u in many platforms. -# (e.g. Linux seems to think, despite the man page, that %u -# 1-based on Sunday...) - -cmp_ok($t->strftime('%U'), 'eq', '09'); # Sun cmp Mon - -SKIP: { - skip "can't strftime %V on Win32 or QNX", 1 if $is_win32 or $is_qnx; - # is this test really broken on Mac OS? -- rjbs, 2006-02-08 - cmp_ok($t->strftime('%V'), 'eq', '09'); # Sun cmp Mon -} - -cmp_ok($t->strftime('%w'), '==', 2); -cmp_ok($t->strftime('%W'), 'eq', '09'); # Sun cmp Mon - -# %x is locale and implementation dependent. - -cmp_ok($t->strftime('%y'), '==', 0); # should test with 1999 -cmp_ok($t->strftime('%Y'), 'eq', '2000'); - -# %Z is locale and implementation dependent -# (there is NO standard for timezone names) -cmp_ok($t->date(""), 'eq', '20000229'); -cmp_ok($t->ymd("") , 'eq', '20000229'); -cmp_ok($t->mdy("/"), 'eq', '02/29/2000'); -cmp_ok($t->dmy("."), 'eq', '29.02.2000'); -cmp_ok($t->date_separator, 'eq', '-'); - -$t->date_separator("/"); -cmp_ok($t->date_separator, 'eq', '/'); -cmp_ok($t->ymd, 'eq', '2000/02/29'); - -$t->date_separator("-"); -cmp_ok($t->time_separator, 'eq', ':'); -cmp_ok($t->hms("."), 'eq', '12.34.56'); - -$t->time_separator("."); -cmp_ok($t->time_separator, 'eq', '.'); -cmp_ok($t->hms, 'eq', '12.34.56'); - -$t->time_separator(":"); - -my @fidays = qw( sunnuntai maanantai tiistai keskiviikko torstai - perjantai lauantai ); -my @frdays = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi ); - -cmp_ok($t->day(@fidays), 'eq', "tiistai"); -my @days = $t->day_list(); - -$t->day_list(@frdays); - -cmp_ok($t->day, 'eq', "Merdi"); - -$t->day_list(@days); - -cmp_ok($t->day, 'eq', "Tue"); - -my @months = $t->mon_list(); - -my @dumonths = qw(januari februari maart april mei juni - juli augustus september oktober november december); - -cmp_ok($t->month(@dumonths), 'eq', "februari"); - -$t->mon_list(@dumonths); - -cmp_ok($t->month, 'eq', "februari"); - -$t->mon_list(@months); - -cmp_ok($t->month, 'eq', "Feb"); - -cmp_ok( - $t->datetime(date => '/', T => ' ', time => '-'), - 'eq', - "2000/02/29 12-34-56" -); - -ok($t->is_leap_year); # should test more with different dates - -cmp_ok($t->month_last_day, '==', 29); # test more - -ok(!Time::Piece::_is_leap_year(1900)); - -ok(!Time::Piece::_is_leap_year(1901)); - -ok(Time::Piece::_is_leap_year(1904)); - -cmp_ok(Time::Piece->strptime("1945", "%Y")->year, '==', 1945, "Year is 1945?"); - -cmp_ok(Time::Piece->strptime("13:00", "%H:%M")->hour, '==', 13, "Hour is 13?"); - -# Test week number -# [from Ilya Martynov] -cmp_ok(Time::Piece->strptime("2002/06/10 0", '%Y/%m/%d %H')->week, '==', 24); -cmp_ok(Time::Piece->strptime("2002/06/10 1", '%Y/%m/%d %H')->week, '==', 24); -cmp_ok(Time::Piece->strptime("2002/06/10 2", '%Y/%m/%d %H')->week, '==', 24); -cmp_ok(Time::Piece->strptime("2002/06/10 12", '%Y/%m/%d %H')->week, '==', 24); -cmp_ok(Time::Piece->strptime("2002/06/10 13", '%Y/%m/%d %H')->week, '==', 24); -cmp_ok(Time::Piece->strptime("2002/06/10 14", '%Y/%m/%d %H')->week, '==', 24); -cmp_ok(Time::Piece->strptime("2002/06/10 23", '%Y/%m/%d %H')->week, '==', 24); - -# Test that strptime populates all relevant fields -cmp_ok(Time::Piece->strptime("2002/07/10", '%Y/%m/%d')->wday, '==', 4); -cmp_ok(Time::Piece->strptime("2002/12/31", '%Y/%m/%d')->yday, '==', 364); -cmp_ok(Time::Piece->strptime("2002/07/10", '%Y/%m/%d')->isdst, '==', 0); -cmp_ok(Time::Piece->strptime("2002/07/10", '%Y/%m/%d')->day_of_week, '==', 3); - -cmp_ok( - Time::Piece->strptime("2000/02/29 12:34:56", '%Y/%m/%d %H:%M:%S')->epoch, - '==', - 951827696 -); diff --git a/ext/Time-Piece/t/03compare.t b/ext/Time-Piece/t/03compare.t deleted file mode 100644 index ccd8535829..0000000000 --- a/ext/Time-Piece/t/03compare.t +++ /dev/null @@ -1,19 +0,0 @@ -use Test; -BEGIN { plan tests => 5 } -use Time::Piece; - -my @t = ('2002-01-01 00:00', - '2002-01-01 01:20'); - -@t = map Time::Piece->strptime($_, '%Y-%m-%d %H:%M'), @t; - -ok($t[0] < $t[1]); - -ok($t[0] != $t[1]); - -ok($t[0] == $t[0]); - -ok($t[0] != $t[1]); - -ok($t[0] <= $t[1]); - diff --git a/ext/Time-Piece/t/04mjd.t b/ext/Time-Piece/t/04mjd.t deleted file mode 100644 index eae8e25cbb..0000000000 --- a/ext/Time-Piece/t/04mjd.t +++ /dev/null @@ -1,33 +0,0 @@ -use Test; -BEGIN { plan tests => 12 } -# Test the calculation of (modified) Julian date -use Time::Piece; - -# First a lookup table of epoch and MJD -# Use 3 sig fig in MJD (hence the use of strings) -# This will not work on systems that use a different reference -# epoch to unix time. To be more general we should use strptime -# to parse the reference date. -my %mjd = ( - 951827696 => '51603.524', # 2000-02-29T12:34:56UT - 1000011 => '40598.574', # 1970-01-12T13:46:51UT - 1021605703 => '52411.140', # 2002-05-17T03:21:43UT - 1121605703 => '53568.547', # 2005-07-17T13:08:23UT - 1011590000 => '52295.218', # 2002-01-21T05:13:20UT - 1011605703 => '52295.399', # 2002-01-21T09:35:03 - ); - -# Now loop over each MJD -for my $time (keys %mjd) { - - # First check using GMT - my $tp = gmtime( $time ); - ok(sprintf("%.3f",$tp->mjd),$mjd{$time}); - - # Now localtime should give the same answer for MJD - # since MJD is always referred to as UT - $tp = localtime( $time ); - ok(sprintf("%.3f",$tp->mjd),$mjd{$time}); - -} - diff --git a/ext/Time-Piece/t/05overload.t b/ext/Time-Piece/t/05overload.t deleted file mode 100644 index 674cc94efd..0000000000 --- a/ext/Time-Piece/t/05overload.t +++ /dev/null @@ -1,9 +0,0 @@ -# Tests for overloads (+,-,<,>, etc) -use Test; -BEGIN { plan tests => 1 } -use Time::Piece; -my $t = localtime; -my $s = Time::Seconds->new(15); -eval { my $result = $t + $s }; -ok($@, "", "Adding Time::Seconds does not cause runtime error"); - diff --git a/ext/Time-Piece/t/06subclass.t b/ext/Time-Piece/t/06subclass.t deleted file mode 100644 index dce097a29b..0000000000 --- a/ext/Time-Piece/t/06subclass.t +++ /dev/null @@ -1,66 +0,0 @@ -#!perl -use strict; -use warnings; - -# This test file exists to show that Time::Piece can be subclassed and that its -# methods will return objects of the class on which they're called. - -use Test::More 'no_plan'; - -BEGIN { use_ok('Time::Piece'); } - -my $class = 'Time::Piece::Twin'; - -for my $method (qw(new localtime gmtime)) { - my $piece = $class->$method; - isa_ok($piece, $class, "timepiece made via $method"); -} - -{ - my $piece = $class->strptime("2005-01-01", "%Y-%m-%d"); - isa_ok($piece, $class, "timepiece made via strptime"); -} - -{ - my $piece = $class->new; - isa_ok($piece, $class, "timepiece made via new (again)"); - - my $sum = $piece + 86_400; - isa_ok($sum, $class, "tomorrow via addition operator"); - - my $diff = $piece - 86_400; - isa_ok($diff, $class, "yesterday via subtraction operator"); -} - -{ - # let's verify that we can use gmtime from T::P without the export magic - my $piece = Time::Piece::gmtime; - isa_ok($piece, "Time::Piece", "object created via full-qualified gmtime"); - isnt(ref $piece, 'Time::Piece::Twin', "it's not a Twin"); -} - -## below is our doppelgaenger package -{ - package Time::Piece::Twin; - use base qw(Time::Piece); - # this package is identical, but will be ->isa('Time::Piece::Twin'); -} - -{ - my $class = "Time::Piece::NumString"; - my $piece = $class->strptime ("2006", "%Y"); - is (2007 - $piece, 1, - "subtract attempts stringify for unrecognized objects."); -} - -## Below is a package which only changes the stringify function. -{ - package Time::Piece::NumString; - use base qw(Time::Piece); - use overload '""' => \&_stringify; - sub _stringify - { - my $self = shift; - return $self->strftime ("%Y"); - } -} diff --git a/ext/Time-Piece/t/07arith.t b/ext/Time-Piece/t/07arith.t deleted file mode 100644 index c4836a96b8..0000000000 --- a/ext/Time-Piece/t/07arith.t +++ /dev/null @@ -1,26 +0,0 @@ -use Test::More tests => 13; - -BEGIN { use_ok('Time::Piece'); } - -ok(1); - -my $t = gmtime(951827696); # 2000-02-29T12:34:56 - -is($t->mon, 2); -is($t->mday, 29); - -my $t2 = $t->add_months(1); -is($t2->year, 2000); -is($t2->mon, 3); -is($t2->mday, 29); - -my $t3 = $t->add_months(-1); -is($t3->year, 2000); -is($t3->mon, 1); -is($t3->mday, 29); - -# this one wraps around to March because of the leap year -my $t4 = $t->add_years(1); -is($t4->year, 2001); -is($t4->mon, 3); -is($t4->mday, 1); |