← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mentat.storage.mongo.pl
  Run on Tue Jun 24 10:04:38 2014
Reported on Tue Jun 24 10:05:05 2014

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