← Index
NYTProf Performance Profile   « line view »
For -e
  Run on Thu Jun 30 16:34:56 2016
Reported on Thu Jun 30 16:35:09 2016

Filename/home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/x86_64-linux/DateTime/Duration.pm
StatementsExecuted 19 statements in 2.64ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1111.24ms1.93msDateTime::Duration::::BEGIN@13DateTime::Duration::BEGIN@13
111547µs6.87msDateTime::Duration::::BEGIN@11DateTime::Duration::BEGIN@11
111306µs2.34msDateTime::Duration::::BEGIN@10DateTime::Duration::BEGIN@10
11124µs27µsDateTime::Duration::::BEGIN@3DateTime::Duration::BEGIN@3
1118µs14µsDateTime::Duration::::BEGIN@4DateTime::Duration::BEGIN@4
1118µs8µsDateTime::Duration::::BEGIN@9DateTime::Duration::BEGIN@9
1118µs44µsDateTime::Duration::::BEGIN@22DateTime::Duration::BEGIN@22
1114µs4µsDateTime::Duration::::BEGIN@8DateTime::Duration::BEGIN@8
0000s0sDateTime::Duration::::_add_overloadDateTime::Duration::_add_overload
0000s0sDateTime::Duration::::_compare_overloadDateTime::Duration::_compare_overload
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
3230µs230µs
# spent 27µs (24+3) within DateTime::Duration::BEGIN@3 which was called: # once (24µs+3µs) by DateTime::BEGIN@12 at line 3
use strict;
# spent 27µs making 1 call to DateTime::Duration::BEGIN@3 # spent 3µs making 1 call to strict::import
4236µs219µs
# spent 14µs (8+6) within DateTime::Duration::BEGIN@4 which was called: # once (8µs+6µs) by DateTime::BEGIN@12 at line 4
use warnings;
# spent 14µs making 1 call to DateTime::Duration::BEGIN@4 # spent 6µs making 1 call to warnings::import
5
61600nsour $VERSION = '1.27';
7
8221µs14µs
# spent 4µs within DateTime::Duration::BEGIN@8 which was called: # once (4µs+0s) by DateTime::BEGIN@12 at line 8
use Carp ();
# spent 4µs making 1 call to DateTime::Duration::BEGIN@8
9226µs18µs
# spent 8µs within DateTime::Duration::BEGIN@9 which was called: # once (8µs+0s) by DateTime::BEGIN@12 at line 9
use DateTime;
# spent 8µs making 1 call to DateTime::Duration::BEGIN@9
102178µs12.34ms
# spent 2.34ms (306µs+2.03) within DateTime::Duration::BEGIN@10 which was called: # once (306µs+2.03ms) by DateTime::BEGIN@12 at line 10
use DateTime::Helpers;
# spent 2.34ms making 1 call to DateTime::Duration::BEGIN@10
112228µs26.93ms
# spent 6.87ms (547µs+6.33) within DateTime::Duration::BEGIN@11 which was called: # once (547µs+6.33ms) by DateTime::BEGIN@12 at line 11
use Params::Validate qw( validate SCALAR );
# spent 6.87ms making 1 call to DateTime::Duration::BEGIN@11 # spent 57µs making 1 call to Exporter::import
12
13
# spent 1.93ms (1.24+683µs) within DateTime::Duration::BEGIN@13 which was called: # once (1.24ms+683µs) by DateTime::BEGIN@12 at line 20
use overload (
1415µs141µs fallback => 1,
# spent 41µs making 1 call to overload::import
15 '+' => '_add_overload',
16 '-' => '_subtract_overload',
17 '*' => '_multiply_overload',
18 '<=>' => '_compare_overload',
19 'cmp' => '_compare_overload',
201653µs11.93ms);
# spent 1.93ms making 1 call to DateTime::Duration::BEGIN@13
21
2221.45ms280µs
# spent 44µs (8+36) within DateTime::Duration::BEGIN@22 which was called: # once (8µs+36µs) by DateTime::BEGIN@12 at line 22
use constant MAX_NANOSECONDS => 1_000_000_000; # 1E9 = almost 32 bits
# spent 44µs making 1 call to DateTime::Duration::BEGIN@22 # spent 36µs making 1 call to constant::import
23
2411µsmy @all_units = qw( months days minutes seconds nanoseconds );
25
26# XXX - need to reject non-integers but accept infinity, NaN, &
27# 1.56e+18
28sub new {
29 my $class = shift;
30 my %p = validate(
31 @_, {
32 years => { type => SCALAR, default => 0 },
33 months => { type => SCALAR, default => 0 },
34 weeks => { type => SCALAR, default => 0 },
35 days => { type => SCALAR, default => 0 },
36 hours => { type => SCALAR, default => 0 },
37 minutes => { type => SCALAR, default => 0 },
38 seconds => { type => SCALAR, default => 0 },
39 nanoseconds => { type => SCALAR, default => 0 },
40 end_of_month => {
41 type => SCALAR, default => undef,
42 regex => qr/^(?:wrap|limit|preserve)$/
43 },
44 }
45 );
46
47 my $self = bless {}, $class;
48
49 $self->{months} = ( $p{years} * 12 ) + $p{months};
50
51 $self->{days} = ( $p{weeks} * 7 ) + $p{days};
52
53 $self->{minutes} = ( $p{hours} * 60 ) + $p{minutes};
54
55 $self->{seconds} = $p{seconds};
56
57 if ( $p{nanoseconds} ) {
58 $self->{nanoseconds} = $p{nanoseconds};
59 $self->_normalize_nanoseconds;
60 }
61 else {
62
63 # shortcut - if they don't need nanoseconds
64 $self->{nanoseconds} = 0;
65 }
66
67 $self->{end_of_month} = (
68 defined $p{end_of_month} ? $p{end_of_month}
69 : $self->{months} < 0 ? 'preserve'
70 : 'wrap'
71 );
72
73 return $self;
74}
75
76# make the signs of seconds, nanos the same; 0 < abs(nanos) < MAX_NANOS
77# NB this requires nanoseconds != 0 (callers check this already)
78sub _normalize_nanoseconds {
79 my $self = shift;
80
81 return
82 if ( $self->{nanoseconds} == DateTime::INFINITY()
83 || $self->{nanoseconds} == DateTime::NEG_INFINITY()
84 || $self->{nanoseconds} eq DateTime::NAN() );
85
86 my $seconds = $self->{seconds} + $self->{nanoseconds} / MAX_NANOSECONDS;
87 $self->{seconds} = int($seconds);
88 $self->{nanoseconds} = $self->{nanoseconds} % MAX_NANOSECONDS;
89 $self->{nanoseconds} -= MAX_NANOSECONDS if $seconds < 0;
90}
91
92sub clone { bless { %{ $_[0] } }, ref $_[0] }
93
94sub years { abs( $_[0]->in_units('years') ) }
95sub months { abs( $_[0]->in_units( 'months', 'years' ) ) }
96sub weeks { abs( $_[0]->in_units('weeks') ) }
97sub days { abs( $_[0]->in_units( 'days', 'weeks' ) ) }
98sub hours { abs( $_[0]->in_units('hours') ) }
99sub minutes { abs( $_[0]->in_units( 'minutes', 'hours' ) ) }
100sub seconds { abs( $_[0]->in_units('seconds') ) }
101sub nanoseconds { abs( $_[0]->in_units( 'nanoseconds', 'seconds' ) ) }
102
103sub is_positive { $_[0]->_has_positive && !$_[0]->_has_negative }
104sub is_negative { !$_[0]->_has_positive && $_[0]->_has_negative }
105
106sub _has_positive {
107 ( grep { $_ > 0 } @{ $_[0] }{@all_units} ) ? 1 : 0;
108}
109
110sub _has_negative {
111 ( grep { $_ < 0 } @{ $_[0] }{@all_units} ) ? 1 : 0;
112}
113
114sub is_zero {
115 return 0 if grep { $_ != 0 } @{ $_[0] }{@all_units};
116 return 1;
117}
118
119sub delta_months { $_[0]->{months} }
120sub delta_days { $_[0]->{days} }
121sub delta_minutes { $_[0]->{minutes} }
122sub delta_seconds { $_[0]->{seconds} }
123sub delta_nanoseconds { $_[0]->{nanoseconds} }
124
125sub deltas {
126 map { $_ => $_[0]->{$_} } @all_units;
127}
128
129sub in_units {
130 my $self = shift;
131 my @units = @_;
132
133 my %units = map { $_ => 1 } @units;
134
135 my %ret;
136
137 my ( $months, $days, $minutes, $seconds )
138 = @{$self}{qw( months days minutes seconds )};
139
140 if ( $units{years} ) {
141 $ret{years} = int( $months / 12 );
142 $months -= $ret{years} * 12;
143 }
144
145 if ( $units{months} ) {
146 $ret{months} = $months;
147 }
148
149 if ( $units{weeks} ) {
150 $ret{weeks} = int( $days / 7 );
151 $days -= $ret{weeks} * 7;
152 }
153
154 if ( $units{days} ) {
155 $ret{days} = $days;
156 }
157
158 if ( $units{hours} ) {
159 $ret{hours} = int( $minutes / 60 );
160 $minutes -= $ret{hours} * 60;
161 }
162
163 if ( $units{minutes} ) {
164 $ret{minutes} = $minutes;
165 }
166
167 if ( $units{seconds} ) {
168 $ret{seconds} = $seconds;
169 $seconds = 0;
170 }
171
172 if ( $units{nanoseconds} ) {
173 $ret{nanoseconds} = $seconds * MAX_NANOSECONDS + $self->{nanoseconds};
174 }
175
176 wantarray ? @ret{@units} : $ret{ $units[0] };
177}
178
179sub is_wrap_mode { $_[0]->{end_of_month} eq 'wrap' ? 1 : 0 }
180sub is_limit_mode { $_[0]->{end_of_month} eq 'limit' ? 1 : 0 }
181sub is_preserve_mode { $_[0]->{end_of_month} eq 'preserve' ? 1 : 0 }
182
183sub end_of_month_mode { $_[0]->{end_of_month} }
184
185sub calendar_duration {
186 my $self = shift;
187
188 return ( ref $self )
189 ->new( map { $_ => $self->{$_} } qw( months days end_of_month ) );
190}
191
192sub clock_duration {
193 my $self = shift;
194
195 return ( ref $self )
196 ->new( map { $_ => $self->{$_} }
197 qw( minutes seconds nanoseconds end_of_month ) );
198}
199
200sub inverse {
201 my $self = shift;
202 my %p = @_;
203
204 my %new;
205 foreach my $u (@all_units) {
206 $new{$u} = $self->{$u};
207
208 # avoid -0 bug
209 $new{$u} *= -1 if $new{$u};
210 }
211
212 $new{end_of_month} = $p{end_of_month}
213 if exists $p{end_of_month};
214
215 return ( ref $self )->new(%new);
216}
217
218sub add_duration {
219 my ( $self, $dur ) = @_;
220
221 foreach my $u (@all_units) {
222 $self->{$u} += $dur->{$u};
223 }
224
225 $self->_normalize_nanoseconds if $self->{nanoseconds};
226
227 return $self;
228}
229
230sub add {
231 my $self = shift;
232
233 return $self->add_duration( ( ref $self )->new(@_) );
234}
235
236sub subtract_duration { return $_[0]->add_duration( $_[1]->inverse ) }
237
238sub subtract {
239 my $self = shift;
240
241 return $self->subtract_duration( ( ref $self )->new(@_) );
242}
243
244sub multiply {
245 my $self = shift;
246 my $multiplier = shift;
247
248 foreach my $u (@all_units) {
249 $self->{$u} *= $multiplier;
250 }
251
252 $self->_normalize_nanoseconds if $self->{nanoseconds};
253
254 return $self;
255}
256
257sub compare {
258 my ( $class, $dur1, $dur2, $dt ) = @_;
259
260 $dt ||= DateTime->now;
261
262 return DateTime->compare(
263 $dt->clone->add_duration($dur1),
264 $dt->clone->add_duration($dur2)
265 );
266}
267
268sub _add_overload {
269 my ( $d1, $d2, $rev ) = @_;
270
271 ( $d1, $d2 ) = ( $d2, $d1 ) if $rev;
272
273 if ( DateTime::Helpers::isa( $d2, 'DateTime' ) ) {
274 $d2->add_duration($d1);
275 return;
276 }
277
278 # will also work if $d1 is a DateTime.pm object
279 return $d1->clone->add_duration($d2);
280}
281
282sub _subtract_overload {
283 my ( $d1, $d2, $rev ) = @_;
284
285 ( $d1, $d2 ) = ( $d2, $d1 ) if $rev;
286
287 Carp::croak(
288 "Cannot subtract a DateTime object from a DateTime::Duration object")
289 if DateTime::Helpers::isa( $d2, 'DateTime' );
290
291 return $d1->clone->subtract_duration($d2);
292}
293
294sub _multiply_overload {
295 my $self = shift;
296
297 my $new = $self->clone;
298
299 return $new->multiply(@_);
300}
301
302sub _compare_overload {
303 Carp::croak( 'DateTime::Duration does not overload comparison.'
304 . ' See the documentation on the compare() method for details.'
305 );
306}
307
30814µs1;
309
310# ABSTRACT: Duration objects for date math
311
312__END__