ext/Time/HiRes/Makefile.PL Time::HiRes extension
ext/Time/HiRes/t/HiRes.t Test for Time::HiRes
ext/Time/HiRes/typemap Time::HiRes extension
+ext/Time/Piece/Changes Time::Piece extension
+ext/Time/Piece/Makefile.PL Time::Piece extension
+ext/Time/Piece/Piece.pm Time::Piece extension
+ext/Time/Piece/Piece.xs Time::Piece extension
+ext/Time/Piece/README Time::Piece extension
+ext/Time/Piece/Seconds.pm Time::Piece extension
+ext/Time/Piece/t/01base.t Test for Time::Piece
+ext/Time/Piece/t/02core.t Test for Time::Piece
+ext/Time/Piece/t/03compare.t Test for Time::Piece
+ext/Time/Piece/t/04mjd.t Test for Time::Piece
+ext/Time/Piece/t/05overload.t Test for Time::Piece
+ext/Time/Piece/t/06subclass.t Test for Time::Piece
ext/Unicode/Normalize/Changes Unicode::Normalize
ext/Unicode/Normalize/Makefile.PL Unicode::Normalize
ext/Unicode/Normalize/mkheader Unicode::Normalize
'markm' => 'Mark Mielke <markm@cpan.org>',
'mhx' => 'Marcus Holland-Moritz <mhx@cpan.org>',
'mjd' => 'Mark-Jason Dominus <mjd@plover.com>',
+ 'msergeant' => 'Matt Sergeant <msergeant@cpan.org>'.
'mshelor' => 'Mark Shelor <mshelor@cpan.org>',
'muir' => 'David Muir Sharnoff <muir@cpan.org>',
'neilb' => 'Neil Bowers <neilb@cpan.org>',
'CPAN' => 1,
},
+ 'Time::Piece' =>
+ {
+ 'MAINTAINER' => 'msergeant',
+ 'FILES' => q[ext/Time/Piece],
+ 'CPAN' => 1,
+ },
+
'Unicode::Collate' =>
{
'MAINTAINER' => 'sadahiro',
--- /dev/null
+
+Time::Piece Changes
+
+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())
+
--- /dev/null
+use ExtUtils::MakeMaker;
+
+require 5.006;
+
+WriteMakefile(
+ 'NAME' => 'Time::Piece',
+ 'VERSION_FROM' => 'Piece.pm', # finds $VERSION
+ 'AUTHOR' => 'Matt Sergeant',
+ 'ABSTRACT_FROM' => 'Piece.pm',
+ 'MAN3PODS' => {}, # Pods will be built by installman.
+);
--- /dev/null
+# $Id: Piece.pm 70 2006-09-07 17:43:38Z 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.11';
+
+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;
+ }
+ die "Can't subtract a date from something!" if shift;
+
+ 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;
+}
+
+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.
+
+=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 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
--- /dev/null
+#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 yet:
+ * 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 temporary workaround to be removed once Configure
+ * support is added and NETaa14816 is considered in full.
+ * It does not address tzname aspects of NETaa14816.
+ */
+#if !defined(HAS_GNULIBC)
+# ifndef STRUCT_TM_HASZONE
+# define STRUCT_TM_HASZONE
+# else
+# define USE_TM_GMTOFF
+# endif
+#endif
+
+#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 */
+
+#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
+
+/*
+ * my_mini_mktime - normalise struct tm values without the localtime()
+ * semantics (and overhead) of mktime().
+ */
+static void
+my_mini_mktime(struct tm *ptm)
+{
+ int yearday;
+ int secs;
+ int month, mday, year, jday;
+ int odd_cent, odd_year;
+
+/*
+ * Year/day algorithm notes:
+ *
+ * With a suitable offset for numeric value of the month, one can find
+ * an offset into the year by considering months to have 30.6 (153/5) days,
+ * using integer arithmetic (i.e., with truncation). To avoid too much
+ * messing about with leap days, we consider January and February to be
+ * the 13th and 14th month of the previous year. After that transformation,
+ * we need the month index we use to be high by 1 from 'normal human' usage,
+ * so the month index values we use run from 4 through 15.
+ *
+ * Given that, and the rules for the Gregorian calendar (leap years are those
+ * divisible by 4 unless also divisible by 100, when they must be divisible
+ * by 400 instead), we can simply calculate the number of days since some
+ * arbitrary 'beginning of time' by futzing with the (adjusted) year number,
+ * the days we derive from our month index, and adding in the day of the
+ * month. The value used here is not adjusted for the actual origin which
+ * it normally would use (1 January A.D. 1), since we're not exposing it.
+ * We're only building the value so we can turn around and get the
+ * normalised values for the year, month, day-of-month, and day-of-year.
+ *
+ * For going backward, we need to bias the value we're using so that we find
+ * the right year value. (Basically, we don't want the contribution of
+ * March 1st to the number to apply while deriving the year). Having done
+ * that, we 'count up' the contribution to the year number by accounting for
+ * full quadracenturies (400-year periods) with their extra leap days, plus
+ * the contribution from full centuries (to avoid counting in the lost leap
+ * days), plus the contribution from full quad-years (to count in the normal
+ * leap days), plus the leftover contribution from any non-leap years.
+ * At this point, if we were working with an actual leap day, we'll have 0
+ * days left over. This is also true for March 1st, however. So, we have
+ * to special-case that result, and (earlier) keep track of the 'odd'
+ * century and year contributions. If we got 4 extra centuries in a qcent,
+ * or 4 extra years in a qyear, then it's a leap day and we call it 29 Feb.
+ * Otherwise, we add back in the earlier bias we removed (the 123 from
+ * figuring in March 1st), find the month index (integer division by 30.6),
+ * and the remainder is the day-of-month. We then have to convert back to
+ * 'real' months (including fixing January and February from being 14/15 in
+ * the previous year to being in the proper year). After that, to get
+ * tm_yday, we work with the normalised year and get a new yearday value for
+ * January 1st, which we subtract from the yearday value we had earlier,
+ * representing the date we've re-built. This is done from January 1
+ * because tm_yday is 0-origin.
+ *
+ * Since POSIX time routines are only guaranteed to work for times since the
+ * UNIX epoch (00:00:00 1 Jan 1970 UTC), the fact that this algorithm
+ * applies Gregorian calendar rules even to dates before the 16th century
+ * doesn't bother me. Besides, you'd need cultural context for a given
+ * date to know whether it was Julian or Gregorian calendar, and that's
+ * outside the scope for this routine. Since we convert back based on the
+ * same rules we used to build the yearday, you'll only get strange results
+ * for input which needed normalising, or for the 'odd' century years which
+ * were leap years in the Julian calander but not in the Gregorian one.
+ * I can live with that.
+ *
+ * This algorithm also fails to handle years before A.D. 1 gracefully, but
+ * that's still outside the scope for POSIX time manipulation, so I don't
+ * care.
+ */
+
+ 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;
+}
+
+#if defined(WIN32) /* No strptime on Win32 */
+#define strncasecmp(x,y,n) strnicmp(x,y,n)
+#define alloca _alloca
+#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(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(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(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(buf, "%a %Ef %T %Y", tm);
+ if (buf == 0)
+ return 0;
+ break;
+
+ case 'D':
+ buf = _strptime(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(buf, (c == 'f') ? Locale->Ef_fmt : Locale->EF_fmt, tm);
+ if (buf == 0)
+ return 0;
+ break;
+
+ case 'R':
+ buf = _strptime(buf, "%H:%M", tm);
+ if (buf == 0)
+ return 0;
+ break;
+
+ case 'r':
+ buf = _strptime(buf, "%I:%M:%S %p", tm);
+ if (buf == 0)
+ return 0;
+ break;
+
+ case 'T':
+ buf = _strptime(buf, "%H:%M:%S", tm);
+ if (buf == 0)
+ return 0;
+ break;
+
+ case 'X':
+ buf = _strptime(buf, Locale->X_fmt, tm);
+ if (buf == 0)
+ return 0;
+ break;
+
+ case 'x':
+ buf = _strptime(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 = alloca(cp - buf + 1);
+ strncpy(zonestr, buf, cp - buf);
+ zonestr[cp - buf] = '\0';
+ tzset();
+ if (0 == strcmp(zonestr, "GMT")) {
+ got_GMT = 1;
+ } else {
+ return 0;
+ }
+ buf += cp - buf;
+ }
+ }
+ break;
+ }
+ }
+ return (char *)buf;
+}
+
+
+char *
+strptime(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(buf, fmt, tm);
+
+#ifdef _THREAD_SAFE
+ pthread_mutex_unlock(&gotgmt_mutex);
+#endif
+
+ return ret;
+}
+
+#endif /* Mac OS X */
+
+MODULE = Time::Piece PACKAGE = Time::Piece
+
+PROTOTYPES: ENABLE
+
+char *
+_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:
+ tzset();
+
+
+void
+_strptime ( string, format )
+ char * string
+ char * format
+ PREINIT:
+ char tmpbuf[128];
+ struct tm mytm;
+ time_t t;
+ char * remainder;
+ int len;
+ int tzdiff;
+ PPCODE:
+ t = 0;
+ mytm = *gmtime(&t);
+
+ remainder = (char *)strptime(string, format, &mytm);
+
+ 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)));
--- /dev/null
+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 :-)
+
--- /dev/null
+# $Id: Seconds.pm 69 2006-09-07 17:41:05Z 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
--- /dev/null
+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');
--- /dev/null
+use Test::More tests => 93;
+
+my $is_win32 = ($^O =~ /Win32/);
+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?
+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", 2 if $is_win32;
+ cmp_ok($t->strftime('%D'), 'eq', '02/29/00'); # Yech!
+ 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", 1 if $is_win32;
+ 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", 1 if $is_win32;
+ # 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
+);
--- /dev/null
+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]);
+
--- /dev/null
+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});
+
+}
+
--- /dev/null
+# 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");
+
--- /dev/null
+#!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');
+}
projects / p5sagit/p5-mst-13.2.git / commitdiff