Commit | Line | Data |
3fea05b9 |
1 | package DateTime::Duration; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | our $VERSION = '0.53'; |
7 | |
8 | use Carp (); |
9 | use DateTime; |
10 | use DateTime::Helpers; |
11 | use Params::Validate qw( validate SCALAR ); |
12 | |
13 | use overload ( fallback => 1, |
14 | '+' => '_add_overload', |
15 | '-' => '_subtract_overload', |
16 | '*' => '_multiply_overload', |
17 | '<=>' => '_compare_overload', |
18 | 'cmp' => '_compare_overload', |
19 | ); |
20 | |
21 | use constant MAX_NANOSECONDS => 1_000_000_000; # 1E9 = almost 32 bits |
22 | |
23 | my @all_units = qw( months days minutes seconds nanoseconds ); |
24 | |
25 | # XXX - need to reject non-integers but accept infinity, NaN, & |
26 | # 1.56e+18 |
27 | sub new |
28 | { |
29 | my $class = shift; |
30 | my %p = validate( @_, |
31 | { years => { type => SCALAR, default => 0 }, |
32 | months => { type => SCALAR, default => 0 }, |
33 | weeks => { type => SCALAR, default => 0 }, |
34 | days => { type => SCALAR, default => 0 }, |
35 | hours => { type => SCALAR, default => 0 }, |
36 | minutes => { type => SCALAR, default => 0 }, |
37 | seconds => { type => SCALAR, default => 0 }, |
38 | nanoseconds => { type => SCALAR, default => 0 }, |
39 | end_of_month => { type => SCALAR, default => undef, |
40 | regex => qr/^(?:wrap|limit|preserve)$/ }, |
41 | } ); |
42 | |
43 | my $self = bless {}, $class; |
44 | |
45 | $self->{months} = ( $p{years} * 12 ) + $p{months}; |
46 | |
47 | $self->{days} = ( $p{weeks} * 7 ) + $p{days}; |
48 | |
49 | $self->{minutes} = ( $p{hours} * 60 ) + $p{minutes}; |
50 | |
51 | $self->{seconds} = $p{seconds}; |
52 | |
53 | if ( $p{nanoseconds} ) |
54 | { |
55 | $self->{nanoseconds} = $p{nanoseconds}; |
56 | $self->_normalize_nanoseconds; |
57 | } |
58 | else |
59 | { |
60 | # shortcut - if they don't need nanoseconds |
61 | $self->{nanoseconds} = 0; |
62 | } |
63 | |
64 | $self->{end_of_month} = |
65 | ( defined $p{end_of_month} |
66 | ? $p{end_of_month} |
67 | : $self->{months} < 0 |
68 | ? 'preserve' |
69 | : 'wrap' |
70 | ); |
71 | |
72 | return $self; |
73 | } |
74 | |
75 | # make the signs of seconds, nanos the same; 0 < abs(nanos) < MAX_NANOS |
76 | # NB this requires nanoseconds != 0 (callers check this already) |
77 | sub _normalize_nanoseconds |
78 | { |
79 | my $self = shift; |
80 | |
81 | return if |
82 | ( $self->{nanoseconds} == DateTime::INFINITY() |
83 | || $self->{nanoseconds} == DateTime::NEG_INFINITY() |
84 | || $self->{nanoseconds} eq DateTime::NAN() |
85 | ); |
86 | |
87 | my $seconds = $self->{seconds} + $self->{nanoseconds} / MAX_NANOSECONDS; |
88 | $self->{seconds} = int( $seconds ); |
89 | $self->{nanoseconds} = $self->{nanoseconds} % MAX_NANOSECONDS; |
90 | $self->{nanoseconds} -= MAX_NANOSECONDS if $seconds < 0; |
91 | } |
92 | |
93 | sub clone { bless { %{ $_[0] } }, ref $_[0] } |
94 | |
95 | sub years { abs( $_[0]->in_units( 'years' ) ) } |
96 | sub months { abs( $_[0]->in_units( 'months', 'years' ) ) } |
97 | sub weeks { abs( $_[0]->in_units( 'weeks' ) ) } |
98 | sub days { abs( $_[0]->in_units( 'days', 'weeks' ) ) } |
99 | sub hours { abs( $_[0]->in_units( 'hours' ) ) } |
100 | sub minutes { abs( $_[0]->in_units( 'minutes', 'hours' ) ) } |
101 | sub seconds { abs( $_[0]->in_units( 'seconds' ) ) } |
102 | sub nanoseconds { abs( $_[0]->in_units( 'nanoseconds', 'seconds' ) ) } |
103 | |
104 | sub is_positive { $_[0]->_has_positive && ! $_[0]->_has_negative } |
105 | sub is_negative { ! $_[0]->_has_positive && $_[0]->_has_negative } |
106 | |
107 | sub _has_positive { ( grep { $_ > 0 } @{ $_[0] }{@all_units} ) ? 1 : 0} |
108 | sub _has_negative { ( grep { $_ < 0 } @{ $_[0] }{@all_units} ) ? 1 : 0 } |
109 | |
110 | sub is_zero { return 0 if grep { $_ != 0 } @{ $_[0] }{@all_units}; |
111 | return 1 } |
112 | |
113 | sub delta_months { $_[0]->{months} } |
114 | sub delta_days { $_[0]->{days} } |
115 | sub delta_minutes { $_[0]->{minutes} } |
116 | sub delta_seconds { $_[0]->{seconds} } |
117 | sub delta_nanoseconds { $_[0]->{nanoseconds} } |
118 | |
119 | sub deltas |
120 | { |
121 | map { $_ => $_[0]->{$_} } @all_units; |
122 | } |
123 | |
124 | sub in_units |
125 | { |
126 | my $self = shift; |
127 | my @units = @_; |
128 | |
129 | my %units = map { $_ => 1 } @units; |
130 | |
131 | my %ret; |
132 | |
133 | my ( $months, $days, $minutes, $seconds ) = |
134 | @{ $self }{qw( months days minutes seconds )}; |
135 | |
136 | if ( $units{years} ) |
137 | { |
138 | $ret{years} = int( $months / 12 ); |
139 | $months -= $ret{years} * 12; |
140 | } |
141 | |
142 | if ( $units{months} ) |
143 | { |
144 | $ret{months} = $months; |
145 | } |
146 | |
147 | if ( $units{weeks} ) |
148 | { |
149 | $ret{weeks} = int( $days / 7 ); |
150 | $days -= $ret{weeks} * 7; |
151 | } |
152 | |
153 | if ( $units{days} ) |
154 | { |
155 | $ret{days} = $days; |
156 | } |
157 | |
158 | if ( $units{hours} ) |
159 | { |
160 | $ret{hours} = int( $minutes / 60 ); |
161 | $minutes -= $ret{hours} * 60; |
162 | } |
163 | |
164 | if ( $units{minutes} ) |
165 | { |
166 | $ret{minutes} = $minutes |
167 | } |
168 | |
169 | if ( $units{seconds} ) |
170 | { |
171 | $ret{seconds} = $seconds; |
172 | $seconds = 0; |
173 | } |
174 | |
175 | if ( $units{nanoseconds} ) |
176 | { |
177 | $ret{nanoseconds} = $seconds * MAX_NANOSECONDS + $self->{nanoseconds}; |
178 | } |
179 | |
180 | wantarray ? @ret{@units} : $ret{ $units[0] }; |
181 | } |
182 | |
183 | sub is_wrap_mode { $_[0]->{end_of_month} eq 'wrap' ? 1 : 0 } |
184 | sub is_limit_mode { $_[0]->{end_of_month} eq 'limit' ? 1 : 0 } |
185 | sub is_preserve_mode { $_[0]->{end_of_month} eq 'preserve' ? 1 : 0 } |
186 | |
187 | sub end_of_month_mode { $_[0]->{end_of_month} } |
188 | |
189 | sub calendar_duration |
190 | { |
191 | my $self = shift; |
192 | |
193 | return |
194 | (ref $self)->new( map { $_ => $self->{$_} } qw( months days end_of_month ) ) |
195 | } |
196 | |
197 | sub clock_duration |
198 | { |
199 | my $self = shift; |
200 | |
201 | return |
202 | (ref $self)->new( map { $_ => $self->{$_} } qw( minutes seconds nanoseconds end_of_month ) ) |
203 | } |
204 | |
205 | sub inverse |
206 | { |
207 | my $self = shift; |
208 | |
209 | my %new; |
210 | foreach my $u (@all_units) |
211 | { |
212 | $new{$u} = $self->{$u}; |
213 | # avoid -0 bug |
214 | $new{$u} *= -1 if $new{$u}; |
215 | } |
216 | |
217 | return (ref $self)->new(%new); |
218 | } |
219 | |
220 | sub add_duration |
221 | { |
222 | my ( $self, $dur ) = @_; |
223 | |
224 | foreach my $u (@all_units) |
225 | { |
226 | $self->{$u} += $dur->{$u}; |
227 | } |
228 | |
229 | $self->_normalize_nanoseconds if $self->{nanoseconds}; |
230 | |
231 | return $self; |
232 | } |
233 | |
234 | sub add |
235 | { |
236 | my $self = shift; |
237 | |
238 | return $self->add_duration( (ref $self)->new(@_) ); |
239 | } |
240 | |
241 | sub subtract_duration { return $_[0]->add_duration( $_[1]->inverse ) } |
242 | |
243 | sub subtract |
244 | { |
245 | my $self = shift; |
246 | |
247 | return $self->subtract_duration( (ref $self)->new(@_) ) |
248 | } |
249 | |
250 | sub multiply |
251 | { |
252 | my $self = shift; |
253 | my $multiplier = shift; |
254 | |
255 | foreach my $u (@all_units) |
256 | { |
257 | $self->{$u} *= $multiplier; |
258 | } |
259 | |
260 | $self->_normalize_nanoseconds if $self->{nanoseconds}; |
261 | |
262 | return $self; |
263 | } |
264 | |
265 | sub compare |
266 | { |
267 | my ( $class, $dur1, $dur2, $dt ) = @_; |
268 | |
269 | $dt ||= DateTime->now; |
270 | |
271 | return |
272 | DateTime->compare( $dt->clone->add_duration($dur1), $dt->clone->add_duration($dur2) ); |
273 | } |
274 | |
275 | sub _add_overload |
276 | { |
277 | my ( $d1, $d2, $rev ) = @_; |
278 | |
279 | ($d1, $d2) = ($d2, $d1) if $rev; |
280 | |
281 | if ( DateTime::Helpers::isa( $d2, 'DateTime' ) ) |
282 | { |
283 | $d2->add_duration($d1); |
284 | return; |
285 | } |
286 | |
287 | # will also work if $d1 is a DateTime.pm object |
288 | return $d1->clone->add_duration($d2); |
289 | } |
290 | |
291 | sub _subtract_overload |
292 | { |
293 | my ( $d1, $d2, $rev ) = @_; |
294 | |
295 | ($d1, $d2) = ($d2, $d1) if $rev; |
296 | |
297 | Carp::croak( "Cannot subtract a DateTime object from a DateTime::Duration object" ) |
298 | if DateTime::Helpers::isa( $d2, 'DateTime' ); |
299 | |
300 | return $d1->clone->subtract_duration($d2); |
301 | } |
302 | |
303 | sub _multiply_overload |
304 | { |
305 | my $self = shift; |
306 | |
307 | my $new = $self->clone; |
308 | |
309 | return $new->multiply(@_); |
310 | } |
311 | |
312 | sub _compare_overload |
313 | { |
314 | Carp::croak( 'DateTime::Duration does not overload comparison.' |
315 | . ' See the documentation on the compare() method for details.' ); |
316 | } |
317 | |
318 | |
319 | 1; |
320 | |
321 | __END__ |
322 | |
323 | =head1 NAME |
324 | |
325 | DateTime::Duration - Duration objects for date math |
326 | |
327 | =head1 SYNOPSIS |
328 | |
329 | use DateTime::Duration; |
330 | |
331 | $d = DateTime::Duration->new( years => 3, |
332 | months => 5, |
333 | weeks => 1, |
334 | days => 1, |
335 | hours => 6, |
336 | minutes => 15, |
337 | seconds => 45, |
338 | nanoseconds => 12000 ); |
339 | |
340 | # Convert to different units |
341 | $d->in_units('days', 'hours', 'seconds'); |
342 | |
343 | # The important parts for date math |
344 | $d->delta_months |
345 | $d->delta_days |
346 | $d->delta_minutes |
347 | $d->delta_seconds |
348 | $d->delta_nanoseconds |
349 | |
350 | my %deltas = $d->deltas |
351 | |
352 | $d->is_wrap_mode |
353 | $d->is_limit_mode |
354 | $d->is_preserve_mode |
355 | |
356 | print $d->end_of_month_mode; |
357 | |
358 | # Multiple all deltas by -1 |
359 | my $opposite = $d->inverse; |
360 | |
361 | my $bigger = $dur1 + $dur2; |
362 | my $smaller = $dur1 - $dur2; # the result could be negative |
363 | my $bigger = $dur1 * 3; |
364 | |
365 | my $base_dt = DateTime->new( year => 2000 ); |
366 | my @sorted = |
367 | sort { DateTime::Duration->compare( $a, $b, $base_dt ) } @durations; |
368 | |
369 | # Human-readable accessors, always positive, but use |
370 | # DateTime::Format::Duration instead |
371 | $d->years; |
372 | $d->months; |
373 | $d->weeks; |
374 | $d->days; |
375 | $d->hours; |
376 | $d->minutes; |
377 | $d->seconds; |
378 | $d->nanoseconds; |
379 | |
380 | if ( $d->is_positive ) { ... } |
381 | if ( $d->is_zero ) { ... } |
382 | if ( $d->is_negative ) { ... } |
383 | |
384 | =head1 DESCRIPTION |
385 | |
386 | This is a simple class for representing duration objects. These |
387 | objects are used whenever you do date math with DateTime.pm. |
388 | |
389 | See the L<How Date Math is Done|DateTime/"How Date Math is Done"> |
390 | section of the DateTime.pm documentation for more details. The short |
391 | course: One cannot in general convert between seconds, minutes, days, |
392 | and months, so this class will never do so. Instead, create the |
393 | duration with the desired units to begin with, for example by calling |
394 | the appropriate subtraction/delta method on a C<DateTime.pm> object. |
395 | |
396 | =head1 METHODS |
397 | |
398 | Like C<DateTime> itself, C<DateTime::Duration> returns the object from |
399 | mutator methods in order to make method chaining possible. |
400 | |
401 | C<DateTime::Duration> has the following methods: |
402 | |
403 | =over 4 |
404 | |
405 | =item * new( ... ) |
406 | |
407 | This method takes the parameters "years", "months", "weeks", "days", |
408 | "hours", "minutes", "seconds", "nanoseconds", and "end_of_month". All |
409 | of these except "end_of_month" are numbers. If any of the numbers are |
410 | negative, the entire duration is negative. |
411 | |
412 | All of the numbers B<must be integers>. |
413 | |
414 | Internally, years as just treated as 12 months. Similarly, weeks are |
415 | treated as 7 days, and hours are converted to minutes. Seconds and |
416 | nanoseconds are both treated separately. |
417 | |
418 | The "end_of_month" parameter must be either "wrap", "limit", or |
419 | "preserve". This parameter specifies how date math that crosses the |
420 | end of a month is handled. |
421 | |
422 | In "wrap" mode, adding months or years that result in days beyond the |
423 | end of the new month will roll over into the following month. For |
424 | instance, adding one year to Feb 29 will result in Mar 1. |
425 | |
426 | If you specify "end_of_month" mode as "limit", the end of the month is |
427 | never crossed. Thus, adding one year to Feb 29, 2000 will result in |
428 | Feb 28, 2001. If you were to then add three more years this will |
429 | result in Feb 28, 2004. |
430 | |
431 | If you specify "end_of_month" mode as "preserve", the same calculation |
432 | is done as for "limit" except that if the original date is at the end |
433 | of the month the new date will also be. For instance, adding one |
434 | month to Feb 29, 2000 will result in Mar 31, 2000. |
435 | |
436 | For positive durations, the "end_of_month" parameter defaults to wrap. |
437 | For negative durations, the default is "limit". This should match how |
438 | most people "intuitively" expect datetime math to work. |
439 | |
440 | =item * clone |
441 | |
442 | Returns a new object with the same properties as the object on which |
443 | this method was called. |
444 | |
445 | =item * in_units( ... ) |
446 | |
447 | Returns the length of the duration in the units (any of those that can |
448 | be passed to L<new>) given as arguments. All lengths are integral, |
449 | but may be negative. Smaller units are computed from what remains |
450 | after taking away the larger units given, so for example: |
451 | |
452 | my $dur = DateTime::Duration->new( years => 1, months => 15 ); |
453 | |
454 | $dur->in_units( 'years' ); # 2 |
455 | $dur->in_units( 'months' ); # 27 |
456 | $dur->in_units( 'years', 'months' ); # (2, 3) |
457 | $dur->in_units( 'weeks', 'days' ); # (0, 0) ! |
458 | |
459 | |
460 | The last example demonstrates that there will not be any conversion |
461 | between units which don't have a fixed conversion rate. The only |
462 | conversions possible are: |
463 | |
464 | =over 8 |
465 | |
466 | =item * years <=> months |
467 | |
468 | =item * weeks <=> days |
469 | |
470 | =item * hours <=> minutes |
471 | |
472 | =item * seconds <=> nanoseconds |
473 | |
474 | =back |
475 | |
476 | For the explanation of why this happens, please see the L<How Date |
477 | Math is Done|DateTime/"How Date Math is Done"> section of the |
478 | DateTime.pm documentation |
479 | |
480 | Note that the numbers returned by this method may not match the values |
481 | given to the constructor. |
482 | |
483 | In list context, in_units returns the lengths in the order of the units |
484 | given. In scalar context, it returns the length in the first unit (but |
485 | still computes in terms of all given units). |
486 | |
487 | If you need more flexibility in presenting information about |
488 | durations, please take a look a C<DateTime::Format::Duration>. |
489 | |
490 | =item * delta_months, delta_days, delta_minutes, delta_seconds, delta_nanoseconds |
491 | |
492 | These methods provide the information C<DateTime.pm> needs for doing |
493 | date math. The numbers returned may be positive or negative. |
494 | |
495 | =item * deltas |
496 | |
497 | Returns a hash with the keys "months", "days", "minutes", "seconds", |
498 | and "nanoseconds", containing all the delta information for the |
499 | object. |
500 | |
501 | =item * is_positive, is_zero, is_negative |
502 | |
503 | Indicates whether or not the duration is positive, zero, or negative. |
504 | |
505 | If the duration contains both positive and negative units, then it |
506 | will return false for B<all> of these methods. |
507 | |
508 | =item * is_wrap_mode, is_limit_mode, is_preserve_mode |
509 | |
510 | Indicates what mode is used for end of month wrapping. |
511 | |
512 | =item * end_of_month_mode |
513 | |
514 | Returns one of "wrap", "limit", or "preserve". |
515 | |
516 | =item * calendar_duration |
517 | |
518 | Returns a new object with the same I<calendar> delta (months and days |
519 | only) and end of month mode as the current object. |
520 | |
521 | =item * clock_duration |
522 | |
523 | Returns a new object with the same I<clock> deltas (minutes, seconds, |
524 | and nanoseconds) and end of month mode as the current object. |
525 | |
526 | =item * inverse |
527 | |
528 | Returns a new object with the same deltas as the current object, but |
529 | multiple by -1. The end of month mode for the new object will be the |
530 | default end of month mode, which depends on whether the new duration |
531 | is positive or negative. |
532 | |
533 | =item * add_duration( $duration_object ), subtract_duration( $duration_object ) |
534 | |
535 | Adds or subtracts one duration from another. |
536 | |
537 | =item * add( ... ), subtract( ... ) |
538 | |
539 | Syntactic sugar for addition and subtraction. The parameters given to |
540 | these methods are used to create a new object, which is then passed to |
541 | C<add_duration()> or C<subtract_duration()>, as appropriate. |
542 | |
543 | =item * multiply( $number ) |
544 | |
545 | Multiplies each unit in the by the specified number. |
546 | |
547 | =item * DateTime::Duration->compare( $duration1, $duration2, $base_datetime ) |
548 | |
549 | This is a class method that can be used to compare or sort durations. |
550 | Comparison is done by adding each duration to the specified |
551 | C<DateTime.pm> object and comparing the resulting datetimes. This is |
552 | necessary because without a base, many durations are not comparable. |
553 | For example, 1 month may or may not be longer than 29 days, depending |
554 | on what datetime it is added to. |
555 | |
556 | If no base datetime is given, then the result of C<< DateTime->now >> |
557 | is used instead. Using this default will give non-repeatable results |
558 | if used to compare two duration objects containing different units. |
559 | It will also give non-repeatable results if the durations contain |
560 | multiple types of units, such as months and days. |
561 | |
562 | However, if you know that both objects only consist of one type of |
563 | unit (months I<or> days I<or> hours, etc.), and each duration contains |
564 | the same type of unit, then the results of the comparison will be |
565 | repeatable. |
566 | |
567 | =item * years, months, weeks, days, hours, minutes, seconds, nanoseconds |
568 | |
569 | These methods return numbers indicating how many of the given unit the |
570 | object represents, after having done a conversion to any larger units. |
571 | For example, days are first converted to weeks, and then the remainder |
572 | is returned. These numbers are always positive. |
573 | |
574 | Here's what each method returns: |
575 | |
576 | $dur->years() == abs( $dur->in_units('years') ) |
577 | $dur->months() == abs( ( $dur->in_units( 'months', 'years' ) )[0] ) |
578 | $dur->weeks() == abs( $dur->in_units( 'weeks' ) ) |
579 | $dur->days() == abs( ( $dur->in_units( 'days', 'weeks' ) )[0] ) |
580 | $dur->hours() == abs( $dur->in_units( 'hours' ) ) |
581 | $dur->minutes == abs( ( $dur->in_units( 'minutes', 'hours' ) )[0] ) |
582 | $dur->seconds == abs( $dur->in_units( 'seconds' ) ) |
583 | $dur->nanoseconds() == abs( ( $dur->in_units( 'nanoseconds', 'seconds' ) )[0] ) |
584 | |
585 | If this seems confusing, remember that you can always use the |
586 | C<in_units()> method to specify exactly what you want. |
587 | |
588 | Better yet, if you are trying to generate output suitable for humans, |
589 | use the C<DateTime::Format::Duration> module. |
590 | |
591 | =back |
592 | |
593 | =head2 Overloading |
594 | |
595 | This class overloads addition, subtraction, and mutiplication. |
596 | |
597 | Comparison is B<not> overloaded. If you attempt to compare durations |
598 | using C<< <=> >> or C<cmp>, then an exception will be thrown! Use the |
599 | C<compare()> class method instead. |
600 | |
601 | =head1 SUPPORT |
602 | |
603 | Support for this module is provided via the datetime@perl.org email |
604 | list. See http://lists.perl.org/ for more details. |
605 | |
606 | =head1 AUTHOR |
607 | |
608 | Dave Rolsky <autarch@urth.org> |
609 | |
610 | However, please see the CREDITS file for more details on who I really |
611 | stole all the code from. |
612 | |
613 | =head1 COPYRIGHT |
614 | |
615 | Copyright (c) 2003-2009 David Rolsky. All rights reserved. This |
616 | program is free software; you can redistribute it and/or modify it |
617 | under the same terms as Perl itself. |
618 | |
619 | Portions of the code in this distribution are derived from other |
620 | works. Please see the CREDITS file for more details. |
621 | |
622 | The full text of the license can be found in the LICENSE file included |
623 | with this module. |
624 | |
625 | =head1 SEE ALSO |
626 | |
627 | datetime@perl.org mailing list |
628 | |
629 | http://datetime.perl.org/ |
630 | |
631 | =cut |
632 | |