From: Steve Peters Date: Sun, 26 Nov 2006 14:14:54 +0000 (+0000) Subject: Adding Time::Piece to the core...again. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=16433e2b386e8771fc6b72a9ee075e11f13d2705;p=p5sagit%2Fp5-mst-13.2.git Adding Time::Piece to the core...again. p4raw-id: //depot/perl@29383 --- diff --git a/MANIFEST b/MANIFEST index 1195c21..435b4ad 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1174,6 +1174,18 @@ ext/Time/HiRes/HiRes.xs Time::HiRes extension 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 diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 7a6cc4c..8944ca1 100644 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -41,6 +41,7 @@ package Maintainers; 'markm' => 'Mark Mielke ', 'mhx' => 'Marcus Holland-Moritz ', 'mjd' => 'Mark-Jason Dominus ', + 'msergeant' => 'Matt Sergeant '. 'mshelor' => 'Mark Shelor ', 'muir' => 'David Muir Sharnoff ', 'neilb' => 'Neil Bowers ', @@ -750,6 +751,13 @@ package Maintainers; 'CPAN' => 1, }, + 'Time::Piece' => + { + 'MAINTAINER' => 'msergeant', + 'FILES' => q[ext/Time/Piece], + 'CPAN' => 1, + }, + 'Unicode::Collate' => { 'MAINTAINER' => 'sadahiro', diff --git a/ext/Time/Piece/Changes b/ext/Time/Piece/Changes new file mode 100644 index 0000000..fcc0b1c --- /dev/null +++ b/ext/Time/Piece/Changes @@ -0,0 +1,53 @@ + +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()) + diff --git a/ext/Time/Piece/Makefile.PL b/ext/Time/Piece/Makefile.PL new file mode 100644 index 0000000..57e9ec2 --- /dev/null +++ b/ext/Time/Piece/Makefile.PL @@ -0,0 +1,11 @@ +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. +); diff --git a/ext/Time/Piece/Piece.pm b/ext/Time/Piece/Piece.pm new file mode 100644 index 0000000..b7e4327 --- /dev/null +++ b/ext/Time/Piece/Piece.pm @@ -0,0 +1,790 @@ +# $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 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 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 diff --git a/ext/Time/Piece/Piece.xs b/ext/Time/Piece/Piece.xs new file mode 100644 index 0000000..ad265d2 --- /dev/null +++ b/ext/Time/Piece/Piece.xs @@ -0,0 +1,927 @@ +#ifdef __cplusplus +#extern "C" { +#endif +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include +#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 +#include +#include +#ifdef _THREAD_SAFE +#include +#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))); diff --git a/ext/Time/Piece/README b/ext/Time/Piece/README new file mode 100644 index 0000000..b7713f9 --- /dev/null +++ b/ext/Time/Piece/README @@ -0,0 +1,39 @@ +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 new file mode 100644 index 0000000..abc1b2c --- /dev/null +++ b/ext/Time/Piece/Seconds.pm @@ -0,0 +1,230 @@ +# $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: Cminutes;> + +=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 new file mode 100644 index 0000000..530cd3d --- /dev/null +++ b/ext/Time/Piece/t/01base.t @@ -0,0 +1,19 @@ +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 new file mode 100644 index 0000000..68639d0 --- /dev/null +++ b/ext/Time/Piece/t/02core.t @@ -0,0 +1,202 @@ +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 +); diff --git a/ext/Time/Piece/t/03compare.t b/ext/Time/Piece/t/03compare.t new file mode 100644 index 0000000..ccd8535 --- /dev/null +++ b/ext/Time/Piece/t/03compare.t @@ -0,0 +1,19 @@ +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 new file mode 100644 index 0000000..eae8e25 --- /dev/null +++ b/ext/Time/Piece/t/04mjd.t @@ -0,0 +1,33 @@ +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 new file mode 100644 index 0000000..674cc94 --- /dev/null +++ b/ext/Time/Piece/t/05overload.t @@ -0,0 +1,9 @@ +# 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 new file mode 100644 index 0000000..0a729d6 --- /dev/null +++ b/ext/Time/Piece/t/06subclass.t @@ -0,0 +1,47 @@ +#!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'); +}