Commit | Line | Data |
---|---|---|
16433e2b SP |
1 | package Time::Piece; |
2 | ||
3 | use strict; | |
4 | ||
5563b392 | 5 | require DynaLoader; |
16433e2b SP |
6 | use Time::Seconds; |
7 | use Carp; | |
8 | use Time::Local; | |
16433e2b | 9 | |
5563b392 CBW |
10 | our @ISA = qw(DynaLoader); |
11 | ||
12bbe8b8 | 12 | use Exporter (); |
16433e2b SP |
13 | |
14 | our @EXPORT = qw( | |
15 | localtime | |
16 | gmtime | |
17 | ); | |
18 | ||
19 | our %EXPORT_TAGS = ( | |
20 | ':override' => 'internal', | |
21 | ); | |
22 | ||
5563b392 | 23 | our $VERSION = '1.31'; |
16433e2b | 24 | |
5563b392 | 25 | bootstrap Time::Piece $VERSION; |
16433e2b SP |
26 | |
27 | my $DATE_SEP = '-'; | |
28 | my $TIME_SEP = ':'; | |
29 | my @MON_LIST = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); | |
30 | my @FULLMON_LIST = qw(January February March April May June July | |
31 | August September October November December); | |
32 | my @DAY_LIST = qw(Sun Mon Tue Wed Thu Fri Sat); | |
33 | my @FULLDAY_LIST = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); | |
34 | ||
12bbe8b8 CBW |
35 | use constant { |
36 | 'c_sec' => 0, | |
37 | 'c_min' => 1, | |
38 | 'c_hour' => 2, | |
39 | 'c_mday' => 3, | |
40 | 'c_mon' => 4, | |
41 | 'c_year' => 5, | |
42 | 'c_wday' => 6, | |
43 | 'c_yday' => 7, | |
44 | 'c_isdst' => 8, | |
45 | 'c_epoch' => 9, | |
46 | 'c_islocal' => 10, | |
47 | }; | |
16433e2b SP |
48 | |
49 | sub localtime { | |
50 | unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') }; | |
51 | my $class = shift; | |
52 | my $time = shift; | |
53 | $time = time if (!defined $time); | |
54 | $class->_mktime($time, 1); | |
55 | } | |
56 | ||
57 | sub gmtime { | |
58 | unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') }; | |
59 | my $class = shift; | |
60 | my $time = shift; | |
61 | $time = time if (!defined $time); | |
62 | $class->_mktime($time, 0); | |
63 | } | |
64 | ||
65 | sub new { | |
66 | my $class = shift; | |
67 | my ($time) = @_; | |
12bbe8b8 | 68 | |
16433e2b | 69 | my $self; |
12bbe8b8 | 70 | |
16433e2b SP |
71 | if (defined($time)) { |
72 | $self = $class->localtime($time); | |
73 | } | |
74 | elsif (ref($class) && $class->isa(__PACKAGE__)) { | |
75 | $self = $class->_mktime($class->epoch, $class->[c_islocal]); | |
76 | } | |
77 | else { | |
78 | $self = $class->localtime(); | |
79 | } | |
12bbe8b8 | 80 | |
90d55c29 | 81 | return bless $self, ref($class) || $class; |
16433e2b SP |
82 | } |
83 | ||
84 | sub parse { | |
85 | my $proto = shift; | |
86 | my $class = ref($proto) || $proto; | |
87 | my @components; | |
12bbe8b8 CBW |
88 | |
89 | warnings::warnif("deprecated", | |
90 | "parse() is deprecated, use strptime() instead."); | |
91 | ||
16433e2b SP |
92 | if (@_ > 1) { |
93 | @components = @_; | |
94 | } | |
95 | else { | |
96 | @components = shift =~ /(\d+)$DATE_SEP(\d+)$DATE_SEP(\d+)(?:(?:T|\s+)(\d+)$TIME_SEP(\d+)(?:$TIME_SEP(\d+)))/; | |
97 | @components = reverse(@components[0..5]); | |
98 | } | |
12bbe8b8 | 99 | return $class->new(_strftime("%s", timelocal(@components))); |
16433e2b SP |
100 | } |
101 | ||
102 | sub _mktime { | |
103 | my ($class, $time, $islocal) = @_; | |
104 | $class = eval { (ref $class) && (ref $class)->isa('Time::Piece') } | |
105 | ? ref $class | |
106 | : $class; | |
107 | if (ref($time)) { | |
12bbe8b8 CBW |
108 | my @tm_parts = (@{$time}[c_sec .. c_mon], $time->[c_year]+1900); |
109 | $time->[c_epoch] = $islocal ? timelocal(@tm_parts) : timegm(@tm_parts); | |
110 | ||
90d55c29 | 111 | return wantarray ? @$time : bless [@$time[0..9], $islocal], $class; |
16433e2b SP |
112 | } |
113 | _tzset(); | |
114 | my @time = $islocal ? | |
115 | CORE::localtime($time) | |
116 | : | |
117 | CORE::gmtime($time); | |
118 | wantarray ? @time : bless [@time, $time, $islocal], $class; | |
119 | } | |
120 | ||
121 | my %_special_exports = ( | |
122 | localtime => sub { my $c = $_[0]; sub { $c->localtime(@_) } }, | |
123 | gmtime => sub { my $c = $_[0]; sub { $c->gmtime(@_) } }, | |
124 | ); | |
125 | ||
126 | sub export { | |
127 | my ($class, $to, @methods) = @_; | |
128 | for my $method (@methods) { | |
129 | if (exists $_special_exports{$method}) { | |
130 | no strict 'refs'; | |
131 | no warnings 'redefine'; | |
132 | *{$to . "::$method"} = $_special_exports{$method}->($class); | |
133 | } else { | |
12bbe8b8 | 134 | $class->Exporter::export($to, $method); |
16433e2b SP |
135 | } |
136 | } | |
137 | } | |
138 | ||
139 | sub import { | |
12bbe8b8 | 140 | # replace CORE::GLOBAL localtime and gmtime if passed :override |
16433e2b SP |
141 | my $class = shift; |
142 | my %params; | |
143 | map($params{$_}++,@_,@EXPORT); | |
144 | if (delete $params{':override'}) { | |
145 | $class->export('CORE::GLOBAL', keys %params); | |
146 | } | |
147 | else { | |
12bbe8b8 | 148 | $class->export(scalar caller, keys %params); |
16433e2b SP |
149 | } |
150 | } | |
151 | ||
152 | ## Methods ## | |
153 | ||
154 | sub sec { | |
155 | my $time = shift; | |
156 | $time->[c_sec]; | |
157 | } | |
158 | ||
159 | *second = \&sec; | |
160 | ||
161 | sub min { | |
162 | my $time = shift; | |
163 | $time->[c_min]; | |
164 | } | |
165 | ||
166 | *minute = \&min; | |
167 | ||
168 | sub hour { | |
169 | my $time = shift; | |
170 | $time->[c_hour]; | |
171 | } | |
172 | ||
173 | sub mday { | |
174 | my $time = shift; | |
175 | $time->[c_mday]; | |
176 | } | |
177 | ||
178 | *day_of_month = \&mday; | |
179 | ||
180 | sub mon { | |
181 | my $time = shift; | |
182 | $time->[c_mon] + 1; | |
183 | } | |
184 | ||
185 | sub _mon { | |
186 | my $time = shift; | |
187 | $time->[c_mon]; | |
188 | } | |
189 | ||
190 | sub month { | |
191 | my $time = shift; | |
192 | if (@_) { | |
193 | return $_[$time->[c_mon]]; | |
194 | } | |
195 | elsif (@MON_LIST) { | |
196 | return $MON_LIST[$time->[c_mon]]; | |
197 | } | |
198 | else { | |
199 | return $time->strftime('%b'); | |
200 | } | |
201 | } | |
202 | ||
203 | *monname = \&month; | |
204 | ||
205 | sub fullmonth { | |
206 | my $time = shift; | |
207 | if (@_) { | |
208 | return $_[$time->[c_mon]]; | |
209 | } | |
210 | elsif (@FULLMON_LIST) { | |
211 | return $FULLMON_LIST[$time->[c_mon]]; | |
212 | } | |
213 | else { | |
214 | return $time->strftime('%B'); | |
215 | } | |
216 | } | |
217 | ||
218 | sub year { | |
219 | my $time = shift; | |
220 | $time->[c_year] + 1900; | |
221 | } | |
222 | ||
223 | sub _year { | |
224 | my $time = shift; | |
225 | $time->[c_year]; | |
226 | } | |
227 | ||
228 | sub yy { | |
229 | my $time = shift; | |
230 | my $res = $time->[c_year] % 100; | |
231 | return $res > 9 ? $res : "0$res"; | |
232 | } | |
233 | ||
234 | sub wday { | |
235 | my $time = shift; | |
236 | $time->[c_wday] + 1; | |
237 | } | |
238 | ||
239 | sub _wday { | |
240 | my $time = shift; | |
241 | $time->[c_wday]; | |
242 | } | |
243 | ||
244 | *day_of_week = \&_wday; | |
245 | ||
246 | sub wdayname { | |
247 | my $time = shift; | |
248 | if (@_) { | |
249 | return $_[$time->[c_wday]]; | |
250 | } | |
251 | elsif (@DAY_LIST) { | |
252 | return $DAY_LIST[$time->[c_wday]]; | |
253 | } | |
254 | else { | |
255 | return $time->strftime('%a'); | |
256 | } | |
257 | } | |
258 | ||
259 | *day = \&wdayname; | |
260 | ||
261 | sub fullday { | |
262 | my $time = shift; | |
263 | if (@_) { | |
264 | return $_[$time->[c_wday]]; | |
265 | } | |
266 | elsif (@FULLDAY_LIST) { | |
267 | return $FULLDAY_LIST[$time->[c_wday]]; | |
268 | } | |
269 | else { | |
270 | return $time->strftime('%A'); | |
271 | } | |
272 | } | |
273 | ||
274 | sub yday { | |
275 | my $time = shift; | |
276 | $time->[c_yday]; | |
277 | } | |
278 | ||
279 | *day_of_year = \&yday; | |
280 | ||
281 | sub isdst { | |
282 | my $time = shift; | |
283 | $time->[c_isdst]; | |
284 | } | |
285 | ||
286 | *daylight_savings = \&isdst; | |
287 | ||
288 | # Thanks to Tony Olekshy <olekshy@cs.ualberta.ca> for this algorithm | |
289 | sub tzoffset { | |
290 | my $time = shift; | |
12bbe8b8 | 291 | |
16433e2b SP |
292 | return Time::Seconds->new(0) unless $time->[c_islocal]; |
293 | ||
294 | my $epoch = $time->epoch; | |
295 | ||
296 | my $j = sub { | |
297 | ||
298 | my ($s,$n,$h,$d,$m,$y) = @_; $m += 1; $y += 1900; | |
299 | ||
300 | $time->_jd($y, $m, $d, $h, $n, $s); | |
301 | ||
302 | }; | |
303 | ||
304 | # Compute floating offset in hours. | |
305 | # | |
90d55c29 CBW |
306 | # Note use of crt methods so the tz is properly set... |
307 | # See: http://perlmonks.org/?node_id=820347 | |
308 | my $delta = 24 * ($j->(_crt_localtime($epoch)) - $j->(_crt_gmtime($epoch))); | |
16433e2b SP |
309 | |
310 | # Return value in seconds rounded to nearest minute. | |
311 | return Time::Seconds->new( int($delta * 60 + ($delta >= 0 ? 0.5 : -0.5)) * 60 ); | |
312 | } | |
313 | ||
314 | sub epoch { | |
315 | my $time = shift; | |
316 | if (defined($time->[c_epoch])) { | |
317 | return $time->[c_epoch]; | |
318 | } | |
319 | else { | |
320 | my $epoch = $time->[c_islocal] ? | |
321 | timelocal(@{$time}[c_sec .. c_mon], $time->[c_year]+1900) | |
322 | : | |
323 | timegm(@{$time}[c_sec .. c_mon], $time->[c_year]+1900); | |
324 | $time->[c_epoch] = $epoch; | |
325 | return $epoch; | |
326 | } | |
327 | } | |
328 | ||
329 | sub hms { | |
330 | my $time = shift; | |
331 | my $sep = @_ ? shift(@_) : $TIME_SEP; | |
332 | sprintf("%02d$sep%02d$sep%02d", $time->[c_hour], $time->[c_min], $time->[c_sec]); | |
333 | } | |
334 | ||
335 | *time = \&hms; | |
336 | ||
337 | sub ymd { | |
338 | my $time = shift; | |
339 | my $sep = @_ ? shift(@_) : $DATE_SEP; | |
340 | sprintf("%d$sep%02d$sep%02d", $time->year, $time->mon, $time->[c_mday]); | |
341 | } | |
342 | ||
343 | *date = \&ymd; | |
344 | ||
345 | sub mdy { | |
346 | my $time = shift; | |
347 | my $sep = @_ ? shift(@_) : $DATE_SEP; | |
348 | sprintf("%02d$sep%02d$sep%d", $time->mon, $time->[c_mday], $time->year); | |
349 | } | |
350 | ||
351 | sub dmy { | |
352 | my $time = shift; | |
353 | my $sep = @_ ? shift(@_) : $DATE_SEP; | |
354 | sprintf("%02d$sep%02d$sep%d", $time->[c_mday], $time->mon, $time->year); | |
355 | } | |
356 | ||
357 | sub datetime { | |
358 | my $time = shift; | |
359 | my %seps = (date => $DATE_SEP, T => 'T', time => $TIME_SEP, @_); | |
360 | return join($seps{T}, $time->date($seps{date}), $time->time($seps{time})); | |
361 | } | |
362 | ||
363 | ||
364 | ||
365 | # Julian Day is always calculated for UT regardless | |
366 | # of local time | |
367 | sub julian_day { | |
368 | my $time = shift; | |
369 | # Correct for localtime | |
370 | $time = $time->gmtime( $time->epoch ) if $time->[c_islocal]; | |
371 | ||
372 | # Calculate the Julian day itself | |
373 | my $jd = $time->_jd( $time->year, $time->mon, $time->mday, | |
374 | $time->hour, $time->min, $time->sec); | |
375 | ||
376 | return $jd; | |
377 | } | |
378 | ||
379 | # MJD is defined as JD - 2400000.5 days | |
380 | sub mjd { | |
381 | return shift->julian_day - 2_400_000.5; | |
382 | } | |
383 | ||
384 | # Internal calculation of Julian date. Needed here so that | |
385 | # both tzoffset and mjd/jd methods can share the code | |
386 | # Algorithm from Hatcher 1984 (QJRAS 25, 53-55), and | |
387 | # Hughes et al, 1989, MNRAS, 238, 15 | |
388 | # See: http://adsabs.harvard.edu/cgi-bin/nph-bib_query?bibcode=1989MNRAS.238.1529H&db_key=AST | |
389 | # for more details | |
390 | ||
391 | sub _jd { | |
392 | my $self = shift; | |
393 | my ($y, $m, $d, $h, $n, $s) = @_; | |
394 | ||
395 | # Adjust input parameters according to the month | |
396 | $y = ( $m > 2 ? $y : $y - 1); | |
397 | $m = ( $m > 2 ? $m - 3 : $m + 9); | |
398 | ||
399 | # Calculate the Julian Date (assuming Julian calendar) | |
400 | my $J = int( 365.25 *( $y + 4712) ) | |
401 | + int( (30.6 * $m) + 0.5) | |
402 | + 59 | |
403 | + $d | |
404 | - 0.5; | |
405 | ||
406 | # Calculate the Gregorian Correction (since we have Gregorian dates) | |
407 | my $G = 38 - int( 0.75 * int(49+($y/100))); | |
408 | ||
409 | # Calculate the actual Julian Date | |
410 | my $JD = $J + $G; | |
411 | ||
412 | # Modify to include hours/mins/secs in floating portion. | |
413 | return $JD + ($h + ($n + $s / 60) / 60) / 24; | |
414 | } | |
415 | ||
416 | sub week { | |
417 | my $self = shift; | |
418 | ||
419 | my $J = $self->julian_day; | |
420 | # Julian day is independent of time zone so add on tzoffset | |
421 | # if we are using local time here since we want the week day | |
422 | # to reflect the local time rather than UTC | |
423 | $J += ($self->tzoffset/(24*3600)) if $self->[c_islocal]; | |
424 | ||
425 | # Now that we have the Julian day including fractions | |
426 | # convert it to an integer Julian Day Number using nearest | |
ca06683f | 427 | # int (since the day changes at midday we convert all Julian |
16433e2b SP |
428 | # dates to following midnight). |
429 | $J = int($J+0.5); | |
430 | ||
431 | use integer; | |
432 | my $d4 = ((($J + 31741 - ($J % 7)) % 146097) % 36524) % 1461; | |
433 | my $L = $d4 / 1460; | |
434 | my $d1 = (($d4 - $L) % 365) + $L; | |
435 | return $d1 / 7 + 1; | |
436 | } | |
437 | ||
438 | sub _is_leap_year { | |
439 | my $year = shift; | |
440 | return (($year %4 == 0) && !($year % 100 == 0)) || ($year % 400 == 0) | |
441 | ? 1 : 0; | |
442 | } | |
443 | ||
444 | sub is_leap_year { | |
445 | my $time = shift; | |
446 | my $year = $time->year; | |
447 | return _is_leap_year($year); | |
448 | } | |
449 | ||
450 | my @MON_LAST = qw(31 28 31 30 31 30 31 31 30 31 30 31); | |
451 | ||
452 | sub month_last_day { | |
453 | my $time = shift; | |
454 | my $year = $time->year; | |
455 | my $_mon = $time->_mon; | |
456 | return $MON_LAST[$_mon] + ($_mon == 1 ? _is_leap_year($year) : 0); | |
457 | } | |
458 | ||
12bbe8b8 CBW |
459 | #since %z and %Z are not portable lets just |
460 | #parse it out before calling native strftime | |
461 | #(but only if we are in UTC time) | |
462 | my %GMT_REPR = ( | |
463 | '%z' => '+0000', | |
464 | '%Z' => 'UTC', | |
465 | ); | |
466 | ||
16433e2b SP |
467 | sub strftime { |
468 | my $time = shift; | |
12bbe8b8 CBW |
469 | my $format = @_ ? shift(@_) : '%a, %d %b %Y %H:%M:%S %Z'; |
470 | if (! $time->[c_islocal]) { | |
471 | $format =~ s/(%.)/$GMT_REPR{$1} || $1/eg; | |
16433e2b | 472 | } |
12bbe8b8 CBW |
473 | |
474 | return _strftime($format, $time->epoch, $time->[c_islocal]); | |
16433e2b SP |
475 | } |
476 | ||
477 | sub strptime { | |
478 | my $time = shift; | |
479 | my $string = shift; | |
480 | my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z"; | |
481 | my @vals = _strptime($string, $format); | |
482 | # warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals))); | |
483 | return scalar $time->_mktime(\@vals, (ref($time) ? $time->[c_islocal] : 0)); | |
484 | } | |
485 | ||
486 | sub day_list { | |
487 | shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method | |
488 | my @old = @DAY_LIST; | |
489 | if (@_) { | |
490 | @DAY_LIST = @_; | |
491 | } | |
492 | return @old; | |
493 | } | |
494 | ||
495 | sub mon_list { | |
496 | shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method | |
497 | my @old = @MON_LIST; | |
498 | if (@_) { | |
499 | @MON_LIST = @_; | |
500 | } | |
501 | return @old; | |
502 | } | |
503 | ||
504 | sub time_separator { | |
505 | shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); | |
506 | my $old = $TIME_SEP; | |
507 | if (@_) { | |
508 | $TIME_SEP = $_[0]; | |
509 | } | |
510 | return $old; | |
511 | } | |
512 | ||
513 | sub date_separator { | |
514 | shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); | |
515 | my $old = $DATE_SEP; | |
516 | if (@_) { | |
517 | $DATE_SEP = $_[0]; | |
518 | } | |
519 | return $old; | |
520 | } | |
521 | ||
522 | use overload '""' => \&cdate, | |
523 | 'cmp' => \&str_compare, | |
524 | 'fallback' => undef; | |
525 | ||
526 | sub cdate { | |
527 | my $time = shift; | |
528 | if ($time->[c_islocal]) { | |
529 | return scalar(CORE::localtime($time->epoch)); | |
530 | } | |
531 | else { | |
532 | return scalar(CORE::gmtime($time->epoch)); | |
533 | } | |
534 | } | |
535 | ||
536 | sub str_compare { | |
537 | my ($lhs, $rhs, $reverse) = @_; | |
538 | if (UNIVERSAL::isa($rhs, 'Time::Piece')) { | |
539 | $rhs = "$rhs"; | |
540 | } | |
541 | return $reverse ? $rhs cmp $lhs->cdate : $lhs->cdate cmp $rhs; | |
542 | } | |
543 | ||
544 | use overload | |
545 | '-' => \&subtract, | |
546 | '+' => \&add; | |
547 | ||
548 | sub subtract { | |
549 | my $time = shift; | |
550 | my $rhs = shift; | |
551 | if (UNIVERSAL::isa($rhs, 'Time::Seconds')) { | |
552 | $rhs = $rhs->seconds; | |
553 | } | |
e3db0d81 RGS |
554 | |
555 | if (shift) | |
556 | { | |
557 | # SWAPED is set (so someone tried an expression like NOTDATE - DATE). | |
558 | # Imitate Perl's standard behavior and return the result as if the | |
559 | # string $time resolves to was subtracted from NOTDATE. This way, | |
560 | # classes which override this one and which have a stringify function | |
561 | # that resolves to something that looks more like a number don't need | |
562 | # to override this function. | |
563 | return $rhs - "$time"; | |
564 | } | |
12bbe8b8 | 565 | |
16433e2b SP |
566 | if (UNIVERSAL::isa($rhs, 'Time::Piece')) { |
567 | return Time::Seconds->new($time->epoch - $rhs->epoch); | |
568 | } | |
569 | else { | |
570 | # rhs is seconds. | |
571 | return $time->_mktime(($time->epoch - $rhs), $time->[c_islocal]); | |
572 | } | |
573 | } | |
574 | ||
575 | sub add { | |
576 | my $time = shift; | |
577 | my $rhs = shift; | |
578 | if (UNIVERSAL::isa($rhs, 'Time::Seconds')) { | |
579 | $rhs = $rhs->seconds; | |
580 | } | |
581 | croak "Invalid rhs of addition: $rhs" if ref($rhs); | |
582 | ||
583 | return $time->_mktime(($time->epoch + $rhs), $time->[c_islocal]); | |
584 | } | |
585 | ||
586 | use overload | |
587 | '<=>' => \&compare; | |
588 | ||
589 | sub get_epochs { | |
590 | my ($lhs, $rhs, $reverse) = @_; | |
591 | if (!UNIVERSAL::isa($rhs, 'Time::Piece')) { | |
592 | $rhs = $lhs->new($rhs); | |
593 | } | |
594 | if ($reverse) { | |
595 | return $rhs->epoch, $lhs->epoch; | |
596 | } | |
597 | return $lhs->epoch, $rhs->epoch; | |
598 | } | |
599 | ||
600 | sub compare { | |
601 | my ($lhs, $rhs) = get_epochs(@_); | |
602 | return $lhs <=> $rhs; | |
603 | } | |
604 | ||
124e6c84 RGS |
605 | sub add_months { |
606 | my ($time, $num_months) = @_; | |
12bbe8b8 | 607 | |
124e6c84 | 608 | croak("add_months requires a number of months") unless defined($num_months); |
12bbe8b8 | 609 | |
124e6c84 RGS |
610 | my $final_month = $time->_mon + $num_months; |
611 | my $num_years = 0; | |
612 | if ($final_month > 11 || $final_month < 0) { | |
613 | # these two ops required because we have no POSIX::floor and don't | |
614 | # want to load POSIX.pm | |
90d55c29 CBW |
615 | if ($final_month < 0 && $final_month % 12 == 0) { |
616 | $num_years = int($final_month / 12) + 1; | |
617 | } | |
618 | else { | |
619 | $num_years = int($final_month / 12); | |
620 | } | |
124e6c84 | 621 | $num_years-- if ($final_month < 0); |
12bbe8b8 | 622 | |
124e6c84 RGS |
623 | $final_month = $final_month % 12; |
624 | } | |
12bbe8b8 | 625 | |
3df1a9e2 GA |
626 | my @vals = _mini_mktime($time->sec, $time->min, $time->hour, |
627 | $time->mday, $final_month, $time->year - 1900 + $num_years); | |
90d55c29 | 628 | # warn(sprintf("got %d vals: %d-%d-%d %d:%d:%d [%d]\n", scalar(@vals), reverse(@vals), $time->[c_islocal])); |
124e6c84 RGS |
629 | return scalar $time->_mktime(\@vals, $time->[c_islocal]); |
630 | } | |
631 | ||
632 | sub add_years { | |
633 | my ($time, $years) = @_; | |
634 | $time->add_months($years * 12); | |
635 | } | |
636 | ||
16433e2b SP |
637 | 1; |
638 | __END__ | |
639 | ||
640 | =head1 NAME | |
641 | ||
642 | Time::Piece - Object Oriented time objects | |
643 | ||
644 | =head1 SYNOPSIS | |
645 | ||
646 | use Time::Piece; | |
647 | ||
648 | my $t = localtime; | |
649 | print "Time is $t\n"; | |
650 | print "Year is ", $t->year, "\n"; | |
651 | ||
652 | =head1 DESCRIPTION | |
653 | ||
9bc7f50b | 654 | This module replaces the standard C<localtime> and C<gmtime> functions with |
16433e2b SP |
655 | implementations that return objects. It does so in a backwards |
656 | compatible manner, so that using localtime/gmtime in the way documented | |
657 | in perlfunc will still return what you expect. | |
658 | ||
659 | The module actually implements most of an interface described by | |
660 | Larry Wall on the perl5-porters mailing list here: | |
661 | http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2000-01/msg00241.html | |
662 | ||
663 | =head1 USAGE | |
664 | ||
665 | After importing this module, when you use localtime or gmtime in a scalar | |
666 | context, rather than getting an ordinary scalar string representing the | |
667 | date and time, you get a Time::Piece object, whose stringification happens | |
668 | to produce the same effect as the localtime and gmtime functions. There is | |
669 | also a new() constructor provided, which is the same as localtime(), except | |
670 | when passed a Time::Piece object, in which case it's a copy constructor. The | |
671 | following methods are available on the object: | |
672 | ||
673 | $t->sec # also available as $t->second | |
674 | $t->min # also available as $t->minute | |
675 | $t->hour # 24 hour | |
676 | $t->mday # also available as $t->day_of_month | |
677 | $t->mon # 1 = January | |
678 | $t->_mon # 0 = January | |
679 | $t->monname # Feb | |
680 | $t->month # same as $t->monname | |
681 | $t->fullmonth # February | |
682 | $t->year # based at 0 (year 0 AD is, of course 1 BC) | |
683 | $t->_year # year minus 1900 | |
684 | $t->yy # 2 digit year | |
685 | $t->wday # 1 = Sunday | |
686 | $t->_wday # 0 = Sunday | |
687 | $t->day_of_week # 0 = Sunday | |
688 | $t->wdayname # Tue | |
689 | $t->day # same as wdayname | |
690 | $t->fullday # Tuesday | |
691 | $t->yday # also available as $t->day_of_year, 0 = Jan 01 | |
692 | $t->isdst # also available as $t->daylight_savings | |
693 | ||
694 | $t->hms # 12:34:56 | |
695 | $t->hms(".") # 12.34.56 | |
696 | $t->time # same as $t->hms | |
697 | ||
698 | $t->ymd # 2000-02-29 | |
699 | $t->date # same as $t->ymd | |
700 | $t->mdy # 02-29-2000 | |
701 | $t->mdy("/") # 02/29/2000 | |
702 | $t->dmy # 29-02-2000 | |
703 | $t->dmy(".") # 29.02.2000 | |
704 | $t->datetime # 2000-02-29T12:34:56 (ISO 8601) | |
705 | $t->cdate # Tue Feb 29 12:34:56 2000 | |
706 | "$t" # same as $t->cdate | |
707 | ||
708 | $t->epoch # seconds since the epoch | |
709 | $t->tzoffset # timezone offset in a Time::Seconds object | |
710 | ||
711 | $t->julian_day # number of days since Julian period began | |
712 | $t->mjd # modified Julian date (JD-2400000.5 days) | |
713 | ||
714 | $t->week # week number (ISO 8601) | |
715 | ||
5563b392 | 716 | $t->is_leap_year # true if it's a leap year |
16433e2b SP |
717 | $t->month_last_day # 28-31 |
718 | ||
719 | $t->time_separator($s) # set the default separator (default ":") | |
720 | $t->date_separator($s) # set the default separator (default "-") | |
721 | $t->day_list(@days) # set the default weekdays | |
722 | $t->mon_list(@days) # set the default months | |
723 | ||
724 | $t->strftime(FORMAT) # same as POSIX::strftime (without the overhead | |
725 | # of the full POSIX extension) | |
726 | $t->strftime() # "Tue, 29 Feb 2000 12:34:56 GMT" | |
727 | ||
728 | Time::Piece->strptime(STRING, FORMAT) | |
729 | # see strptime man page. Creates a new | |
730 | # Time::Piece object | |
731 | ||
9bc7f50b CBW |
732 | Note that C<localtime> and C<gmtime> are not listed above. If called as |
733 | methods on a Time::Piece object, they act as constructors, returning a new | |
734 | Time::Piece object for the current time. In other words: they're not useful as | |
735 | methods. | |
736 | ||
16433e2b SP |
737 | =head2 Local Locales |
738 | ||
739 | Both wdayname (day) and monname (month) allow passing in a list to use | |
740 | to index the name of the days against. This can be useful if you need | |
741 | to implement some form of localisation without actually installing or | |
742 | using locales. | |
743 | ||
744 | my @days = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi ); | |
745 | ||
746 | my $french_day = localtime->day(@days); | |
747 | ||
ca06683f | 748 | These settings can be overridden globally too: |
16433e2b SP |
749 | |
750 | Time::Piece::day_list(@days); | |
751 | ||
752 | Or for months: | |
753 | ||
754 | Time::Piece::mon_list(@months); | |
755 | ||
756 | And locally for months: | |
757 | ||
758 | print localtime->month(@months); | |
759 | ||
760 | =head2 Date Calculations | |
761 | ||
762 | It's possible to use simple addition and subtraction of objects: | |
763 | ||
764 | use Time::Seconds; | |
765 | ||
766 | my $seconds = $t1 - $t2; | |
767 | $t1 += ONE_DAY; # add 1 day (constant from Time::Seconds) | |
768 | ||
769 | The following are valid ($t1 and $t2 are Time::Piece objects): | |
770 | ||
771 | $t1 - $t2; # returns Time::Seconds object | |
772 | $t1 - 42; # returns Time::Piece object | |
773 | $t1 + 533; # returns Time::Piece object | |
774 | ||
775 | However adding a Time::Piece object to another Time::Piece object | |
776 | will cause a runtime error. | |
777 | ||
778 | Note that the first of the above returns a Time::Seconds object, so | |
779 | while examining the object will print the number of seconds (because | |
780 | of the overloading), you can also get the number of minutes, hours, | |
781 | days, weeks and years in that delta, using the Time::Seconds API. | |
782 | ||
124e6c84 RGS |
783 | In addition to adding seconds, there are two APIs for adding months and |
784 | years: | |
785 | ||
786 | $t->add_months(6); | |
787 | $t->add_years(5); | |
788 | ||
789 | The months and years can be negative for subtractions. Note that there | |
790 | is some "strange" behaviour when adding and subtracting months at the | |
791 | ends of months. Generally when the resulting month is shorter than the | |
792 | starting month then the number of overlap days is added. For example | |
793 | subtracting a month from 2008-03-31 will not result in 2008-02-31 as this | |
794 | is an impossible date. Instead you will get 2008-03-02. This appears to | |
795 | be consistent with other date manipulation tools. | |
796 | ||
16433e2b SP |
797 | =head2 Date Comparisons |
798 | ||
799 | Date comparisons are also possible, using the full suite of "<", ">", | |
800 | "<=", ">=", "<=>", "==" and "!=". | |
801 | ||
802 | =head2 Date Parsing | |
803 | ||
90d55c29 | 804 | Time::Piece has a built-in strptime() function (from FreeBSD), allowing |
16433e2b SP |
805 | you incredibly flexible date parsing routines. For example: |
806 | ||
90d55c29 | 807 | my $t = Time::Piece->strptime("Sunday 3rd Nov, 1943", |
16433e2b SP |
808 | "%A %drd %b, %Y"); |
809 | ||
810 | print $t->strftime("%a, %d %b %Y"); | |
811 | ||
812 | Outputs: | |
813 | ||
814 | Wed, 03 Nov 1943 | |
815 | ||
816 | (see, it's even smart enough to fix my obvious date bug) | |
817 | ||
818 | For more information see "man strptime", which should be on all unix | |
819 | systems. | |
820 | ||
90d55c29 CBW |
821 | Alternatively look here: http://www.unix.com/man-page/FreeBSD/3/strftime/ |
822 | ||
16433e2b SP |
823 | =head2 YYYY-MM-DDThh:mm:ss |
824 | ||
825 | The ISO 8601 standard defines the date format to be YYYY-MM-DD, and | |
826 | the time format to be hh:mm:ss (24 hour clock), and if combined, they | |
827 | should be concatenated with date first and with a capital 'T' in front | |
828 | of the time. | |
829 | ||
830 | =head2 Week Number | |
831 | ||
832 | The I<week number> may be an unknown concept to some readers. The ISO | |
833 | 8601 standard defines that weeks begin on a Monday and week 1 of the | |
834 | year is the week that includes both January 4th and the first Thursday | |
835 | of the year. In other words, if the first Monday of January is the | |
836 | 2nd, 3rd, or 4th, the preceding days of the January are part of the | |
837 | last week of the preceding year. Week numbers range from 1 to 53. | |
838 | ||
839 | =head2 Global Overriding | |
840 | ||
841 | Finally, it's possible to override localtime and gmtime everywhere, by | |
842 | including the ':override' tag in the import list: | |
843 | ||
844 | use Time::Piece ':override'; | |
845 | ||
12016aad SH |
846 | =head1 CAVEATS |
847 | ||
848 | =head2 Setting $ENV{TZ} in Threads on Win32 | |
849 | ||
850 | Note that when using perl in the default build configuration on Win32 | |
851 | (specifically, when perl is built with PERL_IMPLICIT_SYS), each perl | |
852 | interpreter maintains its own copy of the environment and only the main | |
853 | interpreter will update the process environment seen by strftime. | |
854 | ||
855 | Therefore, if you make changes to $ENV{TZ} from inside a thread other than | |
856 | the main thread then those changes will not be seen by strftime if you | |
857 | subsequently call that with the %Z formatting code. You must change $ENV{TZ} | |
858 | in the main thread to have the desired effect in this case (and you must | |
859 | also call _tzset() in the main thread to register the environment change). | |
860 | ||
8177d4d9 SH |
861 | Furthermore, remember that this caveat also applies to fork(), which is |
862 | emulated by threads on Win32. | |
863 | ||
90d55c29 CBW |
864 | =head2 Use of epoch seconds |
865 | ||
866 | This module internally uses the epoch seconds system that is provided via | |
867 | the perl C<time()> function and supported by C<gmtime()> and C<localtime()>. | |
868 | ||
869 | If your perl does not support times larger than C<2^31> seconds then this | |
870 | module is likely to fail at processing dates beyond the year 2038. There are | |
871 | moves afoot to fix that in perl. Alternatively use 64 bit perl. Or if none | |
872 | of those are options, use the L<DateTime> module which has support for years | |
873 | well into the future and past. | |
874 | ||
16433e2b SP |
875 | =head1 AUTHOR |
876 | ||
877 | Matt Sergeant, matt@sergeant.org | |
878 | Jarkko Hietaniemi, jhi@iki.fi (while creating Time::Piece for core perl) | |
879 | ||
21d55435 SH |
880 | =head1 COPYRIGHT AND LICENSE |
881 | ||
882 | Copyright 2001, Larry Wall. | |
16433e2b SP |
883 | |
884 | This module is free software, you may distribute it under the same terms | |
885 | as Perl. | |
886 | ||
887 | =head1 SEE ALSO | |
888 | ||
889 | The excellent Calendar FAQ at http://www.tondering.dk/claus/calendar.html | |
890 | ||
891 | =head1 BUGS | |
892 | ||
893 | The test harness leaves much to be desired. Patches welcome. | |
894 | ||
895 | =cut |