← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:50 2015

Filename/usr/share/perl5/DateTime/SpanSet.pm
StatementsExecuted 19 statements in 3.13ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11111µs21µsDateTime::SpanSet::::BEGIN@7DateTime::SpanSet::BEGIN@7
11110µs35µsDateTime::SpanSet::::BEGIN@12DateTime::SpanSet::BEGIN@12
1119µs9µsDateTime::SpanSet::::BEGIN@10DateTime::SpanSet::BEGIN@10
1117µs41µsDateTime::SpanSet::::BEGIN@16DateTime::SpanSet::BEGIN@16
1117µs40µsDateTime::SpanSet::::BEGIN@13DateTime::SpanSet::BEGIN@13
1116µs22µsDateTime::SpanSet::::BEGIN@14DateTime::SpanSet::BEGIN@14
1116µs26µsDateTime::SpanSet::::BEGIN@17DateTime::SpanSet::BEGIN@17
1114µs4µsDateTime::SpanSet::::BEGIN@9DateTime::SpanSet::BEGIN@9
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::::is_empty_setDateTime::SpanSet::is_empty_set
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
7222µs231µs
# spent 21µs (11+10) within DateTime::SpanSet::BEGIN@7 which was called: # once (11µs+10µs) by DateTime::Span::BEGIN@10 at line 7
use strict;
# spent 21µs making 1 call to DateTime::SpanSet::BEGIN@7 # spent 10µs making 1 call to strict::import
8
9222µs14µs
# spent 4µs within DateTime::SpanSet::BEGIN@9 which was called: # once (4µs+0s) by DateTime::Span::BEGIN@10 at line 9
use DateTime::Set;
# spent 4µs making 1 call to DateTime::SpanSet::BEGIN@9
10224µs19µs
# spent 9µs within DateTime::SpanSet::BEGIN@10 which was called: # once (9µs+0s) by DateTime::Span::BEGIN@10 at line 10
use DateTime::Infinite;
# spent 9µs making 1 call to DateTime::SpanSet::BEGIN@10
11
12226µs261µs
# spent 35µs (10+26) within DateTime::SpanSet::BEGIN@12 which was called: # once (10µs+26µs) by DateTime::Span::BEGIN@10 at line 12
use Carp;
# spent 35µs making 1 call to DateTime::SpanSet::BEGIN@12 # spent 26µs making 1 call to Exporter::import
13222µs274µs
# spent 40µs (7+34) within DateTime::SpanSet::BEGIN@13 which was called: # once (7µs+34µs) by DateTime::Span::BEGIN@10 at line 13
use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF );
# spent 40µs making 1 call to DateTime::SpanSet::BEGIN@13 # spent 34µs making 1 call to Exporter::import
14230µs238µs
# spent 22µs (6+16) within DateTime::SpanSet::BEGIN@14 which was called: # once (6µs+16µs) by DateTime::Span::BEGIN@10 at line 14
use vars qw( $VERSION );
# spent 22µs making 1 call to DateTime::SpanSet::BEGIN@14 # spent 16µs making 1 call to vars::import
15
16233µs275µs
# spent 41µs (7+34) within DateTime::SpanSet::BEGIN@16 which was called: # once (7µs+34µs) by DateTime::Span::BEGIN@10 at line 16
use constant INFINITY => 100 ** 100 ** 100 ;
# spent 41µs making 1 call to DateTime::SpanSet::BEGIN@16 # spent 34µs making 1 call to constant::import
1722.95ms248µs
# spent 26µs (6+21) within DateTime::SpanSet::BEGIN@17 which was called: # once (6µs+21µs) by DateTime::Span::BEGIN@10 at line 17
use constant NEG_INFINITY => -1 * (100 ** 100 ** 100);
# spent 26µs making 1 call to DateTime::SpanSet::BEGIN@17 # spent 21µs making 1 call to constant::import
181200ns$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 $_->{set} 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 is_empty_set {
202 my $set = $_[0];
203 $set->{set}->is_null;
204}
205
206sub clone {
207 bless {
208 set => $_[0]->{set}->copy,
209 }, ref $_[0];
210}
211
212
213sub iterator {
214 my $self = shift;
215
216 my %args = @_;
217 my $span;
218 $span = delete $args{span};
219 $span = DateTime::Span->new( %args ) if %args;
220
221 return $self->intersection( $span ) if $span;
222 return $self->clone;
223}
224
225
226# next() gets the next element from an iterator()
227sub next {
228 my ($self) = shift;
229
230 # TODO: this is fixing an error from elsewhere
231 # - find out what's going on! (with "sunset.pl")
232 return undef unless ref $self->{set};
233
234 if ( @_ )
235 {
236 my $max;
237 $max = $_[0]->max if UNIVERSAL::can( $_[0], 'union' );
238 $max = $_[0] if ! defined $max;
239
240 return undef if ! ref( $max ) && $max == INFINITY;
241
242 my $span = DateTime::Span->from_datetimes( start => $max );
243 my $iterator = $self->intersection( $span );
244 my $return = $iterator->next;
245
246 return $return if ! defined $return;
247 return $return if ! $return->intersects( $max );
248
249 return $iterator->next;
250 }
251
252 my ($head, $tail) = $self->{set}->first;
253 $self->{set} = $tail;
254 return $head unless ref $head;
255 my $return = {
256 set => $head,
257 };
258 bless $return, 'DateTime::Span';
259 return $return;
260}
261
262# previous() gets the last element from an iterator()
263sub previous {
264 my ($self) = shift;
265
266 return undef unless ref $self->{set};
267
268 if ( @_ )
269 {
270 my $min;
271 $min = $_[0]->min if UNIVERSAL::can( $_[0], 'union' );
272 $min = $_[0] if ! defined $min;
273
274 return undef if ! ref( $min ) && $min == INFINITY;
275
276 my $span = DateTime::Span->from_datetimes( end => $min );
277 my $iterator = $self->intersection( $span );
278 my $return = $iterator->previous;
279
280 return $return if ! defined $return;
281 return $return if ! $return->intersects( $min );
282
283 return $iterator->previous;
284 }
285
286 my ($head, $tail) = $self->{set}->last;
287 $self->{set} = $tail;
288 return $head unless ref $head;
289 my $return = {
290 set => $head,
291 };
292 bless $return, 'DateTime::Span';
293 return $return;
294}
295
296# "current" means less-or-equal to a DateTime
297sub current {
298 my $self = shift;
299
300 my $previous;
301 my $next;
302 {
303 my $min;
304 $min = $_[0]->min if UNIVERSAL::can( $_[0], 'union' );
305 $min = $_[0] if ! defined $min;
306 return undef if ! ref( $min ) && $min == INFINITY;
307 my $span = DateTime::Span->from_datetimes( end => $min );
308 my $iterator = $self->intersection( $span );
309 $previous = $iterator->previous;
310 $span = DateTime::Span->from_datetimes( start => $min );
311 $iterator = $self->intersection( $span );
312 $next = $iterator->next;
313 }
314 return $previous unless defined $next;
315
316 my $dt1 = defined $previous
317 ? $next->union( $previous )
318 : $next;
319
320 my $return = $dt1->intersected_spans( $_[0] );
321
322 $return = $previous
323 if !defined $return->max;
324
325 bless $return, 'DateTime::SpanSet'
326 if defined $return;
327 return $return;
328}
329
330sub closest {
331 my $self = shift;
332 my $dt = shift;
333
334 my $dt1 = $self->current( $dt );
335 my $dt2 = $self->next( $dt );
336 bless $dt2, 'DateTime::SpanSet'
337 if defined $dt2;
338
339 return $dt2 unless defined $dt1;
340 return $dt1 unless defined $dt2;
341
342 $dt = DateTime::Set->from_datetimes( dates => [ $dt ] )
343 unless UNIVERSAL::can( $dt, 'union' );
344
345 return $dt1 if $dt1->contains( $dt );
346
347 my $delta = $dt->min - $dt1->max;
348 return $dt1 if ( $dt2->min - $delta ) >= $dt->max;
349
350 return $dt2;
351}
352
353sub as_list {
354 my $self = shift;
355 return undef unless ref( $self->{set} );
356
357 my %args = @_;
358 my $span;
359 $span = delete $args{span};
360 $span = DateTime::Span->new( %args ) if %args;
361
362 my $set = $self->clone;
363 $set = $set->intersection( $span ) if $span;
364
365 # Note: removing this line means we may end up in an infinite loop!
366 return undef if $set->{set}->is_too_complex; # undef = no begin/end
367
368 # return if $set->{set}->is_null; # nothing = empty
369 my @result;
370 # we should extract _copies_ of the set elements,
371 # such that the user can't modify the set indirectly
372
373 my $iter = $set->iterator;
374 while ( my $dt = $iter->next )
375 {
376 push @result, $dt
377 if ref( $dt ); # we don't want to return INFINITY value
378 };
379
380 return @result;
381}
382
383# Set::Infinite methods
384
385sub intersection {
386 my ($set1, $set2) = ( shift, shift );
387 my $class = ref($set1);
388 my $tmp = $class->empty_set();
389 $set2 = $set2->as_spanset
390 if $set2->can( 'as_spanset' );
391 $set2 = $set2->as_set
392 if $set2->can( 'as_set' );
393 $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] )
394 unless $set2->can( 'union' );
395 $tmp->{set} = $set1->{set}->intersection( $set2->{set} );
396 return $tmp;
397}
398
399sub intersected_spans {
400 my ($set1, $set2) = ( shift, shift );
401 my $class = ref($set1);
402 my $tmp = $class->empty_set();
403 $set2 = $set2->as_spanset
404 if $set2->can( 'as_spanset' );
405 $set2 = $set2->as_set
406 if $set2->can( 'as_set' );
407 $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] )
408 unless $set2->can( 'union' );
409 $tmp->{set} = $set1->{set}->intersected_spans( $set2->{set} );
410 return $tmp;
411}
412
413sub intersects {
414 my ($set1, $set2) = ( shift, shift );
415
416 unless ( $set2->can( 'union' ) )
417 {
418 for ( $set2, @_ )
419 {
420 return 1 if $set1->contains( $_ );
421 }
422 return 0;
423 }
424
425 my $class = ref($set1);
426 $set2 = $set2->as_spanset
427 if $set2->can( 'as_spanset' );
428 $set2 = $set2->as_set
429 if $set2->can( 'as_set' );
430 $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] )
431 unless $set2->can( 'union' );
432 return $set1->{set}->intersects( $set2->{set} );
433}
434
435sub contains {
436 my ($set1, $set2) = ( shift, shift );
437
438 unless ( $set2->can( 'union' ) )
439 {
440 if ( exists $set1->{set}{method} &&
441 $set1->{set}{method} eq 'until' )
442 {
443 my $start_set = $set1->start_set;
444 my $end_set = $set1->end_set;
445
446 for ( $set2, @_ )
447 {
448 my $start = $start_set->next( $set2 );
449 my $end = $end_set->next( $set2 );
450
451 goto ABORT unless defined $start && defined $end;
452
453 return 0 if $start < $end;
454 }
455 return 1;
456
457 ABORT: ;
458 # don't know
459 }
460 }
461
462 my $class = ref($set1);
463 $set2 = $set2->as_spanset
464 if $set2->can( 'as_spanset' );
465 $set2 = $set2->as_set
466 if $set2->can( 'as_set' );
467 $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] )
468 unless $set2->can( 'union' );
469 return $set1->{set}->contains( $set2->{set} );
470}
471
472sub union {
473 my ($set1, $set2) = ( shift, shift );
474 my $class = ref($set1);
475 my $tmp = $class->empty_set();
476 $set2 = $set2->as_spanset
477 if $set2->can( 'as_spanset' );
478 $set2 = $set2->as_set
479 if $set2->can( 'as_set' );
480 $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] )
481 unless $set2->can( 'union' );
482 $tmp->{set} = $set1->{set}->union( $set2->{set} );
483 return $tmp;
484}
485
486sub complement {
487 my ($set1, $set2) = ( shift, shift );
488 my $class = ref($set1);
489 my $tmp = $class->empty_set();
490 if (defined $set2) {
491 $set2 = $set2->as_spanset
492 if $set2->can( 'as_spanset' );
493 $set2 = $set2->as_set
494 if $set2->can( 'as_set' );
495 $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] )
496 unless $set2->can( 'union' );
497 $tmp->{set} = $set1->{set}->complement( $set2->{set} );
498 }
499 else {
500 $tmp->{set} = $set1->{set}->complement;
501 }
502 return $tmp;
503}
504
505sub min {
506 return DateTime::Set::_fix_datetime( $_[0]->{set}->min );
507}
508
509sub max {
510 return DateTime::Set::_fix_datetime( $_[0]->{set}->max );
511}
512
513# returns a DateTime::Span
514sub span {
515 my $set = $_[0]->{set}->span;
516 my $self = bless { set => $set }, 'DateTime::Span';
517 return $self;
518}
519
520# returns a DateTime::Duration
521sub duration {
522 my $dur;
523
524 return DateTime::Duration->new( seconds => 0 )
525 if $_[0]->{set}->is_empty;
526
527 local $@;
528 eval {
529 local $SIG{__DIE__}; # don't want to trap this (rt ticket 5434)
530 $dur = $_[0]->{set}->size
531 };
532
533 return $dur if defined $dur && ref( $dur );
534 return DateTime::Infinite::Future->new -
535 DateTime::Infinite::Past->new;
536 # return INFINITY;
537}
53811µs*size = \&duration;
539
54013µs1;
541
542__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.