From 302d38aa06a9db991c3d8d4d4150b2d3e93e193b Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Thu, 19 Apr 2001 01:41:10 +0000 Subject: [PATCH] Add Time::Piece, a slight rewrite of Time::Object, from Matt Sergeant. p4raw-id: //depot/perl@9748 --- MANIFEST | 16 +- configure.com | 2 +- djgpp/config.over | 5 +- epoc/config.sh | 2 +- ext/Time/Piece/Makefile.PL | 6 + ext/Time/Piece/Piece.pm | 533 +++++++++++++++++++++++++++++++++++++++++++++ ext/Time/Piece/Piece.xs | 33 +++ ext/Time/Piece/README | 111 ++++++++++ ext/Time/Piece/Seconds.pm | 217 ++++++++++++++++++ hints/uts.sh | 2 +- hints/vmesa.sh | 4 +- t/lib/time-piece.t | 20 ++ win32/Makefile | 19 +- win32/makefile.mk | 4 +- 14 files changed, 959 insertions(+), 15 deletions(-) create mode 100644 ext/Time/Piece/Makefile.PL create mode 100644 ext/Time/Piece/Piece.pm create mode 100644 ext/Time/Piece/Piece.xs create mode 100644 ext/Time/Piece/README create mode 100644 ext/Time/Piece/Seconds.pm create mode 100644 t/lib/time-piece.t diff --git a/MANIFEST b/MANIFEST index d12e44e..1a4e26f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -491,10 +491,15 @@ ext/Thread/unsync.t Test thread implicit synchronisation ext/Thread/unsync2.t Test thread implicit synchronisation ext/Thread/unsync3.t Test thread implicit synchronisation ext/Thread/unsync4.t Test thread implicit synchronisation -ext/Time/HiRes/Changes Time::HiRes -ext/Time/HiRes/HiRes.pm Time::HiRes -ext/Time/HiRes/HiRes.xs Time::HiRes -ext/Time/HiRes/Makefile.PL Time::HiRes +ext/Time/HiRes/Changes Time::HiRes extension +ext/Time/HiRes/HiRes.pm Time::HiRes extension +ext/Time/HiRes/HiRes.xs Time::HiRes extension +ext/Time/HiRes/Makefile.PL Time::HiRes 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/XS/Typemap/Makefile.PL XS::Typemap extension ext/XS/Typemap/README XS::Typemap extension ext/XS/Typemap/Typemap.pm XS::Typemap extension @@ -1612,7 +1617,8 @@ t/lib/tie-stdarray.t Test for Tie::StdArray t/lib/tie-stdhandle.t Test for Tie::StdHandle t/lib/tie-stdpush.t Test for Tie::StdArray t/lib/tie-substrhash.t Test for Tie::SubstrHash -t/lib/time-hires.t Time::HiRes +t/lib/time-hires.t Test for Time::HiRes +t/lib/time-piece.t Test for Time::Piece t/lib/timelocal.t See if Time::Local works t/lib/trig.t See if Math::Trig works t/lib/u-blessed.t Scalar::Util diff --git a/configure.com b/configure.com index ff86731..2aa9541 100644 --- a/configure.com +++ b/configure.com @@ -2396,7 +2396,7 @@ $ echo "SDBM_File if you have the GDBM library built on your machine." $ echo "" $ echo "Which modules do you want to build into perl?" $! we need to add Byteloader to this list: -$ dflt = "re Fcntl Encode Errno File::Glob Filter::Util::Call IO Opcode Devel::Peek Devel::DProf Data::Dumper attrs VMS::Stdio VMS::DCLsym B SDBM_File Storable Thread Sys::Hostname Digest::MD5 PerlIO::Scalar MIME::Base64 XS::Typemap Time::HiRes" +$ dflt = "B Data::Dumper Devel::DProf Devel::Peek Digest::MD5 Encode Errno Fcntl File::Glob Filter::Util::Call IO List::Util MIME::Base64 Opcode PerlIO::Scalar SDBM_File Storable Sys::Hostname Thread Time::HiRes Time::Piece VMS::DCLsym VMS::Stdio XS::Typemap attrs re" $ IF ccname .EQS. "DEC" .OR. ccname .EQS. "CXX" $ THEN $ dflt = dflt + " POSIX" diff --git a/djgpp/config.over b/djgpp/config.over index f6e77f8..9e66eef 100644 --- a/djgpp/config.over +++ b/djgpp/config.over @@ -40,7 +40,10 @@ repair() -e 's=filter/util/call=Filter/Util/Call=' \ -e 's=digest/md5=Digest/MD5=' \ -e 's=perlio/scalar=PerlIO/Scalar=' \ - -e 's=mime/base64=MIME/Base64=' + -e 's=mime/base64=MIME/Base64=' \ + -e 's=time/hires=Time/HiRes=' + -e 's=list/util=List/Util=' \ + -e 's=time/piece=Time/Piece=' } static_ext=$(repair "$static_ext") extensions=$(repair "$extensions") diff --git a/epoc/config.sh b/epoc/config.sh index 0b5fa90..a030a67 100644 --- a/epoc/config.sh +++ b/epoc/config.sh @@ -406,7 +406,7 @@ emacs='' eunicefix=':' exe_ext='' expr='expr' -extensions='Data/Dumper Digest/MD5 Errno Fcntl File/Glob Filter::Util::Call IO MIME::Base64 Opcode PerlIO::Scalar Socket Storable Sys/Hostname attrs re' +extensions='Data/Dumper Digest/MD5 Errno Fcntl File/Glob Filter/Util/Call IO List/Util MIME/Base64 Opcode PerlIO/Scalar Socket Storable Sys/Hostname Time/Piece attrs re' fflushNULL='undef' fflushall='define' find='' diff --git a/ext/Time/Piece/Makefile.PL b/ext/Time/Piece/Makefile.PL new file mode 100644 index 0000000..4aeb77d --- /dev/null +++ b/ext/Time/Piece/Makefile.PL @@ -0,0 +1,6 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + 'NAME' => 'Time::Piece', + 'VERSION_FROM' => 'Piece.pm', +); diff --git a/ext/Time/Piece/Piece.pm b/ext/Time/Piece/Piece.pm new file mode 100644 index 0000000..4da2707 --- /dev/null +++ b/ext/Time/Piece/Piece.pm @@ -0,0 +1,533 @@ +package Time::Piece; + +use strict; +use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS); + +require Exporter; +require DynaLoader; +use Time::Seconds; +use Carp; +use UNIVERSAL; + +@ISA = qw(Exporter DynaLoader); + +@EXPORT = qw( + localtime + gmtime +); + +%EXPORT_TAGS = ( + ':override' => 'internal', + ); + +$VERSION = '0.13'; + +bootstrap Time::Piece $VERSION; + +my $DATE_SEP = '-'; +my $TIME_SEP = ':'; +my @MON_LIST; +my @DAY_LIST; + +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 { + my $time = shift; + $time = time if (!defined $time); + _mktime($time, 1); +} + +sub gmtime { + my $time = shift; + $time = time if (!defined $time); + _mktime($time, 0); +} + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $time = shift; + + my $self; + + if (defined($time)) { + $self = &localtime($time); + } + elsif (ref($proto) && $proto->isa('Time::Piece')) { + $self = _mktime($proto->[c_epoch], $proto->[c_islocal]); + } + else { + $self = &localtime(); + } + + return bless $self, $class; +} + +sub _mktime { + my ($time, $islocal) = @_; + my @time = $islocal ? + CORE::localtime($time) + : + CORE::gmtime($time); + wantarray ? @time : bless [@time, $time, $islocal], 'Time::Piece'; +} + +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 = \&minute; + +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'); + } +} + +sub year { + my $time = shift; + $time->[c_year] + 1900; +} + +sub _year { + my $time = shift; + $time->[c_year]; +} + +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 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; + + my $epoch = $time->[c_epoch]; + + my $j = sub { # Tweaked Julian day number algorithm. + + my ($s,$n,$h,$d,$m,$y) = @_; $m += 1; $y += 1900; + + # Standard Julian day number algorithm without constant. + # + my $y1 = $m > 2 ? $y : $y - 1; + + my $m1 = $m > 2 ? $m + 1 : $m + 13; + + my $day = int(365.25 * $y1) + int(30.6001 * $m1) + $d; + + # Modify to include hours/mins/secs in floating portion. + # + return $day + ($h + ($n + $s / 60) / 60) / 24; + }; + + # 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; + $time->[c_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 $dsep = shift || $DATE_SEP; + my $tsep = shift || $TIME_SEP; + return join('T', $time->date($dsep), $time->time($tsep)); +} + +# taken from Time::JulianDay +sub julian_day { + my $time = shift; + my ($year, $month, $day) = ($time->year, $time->mon, $time->mday); + my ($tmp, $secs); + + $tmp = $day - 32075 + + 1461 * ( $year + 4800 - ( 14 - $month ) / 12 )/4 + + 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12 + - 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4 + ; + + return $tmp; +} + +# Hi Mark Jason! +sub mjd { + # taken from the Calendar FAQ + return shift->julian_day - 2_400_000.5; +} + +sub strftime { + my $time = shift; + my $format = shift || "%a, %d %b %Y %H:%M:%S %Z"; + return _strftime($format, (@$time)[c_sec..c_isdst]); +} + +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; + +sub cdate { + my $time = shift; + if ($time->[c_islocal]) { + return scalar(CORE::localtime($time->[c_epoch])); + } + else { + return scalar(CORE::gmtime($time->[c_epoch])); + } +} + +use overload + '-' => \&subtract, + '+' => \&add; + +sub subtract { + my $time = shift; + my $rhs = shift; + die "Can't subtract a date from something!" if shift; + + if (ref($rhs) && $rhs->isa('Time::Piece')) { + return Time::Seconds->new($time->[c_epoch] - $rhs->epoch); + } + else { + # rhs is seconds. + return _mktime(($time->[c_epoch] - $rhs), $time->[c_islocal]); + } +} + +sub add { + warn "add\n"; + my $time = shift; + my $rhs = shift; + croak "Invalid rhs of addition: $rhs" if ref($rhs); + + return _mktime(($time->[c_epoch] + $rhs), $time->[c_islocal]); +} + +use overload + '<=>' => \&compare; + +sub get_epochs { + my ($time, $rhs, $reverse) = @_; + $time = $time->epoch; + if (UNIVERSAL::isa($rhs, 'Time::Piece')) { + $rhs = $rhs->epoch; + } + if ($reverse) { + return $rhs, $time; + } + return $time, $rhs; +} + +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 + $t->mday # also available as $t->day_of_month + $t->mon # based at 1 + $t->_mon # based at 0 + $t->monname # February + $t->month # same as $t->monname + $t->year # based at 0 (year 0 AD is, of course 1 BC). + $t->_year # year minus 1900 + $t->wday # based at 1 = Sunday + $t->_wday # based at 0 = Sunday + $t->day_of_week # based at 0 = Sunday + $t->wdayname # Tuesday + $t->day # same as wdayname + $t->yday # also available as $t->day_of_year + $t->isdst # also available as $t->daylight_savings + $t->hms # 01:23:45 + $t->time # same as $t->hms + $t->ymd # 2000-02-29 + $t->date # same as $t->ymd + $t->mdy # 02-29-2000 + $t->dmy # 29-02-2000 + $t->cdate # Tue Feb 29 01:23:45 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 calendar began + $t->mjd # modified julian day + $t->strftime(FORMAT) # same as POSIX::strftime (without POSIX.pm) + +=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 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 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 + +This module is based on Time::Piece, with changes suggested by Jarkko +Hietaniemi before including in core perl. + +=head2 License + +This module is free software, you may distribute it under the same terms +as Perl. + +=head2 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..403dccd --- /dev/null +++ b/ext/Time/Piece/Piece.xs @@ -0,0 +1,33 @@ +#ifdef __cplusplus +#extern "C" { +#endif +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include +#ifdef __cplusplus +} +#endif + +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 *buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst); + ST(0) = sv_2mortal(newSVpv(buf, 0)); + free(buf); + } diff --git a/ext/Time/Piece/README b/ext/Time/Piece/README new file mode 100644 index 0000000..a9ef44c --- /dev/null +++ b/ext/Time/Piece/README @@ -0,0 +1,111 @@ +NAME + Time::Object - Object Oriented time objects + +SYNOPSIS + use Time::Object; + + my $t = localtime; + print "Time is $t\n"; + print "Year is ", $t->year, "\n"; + +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 + +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::Object 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::Object 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 + $t->mday # also available as $t->day_of_month + $t->mon # based at 1 + $t->_mon # based at 0 + $t->monname # February + $t->month # same as $t->monname + $t->year # based at 0 (year 0 AD is, of course 1 BC). + $t->_year # year minus 1900 + $t->yr # 2 digit year + $t->wday # based at 1 = Sunday + $t->_wday # based at 0 = Sunday + $t->day_of_week # based at 0 = Sunday + $t->wdayname # Tuesday + $t->day # same as wdayname + $t->yday # also available as $t->day_of_year + $t->isdst # also available as $t->daylight_savings + $t->hms # 01:23:45 + $t->ymd # 2000/02/29 + $t->mdy # 02/29/2000 + $t->dmy # 29/02/2000 + $t->date # Tue Feb 29 01:23:45 2000 + "$t" # same as $t->date + $t->epoch # seconds since the epoch + $t->tzoffset # timezone offset in a Time::Seconds object + $t->strftime(FORMAT) # same as POSIX::strftime (without POSIX.pm) + + 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::Object objects): + + $t1 - $t2; # returns Time::Seconds object + $t1 - 42; # returns Time::Object object + $t1 + 533; # returns Time::Object object + + However adding a Time::Object object to another Time::Object + 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. + + Date Comparisons + + Date comparisons are also possible, using the full suite of "<", + ">", "<=", ">=", "<=>", "==" and "!=". + + Global Overriding + + Finally, it's possible to override localtime and gmtime + everywhere, by including the 'overrideGlobally' tag in the + import list: + + use Time::Object 'overrideGlobally'; + + I'm not too keen on this name yet - suggestions welcome... + +AUTHOR + Matt Sergeant, matt@sergeant.org + + License + + This module is free software, you may distribute it under the + same terms as Perl. + + Bugs + + The test harness leaves much to be desired. Patches welcome. + diff --git a/ext/Time/Piece/Seconds.pm b/ext/Time/Piece/Seconds.pm new file mode 100644 index 0000000..7544915 --- /dev/null +++ b/ext/Time/Piece/Seconds.pm @@ -0,0 +1,217 @@ +package Time::Seconds; +use strict; +use vars qw/@EXPORT @ISA/; + +@ISA = 'Exporter'; + +@EXPORT = qw( + ONE_MINUTE + ONE_HOUR + ONE_DAY + ONE_WEEK + ONE_MONTH + ONE_YEAR + ONE_FINANCIAL_MONTH + LEAP_YEAR + NON_LEAP_YEAR + ); + +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_YEAR => 31_556_930; # 365.24225 days +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 + +use overload + '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; + $$s; +} + +sub minutes { + my $s = shift; + $$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; +} + +*f_months = \&financial_months; + +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 + +=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/hints/uts.sh b/hints/uts.sh index 45363e8..5882e2b 100644 --- a/hints/uts.sh +++ b/hints/uts.sh @@ -14,5 +14,5 @@ libs='-lsocket -lnsl -ldl -lm' optimize='undef' prefix='psf_prefix' static_ext='none' -dynamic_ext='Data/Dumper Digest/MD5 Errno Fcntl Filter::Util::Call GDBM_File IO MIME::Base64 Opcode PerlIO::Scalar POSIX Socket Storable Time::HiRes attrs re' +dynamic_ext='Data/Dumper Digest/MD5 Errno Fcntl Filter/Util/Call GDBM_File IO List/Util MIME/Base64 Opcode PerlIO/Scalar POSIX Socket Storable Time/HiRes Time/Piece attrs re' useshrplib='define' diff --git a/hints/vmesa.sh b/hints/vmesa.sh index 9e7b87a..a36babd 100644 --- a/hints/vmesa.sh +++ b/hints/vmesa.sh @@ -218,7 +218,7 @@ dynamic_ext='' eagain='EAGAIN' ebcdic='define' exe_ext='' -extensions='Data/Dumper Digest/MD5 Errno Fcntl Filter::Util:Call GDBM_File IO IPC/SysV MIME::Base64 NDBM_File Opcode PerlIO::Scalar POSIX Socket Storable Time::HiRes Thread attrs re' +extensions='Data/Dumper Digest/MD5 Errno Fcntl Filter/Util/Call GDBM_File IO IPC/SysV List/Util MIME/Base64 NDBM_File Opcode PerlIO/Scalar POSIX Socket Storable Time/HiRes Time/Piece Thread attrs re' fpostype='fpos_t' freetype='void' groupstype='gid_t' @@ -317,7 +317,7 @@ sig_num_init='0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,2 sizetype='size_t' so='.a' ssizetype='ssize_t' -static_ext='Data/Dumper Digest/MD5 Fcntl Filter::Util::Call GDBM_File IO IPC/SysV MIME::Base64 NDBM_File Opcode PerlIO::Scalar POSIX Socket Storable Thread attrs re' +static_ext='Data/Dumper Digest/MD5 Fcntl Filter/Util/Call GDBM_File IO IPC/SysV List/Util MIME/Base64 NDBM_File Opcode PerlIO/Scalar POSIX Socket Storable Thread Time/HiRes Time/Piece attrs re' stdchar='char' stdio_cnt='(fp)->__countIn' stdio_ptr='(fp)->__bufPtr' diff --git a/t/lib/time-piece.t b/t/lib/time-piece.t new file mode 100644 index 0000000..37cc7d0 --- /dev/null +++ b/t/lib/time-piece.t @@ -0,0 +1,20 @@ +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +print "1..4\n"; + +use Time::Piece; +print "ok 1\n"; + +my $t = gmtime(315532800); # 00:00:00 1/1/1980 + +print "not " unless $t->year == 1980; +print "ok 2\n"; + +print "not " unless $t->hour == 0; +print "ok 3\n"; + +print "not " unless $t->mon == 1; +print "ok 4\n"; diff --git a/win32/Makefile b/win32/Makefile index ebd8d45..1f846d2 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -609,7 +609,7 @@ SETARGV_OBJ = setargv$(o) DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \ Sys/Hostname Storable Filter/Util/Call Encode Digest/MD5 \ - PerlIO/Scalar MIME/Base64 Time/HiRes + PerlIO/Scalar MIME/Base64 Time/HiRes Time/Piece STATIC_EXT = DynaLoader NONXS_EXT = Errno @@ -638,6 +638,7 @@ MD5 = $(EXTDIR)\Digest\MD5\MD5 PERLIOSCALAR = $(EXTDIR)\PerlIO\Scalar\Scalar MIMEBASE64 = $(EXTDIR)\MIME\Base64\Base64 TIMEHIRES = $(EXTDIR)\Time\HiRes\HiRes +TIMEPIECE = $(EXTDIR)\Time\Piece\Piece SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll @@ -662,6 +663,7 @@ MD5_DLL = $(AUTODIR)\Digest\MD5\MD5.dll PERLIOSCALAR_DLL= $(AUTODIR)\PerlIO\Scalar\Scalar.dll MIMEBASE64_DLL = $(AUTODIR)\MIME\Base64\Base64.dll TIMEHIRES_DLL = $(AUTODIR)\Time\HiRes\HiRes.dll +TIMEPIECE_DLL = $(AUTODIR)\Time\Piece\Piece.dll ERRNO_PM = $(LIBDIR)\Errno.pm @@ -688,7 +690,8 @@ EXTENSION_C = \ $(MD5).c \ $(PERLIOSCALAR).c \ $(MIMEBASE64).c \ - $(TIMEHIRES).c + $(TIMEHIRES).c \ + $(TIMEPIECE).c EXTENSION_DLL = \ $(SOCKET_DLL) \ @@ -713,7 +716,8 @@ EXTENSION_DLL = \ $(MD5_DLL) \ $(PERLIOSCALAR_DLL) \ $(MIMEBASE64_DLL) \ - $(TIMEHIRES_DLL) + $(TIMEHIRES_DLL) \ + $(TIMEPIECE_DLL) EXTENSION_PM = \ $(ERRNO_PM) @@ -1039,6 +1043,12 @@ $(TIMEHIRES_DLL): $(PERLEXE) $(TIMEHIRES).xs $(MAKE) cd ..\..\win32 +$(TIMEPIECE_DLL): $(PERLEXE) $(TIMEPIECE).xs + cd $(EXTDIR)\$(*B) + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) + cd ..\..\win32 + $(ERRNO_PM): $(PERLEXE) $(ERRNO)_pm.PL cd $(EXTDIR)\$(*B) ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl @@ -1100,6 +1110,7 @@ distclean: clean -del /f $(LIBDIR)\MIME\Base64\Base64.pm -del /f $(LIBDIR)\MIME\Base64\QuotedPrint.pm -del /f $(LIBDIR)\Time\HiRes\HiRes.pm + -del /f $(LIBDIR)\Time\Piece\Piece.pm -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO -rmdir /s $(LIBDIR)\IO -if exist $(LIBDIR)\Thread rmdir /s /q $(LIBDIR)\Thread @@ -1120,6 +1131,8 @@ distclean: clean -rmdir /s $(LIBDIR)\MIME -if exist $(LIBDIR)\Time\HiRes rmdir /s /q $(LIBDIR)\Time\HiRes -rmdir /s $(LIBDIR)\Time\HiRes + -if exist $(LIBDIR)\Time\Piece rmdir /s /q $(LIBDIR)\Time\Piece + -rmdir /s $(LIBDIR)\Time\Piece cd $(PODDIR) -del /f *.html *.bat checkpods \ perlaix.pod perlamiga.pod perlbs2000.pod perlcygwin.pod \ diff --git a/win32/makefile.mk b/win32/makefile.mk index 6586fc6..4791169 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -764,7 +764,7 @@ SETARGV_OBJ = setargv$(o) DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \ Sys/Hostname Storable Filter/Util/Call Encode \ - Digest/MD5 PerlIO/Scalar MIME/Base64 Time/HiRes + Digest/MD5 PerlIO/Scalar MIME/Base64 Time/HiRes Time/Piece STATIC_EXT = DynaLoader NONXS_EXT = Errno @@ -1123,6 +1123,7 @@ distclean: clean -del /f $(LIBDIR)\MIME\Base64\Base64.pm -del /f $(LIBDIR)\MIME\Base64\QuotedPrint.pm -del /f $(LIBDIR)\Time\HiRes\HiRes.pm + -del /f $(LIBDIR)\Time\Piece\Piece.pm -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO || rmdir /s $(LIBDIR)\IO -if exist $(LIBDIR)\Thread rmdir /s /q $(LIBDIR)\Thread || rmdir /s $(LIBDIR)\Thread -if exist $(LIBDIR)\B rmdir /s /q $(LIBDIR)\B || rmdir /s $(LIBDIR)\B @@ -1134,6 +1135,7 @@ distclean: clean -if exist $(LIBDIR)\MIME\Base64 rmdir /s /q $(LIBDIR)\MIME\Base64 || rmdir /s $(LIBDIR)\MIME\Base64 -if exist $(LIBDIR)\MIME rmdir /s /q $(LIBDIR)\MIME || rmdir /s $(LIBDIR)\MIME -if exist $(LIBDIR)\Time\HiRes rmdir /s /q $(LIBDIR)\Time\HiRes || rmdir /s $(LIBDIR)\Time\HiRes + -if exist $(LIBDIR)\Time\Piece rmdir /s /q $(LIBDIR)\Time\Piece || rmdir /s $(LIBDIR)\Time\Piece -cd $(PODDIR) && del /f *.html *.bat checkpods \ perlaix.pod perlamiga.pod perlbs2000.pod perlcygwin.pod \ perldos.pod perlepoc.pod perlhpux.pod perlmachten.pod \ -- 2.7.4