Typo in #11083.
[p5sagit/p5-mst-13.2.git] / ext / Time / Piece / Piece.pm
CommitLineData
302d38aa 1package Time::Piece;
2
3use strict;
b59310ea 4use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
302d38aa 5
6require Exporter;
7require DynaLoader;
8use Time::Seconds;
9use Carp;
302d38aa 10
11@ISA = qw(Exporter DynaLoader);
12
13@EXPORT = qw(
14 localtime
15 gmtime
16);
17
b59310ea 18@EXPORT_OK = qw(
19 strptime
20);
21
302d38aa 22%EXPORT_TAGS = (
23 ':override' => 'internal',
24 );
25
26$VERSION = '0.13';
27
28bootstrap Time::Piece $VERSION;
29
30my $DATE_SEP = '-';
31my $TIME_SEP = ':';
d0369dd1 32my @MON_NAMES = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
33my @WDAY_NAMES = qw(Sun Mon Tue Wed Thu Fri Sat);
34my @MONTH_NAMES = qw(January February March April May June
35 July August September October Novemeber December);
36my @WEEKDAY_NAMES = qw(Sunday Monday Tuesday Wednesday
37 Thursday Friday Saturday);
302d38aa 38
39use constant 'c_sec' => 0;
40use constant 'c_min' => 1;
41use constant 'c_hour' => 2;
42use constant 'c_mday' => 3;
43use constant 'c_mon' => 4;
44use constant 'c_year' => 5;
45use constant 'c_wday' => 6;
46use constant 'c_yday' => 7;
47use constant 'c_isdst' => 8;
48use constant 'c_epoch' => 9;
49use constant 'c_islocal' => 10;
50
51sub localtime {
52 my $time = shift;
53 $time = time if (!defined $time);
54 _mktime($time, 1);
55}
56
57sub gmtime {
58 my $time = shift;
59 $time = time if (!defined $time);
60 _mktime($time, 0);
61}
62
63sub new {
64 my $proto = shift;
65 my $class = ref($proto) || $proto;
66 my $time = shift;
67
68 my $self;
69
70 if (defined($time)) {
71 $self = &localtime($time);
72 }
73 elsif (ref($proto) && $proto->isa('Time::Piece')) {
74 $self = _mktime($proto->[c_epoch], $proto->[c_islocal]);
75 }
76 else {
77 $self = &localtime();
78 }
79
80 return bless $self, $class;
81}
82
83sub _mktime {
84 my ($time, $islocal) = @_;
85 my @time = $islocal ?
86 CORE::localtime($time)
87 :
88 CORE::gmtime($time);
89 wantarray ? @time : bless [@time, $time, $islocal], 'Time::Piece';
90}
91
92sub import {
93 # replace CORE::GLOBAL localtime and gmtime if required
94 my $class = shift;
95 my %params;
96 map($params{$_}++,@_,@EXPORT);
97 if (delete $params{':override'}) {
98 $class->export('CORE::GLOBAL', keys %params);
99 }
100 else {
101 $class->export((caller)[0], keys %params);
102 }
103}
104
105## Methods ##
106
d0369dd1 107sub s {
302d38aa 108 my $time = shift;
109 $time->[c_sec];
110}
111
d0369dd1 112*sec = \&s;
113*second = \&s;
302d38aa 114
115sub min {
116 my $time = shift;
117 $time->[c_min];
118}
119
d0369dd1 120*minute = \&min;
302d38aa 121
d0369dd1 122sub h {
302d38aa 123 my $time = shift;
124 $time->[c_hour];
125}
126
d0369dd1 127*hour = \&h;
128
129sub d {
302d38aa 130 my $time = shift;
131 $time->[c_mday];
132}
133
d0369dd1 134*mday = \&d;
135*day_of_month = \&d;
302d38aa 136
137sub mon {
138 my $time = shift;
139 $time->[c_mon] + 1;
140}
141
142sub _mon {
143 my $time = shift;
144 $time->[c_mon];
145}
146
79d09e5e 147sub has_mon_names {
148 my $time = shift;
149 return 0;
150}
151
d0369dd1 152sub monname {
302d38aa 153 my $time = shift;
154 if (@_) {
155 return $_[$time->[c_mon]];
156 }
79d09e5e 157 elsif ($time->has_mon_names) {
158 return $time->mon_name($time->[c_mon]);
d0369dd1 159 }
79d09e5e 160 return $MON_NAMES[$time->[c_mon]];
161}
162
163sub has_month_names {
164 my $time = shift;
165 return 0;
d0369dd1 166}
167
168sub monthname {
169 my $time = shift;
170 if (@_) {
171 return $_[$time->[c_mon]];
172 }
79d09e5e 173 elsif ($time->has_month_names) {
174 return $time->month_name($time->[c_mon]);
302d38aa 175 }
79d09e5e 176 return $MONTH_NAMES[$time->[c_mon]];
302d38aa 177}
178
d0369dd1 179*month = \&monthname;
180
181sub y {
302d38aa 182 my $time = shift;
183 $time->[c_year] + 1900;
184}
185
d0369dd1 186*year = \&y;
187
302d38aa 188sub _year {
189 my $time = shift;
190 $time->[c_year];
191}
192
193sub wday {
194 my $time = shift;
195 $time->[c_wday] + 1;
196}
197
198sub _wday {
199 my $time = shift;
200 $time->[c_wday];
201}
202
203*day_of_week = \&_wday;
204
79d09e5e 205sub has_wday_names {
206 my $time = shift;
207 return 0;
208}
209
302d38aa 210sub wdayname {
211 my $time = shift;
212 if (@_) {
213 return $_[$time->[c_wday]];
214 }
79d09e5e 215 elsif ($time->has_wday_names) {
216 return $time->wday_name($time->[c_mon]);
d0369dd1 217 }
79d09e5e 218 return $WDAY_NAMES[$time->[c_wday]];
219}
220
221sub has_weekday_names {
222 my $time = shift;
223 return 0;
d0369dd1 224}
225
226sub weekdayname {
227 my $time = shift;
228 if (@_) {
229 return $_[$time->[c_wday]];
230 }
79d09e5e 231 elsif ($time->has_weekday_names) {
232 return $time->weekday_name($time->[c_mon]);
302d38aa 233 }
79d09e5e 234 return $WEEKDAY_NAMES[$time->[c_wday]];
302d38aa 235}
236
d0369dd1 237*weekdayname = \&weekdayname;
238*weekday = \&weekdayname;
302d38aa 239
240sub yday {
241 my $time = shift;
242 $time->[c_yday];
243}
244
245*day_of_year = \&yday;
246
247sub isdst {
248 my $time = shift;
249 $time->[c_isdst];
250}
251
252*daylight_savings = \&isdst;
253
254# Thanks to Tony Olekshy <olekshy@cs.ualberta.ca> for this algorithm
255sub tzoffset {
256 my $time = shift;
257
258 my $epoch = $time->[c_epoch];
259
260 my $j = sub { # Tweaked Julian day number algorithm.
261
262 my ($s,$n,$h,$d,$m,$y) = @_; $m += 1; $y += 1900;
263
264 # Standard Julian day number algorithm without constant.
265 #
266 my $y1 = $m > 2 ? $y : $y - 1;
267
268 my $m1 = $m > 2 ? $m + 1 : $m + 13;
269
270 my $day = int(365.25 * $y1) + int(30.6001 * $m1) + $d;
271
272 # Modify to include hours/mins/secs in floating portion.
273 #
274 return $day + ($h + ($n + $s / 60) / 60) / 24;
275 };
276
277 # Compute floating offset in hours.
278 #
279 my $delta = 24 * (&$j(CORE::localtime $epoch) - &$j(CORE::gmtime $epoch));
280
281 # Return value in seconds rounded to nearest minute.
282 return Time::Seconds->new( int($delta * 60 + ($delta >= 0 ? 0.5 : -0.5)) * 60);
283}
284
285sub epoch {
286 my $time = shift;
287 $time->[c_epoch];
288}
289
290sub hms {
291 my $time = shift;
2a74cb2d 292 my $sep = @_ ? shift(@_) : $TIME_SEP;
302d38aa 293 sprintf("%02d$sep%02d$sep%02d", $time->[c_hour], $time->[c_min], $time->[c_sec]);
294}
295
296*time = \&hms;
297
298sub ymd {
299 my $time = shift;
2a74cb2d 300 my $sep = @_ ? shift(@_) : $DATE_SEP;
302d38aa 301 sprintf("%d$sep%02d$sep%02d", $time->year, $time->mon, $time->[c_mday]);
302}
303
304*date = \&ymd;
305
306sub mdy {
307 my $time = shift;
2a74cb2d 308 my $sep = @_ ? shift(@_) : $DATE_SEP;
302d38aa 309 sprintf("%02d$sep%02d$sep%d", $time->mon, $time->[c_mday], $time->year);
310}
311
312sub dmy {
313 my $time = shift;
2a74cb2d 314 my $sep = @_ ? shift(@_) : $DATE_SEP;
302d38aa 315 sprintf("%02d$sep%02d$sep%d", $time->[c_mday], $time->mon, $time->year);
316}
317
318sub datetime {
319 my $time = shift;
2a74cb2d 320 my %seps = (date => $DATE_SEP, T => 'T', time => $TIME_SEP, @_);
321 return join($seps{T}, $time->date($seps{date}), $time->time($seps{time}));
302d38aa 322}
323
324# taken from Time::JulianDay
325sub julian_day {
326 my $time = shift;
327 my ($year, $month, $day) = ($time->year, $time->mon, $time->mday);
328 my ($tmp, $secs);
329
330 $tmp = $day - 32075
331 + 1461 * ( $year + 4800 - ( 14 - $month ) / 12 )/4
332 + 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12
333 - 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4
334 ;
335
336 return $tmp;
337}
338
2a74cb2d 339# Hi Mark-Jason!
302d38aa 340sub mjd {
302d38aa 341 return shift->julian_day - 2_400_000.5;
342}
343
2a74cb2d 344sub week {
345 # taken from the Calendar FAQ
346 use integer;
347 my $J = shift->julian_day;
348 my $d4 = ((($J + 31741 - ($J % 7)) % 146097) % 36524) % 1461;
349 my $L = $d4 / 1460;
350 my $d1 = (($d4 - $L) % 365) + $L;
351 return $d1 / 7 + 1;
352}
353
354sub _is_leap_year {
355 my $year = shift;
356 return (($year %4 == 0) && !($year % 100 == 0)) || ($year % 400 == 0)
357 ? 1 : 0;
358}
359
360sub is_leap_year {
361 my $time = shift;
362 my $year = $time->year;
363 return _is_leap_year($year);
364}
365
366my @MON_LAST = qw(31 28 31 30 31 30 31 31 30 31 30 31);
367
368sub month_last_day {
369 my $time = shift;
370 my $year = $time->year;
371 my $_mon = $time->_mon;
372 return $MON_LAST[$_mon] + ($_mon == 1 ? _is_leap_year($year) : 0);
373}
374
d0369dd1 375use vars qw($_ftime);
376
377$_ftime =
378{
379 '%' => sub {
380 return "%";
381 },
382 'a' => sub {
79d09e5e 383 my ($format, $time) = @_;
384 $time->wdayname();
d0369dd1 385 },
386 'A' => sub {
79d09e5e 387 my ($format, $time) = @_;
388 $time->weekdayname();
d0369dd1 389 },
390 'b' => sub {
79d09e5e 391 my ($format, $time) = @_;
392 $time->monname();
d0369dd1 393 },
394 'B' => sub {
79d09e5e 395 my ($format, $time) = @_;
396 $time->monthname();
d0369dd1 397 },
398 'c' => sub {
79d09e5e 399 my ($format, $time) = @_;
400 $time->cdate();
d0369dd1 401 },
402 'C' => sub {
79d09e5e 403 my ($format, $time) = @_;
404 sprintf("%02d", int($time->y() / 100));
d0369dd1 405 },
406 'd' => sub {
79d09e5e 407 my ($format, $time) = @_;
408 sprintf("%02d", $time->d());
d0369dd1 409 },
410 'D' => sub {
79d09e5e 411 my ($format, $time) = @_;
d0369dd1 412 join("/",
79d09e5e 413 $_ftime->{'m'}->('m', $time),
414 $_ftime->{'d'}->('d', $time),
415 $_ftime->{'y'}->('y', $time));
d0369dd1 416 },
417 'e' => sub {
79d09e5e 418 my ($format, $time) = @_;
419 sprintf("%2d", $time->d());
d0369dd1 420 },
79d09e5e 421 'h' => sub {
d0369dd1 422 my ($format, $time, @rest) = @_;
423 $time->monname(@rest);
424 },
425 'H' => sub {
79d09e5e 426 my ($format, $time) = @_;
427 sprintf("%02d", $time->h());
d0369dd1 428 },
429 'I' => sub {
79d09e5e 430 my ($format, $time) = @_;
431 my $h = $time->h();
d0369dd1 432 sprintf("%02d", $h == 0 ? 12 : ($h < 13 ? $h : $h % 12));
433 },
434 'j' => sub {
79d09e5e 435 my ($format, $time) = @_;
436 sprintf("%03d", $time->yday());
d0369dd1 437 },
438 'm' => sub {
79d09e5e 439 my ($format, $time) = @_;
440 sprintf("%02d", $time->mon());
d0369dd1 441 },
442 'M' => sub {
79d09e5e 443 my ($format, $time) = @_;
444 sprintf("%02d", $time->min());
d0369dd1 445 },
446 'n' => sub {
447 return "\n";
448 },
449 'p' => sub {
79d09e5e 450 my ($format, $time) = @_;
451 my $h = $time->h();
d0369dd1 452 $h == 0 ? 'pm' : ($h < 13 ? 'am' : 'pm');
453 },
454 'r' => sub {
79d09e5e 455 my ($format, $time) = @_;
d0369dd1 456 join(":",
79d09e5e 457 $_ftime->{'I'}->('I', $time),
458 $_ftime->{'M'}->('M', $time),
459 $_ftime->{'S'}->('S', $time)) .
460 " " . $_ftime->{'p'}->('p', $time);
d0369dd1 461 },
462 'R' => sub {
79d09e5e 463 my ($format, $time) = @_;
d0369dd1 464 join(":",
79d09e5e 465 $_ftime->{'H'}->('H', $time),
466 $_ftime->{'M'}->('M', $time));
d0369dd1 467 },
468 'S' => sub {
79d09e5e 469 my ($format, $time) = @_;
470 sprintf("%02d", $time->s());
d0369dd1 471 },
472 't' => sub {
473 return "\t";
474 },
475 'T' => sub {
79d09e5e 476 my ($format, $time) = @_;
d0369dd1 477 join(":",
79d09e5e 478 $_ftime->{'H'}->('H', $time),
479 $_ftime->{'M'}->('M', $time),
480 $_ftime->{'S'}->('S', $time));
d0369dd1 481 },
482 'u' => sub {
79d09e5e 483 my ($format, $time) = @_;
484 ($time->wday() + 5) % 7 + 1;
d0369dd1 485 },
79d09e5e 486 # U taken care by libc
d0369dd1 487 'V' => sub {
79d09e5e 488 my ($format, $time) = @_;
489 sprintf("%02d", $time->week());
d0369dd1 490 },
491 'w' => sub {
79d09e5e 492 my ($format, $time) = @_;
493 $time->_wday();
d0369dd1 494 },
79d09e5e 495 # W taken care by libc
d0369dd1 496 'x' => sub {
79d09e5e 497 my ($format, $time) = @_;
d0369dd1 498 join("/",
79d09e5e 499 $_ftime->{'m'}->('m', $time),
500 $_ftime->{'d'}->('d', $time),
501 $_ftime->{'y'}->('y', $time));
d0369dd1 502 },
503 'y' => sub {
79d09e5e 504 my ($format, $time) = @_;
505 sprintf("%02d", $time->y() % 100);
d0369dd1 506 },
507 'Y' => sub {
79d09e5e 508 my ($format, $time) = @_;
509 sprintf("%4d", $time->y());
d0369dd1 510 },
79d09e5e 511 # Z taken care by libc
d0369dd1 512};
513
79d09e5e 514sub has_ftime {
515 my ($format) = @_;
516 exists $_ftime->{$format};
517}
518
519sub has_ftimes {
520 keys %$_ftime;
521}
522
523sub delete_ftime {
524 delete $_ftime->{@_};
525}
526
527sub ftime {
528 my ($format) = $_[0];
529 if (@_ == 1) {
530 return $_ftime->{$format};
531 } elsif (@_ == 2) {
532 if (ref $_[0] eq 'CODE') {
533 $_ftime->{$format} = $_[1];
534 } else {
535 require Carp;
536 Carp::croak "ftime: second argument not a code ref";
537 }
538 } else {
539 require Carp;
540 Carp::croak "ftime: want one or two arguments";
541 }
542}
543
d0369dd1 544sub _ftime {
545 my ($format, $time, @rest) = @_;
79d09e5e 546 if (has_ftime($format)) {
d0369dd1 547 # We are passing format to the anonsubs so that
548 # one can share the same sub among several formats.
549 return $_ftime->{$format}->($format, $time, @rest);
550 }
79d09e5e 551 # If we don't know it, pass it down to the libc layer.
552 # (In other words, cheat.)
553 # This pays for for '%Z', though, and for all the
554 # locale-specific %Ex and %Oy formats.
555 return $time->_strftime("%$format");
d0369dd1 556}
557
302d38aa 558sub strftime {
559 my $time = shift;
2a74cb2d 560 my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z";
d0369dd1 561 $format =~ s/%(.)/_ftime($1, $time, @_)/ge;
562 return $format;
563}
564
565sub _strftime {
566 my $time = shift;
567 my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z";
568 return __strftime($format, (@$time)[c_sec..c_isdst]);
569}
570
79d09e5e 571use vars qw($_ptime);
572
573$_ptime =
574{
575 '%' => sub {
e8be01ad 576 $_[1] =~ s/^%// && $1;
577 },
578 # a unimplemented
579 # A unimplemented
580 # b unimplemented
581 # B unimplemented
582 # c unimplemented
583 'C' => sub {
584 $_[1] =~ s/^(0[0-9])// && $1;
79d09e5e 585 },
586 'd' => sub {
e8be01ad 587 $_[1] =~ s/^(0[1-9]|2[0-9]|3[01])// && $1;
588 },
589 'D' => sub {
590 my %D;
591 my $D;
592 if (defined ($D = $_ptime->{'m'}->($_[0], $_[1]))) {
593 $D{m} = $D;
594 } else {
595 return;
596 }
597 $_[1] =~ s:^/:: || return;
598 if (defined ($D = $_ptime->{'d'}->($_[0], $_[1]))) {
599 $D{d} = $D;
600 } else {
601 return;
602 }
603 $_[1] =~ s:^/:: || return;
604 if (defined ($D = $_ptime->{'y'}->($_[0], $_[1]))) {
605 $D{y} = $D;
606 } else {
607 return;
608 }
609 return { %D };
79d09e5e 610 },
e8be01ad 611 'e' => sub {
612 $_[1] =~ s/^( [1-9]|2[0-9]|3[01])// && $1;
613 },
614 # h unimplemented
79d09e5e 615 'H' => sub {
e8be01ad 616 $_[1] =~ s/^([0-1][0-9]|2[0-3])// && $1;
617 },
618 'I' => sub {
619 $_[1] =~ s/^(0[1-9]|1[012])// && $1;
620 },
621 'j' => sub {
622 $_[1] =~ s/^([0-9][0-9][0-9])// && $1 >= 1 && $1 <= 366 && $1;
79d09e5e 623 },
624 'm' => sub {
e8be01ad 625 $_[1] =~ s/^(0[1-9]|1[012])// && $1;
79d09e5e 626 },
627 'M' => sub {
e8be01ad 628 $_[1] =~ s/^([0-5][0-9])// && $1;
629 },
630 't' => sub {
631 $_[1] =~ s/^\n// && $1;
632 },
633 'p' => sub {
634 $_[1] =~ s/^(am|pm)// && $1;
635 },
636 'r' => sub {
637 my %r;
638 my $r;
639 if (defined ($r = $_ptime->{'I'}->($_[0], $_[1]))) {
640 $r{I} = $r;
641 } else {
642 return;
643 }
644 $_[1] =~ s/^:// || return;
645 if (defined ($r = $_ptime->{'M'}->($_[0], $_[1]))) {
646 $r{M} = $r;
647 } else {
648 return;
649 }
650 $_[1] =~ s/^:// || return;
651 if (defined ($r = $_ptime->{'S'}->($_[0], $_[1]))) {
652 $r{S} = $r;
653 } else {
654 return;
655 }
656 $_[1] =~ s/^ // || return;
657 if (defined ($r = $_ptime->{'p'}->($_[0], $_[1]))) {
658 $r{p} = $r;
659 } else {
660 return;
661 }
662 return { %r };
663 },
664 'R' => sub {
665 my %R;
666 my $R;
667 if (defined ($R = $_ptime->{'H'}->($_[0], $_[1]))) {
668 $R{H} = $R;
669 } else {
670 return;
671 }
672 $_[1] =~ s/^:// || return;
673 if (defined ($R = $_ptime->{'M'}->($_[0], $_[1]))) {
674 $R{M} = $R;
675 } else {
676 return;
677 }
678 return { %R };
79d09e5e 679 },
680 'S' => sub {
e8be01ad 681 $_[1] =~ s/^([0-5][0-9])// && $1;
682 },
683 't' => sub {
684 $_[1] =~ s/^\t// && $1;
685 },
686 'T' => sub {
687 my %T;
688 my $T;
689 if (defined ($T = $_ptime->{'H'}->($_[0], $_[1]))) {
690 $T{H} = $T;
691 } else {
692 return;
693 }
694 $_[1] =~ s/^:// || return;
695 if (defined ($T = $_ptime->{'M'}->($_[0], $_[1]))) {
696 $T{M} = $T;
697 } else {
698 return;
699 }
700 $_[1] =~ s/^:// || return;
701 if (defined ($T = $_ptime->{'S'}->($_[0], $_[1]))) {
702 $T{S} = $T;
703 } else {
704 return;
705 }
706 return { %T };
707 },
708 # u unimplemented
709 # U unimplemented
710 # w unimplemented
711 # W unimplemented
712 'x' => sub {
713 my %x;
714 my $x;
715 if (defined ($x = $_ptime->{'m'}->($_[0], $_[1]))) {
716 $x{m} = $x;
717 } else {
718 return;
719 }
720 $_[1] =~ s:^/:: || return;
721 if (defined ($x = $_ptime->{'d'}->($_[0], $_[1]))) {
722 $x{d} = $x;
723 } else {
724 return;
725 }
726 $_[1] =~ s:^/:: || return;
727 if (defined ($x = $_ptime->{'y'}->($_[0], $_[1]))) {
728 $x{y} = $x;
729 } else {
730 return;
731 }
732 return { %x };
733 },
734 'y' => sub {
735 $_[1] =~ s/^([0-9][0-9])// && $1;
79d09e5e 736 },
737 'Y' => sub {
738 $_[1] =~ s/^([1-9][0-9][0-9][0-9])// && $1;
739 },
e8be01ad 740 # Z too unportable
79d09e5e 741};
742
743sub has_ptime {
744 my ($format) = @_;
745 exists $_ptime->{$format};
746}
747
748sub has_ptimes {
749 keys %$_ptime;
750}
751
752sub delete_ptime {
753 delete $_ptime->{@_};
754}
755
756sub ptime {
757 my ($format) = $_[0];
758 if (@_ == 1) {
759 return $_ptime->{$format};
760 } elsif (@_ == 2) {
761 if (ref $_[0] eq 'CODE') {
762 $_ptime->{$format} = $_[1];
763 } else {
764 require Carp;
765 Carp::croak "ptime: second argument not a code ref";
766 }
767 } else {
768 require Carp;
769 Carp::croak "ptime: want one or two arguments";
770 }
771}
772
773sub _ptime {
774 my ($format, $stime) = @_;
775 if (has_ptime($format)) {
776 # We are passing format to the anonsubs so that
777 # one can share the same sub among several formats.
e8be01ad 778 return $_ptime->{$format}->($format, $_[1]);
79d09e5e 779 }
780 die "strptime: unknown format %$format (time '$stime')\n";
781}
782
783sub strptime {
79d09e5e 784 my $format = shift;
b59310ea 785 my $stime = shift;
79d09e5e 786 my %ptime;
e8be01ad 787
79d09e5e 788 while ($format ne '') {
789 if ($format =~ s/^([^%]+)//) {
790 my $skip = $1;
791 last unless $stime =~ s/^\Q$skip//;
792 }
793 while ($format =~ s/^%(.)//) {
e8be01ad 794 my $f = $1;
795 my $t = _ptime($f, $stime);
79d09e5e 796 if (defined $t) {
e8be01ad 797 if (ref $t eq 'HASH') {
798 @ptime{keys %$t} = values %$t;
799 } else {
800 $ptime{$f} = $t;
801 }
79d09e5e 802 }
803 }
804 }
e8be01ad 805
79d09e5e 806 return %ptime;
807}
808
d0369dd1 809sub wday_names {
810 shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
811 my @old = @WDAY_NAMES;
812 if (@_) {
813 @WDAY_NAMES = @_;
814 }
815 return @old;
816}
817
818sub weekday_names {
819 shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
820 my @old = @WEEKDAY_NAMES;
821 if (@_) {
822 @WEEKDAY_NAMES = @_;
823 }
824 return @old;
302d38aa 825}
826
d0369dd1 827sub mon_names {
302d38aa 828 shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
d0369dd1 829 my @old = @MON_NAMES;
302d38aa 830 if (@_) {
d0369dd1 831 @MON_NAMES = @_;
302d38aa 832 }
833 return @old;
834}
835
d0369dd1 836sub month_names {
302d38aa 837 shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
d0369dd1 838 my @old = @MONTH_NAMES;
302d38aa 839 if (@_) {
d0369dd1 840 @MONTH_NAMES = @_;
302d38aa 841 }
842 return @old;
843}
844
845sub time_separator {
846 shift if ref($_[0]) && $_[0]->isa(__PACKAGE__);
847 my $old = $TIME_SEP;
848 if (@_) {
849 $TIME_SEP = $_[0];
850 }
851 return $old;
852}
853
854sub date_separator {
855 shift if ref($_[0]) && $_[0]->isa(__PACKAGE__);
856 my $old = $DATE_SEP;
857 if (@_) {
858 $DATE_SEP = $_[0];
859 }
860 return $old;
861}
862
863use overload '""' => \&cdate;
864
865sub cdate {
866 my $time = shift;
867 if ($time->[c_islocal]) {
868 return scalar(CORE::localtime($time->[c_epoch]));
869 }
870 else {
871 return scalar(CORE::gmtime($time->[c_epoch]));
872 }
873}
874
875use overload
876 '-' => \&subtract,
877 '+' => \&add;
878
879sub subtract {
880 my $time = shift;
881 my $rhs = shift;
882 die "Can't subtract a date from something!" if shift;
883
884 if (ref($rhs) && $rhs->isa('Time::Piece')) {
885 return Time::Seconds->new($time->[c_epoch] - $rhs->epoch);
886 }
887 else {
888 # rhs is seconds.
889 return _mktime(($time->[c_epoch] - $rhs), $time->[c_islocal]);
890 }
891}
892
893sub add {
894 warn "add\n";
895 my $time = shift;
896 my $rhs = shift;
897 croak "Invalid rhs of addition: $rhs" if ref($rhs);
898
899 return _mktime(($time->[c_epoch] + $rhs), $time->[c_islocal]);
900}
901
902use overload
903 '<=>' => \&compare;
904
905sub get_epochs {
906 my ($time, $rhs, $reverse) = @_;
907 $time = $time->epoch;
908 if (UNIVERSAL::isa($rhs, 'Time::Piece')) {
909 $rhs = $rhs->epoch;
910 }
911 if ($reverse) {
912 return $rhs, $time;
913 }
914 return $time, $rhs;
915}
916
917sub compare {
918 my ($lhs, $rhs) = get_epochs(@_);
919 return $lhs <=> $rhs;
920}
921
9221;
923__END__
924
925=head1 NAME
926
927Time::Piece - Object Oriented time objects
928
929=head1 SYNOPSIS
930
931 use Time::Piece;
932
933 my $t = localtime;
934 print "Time is $t\n";
935 print "Year is ", $t->year, "\n";
936
937=head1 DESCRIPTION
938
939This module replaces the standard localtime and gmtime functions with
940implementations that return objects. It does so in a backwards
941compatible manner, so that using localtime/gmtime in the way documented
942in perlfunc will still return what you expect.
943
944The module actually implements most of an interface described by
945Larry Wall on the perl5-porters mailing list here:
946http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2000-01/msg00241.html
947
948=head1 USAGE
949
b59310ea 950After importing this module, when you use localtime(0 or gmtime() in
951scalar context, rather than getting an ordinary scalar string
952representing the date and time, you get a Time::Piece object, whose
953stringification happens to produce the same effect as the localtime()
954and gmtime(0 functions.
955
956There is also a new() constructor provided, which is the same as
957localtime(), except when passed a Time::Piece object, in which case
958it's a copy constructor.
959
960The following methods are available on the object:
302d38aa 961
c34846e6 962 $t->s # 0..61
963 # 60 and 61: leap second and double leap second
d0369dd1 964 $t->sec # same as $t->s
965 $t->second # same as $t->s
966 $t->min # 0..59
967 $t->h # 0..24
968 $t->hour # same as $t->h
969 $t->d # 1..31
970 $t->mday # same as $t->d
971 $t->mon # 1 = January
972 $t->_mon # 0 = January
973 $t->monname # Feb
974 $t->monthname # February
975 $t->month # same as $t->monthname
976 $t->y # based at 0 (year 0 AD is, of course 1 BC)
977 $t->year # same as $t->y
978 $t->_year # year minus 1900
979 $t->wday # 1 = Sunday
980 $t->day_of_week # 0 = Sunday
981 $t->_wday # 0 = Sunday
982 $t->wdayname # Tue
983 $t->weekdayname # Tuesday
984 $t->weekday # same as weekdayname
985 $t->yday # also available as $t->day_of_year, 0 = Jan 01
986 $t->isdst # also available as $t->daylight_savings
987 $t->daylight_savings # same as $t->isdst
988
989 $t->hms # 12:34:56
990 $t->hms(".") # 12.34.56
991 $t->time # same as $t->hms
992
993 $t->ymd # 2000-02-29
994 $t->date # same as $t->ymd
995 $t->mdy # 02-29-2000
996 $t->mdy("/") # 02/29/2000
997 $t->dmy # 29-02-2000
998 $t->dmy(".") # 29.02.2000
999 $t->datetime # 2000-02-29T12:34:56 (ISO 8601)
1000 $t->cdate # Tue Feb 29 12:34:56 2000
1001 "$t" # same as $t->cdate
2a74cb2d 1002
d0369dd1 1003 $t->epoch # seconds since the epoch
1004 $t->tzoffset # timezone offset in a Time::Seconds object
1005
1006 $t->julian_day # number of days since Julian period began
1007 $t->mjd # modified Julian day
2a74cb2d 1008
d0369dd1 1009 $t->week # week number (ISO 8601)
2a74cb2d 1010
c34846e6 1011 $t->is_leap_year # true if it its
1012 Time::Piece::_is_leap_year($year) # true if it its
1013 $t->month_last_day # 28..31
2a74cb2d 1014
d0369dd1 1015 $t->time_separator($s) # set the default separator (default ":")
1016 $t->date_separator($s) # set the default separator (default "-")
c34846e6 1017 $t->wday_names(@days) # set the default weekday names, abbreviated
1018 $t->weekday_names(@days) # set the default weekday names
1019 $t->mon_names(@days) # set the default month names, abbreviated
1020 $t->month_names(@days) # set the default month names
2a74cb2d 1021
c34846e6 1022 $t->strftime($format) # date and time formatting
d0369dd1 1023 $t->strftime() # "Tue, 29 Feb 2000 12:34:56 GMT"
2a74cb2d 1024
d0369dd1 1025 $t->_strftime($format) # same as POSIX::strftime (without the
1026 # overhead of the full POSIX extension),
1027 # calls the operating system libraries,
1028 # as opposed to $t->strftime()
302d38aa 1029
c34846e6 1030 use Time::Piece 'strptime'; # date parsing
1031 my %p = strptime("%H:%M", "12:34"); # $p{H} and ${M} will be set
1032
302d38aa 1033=head2 Local Locales
1034
2a74cb2d 1035Both wdayname (day) and monname (month) allow passing in a list to use
1036to index the name of the days against. This can be useful if you need
1037to implement some form of localisation without actually installing or
b59310ea 1038using the locales provided by the operating system.
302d38aa 1039
c34846e6 1040 my @weekdays = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi );
302d38aa 1041
c34846e6 1042 my $french_day = localtime->day(@weekdays);
302d38aa 1043
1044These settings can be overriden globally too:
1045
c34846e6 1046 Time::Piece::weekday_names(@weekdays);
1047 Time::Piece::wday_names(@wdays);
302d38aa 1048
1049Or for months:
1050
d0369dd1 1051 Time::Piece::month_names(@months);
c34846e6 1052 Time::Piece::mon_names(@mon);
302d38aa 1053
1054And locally for months:
1055
1056 print localtime->month(@months);
1057
1058=head2 Date Calculations
1059
1060It's possible to use simple addition and subtraction of objects:
1061
1062 use Time::Seconds;
1063
1064 my $seconds = $t1 - $t2;
1065 $t1 += ONE_DAY; # add 1 day (constant from Time::Seconds)
1066
1067The following are valid ($t1 and $t2 are Time::Piece objects):
1068
1069 $t1 - $t2; # returns Time::Seconds object
1070 $t1 - 42; # returns Time::Piece object
1071 $t1 + 533; # returns Time::Piece object
1072
1073However adding a Time::Piece object to another Time::Piece object
1074will cause a runtime error.
1075
1076Note that the first of the above returns a Time::Seconds object, so
1077while examining the object will print the number of seconds (because
1078of the overloading), you can also get the number of minutes, hours,
1079days, weeks and years in that delta, using the Time::Seconds API.
1080
1081=head2 Date Comparisons
1082
1083Date comparisons are also possible, using the full suite of "<", ">",
1084"<=", ">=", "<=>", "==" and "!=".
1085
2a74cb2d 1086=head2 YYYY-MM-DDThh:mm:ss
1087
1088The ISO 8601 standard defines the date format to be YYYY-MM-DD, and
1089the time format to be hh:mm:ss (24 hour clock), and if combined, they
c34846e6 1090should be concatenated with the date first and with a capital 'T' in
1091front of the time.
2a74cb2d 1092
1093=head2 Week Number
1094
1095The I<week number> may be an unknown concept to some readers. The ISO
10968601 standard defines that weeks begin on a Monday and week 1 of the
c34846e6 1097year is the week that includes both January the 4th and the first
1098Thursday of the year. In other words, if the first Monday of January
1099is the 2nd, 3rd, or 4th, the preceding days of the January are part of
1100the last week of the preceding year. Week numbers range from 1 to 53.
1101
1102=head2 strftime method
1103
1104The strftime() method can be used to format Time::Piece objects for output.
1105The argument to strftime() is the format string to be used, for example:
1106
1107 $t->strftime("%H:%M");
1108
1109will output the hours and minutes concatenated with a colon. The
1110available format characters are as in the standard strftime() function
1111(unless otherwise indicated the implementation is in pure Perl,
1112no operating system strftime() is invoked):
1113
1114=over 4
1115
1116=item %%
1117
1118The percentage character "%".
1119
1120=item %a
1121
1122The abbreviated weekday name, e.g. 'Tue'. Note that the abbreviations
1123are not necessarily three characters wide in all languages.
1124
1125=item %A
1126
1127The weekday name, e.g. 'Tuesday'.
1128
1129=item %b
1130
1131The abbreviated month name, e.g. 'Feb'. Note that the abbreviations
1132are not necessarily three characters wide in all languages.
1133
1134=item %B
1135
1136The month name, e.g. 'February'.
1137
1138=item %c
1139
1140The ctime format, or the localtime()/gmtime() format: C<%a %b %m %H:%M:%S %Y>.
1141
1142(Should be avoided: use $t->timedate instead.)
1143
1144=item %C
1145
1146The 'centuries' number, e.g. 19 for the year 1999 and 20 for the year 2000.
1147
1148=item %d
1149
1150The zero-filled right-aligned day of the month, e.g. '09' or '10'.
1151
1152=item %D
1153
1154C<%m/%d/%d>.
1155
1156(Should be avoided: use $t->date instead.)
1157
1158=item %e
1159
1160The space-filled right-aligned day of the month, e.g. ' 9' or '10'.
1161
1162=item %h
1163
1164Same as C<%b>, the abbreviated monthname.
1165
1166=item %H
1167
1168The zero-filled right-aligned hours in 24 hour clock, e.g. '09' or '10'.
1169
1170=item %I
1171
1172The zero-filled right-aligned hours in 12 hour clock, e.g. '09' or '10'.
1173
1174=item %j
1175
1176The zero-filled right-aligned day of the year, e.g. '001' or '365'.
1177
1178=item %m
1179
1180The zero-filled right-aligned month number, e.g. '09' or '10'.
1181
1182=item %M
1183
1184The zero-filled right-aligned minutes, e.g. '09' or '10'.
1185
1186=item %n
1187
1188The newline character "\n".
1189
1190=item %p
1191
1192Notice that this is somewhat meaningless in 24 hour clocks.
1193
1194=item %r
1195
1196C<%I:%M:%S %p>.
1197
1198(Should be avoided: use $t->time instead.)
1199
1200=item %R
1201
1202C<%H:%M>.
1203
1204=item %S
1205
1206The zero-filled right-aligned seconds, e.g. '09' or '10'.
1207
1208=item %t
1209
1210The tabulator character "\t".
1211
1212=item %T
1213
1214C<%H:%M%S>
1215
1216(Should be avoided: use $t->time instead.)
1217
1218=item %u
1219
1220The day of the week with Monday as 1 (one) and Sunday as 7.
1221
1222=item %U
1223
1224The zero-filled right-aligned week number of the year, Sunday as the
1225first day of the week, from '00' to '53'.
1226
1227(Currently taken care by the operating system strftime().)
1228
1229=item %V
1230
1231The zero-filled right-aligned week of the year, e.g. '01' or '53'.
1232(ISO 8601)
1233
1234=item %w
1235
1236The day of the week with Sunday as 0 (zero) and Monday as 1 (one).
1237
1238=item %W
1239
1240The zero-filled right-aligned week number of the year, Monday as the
1241first day of the week, from '00' to '53'.
1242
1243(Currently taken care by the operating system strftime().)
1244
1245=item %x
1246
1247C<%m/%d/%y>.
1248
1249(Should be avoided: use $t->date instead.)
1250
1251=item %y
1252
1253The zero-filled right-aligned last two numbers of the year, e.g. 99
1254for 1999 and 01 for 2001.
1255
1256(Should be avoided: this is the Y2K bug alive and well.)
1257
1258=item %Y
1259
1260The year, e.g. 1999 or 2001.
1261
1262=item %Z
1263
1264The timezone name, for example "GMT" or "EET".
1265
1266(Taken care by the operating system strftime().)
1267
1268=back
1269
1270The format C<Z> and any of the C<O*> and C<E*> formats are handled by
1271the operating system, not by Time::Piece, because those formats are
1272usually rather unportable and non-standard. (For example 'MST' can
1273mean almost anything: 'Mountain Standard Time' or 'Moscow Standard Time'.)
1274
1275=head2 strptime function
1276
1277You can export the strptime() function and use it to parse date and
1278time strings back to numbers. For example the following will return
1279the hours, minutes, and seconds as $parse{H}, $parse{M}, and $parse{S}.
1280
1281 use Time::Piece 'strptime';
1282 my %parse = strptime('%H:%M:S', '12:34:56');
1283
1284For 'compound' formats like for example 'T' strptime() will return
1285the 'components'.
1286
1287strptime() does not perform overly strict checks on the dates and
1288times, it will be perfectly happy with the 31st day of February,
1289for example. Stricter validation should be performed by other means.
2a74cb2d 1290
302d38aa 1291=head2 Global Overriding
1292
1293Finally, it's possible to override localtime and gmtime everywhere, by
1294including the ':override' tag in the import list:
1295
1296 use Time::Piece ':override';
1297
2a74cb2d 1298=head1 SEE ALSO
1299
c34846e6 1300The excellent Calendar FAQ at L<http://www.tondering.dk/claus/calendar.html>
1301
3e2ca581 1302If you just want an object-oriented interface to the usual time
1303functions see L<Time::localtime> and L<Time::gmtime> which are part
1304of the standard distribution. Beware, though, that their fields are as
1305in the C library: the I<year> is I<year-1900> (like $t->_year in Time::Piece)
1306and I<months> begin from zero (like $t->_mon).
1307
c34846e6 1308L<strftime(3)>, L<strftime(3)>
2a74cb2d 1309
302d38aa 1310=head1 AUTHOR
1311
1312Matt Sergeant, matt@sergeant.org
1313
2a74cb2d 1314This module is based on Time::Object, with changes suggested by Jarkko
302d38aa 1315Hietaniemi before including in core perl.
1316
1317=head2 License
1318
1319This module is free software, you may distribute it under the same terms
1320as Perl.
1321
1322=head2 Bugs
1323
1324The test harness leaves much to be desired. Patches welcome.
1325
1326=cut