← 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:12:45 2013

Filename/usr/share/perl5/DateTime/SpanSet.pm
StatementsExecuted 27 statements in 3.01ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11119µs20µsDateTime::SpanSet::::BEGIN@10DateTime::SpanSet::BEGIN@10
11117µs21µsDateTime::SpanSet::::BEGIN@7DateTime::SpanSet::BEGIN@7
11115µs82µsDateTime::SpanSet::::BEGIN@12DateTime::SpanSet::BEGIN@12
11114µs71µsDateTime::SpanSet::::BEGIN@16DateTime::SpanSet::BEGIN@16
11113µs80µsDateTime::SpanSet::::BEGIN@13DateTime::SpanSet::BEGIN@13
11110µs34µsDateTime::SpanSet::::BEGIN@14DateTime::SpanSet::BEGIN@14
11110µs12µsDateTime::SpanSet::::BEGIN@9DateTime::SpanSet::BEGIN@9
11110µs43µsDateTime::SpanSet::::BEGIN@17DateTime::SpanSet::BEGIN@17
0000s0sDateTime::SpanSet::::__ANON__[:31]DateTime::SpanSet::__ANON__[:31]
0000s0sDateTime::SpanSet::::__ANON__[:49]DateTime::SpanSet::__ANON__[:49]
0000s0sDateTime::SpanSet::::__ANON__[:66]DateTime::SpanSet::__ANON__[:66]
0000s0sDateTime::SpanSet::::__ANON__[:82]DateTime::SpanSet::__ANON__[:82]
0000s0sDateTime::SpanSet::::__ANON__[:96]DateTime::SpanSet::__ANON__[:96]
0000s0sDateTime::SpanSet::::as_listDateTime::SpanSet::as_list
0000s0sDateTime::SpanSet::::cloneDateTime::SpanSet::clone
0000s0sDateTime::SpanSet::::closestDateTime::SpanSet::closest
0000s0sDateTime::SpanSet::::complementDateTime::SpanSet::complement
0000s0sDateTime::SpanSet::::containsDateTime::SpanSet::contains
0000s0sDateTime::SpanSet::::currentDateTime::SpanSet::current
0000s0sDateTime::SpanSet::::durationDateTime::SpanSet::duration
0000s0sDateTime::SpanSet::::empty_setDateTime::SpanSet::empty_set
0000s0sDateTime::SpanSet::::end_setDateTime::SpanSet::end_set
0000s0sDateTime::SpanSet::::from_set_and_durationDateTime::SpanSet::from_set_and_duration
0000s0sDateTime::SpanSet::::from_setsDateTime::SpanSet::from_sets
0000s0sDateTime::SpanSet::::from_spansDateTime::SpanSet::from_spans
0000s0sDateTime::SpanSet::::grepDateTime::SpanSet::grep
0000s0sDateTime::SpanSet::::intersected_spansDateTime::SpanSet::intersected_spans
0000s0sDateTime::SpanSet::::intersectionDateTime::SpanSet::intersection
0000s0sDateTime::SpanSet::::intersectsDateTime::SpanSet::intersects
0000s0sDateTime::SpanSet::::iterateDateTime::SpanSet::iterate
0000s0sDateTime::SpanSet::::iteratorDateTime::SpanSet::iterator
0000s0sDateTime::SpanSet::::mapDateTime::SpanSet::map
0000s0sDateTime::SpanSet::::maxDateTime::SpanSet::max
0000s0sDateTime::SpanSet::::minDateTime::SpanSet::min
0000s0sDateTime::SpanSet::::nextDateTime::SpanSet::next
0000s0sDateTime::SpanSet::::previousDateTime::SpanSet::previous
0000s0sDateTime::SpanSet::::set_time_zoneDateTime::SpanSet::set_time_zone
0000s0sDateTime::SpanSet::::spanDateTime::SpanSet::span
0000s0sDateTime::SpanSet::::start_setDateTime::SpanSet::start_set
0000s0sDateTime::SpanSet::::unionDateTime::SpanSet::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::SpanSet;
6
7337µs225µs
# spent 21µs (17+4) within DateTime::SpanSet::BEGIN@7 which was called: # once (17µs+4µs) by DateTime::Span::BEGIN@10 at line 7
use strict;
# spent 21µs making 1 call to DateTime::SpanSet::BEGIN@7 # spent 4µs making 1 call to strict::import
8
9325µs214µs
# spent 12µs (10+2) within DateTime::SpanSet::BEGIN@9 which was called: # once (10µs+2µs) by DateTime::Span::BEGIN@10 at line 9
use DateTime::Set;
# spent 12µs making 1 call to DateTime::SpanSet::BEGIN@9 # spent 2µs making 1 call to UNIVERSAL::import
10335µs222µs
# spent 20µs (19+1) within DateTime::SpanSet::BEGIN@10 which was called: # once (19µs+1µs) by DateTime::Span::BEGIN@10 at line 10
use DateTime::Infinite;
# spent 20µs making 1 call to DateTime::SpanSet::BEGIN@10 # spent 1µs making 1 call to UNIVERSAL::import
11
12399µs2149µs
# spent 82µs (15+67) within DateTime::SpanSet::BEGIN@12 which was called: # once (15µs+67µs) by DateTime::Span::BEGIN@10 at line 12
use Carp;
# spent 82µs making 1 call to DateTime::SpanSet::BEGIN@12 # spent 67µs making 1 call to Exporter::import
13335µs2148µs
# spent 80µs (13+68) within DateTime::SpanSet::BEGIN@13 which was called: # once (13µs+68µs) by DateTime::Span::BEGIN@10 at line 13
use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF );
# spent 80µs making 1 call to DateTime::SpanSet::BEGIN@13 # spent 68µs making 1 call to Exporter::import
14352µs258µs
# spent 34µs (10+24) within DateTime::SpanSet::BEGIN@14 which was called: # once (10µs+24µs) by DateTime::Span::BEGIN@10 at line 14
use vars qw( $VERSION );
# spent 34µs making 1 call to DateTime::SpanSet::BEGIN@14 # spent 24µs making 1 call to vars::import
15
16352µs2127µs
# spent 71µs (14+56) within DateTime::SpanSet::BEGIN@16 which was called: # once (14µs+56µs) by DateTime::Span::BEGIN@10 at line 16
use constant INFINITY => 100 ** 100 ** 100 ;
# spent 71µs making 1 call to DateTime::SpanSet::BEGIN@16 # spent 56µs making 1 call to constant::import
1732.67ms277µs
# spent 43µs (10+34) within DateTime::SpanSet::BEGIN@17 which was called: # once (10µs+34µs) by DateTime::Span::BEGIN@10 at line 17
use constant NEG_INFINITY => -1 * (100 ** 100 ** 100);
# spent 43µs making 1 call to DateTime::SpanSet::BEGIN@17 # spent 34µs making 1 call to constant::import
181400ns$VERSION = $DateTime::Set::VERSION;
19
20sub iterate {
21 my ( $self, $callback ) = @_;
22 my $class = ref( $self );
23 my $return = $class->empty_set;
24 $return->{set} = $self->{set}->iterate(
25 sub {
26 my $span = bless { set => $_[0] }, 'DateTime::Span';
27 $callback->( $span->clone );
28 $span = $span->{set}
29 if UNIVERSAL::can( $span, 'union' );
30 return $span;
31 }
32 );
33 $return;
34}
35
36sub map {
37 my ( $self, $callback ) = @_;
38 my $class = ref( $self );
39 die "The callback parameter to map() must be a subroutine reference"
40 unless ref( $callback ) eq 'CODE';
41 my $return = $class->empty_set;
42 $return->{set} = $self->{set}->iterate(
43 sub {
44 local $_ = bless { set => $_[0]->clone }, 'DateTime::Span';
45 my @list = $callback->();
46 my $set = $class->empty_set;
47 $set = $set->union( $_ ) for @list;
48 return $set->{set};
49 }
50 );
51 $return;
52}
53
54sub grep {
55 my ( $self, $callback ) = @_;
56 my $class = ref( $self );
57 die "The callback parameter to grep() must be a subroutine reference"
58 unless ref( $callback ) eq 'CODE';
59 my $return = $class->empty_set;
60 $return->{set} = $self->{set}->iterate(
61 sub {
62 local $_ = bless { set => $_[0]->clone }, 'DateTime::Span';
63 my $result = $callback->();
64 return $_ if $result;
65 return;
66 }
67 );
68 $return;
69}
70
71sub set_time_zone {
72 my ( $self, $tz ) = @_;
73
74 # TODO - use iterate() instead
75
76 my $result = $self->{set}->iterate(
77 sub {
78 my %tmp = %{ $_[0]->{list}[0] };
79 $tmp{a} = $tmp{a}->clone->set_time_zone( $tz ) if ref $tmp{a};
80 $tmp{b} = $tmp{b}->clone->set_time_zone( $tz ) if ref $tmp{b};
81 \%tmp;
82 },
83 backtrack_callback => sub {
84 my ( $min, $max ) = ( $_[0]->min, $_[0]->max );
85 if ( ref($min) )
86 {
87 $min = $min->clone;
88 $min->set_time_zone( 'floating' );
89 }
90 if ( ref($max) )
91 {
92 $max = $max->clone;
93 $max->set_time_zone( 'floating' );
94 }
95 return Set::Infinite::_recurrence->new( $min, $max );
96 },
97 );
98
99 ### this code enables 'subroutine method' behaviour
100 $self->{set} = $result;
101 return $self;
102}
103
104sub from_spans {
105 my $class = shift;
106 my %args = validate( @_,
107 { spans =>
108 { type => ARRAYREF,
109 optional => 1,
110 },
111 }
112 );
113 my $self = {};
114 my $set = Set::Infinite::_recurrence->new();
115 $set = $set->union( $_->{set} ) for @{ $args{spans} };
116 $self->{set} = $set;
117 bless $self, $class;
118 return $self;
119}
120
121sub from_set_and_duration {
122 # set => $dt_set, days => 1
123 my $class = shift;
124 my %args = @_;
125 my $set = delete $args{set} ||
126 carp "from_set_and_duration needs a 'set' parameter";
127
128 $set = $set->as_set
129 if UNIVERSAL::can( $set, 'as_set' );
130 unless ( UNIVERSAL::can( $set, 'union' ) ) {
131 carp "'set' must be a set" };
132
133 my $duration = delete $args{duration} ||
134 new DateTime::Duration( %args );
135 my $end_set = $set->clone->add_duration( $duration );
136 return $class->from_sets( start_set => $set,
137 end_set => $end_set );
138}
139
140sub from_sets {
141 my $class = shift;
142 my %args = validate( @_,
143 { start_set =>
144 { # can => 'union',
145 optional => 0,
146 },
147 end_set =>
148 { # can => 'union',
149 optional => 0,
150 },
151 }
152 );
153 my $start_set = delete $args{start_set};
154 my $end_set = delete $args{end_set};
155
156 $start_set = $start_set->as_set
157 if UNIVERSAL::can( $start_set, 'as_set' );
158 $end_set = $end_set->as_set
159 if UNIVERSAL::can( $end_set, 'as_set' );
160
161 unless ( UNIVERSAL::can( $start_set, 'union' ) ) {
162 carp "'start_set' must be a set" };
163 unless ( UNIVERSAL::can( $end_set, 'union' ) ) {
164 carp "'end_set' must be a set" };
165
166 my $self;
167 $self->{set} = $start_set->{set}->until(
168 $end_set->{set} );
169 bless $self, $class;
170 return $self;
171}
172
173sub start_set {
174 if ( exists $_[0]->{set}{method} &&
175 $_[0]->{set}{method} eq 'until' )
176 {
177 return bless { set => $_[0]->{set}{parent}[0] }, 'DateTime::Set';
178 }
179 my $return = DateTime::Set->empty_set;
180 $return->{set} = $_[0]->{set}->start_set;
181 $return;
182}
183
184sub end_set {
185 if ( exists $_[0]->{set}{method} &&
186 $_[0]->{set}{method} eq 'until' )
187 {
188 return bless { set => $_[0]->{set}{parent}[1] }, 'DateTime::Set';
189 }
190 my $return = DateTime::Set->empty_set;
191 $return->{set} = $_[0]->{set}->end_set;
192 $return;
193}
194
195sub empty_set {
196 my $class = shift;
197
198 return bless { set => Set::Infinite::_recurrence->new }, $class;
199}
200
201sub clone {
202 bless {
203 set => $_[0]->{set}->copy,
204 }, ref $_[0];
205}
206
207
208sub iterator {
209 my $self = shift;
210
211 my %args = @_;
212 my $span;
213 $span = delete $args{span};
214 $span = DateTime::Span->new( %args ) if %args;
215
216 return $self->intersection( $span ) if $span;
217 return $self->clone;
218}
219
220
221# next() gets the next element from an iterator()
222sub next {
223 my ($self) = shift;
224
225 # TODO: this is fixing an error from elsewhere
226 # - find out what's going on! (with "sunset.pl")
227 return undef unless ref $self->{set};
228
229 if ( @_ )
230 {
231 my $max;
232 $max = $_[0]->max if UNIVERSAL::can( $_[0], 'union' );
233 $max = $_[0] if ! defined $max;
234
235 return undef if ! ref( $max ) && $max == INFINITY;
236
237 my $span = DateTime::Span->from_datetimes( start => $max );
238 my $iterator = $self->intersection( $span );
239 my $return = $iterator->next;
240
241 return $return if ! defined $return;
242 return $return if ! $return->intersects( $max );
243
244 return $iterator->next;
245 }
246
247 my ($head, $tail) = $self->{set}->first;
248 $self->{set} = $tail;
249 return $head unless ref $head;
250 my $return = {
251 set => $head,
252 };
253 bless $return, 'DateTime::Span';
254 return $return;
255}
256
257# previous() gets the last element from an iterator()
258sub previous {
259 my ($self) = shift;
260
261 return undef unless ref $self->{set};
262
263 if ( @_ )
264 {
265 my $min;
266 $min = $_[0]->min if UNIVERSAL::can( $_[0], 'union' );
267 $min = $_[0] if ! defined $min;
268
269 return undef if ! ref( $min ) && $min == INFINITY;
270
271 my $span = DateTime::Span->from_datetimes( end => $min );
272 my $iterator = $self->intersection( $span );
273 my $return = $iterator->previous;
274
275 return $return if ! defined $return;
276 return $return if ! $return->intersects( $min );
277
278 return $iterator->previous;
279 }
280
281 my ($head, $tail) = $self->{set}->last;
282 $self->{set} = $tail;
283 return $head unless ref $head;
284 my $return = {
285 set => $head,
286 };
287 bless $return, 'DateTime::Span';
288 return $return;
289}
290
291# "current" means less-or-equal to a DateTime
292sub current {
293 my $self = shift;
294
295 my $previous;
296 my $next;
297 {
298 my $min;
299 $min = $_[0]->min if UNIVERSAL::can( $_[0], 'union' );
300 $min = $_[0] if ! defined $min;
301 return undef if ! ref( $min ) && $min == INFINITY;
302 my $span = DateTime::Span->from_datetimes( end => $min );
303 my $iterator = $self->intersection( $span );
304 $previous = $iterator->previous;
305 $span = DateTime::Span->from_datetimes( start => $min );
306 $iterator = $self->intersection( $span );
307 $next = $iterator->next;
308 }
309 return $previous unless defined $next;
310
311 my $dt1 = defined $previous
312 ? $next->union( $previous )
313 : $next;
314
315 my $return = $dt1->intersected_spans( $_[0] );
316
317 $return = $previous
318 if !defined $return->max;
319
320 bless $return, 'DateTime::SpanSet'
321 if defined $return;
322 return $return;
323}
324
325sub closest {
326 my $self = shift;
327 my $dt = shift;
328
329 my $dt1 = $self->current( $dt );
330 my $dt2 = $self->next( $dt );
331 bless $dt2, 'DateTime::SpanSet'
332 if defined $dt2;
333
334 return $dt2 unless defined $dt1;
335 return $dt1 unless defined $dt2;
336
337 $dt = DateTime::Set->from_datetimes( dates => [ $dt ] )
338 unless UNIVERSAL::can( $dt, 'union' );
339
340 return $dt1 if $dt1->contains( $dt );
341
342 my $delta = $dt->min - $dt1->max;
343 return $dt1 if ( $dt2->min - $delta ) >= $dt->max;
344
345 return $dt2;
346}
347
348sub as_list {
349 my $self = shift;
350 return undef unless ref( $self->{set} );
351
352 my %args = @_;
353 my $span;
354 $span = delete $args{span};
355 $span = DateTime::Span->new( %args ) if %args;
356
357 my $set = $self->clone;
358 $set = $set->intersection( $span ) if $span;
359
360 # Note: removing this line means we may end up in an infinite loop!
361 return undef if $set->{set}->is_too_complex; # undef = no begin/end
362
363 # return if $set->{set}->is_null; # nothing = empty
364 my @result;
365 # we should extract _copies_ of the set elements,
366 # such that the user can't modify the set indirectly
367
368 my $iter = $set->iterator;
369 while ( my $dt = $iter->next )
370 {
371 push @result, $dt
372 if ref( $dt ); # we don't want to return INFINITY value
373 };
374
375 return @result;
376}
377
378# Set::Infinite methods
379
380sub intersection {
381 my ($set1, $set2) = ( shift, shift );
382 my $class = ref($set1);
383 my $tmp = $class->empty_set();
384 $set2 = $set2->as_spanset
385 if $set2->can( 'as_spanset' );
386 $set2 = $set2->as_set
387 if $set2->can( 'as_set' );
388 $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] )
389 unless $set2->can( 'union' );
390 $tmp->{set} = $set1->{set}->intersection( $set2->{set} );
391 return $tmp;
392}
393
394sub intersected_spans {
395 my ($set1, $set2) = ( shift, shift );
396 my $class = ref($set1);
397 my $tmp = $class->empty_set();
398 $set2 = $set2->as_spanset
399 if $set2->can( 'as_spanset' );
400 $set2 = $set2->as_set
401 if $set2->can( 'as_set' );
402 $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] )
403 unless $set2->can( 'union' );
404 $tmp->{set} = $set1->{set}->intersected_spans( $set2->{set} );
405 return $tmp;
406}
407
408sub intersects {
409 my ($set1, $set2) = ( shift, shift );
410
411 unless ( $set2->can( 'union' ) )
412 {
413 for ( $set2, @_ )
414 {
415 return 1 if $set1->contains( $_ );
416 }
417 return 0;
418 }
419
420 my $class = ref($set1);
421 $set2 = $set2->as_spanset
422 if $set2->can( 'as_spanset' );
423 $set2 = $set2->as_set
424 if $set2->can( 'as_set' );
425 $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] )
426 unless $set2->can( 'union' );
427 return $set1->{set}->intersects( $set2->{set} );
428}
429
430sub contains {
431 my ($set1, $set2) = ( shift, shift );
432
433 unless ( $set2->can( 'union' ) )
434 {
435 if ( exists $set1->{set}{method} &&
436 $set1->{set}{method} eq 'until' )
437 {
438 my $start_set = $set1->start_set;
439 my $end_set = $set1->end_set;
440
441 for ( $set2, @_ )
442 {
443 my $start = $start_set->next( $set2 );
444 my $end = $end_set->next( $set2 );
445
446 goto ABORT unless defined $start && defined $end;
447
448 return 0 if $start < $end;
449 }
450 return 1;
451
452 ABORT: ;
453 # don't know
454 }
455 }
456
457 my $class = ref($set1);
458 $set2 = $set2->as_spanset
459 if $set2->can( 'as_spanset' );
460 $set2 = $set2->as_set
461 if $set2->can( 'as_set' );
462 $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] )
463 unless $set2->can( 'union' );
464 return $set1->{set}->contains( $set2->{set} );
465}
466
467sub union {
468 my ($set1, $set2) = ( shift, shift );
469 my $class = ref($set1);
470 my $tmp = $class->empty_set();
471 $set2 = $set2->as_spanset
472 if $set2->can( 'as_spanset' );
473 $set2 = $set2->as_set
474 if $set2->can( 'as_set' );
475 $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] )
476 unless $set2->can( 'union' );
477 $tmp->{set} = $set1->{set}->union( $set2->{set} );
478 return $tmp;
479}
480
481sub complement {
482 my ($set1, $set2) = ( shift, shift );
483 my $class = ref($set1);
484 my $tmp = $class->empty_set();
485 if (defined $set2) {
486 $set2 = $set2->as_spanset
487 if $set2->can( 'as_spanset' );
488 $set2 = $set2->as_set
489 if $set2->can( 'as_set' );
490 $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] )
491 unless $set2->can( 'union' );
492 $tmp->{set} = $set1->{set}->complement( $set2->{set} );
493 }
494 else {
495 $tmp->{set} = $set1->{set}->complement;
496 }
497 return $tmp;
498}
499
500sub min {
501 return DateTime::Set::_fix_datetime( $_[0]->{set}->min );
502}
503
504sub max {
505 return DateTime::Set::_fix_datetime( $_[0]->{set}->max );
506}
507
508# returns a DateTime::Span
509sub span {
510 my $set = $_[0]->{set}->span;
511 my $self = bless { set => $set }, 'DateTime::Span';
512 return $self;
513}
514
515# returns a DateTime::Duration
516sub duration {
517 my $dur;
518
519 return DateTime::Duration->new( seconds => 0 )
520 if $_[0]->{set}->is_empty;
521
522 local $@;
523 eval {
524 local $SIG{__DIE__}; # don't want to trap this (rt ticket 5434)
525 $dur = $_[0]->{set}->size
526 };
527
528 return $dur if defined $dur && ref( $dur );
529 return DateTime::Infinite::Future->new -
530 DateTime::Infinite::Past->new;
531 # return INFINITY;
532}
53312µs*size = \&duration;
534
53514µs1;
536
537__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.