Add Time::Piece, a slight rewrite of Time::Object,
Jarkko Hietaniemi [Thu, 19 Apr 2001 01:41:10 +0000 (01:41 +0000)]
from Matt Sergeant.

p4raw-id: //depot/perl@9748

14 files changed:
MANIFEST
configure.com
djgpp/config.over
epoc/config.sh
ext/Time/Piece/Makefile.PL [new file with mode: 0644]
ext/Time/Piece/Piece.pm [new file with mode: 0644]
ext/Time/Piece/Piece.xs [new file with mode: 0644]
ext/Time/Piece/README [new file with mode: 0644]
ext/Time/Piece/Seconds.pm [new file with mode: 0644]
hints/uts.sh
hints/vmesa.sh
t/lib/time-piece.t [new file with mode: 0644]
win32/Makefile
win32/makefile.mk

index d12e44e..1a4e26f 100644 (file)
--- 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
index ff86731..2aa9541 100644 (file)
@@ -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"
index f6e77f8..9e66eef 100644 (file)
@@ -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")
index 0b5fa90..a030a67 100644 (file)
@@ -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 (file)
index 0000000..4aeb77d
--- /dev/null
@@ -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 (file)
index 0000000..4da2707
--- /dev/null
@@ -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 <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
diff --git a/ext/Time/Piece/Piece.xs b/ext/Time/Piece/Piece.xs
new file mode 100644 (file)
index 0000000..403dccd
--- /dev/null
@@ -0,0 +1,33 @@
+#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);
+       }
diff --git a/ext/Time/Piece/README b/ext/Time/Piece/README
new file mode 100644 (file)
index 0000000..a9ef44c
--- /dev/null
@@ -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 (file)
index 0000000..7544915
--- /dev/null
@@ -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,
+               '=' => \&copy;
+
+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
index 45363e8..5882e2b 100644 (file)
@@ -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'  
index 9e7b87a..a36babd 100644 (file)
@@ -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 (file)
index 0000000..37cc7d0
--- /dev/null
@@ -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";
index ebd8d45..1f846d2 100644 (file)
@@ -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 \
index 6586fc6..4791169 100644 (file)
@@ -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 \