← 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 17:10:45 2013
Reported on Tue Oct 15 17:11:26 2013

Filename/usr/share/perl5/DateTime/Span.pm
StatementsExecuted 26 statements in 1.72ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1113.03ms3.40msDateTime::Span::::BEGIN@10DateTime::Span::BEGIN@10
11119µs23µsDateTime::Span::::BEGIN@7DateTime::Span::BEGIN@7
11115µs16µsDateTime::Span::::BEGIN@9DateTime::Span::BEGIN@9
11111µs115µsDateTime::Span::::BEGIN@15DateTime::Span::BEGIN@15
11111µs74µsDateTime::Span::::BEGIN@12DateTime::Span::BEGIN@12
11110µs47µsDateTime::Span::::BEGIN@16DateTime::Span::BEGIN@16
11110µs35µsDateTime::Span::::BEGIN@13DateTime::Span::BEGIN@13
0000s0sDateTime::Span::::__ANON__[:28]DateTime::Span::__ANON__[:28]
0000s0sDateTime::Span::::cloneDateTime::Span::clone
0000s0sDateTime::Span::::complementDateTime::Span::complement
0000s0sDateTime::Span::::containsDateTime::Span::contains
0000s0sDateTime::Span::::durationDateTime::Span::duration
0000s0sDateTime::Span::::endDateTime::Span::end
0000s0sDateTime::Span::::end_is_closedDateTime::Span::end_is_closed
0000s0sDateTime::Span::::end_is_openDateTime::Span::end_is_open
0000s0sDateTime::Span::::from_datetime_and_durationDateTime::Span::from_datetime_and_duration
0000s0sDateTime::Span::::from_datetimesDateTime::Span::from_datetimes
0000s0sDateTime::Span::::intersectionDateTime::Span::intersection
0000s0sDateTime::Span::::intersectsDateTime::Span::intersects
0000s0sDateTime::Span::::newDateTime::Span::new
0000s0sDateTime::Span::::set_time_zoneDateTime::Span::set_time_zone
0000s0sDateTime::Span::::spanDateTime::Span::span
0000s0sDateTime::Span::::startDateTime::Span::start
0000s0sDateTime::Span::::start_is_closedDateTime::Span::start_is_closed
0000s0sDateTime::Span::::start_is_openDateTime::Span::start_is_open
0000s0sDateTime::Span::::unionDateTime::Span::union
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved.
2# This program is free software; you can redistribute it and/or
3# modify it under the same terms as Perl itself.
4
5package DateTime::Span;
6
7332µs227µs
# spent 23µs (19+4) within DateTime::Span::BEGIN@7 which was called: # once (19µs+4µs) by DateTime::Set::BEGIN@9 at line 7
use strict;
# spent 23µs making 1 call to DateTime::Span::BEGIN@7 # spent 4µs making 1 call to strict::import
8
9329µs218µs
# spent 16µs (15+2) within DateTime::Span::BEGIN@9 which was called: # once (15µs+2µs) by DateTime::Set::BEGIN@9 at line 9
use DateTime::Set;
# spent 16µs making 1 call to DateTime::Span::BEGIN@9 # spent 2µs making 1 call to UNIVERSAL::import
103124µs23.40ms
# spent 3.40ms (3.03+367µs) within DateTime::Span::BEGIN@10 which was called: # once (3.03ms+367µs) by DateTime::Set::BEGIN@9 at line 10
use DateTime::SpanSet;
# spent 3.40ms making 1 call to DateTime::Span::BEGIN@10 # spent 3µs making 1 call to UNIVERSAL::import
11
12334µs2137µs
# spent 74µs (11+63) within DateTime::Span::BEGIN@12 which was called: # once (11µs+63µs) by DateTime::Set::BEGIN@9 at line 12
use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF );
# spent 74µs making 1 call to DateTime::Span::BEGIN@12 # spent 63µs making 1 call to Exporter::import
13336µs260µs
# spent 35µs (10+25) within DateTime::Span::BEGIN@13 which was called: # once (10µs+25µs) by DateTime::Set::BEGIN@9 at line 13
use vars qw( $VERSION );
# spent 35µs making 1 call to DateTime::Span::BEGIN@13 # spent 25µs making 1 call to vars::import
14
15342µs2220µs
# spent 115µs (11+104) within DateTime::Span::BEGIN@15 which was called: # once (11µs+104µs) by DateTime::Set::BEGIN@9 at line 15
use constant INFINITY => DateTime::INFINITY;
# spent 115µs making 1 call to DateTime::Span::BEGIN@15 # spent 104µs making 1 call to constant::import
1631.41ms284µs
# spent 47µs (10+37) within DateTime::Span::BEGIN@16 which was called: # once (10µs+37µs) by DateTime::Set::BEGIN@9 at line 16
use constant NEG_INFINITY => DateTime::NEG_INFINITY;
# spent 47µs making 1 call to DateTime::Span::BEGIN@16 # spent 37µs making 1 call to constant::import
171500ns$VERSION = $DateTime::Set::VERSION;
18
19sub set_time_zone {
20 my ( $self, $tz ) = @_;
21
22 $self->{set} = $self->{set}->iterate(
23 sub {
24 my %tmp = %{ $_[0]->{list}[0] };
25 $tmp{a} = $tmp{a}->clone->set_time_zone( $tz ) if ref $tmp{a};
26 $tmp{b} = $tmp{b}->clone->set_time_zone( $tz ) if ref $tmp{b};
27 \%tmp;
28 }
29 );
30 return $self;
31}
32
33# note: the constructor must clone its DateTime parameters, such that
34# the set elements become immutable
35sub from_datetimes {
36 my $class = shift;
37 my %args = validate( @_,
38 { start =>
39 { type => OBJECT,
40 optional => 1,
41 },
42 end =>
43 { type => OBJECT,
44 optional => 1,
45 },
46 after =>
47 { type => OBJECT,
48 optional => 1,
49 },
50 before =>
51 { type => OBJECT,
52 optional => 1,
53 },
54 }
55 );
56 my $self = {};
57 my $set;
58
59 die "No arguments given to DateTime::Span->from_datetimes\n"
60 unless keys %args;
61
62 if ( exists $args{start} && exists $args{after} ) {
63 die "Cannot give both start and after arguments to DateTime::Span->from_datetimes\n";
64 }
65 if ( exists $args{end} && exists $args{before} ) {
66 die "Cannot give both end and before arguments to DateTime::Span->from_datetimes\n";
67 }
68
69 my ( $start, $open_start, $end, $open_end );
70 ( $start, $open_start ) = ( NEG_INFINITY, 0 );
71 ( $start, $open_start ) = ( $args{start}, 0 ) if exists $args{start};
72 ( $start, $open_start ) = ( $args{after}, 1 ) if exists $args{after};
73 ( $end, $open_end ) = ( INFINITY, 0 );
74 ( $end, $open_end ) = ( $args{end}, 0 ) if exists $args{end};
75 ( $end, $open_end ) = ( $args{before}, 1 ) if exists $args{before};
76
77 if ( $start > $end ) {
78 die "Span cannot start after the end in DateTime::Span->from_datetimes\n";
79 }
80 $set = Set::Infinite::_recurrence->new( $start, $end );
81 if ( $start != $end ) {
82 # remove start, such that we have ">" instead of ">="
83 $set = $set->complement( $start ) if $open_start;
84 # remove end, such that we have "<" instead of "<="
85 $set = $set->complement( $end ) if $open_end;
86 }
87
88 $self->{set} = $set;
89 bless $self, $class;
90 return $self;
91}
92
93sub from_datetime_and_duration {
94 my $class = shift;
95 my %args = @_;
96
97 my $key;
98 my $dt;
99 # extract datetime parameters
100 for ( qw( start end before after ) ) {
101 if ( exists $args{$_} ) {
102 $key = $_;
103 $dt = delete $args{$_};
104 }
105 }
106
107 # extract duration parameters
108 my $dt_duration;
109 if ( exists $args{duration} ) {
110 $dt_duration = $args{duration};
111 }
112 else {
113 $dt_duration = DateTime::Duration->new( %args );
114 }
115 # warn "Creating span from $key => ".$dt->datetime." and $dt_duration";
116 my $other_date = $dt->clone->add_duration( $dt_duration );
117 # warn "Creating span from $key => ".$dt->datetime." and ".$other_date->datetime;
118 my $other_key;
119 if ( $dt_duration->is_positive ) {
120 # check if have to invert keys
121 $key = 'after' if $key eq 'end';
122 $key = 'start' if $key eq 'before';
123 $other_key = 'before';
124 }
125 else {
126 # check if have to invert keys
127 $other_key = 'end' if $key eq 'after';
128 $other_key = 'before' if $key eq 'start';
129 $key = 'start';
130 }
131 return $class->new( $key => $dt, $other_key => $other_date );
132}
133
134# This method is intentionally not documented. It's really only for
135# use by ::Set and ::SpanSet's as_list() and iterator() methods.
136sub new {
137 my $class = shift;
138 my %args = @_;
139
140 # If we find anything _not_ appropriate for from_datetimes, we
141 # assume it must be for durations, and call this constructor.
142 # This way, we don't need to hardcode the DateTime::Duration
143 # parameters.
144 foreach ( keys %args )
145 {
146 return $class->from_datetime_and_duration(%args)
147 unless /^(?:before|after|start|end)$/;
148 }
149
150 return $class->from_datetimes(%args);
151}
152
153sub clone {
154 bless {
155 set => $_[0]->{set}->copy,
156 }, ref $_[0];
157}
158
159# Set::Infinite methods
160
161sub intersection {
162 my ($set1, $set2) = @_;
163 my $class = ref($set1);
164 my $tmp = {}; # $class->new();
165 $set2 = $set2->as_spanset
166 if $set2->can( 'as_spanset' );
167 $set2 = $set2->as_set
168 if $set2->can( 'as_set' );
169 $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] )
170 unless $set2->can( 'union' );
171 $tmp->{set} = $set1->{set}->intersection( $set2->{set} );
172
173 # intersection() can generate something more complex than a span.
174 bless $tmp, 'DateTime::SpanSet';
175
176 return $tmp;
177}
178
179sub intersects {
180 my ($set1, $set2) = @_;
181 my $class = ref($set1);
182 $set2 = $set2->as_spanset
183 if $set2->can( 'as_spanset' );
184 $set2 = $set2->as_set
185 if $set2->can( 'as_set' );
186 $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] )
187 unless $set2->can( 'union' );
188 return $set1->{set}->intersects( $set2->{set} );
189}
190
191sub contains {
192 my ($set1, $set2) = @_;
193 my $class = ref($set1);
194 $set2 = $set2->as_spanset
195 if $set2->can( 'as_spanset' );
196 $set2 = $set2->as_set
197 if $set2->can( 'as_set' );
198 $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] )
199 unless $set2->can( 'union' );
200 return $set1->{set}->contains( $set2->{set} );
201}
202
203sub union {
204 my ($set1, $set2) = @_;
205 my $class = ref($set1);
206 my $tmp = {}; # $class->new();
207 $set2 = $set2->as_spanset
208 if $set2->can( 'as_spanset' );
209 $set2 = $set2->as_set
210 if $set2->can( 'as_set' );
211 $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] )
212 unless $set2->can( 'union' );
213 $tmp->{set} = $set1->{set}->union( $set2->{set} );
214
215 # union() can generate something more complex than a span.
216 bless $tmp, 'DateTime::SpanSet';
217
218 # # We have to check it's internal structure to find out.
219 # if ( $#{ $tmp->{set}->{list} } != 0 ) {
220 # bless $tmp, 'Date::SpanSet';
221 # }
222
223 return $tmp;
224}
225
226sub complement {
227 my ($set1, $set2) = @_;
228 my $class = ref($set1);
229 my $tmp = {}; # $class->new;
230 if (defined $set2) {
231 $set2 = $set2->as_spanset
232 if $set2->can( 'as_spanset' );
233 $set2 = $set2->as_set
234 if $set2->can( 'as_set' );
235 $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] )
236 unless $set2->can( 'union' );
237 $tmp->{set} = $set1->{set}->complement( $set2->{set} );
238 }
239 else {
240 $tmp->{set} = $set1->{set}->complement;
241 }
242
243 # complement() can generate something more complex than a span.
244 bless $tmp, 'DateTime::SpanSet';
245
246 # # We have to check it's internal structure to find out.
247 # if ( $#{ $tmp->{set}->{list} } != 0 ) {
248 # bless $tmp, 'Date::SpanSet';
249 # }
250
251 return $tmp;
252}
253
254sub start {
255 return DateTime::Set::_fix_datetime( $_[0]->{set}->min );
256}
257
25812µs*min = \&start;
259
260sub end {
261 return DateTime::Set::_fix_datetime( $_[0]->{set}->max );
262}
263
2641600ns*max = \&end;
265
266sub start_is_open {
267 # min_a returns info about the set boundary
268 my ($min, $open) = $_[0]->{set}->min_a;
269 return $open;
270}
271
272sub start_is_closed { $_[0]->start_is_open ? 0 : 1 }
273
274sub end_is_open {
275 # max_a returns info about the set boundary
276 my ($max, $open) = $_[0]->{set}->max_a;
277 return $open;
278}
279
280sub end_is_closed { $_[0]->end_is_open ? 0 : 1 }
281
282
283# span == $self
284sub span { @_ }
285
286sub duration {
287 my $dur;
288
289 local $@;
290 eval {
291 local $SIG{__DIE__}; # don't want to trap this (rt ticket 5434)
292 $dur = $_[0]->end->subtract_datetime_absolute( $_[0]->start )
293 };
294
295 return $dur if defined $dur;
296
297 return DateTime::Infinite::Future->new -
298 DateTime::Infinite::Past->new;
299}
3001500ns*size = \&duration;
301
30216µs1;
303
304__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.