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