1 # $Id: Piece.pm 70 2006-09-07 17:43:38Z matt $
12 use UNIVERSAL qw(isa);
14 our @ISA = qw(Exporter DynaLoader);
22 ':override' => 'internal',
25 our $VERSION = '1.11_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;
599 Time::Piece - Object Oriented time objects
606 print "Time is $t\n";
607 print "Year is ", $t->year, "\n";
611 This module replaces the standard localtime and gmtime functions with
612 implementations that return objects. It does so in a backwards
613 compatible manner, so that using localtime/gmtime in the way documented
614 in perlfunc will still return what you expect.
616 The module actually implements most of an interface described by
617 Larry Wall on the perl5-porters mailing list here:
618 http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2000-01/msg00241.html
622 After importing this module, when you use localtime or gmtime in a scalar
623 context, rather than getting an ordinary scalar string representing the
624 date and time, you get a Time::Piece object, whose stringification happens
625 to produce the same effect as the localtime and gmtime functions. There is
626 also a new() constructor provided, which is the same as localtime(), except
627 when passed a Time::Piece object, in which case it's a copy constructor. The
628 following methods are available on the object:
630 $t->sec # also available as $t->second
631 $t->min # also available as $t->minute
633 $t->mday # also available as $t->day_of_month
634 $t->mon # 1 = January
635 $t->_mon # 0 = January
637 $t->month # same as $t->monname
638 $t->fullmonth # February
639 $t->year # based at 0 (year 0 AD is, of course 1 BC)
640 $t->_year # year minus 1900
641 $t->yy # 2 digit year
642 $t->wday # 1 = Sunday
643 $t->_wday # 0 = Sunday
644 $t->day_of_week # 0 = Sunday
646 $t->day # same as wdayname
647 $t->fullday # Tuesday
648 $t->yday # also available as $t->day_of_year, 0 = Jan 01
649 $t->isdst # also available as $t->daylight_savings
652 $t->hms(".") # 12.34.56
653 $t->time # same as $t->hms
656 $t->date # same as $t->ymd
658 $t->mdy("/") # 02/29/2000
660 $t->dmy(".") # 29.02.2000
661 $t->datetime # 2000-02-29T12:34:56 (ISO 8601)
662 $t->cdate # Tue Feb 29 12:34:56 2000
663 "$t" # same as $t->cdate
665 $t->epoch # seconds since the epoch
666 $t->tzoffset # timezone offset in a Time::Seconds object
668 $t->julian_day # number of days since Julian period began
669 $t->mjd # modified Julian date (JD-2400000.5 days)
671 $t->week # week number (ISO 8601)
673 $t->is_leap_year # true if it its
674 $t->month_last_day # 28-31
676 $t->time_separator($s) # set the default separator (default ":")
677 $t->date_separator($s) # set the default separator (default "-")
678 $t->day_list(@days) # set the default weekdays
679 $t->mon_list(@days) # set the default months
681 $t->strftime(FORMAT) # same as POSIX::strftime (without the overhead
682 # of the full POSIX extension)
683 $t->strftime() # "Tue, 29 Feb 2000 12:34:56 GMT"
685 Time::Piece->strptime(STRING, FORMAT)
686 # see strptime man page. Creates a new
691 Both wdayname (day) and monname (month) allow passing in a list to use
692 to index the name of the days against. This can be useful if you need
693 to implement some form of localisation without actually installing or
696 my @days = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi );
698 my $french_day = localtime->day(@days);
700 These settings can be overriden globally too:
702 Time::Piece::day_list(@days);
706 Time::Piece::mon_list(@months);
708 And locally for months:
710 print localtime->month(@months);
712 =head2 Date Calculations
714 It's possible to use simple addition and subtraction of objects:
718 my $seconds = $t1 - $t2;
719 $t1 += ONE_DAY; # add 1 day (constant from Time::Seconds)
721 The following are valid ($t1 and $t2 are Time::Piece objects):
723 $t1 - $t2; # returns Time::Seconds object
724 $t1 - 42; # returns Time::Piece object
725 $t1 + 533; # returns Time::Piece object
727 However adding a Time::Piece object to another Time::Piece object
728 will cause a runtime error.
730 Note that the first of the above returns a Time::Seconds object, so
731 while examining the object will print the number of seconds (because
732 of the overloading), you can also get the number of minutes, hours,
733 days, weeks and years in that delta, using the Time::Seconds API.
735 =head2 Date Comparisons
737 Date comparisons are also possible, using the full suite of "<", ">",
738 "<=", ">=", "<=>", "==" and "!=".
742 Time::Piece links to your C library's strptime() function, allowing
743 you incredibly flexible date parsing routines. For example:
745 my $t = Time::Piece->strptime("Sun 3rd Nov, 1943",
748 print $t->strftime("%a, %d %b %Y");
754 (see, it's even smart enough to fix my obvious date bug)
756 For more information see "man strptime", which should be on all unix
759 =head2 YYYY-MM-DDThh:mm:ss
761 The ISO 8601 standard defines the date format to be YYYY-MM-DD, and
762 the time format to be hh:mm:ss (24 hour clock), and if combined, they
763 should be concatenated with date first and with a capital 'T' in front
768 The I<week number> may be an unknown concept to some readers. The ISO
769 8601 standard defines that weeks begin on a Monday and week 1 of the
770 year is the week that includes both January 4th and the first Thursday
771 of the year. In other words, if the first Monday of January is the
772 2nd, 3rd, or 4th, the preceding days of the January are part of the
773 last week of the preceding year. Week numbers range from 1 to 53.
775 =head2 Global Overriding
777 Finally, it's possible to override localtime and gmtime everywhere, by
778 including the ':override' tag in the import list:
780 use Time::Piece ':override';
784 Matt Sergeant, matt@sergeant.org
785 Jarkko Hietaniemi, jhi@iki.fi (while creating Time::Piece for core perl)
789 This module is free software, you may distribute it under the same terms
794 The excellent Calendar FAQ at http://www.tondering.dk/claus/calendar.html
798 The test harness leaves much to be desired. Patches welcome.