from Matt Sergeant.
p4raw-id: //depot/perl@9748
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
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
$ 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"
-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")
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=''
--- /dev/null
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'Time::Piece',
+ 'VERSION_FROM' => 'Piece.pm',
+);
--- /dev/null
+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 <olekshy@cs.ualberta.ca> 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
--- /dev/null
+#ifdef __cplusplus
+#extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <time.h>
+#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);
+ }
--- /dev/null
+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.
+
--- /dev/null
+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: C<print
+ONE_WEEK-E<gt>minutes;>
+
+=head1 METHODS
+
+The following methods are available:
+
+ my $val = Time::Seconds->new(SECONDS)
+ $val->seconds;
+ $val->minutes;
+ $val->hours;
+ $val->days;
+ $val->weeks;
+ $val->months;
+ $val->financial_months; # 30 days
+ $val->years;
+
+The methods make the assumption that there are 24 hours in a day, 7 days in
+a week, 365.24225 days in a year and 12 months in a year.
+(from The Calendar FAQ at http://www.tondering.dk/claus/calendar.html)
+
+=head1 AUTHOR
+
+Matt Sergeant, matt@sergeant.org
+
+Tobias Brox, tobiasb@tobiasb.funcom.com
+
+=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
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'
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'
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'
--- /dev/null
+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";
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
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
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
$(MD5).c \
$(PERLIOSCALAR).c \
$(MIMEBASE64).c \
- $(TIMEHIRES).c
+ $(TIMEHIRES).c \
+ $(TIMEPIECE).c
EXTENSION_DLL = \
$(SOCKET_DLL) \
$(MD5_DLL) \
$(PERLIOSCALAR_DLL) \
$(MIMEBASE64_DLL) \
- $(TIMEHIRES_DLL)
+ $(TIMEHIRES_DLL) \
+ $(TIMEPIECE_DLL)
EXTENSION_PM = \
$(ERRNO_PM)
$(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
-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)\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 \
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
-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
-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 \
projects / p5sagit/p5-mst-13.2.git / commitdiff