1 # $Id: Piece.pm 76 2008-03-02 20:15:09Z matt $
12 use UNIVERSAL qw(isa);
14 our @ISA = qw(Exporter DynaLoader);
22 ':override' => 'internal',
25 our $VERSION = '1.13_02';
27 bootstrap Time::Piece $VERSION;
31 my @MON_LIST = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
32 my @FULLMON_LIST = qw(January February March April May June July
33 August September October November December);
34 my @DAY_LIST = qw(Sun Mon Tue Wed Thu Fri Sat);
35 my @FULLDAY_LIST = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
37 use constant 'c_sec' => 0;
38 use constant 'c_min' => 1;
39 use constant 'c_hour' => 2;
40 use constant 'c_mday' => 3;
41 use constant 'c_mon' => 4;
42 use constant 'c_year' => 5;
43 use constant 'c_wday' => 6;
44 use constant 'c_yday' => 7;
45 use constant 'c_isdst' => 8;
46 use constant 'c_epoch' => 9;
47 use constant 'c_islocal' => 10;
50 unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') };
53 $time = time if (!defined $time);
54 $class->_mktime($time, 1);
58 unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') };
61 $time = time if (!defined $time);
62 $class->_mktime($time, 0);
72 $self = $class->localtime($time);
74 elsif (ref($class) && $class->isa(__PACKAGE__)) {
75 $self = $class->_mktime($class->epoch, $class->[c_islocal]);
78 $self = $class->localtime();
81 return bless $self, $class;
86 my $class = ref($proto) || $proto;
92 @components = shift =~ /(\d+)$DATE_SEP(\d+)$DATE_SEP(\d+)(?:(?:T|\s+)(\d+)$TIME_SEP(\d+)(?:$TIME_SEP(\d+)))/;
93 @components = reverse(@components[0..5]);
95 return $class->new(_strftime("%s", @components));
99 my ($class, $time, $islocal) = @_;
100 $class = eval { (ref $class) && (ref $class)->isa('Time::Piece') }
104 $time->[c_epoch] = undef;
105 return wantarray ? @$time : bless [@$time, $islocal], $class;
108 my @time = $islocal ?
109 CORE::localtime($time)
112 wantarray ? @time : bless [@time, $time, $islocal], $class;
115 my %_special_exports = (
116 localtime => sub { my $c = $_[0]; sub { $c->localtime(@_) } },
117 gmtime => sub { my $c = $_[0]; sub { $c->gmtime(@_) } },
121 my ($class, $to, @methods) = @_;
122 for my $method (@methods) {
123 if (exists $_special_exports{$method}) {
125 no warnings 'redefine';
126 *{$to . "::$method"} = $_special_exports{$method}->($class);
128 $class->SUPER::export($to, $method);
134 # replace CORE::GLOBAL localtime and gmtime if required
137 map($params{$_}++,@_,@EXPORT);
138 if (delete $params{':override'}) {
139 $class->export('CORE::GLOBAL', keys %params);
142 $class->export((caller)[0], keys %params);
172 *day_of_month = \&mday;
187 return $_[$time->[c_mon]];
190 return $MON_LIST[$time->[c_mon]];
193 return $time->strftime('%b');
202 return $_[$time->[c_mon]];
204 elsif (@FULLMON_LIST) {
205 return $FULLMON_LIST[$time->[c_mon]];
208 return $time->strftime('%B');
214 $time->[c_year] + 1900;
224 my $res = $time->[c_year] % 100;
225 return $res > 9 ? $res : "0$res";
238 *day_of_week = \&_wday;
243 return $_[$time->[c_wday]];
246 return $DAY_LIST[$time->[c_wday]];
249 return $time->strftime('%a');
258 return $_[$time->[c_wday]];
260 elsif (@FULLDAY_LIST) {
261 return $FULLDAY_LIST[$time->[c_wday]];
264 return $time->strftime('%A');
273 *day_of_year = \&yday;
280 *daylight_savings = \&isdst;
282 # Thanks to Tony Olekshy <olekshy@cs.ualberta.ca> for this algorithm
286 return Time::Seconds->new(0) unless $time->[c_islocal];
288 my $epoch = $time->epoch;
292 my ($s,$n,$h,$d,$m,$y) = @_; $m += 1; $y += 1900;
294 $time->_jd($y, $m, $d, $h, $n, $s);
298 # Compute floating offset in hours.
300 my $delta = 24 * (&$j(CORE::localtime $epoch) - &$j(CORE::gmtime $epoch));
302 # Return value in seconds rounded to nearest minute.
303 return Time::Seconds->new( int($delta * 60 + ($delta >= 0 ? 0.5 : -0.5)) * 60 );
308 if (defined($time->[c_epoch])) {
309 return $time->[c_epoch];
312 my $epoch = $time->[c_islocal] ?
313 timelocal(@{$time}[c_sec .. c_mon], $time->[c_year]+1900)
315 timegm(@{$time}[c_sec .. c_mon], $time->[c_year]+1900);
316 $time->[c_epoch] = $epoch;
323 my $sep = @_ ? shift(@_) : $TIME_SEP;
324 sprintf("%02d$sep%02d$sep%02d", $time->[c_hour], $time->[c_min], $time->[c_sec]);
331 my $sep = @_ ? shift(@_) : $DATE_SEP;
332 sprintf("%d$sep%02d$sep%02d", $time->year, $time->mon, $time->[c_mday]);
339 my $sep = @_ ? shift(@_) : $DATE_SEP;
340 sprintf("%02d$sep%02d$sep%d", $time->mon, $time->[c_mday], $time->year);
345 my $sep = @_ ? shift(@_) : $DATE_SEP;
346 sprintf("%02d$sep%02d$sep%d", $time->[c_mday], $time->mon, $time->year);
351 my %seps = (date => $DATE_SEP, T => 'T', time => $TIME_SEP, @_);
352 return join($seps{T}, $time->date($seps{date}), $time->time($seps{time}));
357 # Julian Day is always calculated for UT regardless
361 # Correct for localtime
362 $time = $time->gmtime( $time->epoch ) if $time->[c_islocal];
364 # Calculate the Julian day itself
365 my $jd = $time->_jd( $time->year, $time->mon, $time->mday,
366 $time->hour, $time->min, $time->sec);
371 # MJD is defined as JD - 2400000.5 days
373 return shift->julian_day - 2_400_000.5;
376 # Internal calculation of Julian date. Needed here so that
377 # both tzoffset and mjd/jd methods can share the code
378 # Algorithm from Hatcher 1984 (QJRAS 25, 53-55), and
379 # Hughes et al, 1989, MNRAS, 238, 15
380 # See: http://adsabs.harvard.edu/cgi-bin/nph-bib_query?bibcode=1989MNRAS.238.1529H&db_key=AST
385 my ($y, $m, $d, $h, $n, $s) = @_;
387 # Adjust input parameters according to the month
388 $y = ( $m > 2 ? $y : $y - 1);
389 $m = ( $m > 2 ? $m - 3 : $m + 9);
391 # Calculate the Julian Date (assuming Julian calendar)
392 my $J = int( 365.25 *( $y + 4712) )
393 + int( (30.6 * $m) + 0.5)
398 # Calculate the Gregorian Correction (since we have Gregorian dates)
399 my $G = 38 - int( 0.75 * int(49+($y/100)));
401 # Calculate the actual Julian Date
404 # Modify to include hours/mins/secs in floating portion.
405 return $JD + ($h + ($n + $s / 60) / 60) / 24;
411 my $J = $self->julian_day;
412 # Julian day is independent of time zone so add on tzoffset
413 # if we are using local time here since we want the week day
414 # to reflect the local time rather than UTC
415 $J += ($self->tzoffset/(24*3600)) if $self->[c_islocal];
417 # Now that we have the Julian day including fractions
418 # convert it to an integer Julian Day Number using nearest
419 # int (since the day changes at midday we oconvert all Julian
420 # dates to following midnight).
424 my $d4 = ((($J + 31741 - ($J % 7)) % 146097) % 36524) % 1461;
426 my $d1 = (($d4 - $L) % 365) + $L;
432 return (($year %4 == 0) && !($year % 100 == 0)) || ($year % 400 == 0)
438 my $year = $time->year;
439 return _is_leap_year($year);
442 my @MON_LAST = qw(31 28 31 30 31 30 31 31 30 31 30 31);
446 my $year = $time->year;
447 my $_mon = $time->_mon;
448 return $MON_LAST[$_mon] + ($_mon == 1 ? _is_leap_year($year) : 0);
453 my $tzname = $time->[c_islocal] ? '%Z' : 'UTC';
454 my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S $tzname";
455 if (!defined $time->[c_wday]) {
456 if ($time->[c_islocal]) {
457 return _strftime($format, CORE::localtime($time->epoch));
460 return _strftime($format, CORE::gmtime($time->epoch));
463 return _strftime($format, (@$time)[c_sec..c_isdst]);
469 my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z";
470 my @vals = _strptime($string, $format);
471 # warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals)));
472 return scalar $time->_mktime(\@vals, (ref($time) ? $time->[c_islocal] : 0));
476 shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
485 shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
494 shift if ref($_[0]) && $_[0]->isa(__PACKAGE__);
503 shift if ref($_[0]) && $_[0]->isa(__PACKAGE__);
511 use overload '""' => \&cdate,
512 'cmp' => \&str_compare,
517 if ($time->[c_islocal]) {
518 return scalar(CORE::localtime($time->epoch));
521 return scalar(CORE::gmtime($time->epoch));
526 my ($lhs, $rhs, $reverse) = @_;
527 if (UNIVERSAL::isa($rhs, 'Time::Piece')) {
530 return $reverse ? $rhs cmp $lhs->cdate : $lhs->cdate cmp $rhs;
540 if (UNIVERSAL::isa($rhs, 'Time::Seconds')) {
541 $rhs = $rhs->seconds;
546 # SWAPED is set (so someone tried an expression like NOTDATE - DATE).
547 # Imitate Perl's standard behavior and return the result as if the
548 # string $time resolves to was subtracted from NOTDATE. This way,
549 # classes which override this one and which have a stringify function
550 # that resolves to something that looks more like a number don't need
551 # to override this function.
552 return $rhs - "$time";
555 if (UNIVERSAL::isa($rhs, 'Time::Piece')) {
556 return Time::Seconds->new($time->epoch - $rhs->epoch);
560 return $time->_mktime(($time->epoch - $rhs), $time->[c_islocal]);
567 if (UNIVERSAL::isa($rhs, 'Time::Seconds')) {
568 $rhs = $rhs->seconds;
570 croak "Invalid rhs of addition: $rhs" if ref($rhs);
572 return $time->_mktime(($time->epoch + $rhs), $time->[c_islocal]);
579 my ($lhs, $rhs, $reverse) = @_;
580 if (!UNIVERSAL::isa($rhs, 'Time::Piece')) {
581 $rhs = $lhs->new($rhs);
584 return $rhs->epoch, $lhs->epoch;
586 return $lhs->epoch, $rhs->epoch;
590 my ($lhs, $rhs) = get_epochs(@_);
591 return $lhs <=> $rhs;
595 my ($time, $num_months) = @_;
597 croak("add_months requires a number of months") unless defined($num_months);
599 my $final_month = $time->_mon + $num_months;
601 if ($final_month > 11 || $final_month < 0) {
602 # these two ops required because we have no POSIX::floor and don't
603 # want to load POSIX.pm
604 $num_years = int($final_month / 12);
605 $num_years-- if ($final_month < 0);
607 $final_month = $final_month % 12;
610 my @vals = _mini_mktime($time->sec, $time->min, $time->hour,
611 $time->mday, $final_month, $time->year - 1900 + $num_years);
612 # warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals)));
613 return scalar $time->_mktime(\@vals, $time->[c_islocal]);
617 my ($time, $years) = @_;
618 $time->add_months($years * 12);
626 Time::Piece - Object Oriented time objects
633 print "Time is $t\n";
634 print "Year is ", $t->year, "\n";
638 This module replaces the standard localtime and gmtime functions with
639 implementations that return objects. It does so in a backwards
640 compatible manner, so that using localtime/gmtime in the way documented
641 in perlfunc will still return what you expect.
643 The module actually implements most of an interface described by
644 Larry Wall on the perl5-porters mailing list here:
645 http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2000-01/msg00241.html
649 After importing this module, when you use localtime or gmtime in a scalar
650 context, rather than getting an ordinary scalar string representing the
651 date and time, you get a Time::Piece object, whose stringification happens
652 to produce the same effect as the localtime and gmtime functions. There is
653 also a new() constructor provided, which is the same as localtime(), except
654 when passed a Time::Piece object, in which case it's a copy constructor. The
655 following methods are available on the object:
657 $t->sec # also available as $t->second
658 $t->min # also available as $t->minute
660 $t->mday # also available as $t->day_of_month
661 $t->mon # 1 = January
662 $t->_mon # 0 = January
664 $t->month # same as $t->monname
665 $t->fullmonth # February
666 $t->year # based at 0 (year 0 AD is, of course 1 BC)
667 $t->_year # year minus 1900
668 $t->yy # 2 digit year
669 $t->wday # 1 = Sunday
670 $t->_wday # 0 = Sunday
671 $t->day_of_week # 0 = Sunday
673 $t->day # same as wdayname
674 $t->fullday # Tuesday
675 $t->yday # also available as $t->day_of_year, 0 = Jan 01
676 $t->isdst # also available as $t->daylight_savings
679 $t->hms(".") # 12.34.56
680 $t->time # same as $t->hms
683 $t->date # same as $t->ymd
685 $t->mdy("/") # 02/29/2000
687 $t->dmy(".") # 29.02.2000
688 $t->datetime # 2000-02-29T12:34:56 (ISO 8601)
689 $t->cdate # Tue Feb 29 12:34:56 2000
690 "$t" # same as $t->cdate
692 $t->epoch # seconds since the epoch
693 $t->tzoffset # timezone offset in a Time::Seconds object
695 $t->julian_day # number of days since Julian period began
696 $t->mjd # modified Julian date (JD-2400000.5 days)
698 $t->week # week number (ISO 8601)
700 $t->is_leap_year # true if it its
701 $t->month_last_day # 28-31
703 $t->time_separator($s) # set the default separator (default ":")
704 $t->date_separator($s) # set the default separator (default "-")
705 $t->day_list(@days) # set the default weekdays
706 $t->mon_list(@days) # set the default months
708 $t->strftime(FORMAT) # same as POSIX::strftime (without the overhead
709 # of the full POSIX extension)
710 $t->strftime() # "Tue, 29 Feb 2000 12:34:56 GMT"
712 Time::Piece->strptime(STRING, FORMAT)
713 # see strptime man page. Creates a new
718 Both wdayname (day) and monname (month) allow passing in a list to use
719 to index the name of the days against. This can be useful if you need
720 to implement some form of localisation without actually installing or
723 my @days = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi );
725 my $french_day = localtime->day(@days);
727 These settings can be overriden globally too:
729 Time::Piece::day_list(@days);
733 Time::Piece::mon_list(@months);
735 And locally for months:
737 print localtime->month(@months);
739 =head2 Date Calculations
741 It's possible to use simple addition and subtraction of objects:
745 my $seconds = $t1 - $t2;
746 $t1 += ONE_DAY; # add 1 day (constant from Time::Seconds)
748 The following are valid ($t1 and $t2 are Time::Piece objects):
750 $t1 - $t2; # returns Time::Seconds object
751 $t1 - 42; # returns Time::Piece object
752 $t1 + 533; # returns Time::Piece object
754 However adding a Time::Piece object to another Time::Piece object
755 will cause a runtime error.
757 Note that the first of the above returns a Time::Seconds object, so
758 while examining the object will print the number of seconds (because
759 of the overloading), you can also get the number of minutes, hours,
760 days, weeks and years in that delta, using the Time::Seconds API.
762 In addition to adding seconds, there are two APIs for adding months and
768 The months and years can be negative for subtractions. Note that there
769 is some "strange" behaviour when adding and subtracting months at the
770 ends of months. Generally when the resulting month is shorter than the
771 starting month then the number of overlap days is added. For example
772 subtracting a month from 2008-03-31 will not result in 2008-02-31 as this
773 is an impossible date. Instead you will get 2008-03-02. This appears to
774 be consistent with other date manipulation tools.
776 =head2 Date Comparisons
778 Date comparisons are also possible, using the full suite of "<", ">",
779 "<=", ">=", "<=>", "==" and "!=".
783 Time::Piece links to your C library's strptime() function, allowing
784 you incredibly flexible date parsing routines. For example:
786 my $t = Time::Piece->strptime("Sun 3rd Nov, 1943",
789 print $t->strftime("%a, %d %b %Y");
795 (see, it's even smart enough to fix my obvious date bug)
797 For more information see "man strptime", which should be on all unix
800 =head2 YYYY-MM-DDThh:mm:ss
802 The ISO 8601 standard defines the date format to be YYYY-MM-DD, and
803 the time format to be hh:mm:ss (24 hour clock), and if combined, they
804 should be concatenated with date first and with a capital 'T' in front
809 The I<week number> may be an unknown concept to some readers. The ISO
810 8601 standard defines that weeks begin on a Monday and week 1 of the
811 year is the week that includes both January 4th and the first Thursday
812 of the year. In other words, if the first Monday of January is the
813 2nd, 3rd, or 4th, the preceding days of the January are part of the
814 last week of the preceding year. Week numbers range from 1 to 53.
816 =head2 Global Overriding
818 Finally, it's possible to override localtime and gmtime everywhere, by
819 including the ':override' tag in the import list:
821 use Time::Piece ':override';
825 Matt Sergeant, matt@sergeant.org
826 Jarkko Hietaniemi, jhi@iki.fi (while creating Time::Piece for core perl)
830 This module is free software, you may distribute it under the same terms
835 The excellent Calendar FAQ at http://www.tondering.dk/claus/calendar.html
839 The test harness leaves much to be desired. Patches welcome.