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';
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;
543 die "Can't subtract a date from something!" if shift;
545 if (UNIVERSAL::isa($rhs, 'Time::Piece')) {
546 return Time::Seconds->new($time->epoch - $rhs->epoch);
550 return $time->_mktime(($time->epoch - $rhs), $time->[c_islocal]);
557 if (UNIVERSAL::isa($rhs, 'Time::Seconds')) {
558 $rhs = $rhs->seconds;
560 croak "Invalid rhs of addition: $rhs" if ref($rhs);
562 return $time->_mktime(($time->epoch + $rhs), $time->[c_islocal]);
569 my ($lhs, $rhs, $reverse) = @_;
570 if (!UNIVERSAL::isa($rhs, 'Time::Piece')) {
571 $rhs = $lhs->new($rhs);
574 return $rhs->epoch, $lhs->epoch;
576 return $lhs->epoch, $rhs->epoch;
580 my ($lhs, $rhs) = get_epochs(@_);
581 return $lhs <=> $rhs;
589 Time::Piece - Object Oriented time objects
596 print "Time is $t\n";
597 print "Year is ", $t->year, "\n";
601 This module replaces the standard localtime and gmtime functions with
602 implementations that return objects. It does so in a backwards
603 compatible manner, so that using localtime/gmtime in the way documented
604 in perlfunc will still return what you expect.
606 The module actually implements most of an interface described by
607 Larry Wall on the perl5-porters mailing list here:
608 http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2000-01/msg00241.html
612 After importing this module, when you use localtime or gmtime in a scalar
613 context, rather than getting an ordinary scalar string representing the
614 date and time, you get a Time::Piece object, whose stringification happens
615 to produce the same effect as the localtime and gmtime functions. There is
616 also a new() constructor provided, which is the same as localtime(), except
617 when passed a Time::Piece object, in which case it's a copy constructor. The
618 following methods are available on the object:
620 $t->sec # also available as $t->second
621 $t->min # also available as $t->minute
623 $t->mday # also available as $t->day_of_month
624 $t->mon # 1 = January
625 $t->_mon # 0 = January
627 $t->month # same as $t->monname
628 $t->fullmonth # February
629 $t->year # based at 0 (year 0 AD is, of course 1 BC)
630 $t->_year # year minus 1900
631 $t->yy # 2 digit year
632 $t->wday # 1 = Sunday
633 $t->_wday # 0 = Sunday
634 $t->day_of_week # 0 = Sunday
636 $t->day # same as wdayname
637 $t->fullday # Tuesday
638 $t->yday # also available as $t->day_of_year, 0 = Jan 01
639 $t->isdst # also available as $t->daylight_savings
642 $t->hms(".") # 12.34.56
643 $t->time # same as $t->hms
646 $t->date # same as $t->ymd
648 $t->mdy("/") # 02/29/2000
650 $t->dmy(".") # 29.02.2000
651 $t->datetime # 2000-02-29T12:34:56 (ISO 8601)
652 $t->cdate # Tue Feb 29 12:34:56 2000
653 "$t" # same as $t->cdate
655 $t->epoch # seconds since the epoch
656 $t->tzoffset # timezone offset in a Time::Seconds object
658 $t->julian_day # number of days since Julian period began
659 $t->mjd # modified Julian date (JD-2400000.5 days)
661 $t->week # week number (ISO 8601)
663 $t->is_leap_year # true if it its
664 $t->month_last_day # 28-31
666 $t->time_separator($s) # set the default separator (default ":")
667 $t->date_separator($s) # set the default separator (default "-")
668 $t->day_list(@days) # set the default weekdays
669 $t->mon_list(@days) # set the default months
671 $t->strftime(FORMAT) # same as POSIX::strftime (without the overhead
672 # of the full POSIX extension)
673 $t->strftime() # "Tue, 29 Feb 2000 12:34:56 GMT"
675 Time::Piece->strptime(STRING, FORMAT)
676 # see strptime man page. Creates a new
681 Both wdayname (day) and monname (month) allow passing in a list to use
682 to index the name of the days against. This can be useful if you need
683 to implement some form of localisation without actually installing or
686 my @days = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi );
688 my $french_day = localtime->day(@days);
690 These settings can be overriden globally too:
692 Time::Piece::day_list(@days);
696 Time::Piece::mon_list(@months);
698 And locally for months:
700 print localtime->month(@months);
702 =head2 Date Calculations
704 It's possible to use simple addition and subtraction of objects:
708 my $seconds = $t1 - $t2;
709 $t1 += ONE_DAY; # add 1 day (constant from Time::Seconds)
711 The following are valid ($t1 and $t2 are Time::Piece objects):
713 $t1 - $t2; # returns Time::Seconds object
714 $t1 - 42; # returns Time::Piece object
715 $t1 + 533; # returns Time::Piece object
717 However adding a Time::Piece object to another Time::Piece object
718 will cause a runtime error.
720 Note that the first of the above returns a Time::Seconds object, so
721 while examining the object will print the number of seconds (because
722 of the overloading), you can also get the number of minutes, hours,
723 days, weeks and years in that delta, using the Time::Seconds API.
725 =head2 Date Comparisons
727 Date comparisons are also possible, using the full suite of "<", ">",
728 "<=", ">=", "<=>", "==" and "!=".
732 Time::Piece links to your C library's strptime() function, allowing
733 you incredibly flexible date parsing routines. For example:
735 my $t = Time::Piece->strptime("Sun 3rd Nov, 1943",
738 print $t->strftime("%a, %d %b %Y");
744 (see, it's even smart enough to fix my obvious date bug)
746 For more information see "man strptime", which should be on all unix
749 =head2 YYYY-MM-DDThh:mm:ss
751 The ISO 8601 standard defines the date format to be YYYY-MM-DD, and
752 the time format to be hh:mm:ss (24 hour clock), and if combined, they
753 should be concatenated with date first and with a capital 'T' in front
758 The I<week number> may be an unknown concept to some readers. The ISO
759 8601 standard defines that weeks begin on a Monday and week 1 of the
760 year is the week that includes both January 4th and the first Thursday
761 of the year. In other words, if the first Monday of January is the
762 2nd, 3rd, or 4th, the preceding days of the January are part of the
763 last week of the preceding year. Week numbers range from 1 to 53.
765 =head2 Global Overriding
767 Finally, it's possible to override localtime and gmtime everywhere, by
768 including the ':override' tag in the import list:
770 use Time::Piece ':override';
774 Matt Sergeant, matt@sergeant.org
775 Jarkko Hietaniemi, jhi@iki.fi (while creating Time::Piece for core perl)
779 This module is free software, you may distribute it under the same terms
784 The excellent Calendar FAQ at http://www.tondering.dk/claus/calendar.html
788 The test harness leaves much to be desired. Patches welcome.