← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:01:26 2013

Filename/usr/lib/perl5/DateTime/Duration.pm
StatementsExecuted 27 statements in 2.05ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11118µs71µsDateTime::Duration::::BEGIN@23DateTime::Duration::BEGIN@23
11116µs79µsDateTime::Duration::::BEGIN@12DateTime::Duration::BEGIN@12
11115µs99µsDateTime::Duration::::BEGIN@14DateTime::Duration::BEGIN@14
11114µs14µsDateTime::Duration::::BEGIN@2DateTime::Duration::BEGIN@2
11112µs16µsDateTime::Duration::::BEGIN@6DateTime::Duration::BEGIN@6
11110µs10µsDateTime::Duration::::BEGIN@10DateTime::Duration::BEGIN@10
1119µs21µsDateTime::Duration::::BEGIN@7DateTime::Duration::BEGIN@7
1116µs6µsDateTime::Duration::::BEGIN@9DateTime::Duration::BEGIN@9
1115µs5µsDateTime::Duration::::BEGIN@11DateTime::Duration::BEGIN@11
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
# spent 14µs within DateTime::Duration::BEGIN@2 which was called: # once (14µs+0s) by DateTime::BEGIN@39 at line 4
BEGIN {
3119µs $DateTime::Duration::VERSION = '0.61';
4145µs114µs}
# spent 14µs making 1 call to DateTime::Duration::BEGIN@2
5
6329µs220µs
# spent 16µs (12+4) within DateTime::Duration::BEGIN@6 which was called: # once (12µs+4µs) by DateTime::BEGIN@39 at line 6
use strict;
# spent 16µs making 1 call to DateTime::Duration::BEGIN@6 # spent 4µs making 1 call to strict::import
7326µs234µs
# spent 21µs (9+12) within DateTime::Duration::BEGIN@7 which was called: # once (9µs+12µs) by DateTime::BEGIN@39 at line 7
use warnings;
# spent 21µs making 1 call to DateTime::Duration::BEGIN@7 # spent 12µs making 1 call to warnings::import
8
9321µs16µs
# spent 6µs within DateTime::Duration::BEGIN@9 which was called: # once (6µs+0s) by DateTime::BEGIN@39 at line 9
use Carp ();
# spent 6µs making 1 call to DateTime::Duration::BEGIN@9
10328µs110µs
# spent 10µs within DateTime::Duration::BEGIN@10 which was called: # once (10µs+0s) by DateTime::BEGIN@39 at line 10
use DateTime;
# spent 10µs making 1 call to DateTime::Duration::BEGIN@10
11326µs15µs
# spent 5µs within DateTime::Duration::BEGIN@11 which was called: # once (5µs+0s) by DateTime::BEGIN@39 at line 11
use DateTime::Helpers;
# spent 5µs making 1 call to DateTime::Duration::BEGIN@11
12358µs2142µs
# spent 79µs (16+63) within DateTime::Duration::BEGIN@12 which was called: # once (16µs+63µs) by DateTime::BEGIN@39 at line 12
use Params::Validate qw( validate SCALAR );
# spent 79µs making 1 call to DateTime::Duration::BEGIN@12 # spent 63µs making 1 call to Exporter::import
13
14
# spent 99µs (15+84) within DateTime::Duration::BEGIN@14 which was called: # once (15µs+84µs) by DateTime::BEGIN@39 at line 21
use overload (
15184µs fallback => 1,
# spent 84µs making 1 call to overload::import
16 '+' => '_add_overload',
17 '-' => '_subtract_overload',
18 '*' => '_multiply_overload',
19 '<=>' => '_compare_overload',
20 'cmp' => '_compare_overload',
21339µs199µs);
# spent 99µs making 1 call to DateTime::Duration::BEGIN@14
22
2331.75ms2124µs
# spent 71µs (18+53) within DateTime::Duration::BEGIN@23 which was called: # once (18µs+53µs) by DateTime::BEGIN@39 at line 23
use constant MAX_NANOSECONDS => 1_000_000_000; # 1E9 = almost 32 bits
# spent 71µs making 1 call to DateTime::Duration::BEGIN@23 # spent 52µ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
29sub new {
30 my $class = shift;
31 my %p = validate(
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
- -
313=pod
314
- -
625__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.