← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:04 2021

Filename/usr/local/lib/perl5/site_perl/mach/5.32/DateTime/Duration.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sDateTime::Duration::::BEGIN@10DateTime::Duration::BEGIN@10
0000s0sDateTime::Duration::::BEGIN@11DateTime::Duration::BEGIN@11
0000s0sDateTime::Duration::::BEGIN@12DateTime::Duration::BEGIN@12
0000s0sDateTime::Duration::::BEGIN@13DateTime::Duration::BEGIN@13
0000s0sDateTime::Duration::::BEGIN@14DateTime::Duration::BEGIN@14
0000s0sDateTime::Duration::::BEGIN@16DateTime::Duration::BEGIN@16
0000s0sDateTime::Duration::::BEGIN@3DateTime::Duration::BEGIN@3
0000s0sDateTime::Duration::::BEGIN@4DateTime::Duration::BEGIN@4
0000s0sDateTime::Duration::::BEGIN@5DateTime::Duration::BEGIN@5
0000s0sDateTime::Duration::::BEGIN@9DateTime::Duration::BEGIN@9
0000s0sDateTime::Duration::::__ANON__DateTime::Duration::__ANON__ (xsub)
0000s0sDateTime::Duration::::_add_overloadDateTime::Duration::_add_overload
0000s0sDateTime::Duration::::_compare_overloadDateTime::Duration::_compare_overload
0000s0sDateTime::Duration::::_duration_object_from_argsDateTime::Duration::_duration_object_from_args
0000s0sDateTime::Duration::::_has_negativeDateTime::Duration::_has_negative
0000s0sDateTime::Duration::::_has_positiveDateTime::Duration::_has_positive
0000s0sDateTime::Duration::::_multiply_overloadDateTime::Duration::_multiply_overload
0000s0sDateTime::Duration::::_normalize_nanosecondsDateTime::Duration::_normalize_nanoseconds
0000s0sDateTime::Duration::::_subtract_overloadDateTime::Duration::_subtract_overload
0000s0sDateTime::Duration::::addDateTime::Duration::add
0000s0sDateTime::Duration::::add_durationDateTime::Duration::add_duration
0000s0sDateTime::Duration::::calendar_durationDateTime::Duration::calendar_duration
0000s0sDateTime::Duration::::clock_durationDateTime::Duration::clock_duration
0000s0sDateTime::Duration::::cloneDateTime::Duration::clone
0000s0sDateTime::Duration::::compareDateTime::Duration::compare
0000s0sDateTime::Duration::::daysDateTime::Duration::days
0000s0sDateTime::Duration::::delta_daysDateTime::Duration::delta_days
0000s0sDateTime::Duration::::delta_minutesDateTime::Duration::delta_minutes
0000s0sDateTime::Duration::::delta_monthsDateTime::Duration::delta_months
0000s0sDateTime::Duration::::delta_nanosecondsDateTime::Duration::delta_nanoseconds
0000s0sDateTime::Duration::::delta_secondsDateTime::Duration::delta_seconds
0000s0sDateTime::Duration::::deltasDateTime::Duration::deltas
0000s0sDateTime::Duration::::end_of_month_modeDateTime::Duration::end_of_month_mode
0000s0sDateTime::Duration::::hoursDateTime::Duration::hours
0000s0sDateTime::Duration::::in_unitsDateTime::Duration::in_units
0000s0sDateTime::Duration::::inverseDateTime::Duration::inverse
0000s0sDateTime::Duration::::is_limit_modeDateTime::Duration::is_limit_mode
0000s0sDateTime::Duration::::is_negativeDateTime::Duration::is_negative
0000s0sDateTime::Duration::::is_positiveDateTime::Duration::is_positive
0000s0sDateTime::Duration::::is_preserve_modeDateTime::Duration::is_preserve_mode
0000s0sDateTime::Duration::::is_wrap_modeDateTime::Duration::is_wrap_mode
0000s0sDateTime::Duration::::is_zeroDateTime::Duration::is_zero
0000s0sDateTime::Duration::::minutesDateTime::Duration::minutes
0000s0sDateTime::Duration::::monthsDateTime::Duration::months
0000s0sDateTime::Duration::::multiplyDateTime::Duration::multiply
0000s0sDateTime::Duration::::nanosecondsDateTime::Duration::nanoseconds
0000s0sDateTime::Duration::::newDateTime::Duration::new
0000s0sDateTime::Duration::::secondsDateTime::Duration::seconds
0000s0sDateTime::Duration::::subtractDateTime::Duration::subtract
0000s0sDateTime::Duration::::subtract_durationDateTime::Duration::subtract_duration
0000s0sDateTime::Duration::::weeksDateTime::Duration::weeks
0000s0sDateTime::Duration::::yearsDateTime::Duration::years
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package DateTime::Duration;
2
3use strict;
4use warnings;
5use namespace::autoclean;
6
7our $VERSION = '1.54';
8
9use Carp ();
10use DateTime;
11use DateTime::Helpers;
12use DateTime::Types;
13use Params::ValidationCompiler 0.26 qw( validation_for );
14use Scalar::Util qw( blessed );
15
16use overload (
17 fallback => 1,
18 '+' => '_add_overload',
19 '-' => '_subtract_overload',
20 '*' => '_multiply_overload',
21 '<=>' => '_compare_overload',
22 'cmp' => '_compare_overload',
23);
24
25sub MAX_NANOSECONDS () {1_000_000_000} # 1E9 = almost 32 bits
26
27my @all_units = qw( months days minutes seconds nanoseconds );
28
29{
30 my %units = map {
31 $_ => {
32
33 # XXX - what we really want is to accept an integer, Inf, -Inf,
34 # and NaN, but I can't figure out how to accept NaN since it never
35 # compares to anything.
36 type => t('Defined'),
37 default => 0,
38 }
39 } qw(
40 years
41 months
42 weeks
43 days
44 hours
45 minutes
46 seconds
47 nanoseconds
48 );
49
50 my $check = validation_for(
51 name => '_check_new_params',
52 name_is_optional => 1,
53 params => {
54 %units,
55 end_of_month => {
56 type => t('EndOfMonthMode'),
57 optional => 1,
58 },
59 },
60 );
61
62 sub new {
63 my $class = shift;
64 my %p = $check->(@_);
65
66 my $self = bless {}, $class;
67
68 $self->{months} = ( $p{years} * 12 ) + $p{months};
69
70 $self->{days} = ( $p{weeks} * 7 ) + $p{days};
71
72 $self->{minutes} = ( $p{hours} * 60 ) + $p{minutes};
73
74 $self->{seconds} = $p{seconds};
75
76 if ( $p{nanoseconds} ) {
77 $self->{nanoseconds} = $p{nanoseconds};
78 $self->_normalize_nanoseconds;
79 }
80 else {
81
82 # shortcut - if they don't need nanoseconds
83 $self->{nanoseconds} = 0;
84 }
85
86 $self->{end_of_month} = (
87 defined $p{end_of_month} ? $p{end_of_month}
88 : $self->{months} < 0 ? 'preserve'
89 : 'wrap'
90 );
91
92 return $self;
93 }
94}
95
96# make the signs of seconds, nanos the same; 0 < abs(nanos) < MAX_NANOS
97# NB this requires nanoseconds != 0 (callers check this already)
98sub _normalize_nanoseconds {
99 my $self = shift;
100
101 return
102 if ( $self->{nanoseconds} == DateTime::INFINITY()
103 || $self->{nanoseconds} == DateTime::NEG_INFINITY()
104 || $self->{nanoseconds} eq DateTime::NAN() );
105
106 my $seconds = $self->{seconds} + $self->{nanoseconds} / MAX_NANOSECONDS;
107 $self->{seconds} = int($seconds);
108 $self->{nanoseconds} = $self->{nanoseconds} % MAX_NANOSECONDS;
109 $self->{nanoseconds} -= MAX_NANOSECONDS if $seconds < 0;
110}
111
112sub clone { bless { %{ $_[0] } }, ref $_[0] }
113
114sub years { abs( $_[0]->in_units('years') ) }
115sub months { abs( $_[0]->in_units( 'months', 'years' ) ) }
116sub weeks { abs( $_[0]->in_units('weeks') ) }
117sub days { abs( $_[0]->in_units( 'days', 'weeks' ) ) }
118sub hours { abs( $_[0]->in_units('hours') ) }
119sub minutes { abs( $_[0]->in_units( 'minutes', 'hours' ) ) }
120sub seconds { abs( $_[0]->in_units('seconds') ) }
121sub nanoseconds { abs( $_[0]->in_units( 'nanoseconds', 'seconds' ) ) }
122
123sub is_positive { $_[0]->_has_positive && !$_[0]->_has_negative }
124sub is_negative { !$_[0]->_has_positive && $_[0]->_has_negative }
125
126sub _has_positive {
127 ( grep { $_ > 0 } @{ $_[0] }{@all_units} ) ? 1 : 0;
128}
129
130sub _has_negative {
131 ( grep { $_ < 0 } @{ $_[0] }{@all_units} ) ? 1 : 0;
132}
133
134sub is_zero {
135 return 0 if grep { $_ != 0 } @{ $_[0] }{@all_units};
136 return 1;
137}
138
139sub delta_months { $_[0]->{months} }
140sub delta_days { $_[0]->{days} }
141sub delta_minutes { $_[0]->{minutes} }
142sub delta_seconds { $_[0]->{seconds} }
143sub delta_nanoseconds { $_[0]->{nanoseconds} }
144
145sub deltas {
146 map { $_ => $_[0]->{$_} } @all_units;
147}
148
149sub in_units {
150 my $self = shift;
151 my @units = @_;
152
153 my %units = map { $_ => 1 } @units;
154
155 my %ret;
156
157 my ( $months, $days, $minutes, $seconds )
158 = @{$self}{qw( months days minutes seconds )};
159
160 if ( $units{years} ) {
161 $ret{years} = int( $months / 12 );
162 $months -= $ret{years} * 12;
163 }
164
165 if ( $units{months} ) {
166 $ret{months} = $months;
167 }
168
169 if ( $units{weeks} ) {
170 $ret{weeks} = int( $days / 7 );
171 $days -= $ret{weeks} * 7;
172 }
173
174 if ( $units{days} ) {
175 $ret{days} = $days;
176 }
177
178 if ( $units{hours} ) {
179 $ret{hours} = int( $minutes / 60 );
180 $minutes -= $ret{hours} * 60;
181 }
182
183 if ( $units{minutes} ) {
184 $ret{minutes} = $minutes;
185 }
186
187 if ( $units{seconds} ) {
188 $ret{seconds} = $seconds;
189 $seconds = 0;
190 }
191
192 if ( $units{nanoseconds} ) {
193 $ret{nanoseconds} = $seconds * MAX_NANOSECONDS + $self->{nanoseconds};
194 }
195
196 wantarray ? @ret{@units} : $ret{ $units[0] };
197}
198
199sub is_wrap_mode { $_[0]->{end_of_month} eq 'wrap' ? 1 : 0 }
200sub is_limit_mode { $_[0]->{end_of_month} eq 'limit' ? 1 : 0 }
201sub is_preserve_mode { $_[0]->{end_of_month} eq 'preserve' ? 1 : 0 }
202
203sub end_of_month_mode { $_[0]->{end_of_month} }
204
205sub calendar_duration {
206 my $self = shift;
207
208 return ( ref $self )
209 ->new( map { $_ => $self->{$_} } qw( months days end_of_month ) );
210}
211
212sub clock_duration {
213 my $self = shift;
214
215 return ( ref $self )
216 ->new( map { $_ => $self->{$_} }
217 qw( minutes seconds nanoseconds end_of_month ) );
218}
219
220sub inverse {
221 my $self = shift;
222 my %p = @_;
223
224 my %new;
225 foreach my $u (@all_units) {
226 $new{$u} = $self->{$u};
227
228 # avoid -0 bug
229 $new{$u} *= -1 if $new{$u};
230 }
231
232 $new{end_of_month} = $p{end_of_month}
233 if exists $p{end_of_month};
234
235 return ( ref $self )->new(%new);
236}
237
238sub add_duration {
239 my ( $self, $dur ) = @_;
240
241 foreach my $u (@all_units) {
242 $self->{$u} += $dur->{$u};
243 }
244
245 $self->_normalize_nanoseconds if $self->{nanoseconds};
246
247 return $self;
248}
249
250sub add {
251 my $self = shift;
252
253 return $self->add_duration( $self->_duration_object_from_args(@_) );
254}
255
256sub subtract {
257 my $self = shift;
258
259 return $self->subtract_duration( $self->_duration_object_from_args(@_) );
260}
261
262# Syntactic sugar for add and subtract: use a duration object if it's
263# supplied, otherwise build a new one from the arguments.
264sub _duration_object_from_args {
265 my $self = shift;
266
267 return $_[0]
268 if @_ == 1 && blessed( $_[0] ) && $_[0]->isa(__PACKAGE__);
269
270 return __PACKAGE__->new(@_);
271}
272
273sub subtract_duration { return $_[0]->add_duration( $_[1]->inverse ) }
274
275{
276 my $check = validation_for(
277 name => '_check_multiply_params',
278 name_is_optional => 1,
279 params => [
280 { type => t('Int') },
281 ],
282 );
283
284 sub multiply {
285 my $self = shift;
286 my ($multiplier) = $check->(@_);
287
288 foreach my $u (@all_units) {
289 $self->{$u} *= $multiplier;
290 }
291
292 $self->_normalize_nanoseconds if $self->{nanoseconds};
293
294 return $self;
295 }
296}
297
298sub compare {
299 my ( undef, $dur1, $dur2, $dt ) = @_;
300
301 $dt ||= DateTime->now;
302
303 return DateTime->compare(
304 $dt->clone->add_duration($dur1),
305 $dt->clone->add_duration($dur2)
306 );
307}
308
309sub _add_overload {
310 my ( $d1, $d2, $rev ) = @_;
311
312 ( $d1, $d2 ) = ( $d2, $d1 ) if $rev;
313
314 if ( DateTime::Helpers::isa( $d2, 'DateTime' ) ) {
315 $d2->add_duration($d1);
316 return;
317 }
318
319 # will also work if $d1 is a DateTime.pm object
320 return $d1->clone->add_duration($d2);
321}
322
323sub _subtract_overload {
324 my ( $d1, $d2, $rev ) = @_;
325
326 ( $d1, $d2 ) = ( $d2, $d1 ) if $rev;
327
328 Carp::croak(
329 'Cannot subtract a DateTime object from a DateTime::Duration object')
330 if DateTime::Helpers::isa( $d2, 'DateTime' );
331
332 return $d1->clone->subtract_duration($d2);
333}
334
335sub _multiply_overload {
336 my $self = shift;
337
338 my $new = $self->clone;
339
340 return $new->multiply(shift);
341}
342
343sub _compare_overload {
344 Carp::croak( 'DateTime::Duration does not overload comparison.'
345 . ' See the documentation on the compare() method for details.'
346 );
347}
348
3491;
350
351# ABSTRACT: Duration objects for date math
352
353__END__