← 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/Set.pm
StatementsExecuted 26 statements in 5.60ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1116.29ms14.8msDateTime::Set::::BEGIN@9DateTime::Set::BEGIN@9
1112.23ms2.42msDateTime::Set::::BEGIN@10DateTime::Set::BEGIN@10
1111.90ms6.01msDateTime::Set::::BEGIN@8DateTime::Set::BEGIN@8
11111µs21µsDateTime::Set::::BEGIN@3DateTime::Set::BEGIN@3
11111µs19µsDateTime::Set::::BEGIN@6DateTime::Set::BEGIN@6
11110µs45µsDateTime::Set::::BEGIN@5DateTime::Set::BEGIN@5
1117µs23µsDateTime::Set::::BEGIN@12DateTime::Set::BEGIN@12
1116µs27µsDateTime::Set::::BEGIN@15DateTime::Set::BEGIN@15
1116µs33µsDateTime::Set::::BEGIN@4DateTime::Set::BEGIN@4
1116µs30µsDateTime::Set::::BEGIN@14DateTime::Set::BEGIN@14
1115µs5µsDateTime::Set::::BEGIN@7DateTime::Set::BEGIN@7
1113µs3µsDateTime::Set::::BEGIN@17DateTime::Set::BEGIN@17
0000s0sDateTime::Set::::__ANON__[:109]DateTime::Set::__ANON__[:109]
0000s0sDateTime::Set::::__ANON__[:128]DateTime::Set::__ANON__[:128]
0000s0sDateTime::Set::::__ANON__[:142]DateTime::Set::__ANON__[:142]
0000s0sDateTime::Set::::__ANON__[:154]DateTime::Set::__ANON__[:154]
0000s0sDateTime::Set::::__ANON__[:168]DateTime::Set::__ANON__[:168]
0000s0sDateTime::Set::::__ANON__[:184]DateTime::Set::__ANON__[:184]
0000s0sDateTime::Set::::__ANON__[:215]DateTime::Set::__ANON__[:215]
0000s0sDateTime::Set::::__ANON__[:223]DateTime::Set::__ANON__[:223]
0000s0sDateTime::Set::::__ANON__[:232]DateTime::Set::__ANON__[:232]
0000s0sDateTime::Set::::__ANON__[:240]DateTime::Set::__ANON__[:240]
0000s0sDateTime::Set::::__ANON__[:70]DateTime::Set::__ANON__[:70]
0000s0sDateTime::Set::::__ANON__[:90]DateTime::Set::__ANON__[:90]
0000s0sDateTime::Set::::_callback_nextDateTime::Set::_callback_next
0000s0sDateTime::Set::::_callback_previousDateTime::Set::_callback_previous
0000s0sDateTime::Set::::_fix_datetimeDateTime::Set::_fix_datetime
0000s0sDateTime::Set::::_fix_return_datetimeDateTime::Set::_fix_return_datetime
0000s0sDateTime::Set::::addDateTime::Set::add
0000s0sDateTime::Set::::add_durationDateTime::Set::add_duration
0000s0sDateTime::Set::::as_listDateTime::Set::as_list
0000s0sDateTime::Set::::cloneDateTime::Set::clone
0000s0sDateTime::Set::::closestDateTime::Set::closest
0000s0sDateTime::Set::::complementDateTime::Set::complement
0000s0sDateTime::Set::::containsDateTime::Set::contains
0000s0sDateTime::Set::::countDateTime::Set::count
0000s0sDateTime::Set::::currentDateTime::Set::current
0000s0sDateTime::Set::::empty_setDateTime::Set::empty_set
0000s0sDateTime::Set::::from_datetimesDateTime::Set::from_datetimes
0000s0sDateTime::Set::::from_recurrenceDateTime::Set::from_recurrence
0000s0sDateTime::Set::::grepDateTime::Set::grep
0000s0sDateTime::Set::::intersectionDateTime::Set::intersection
0000s0sDateTime::Set::::intersectsDateTime::Set::intersects
0000s0sDateTime::Set::::is_empty_setDateTime::Set::is_empty_set
0000s0sDateTime::Set::::iterateDateTime::Set::iterate
0000s0sDateTime::Set::::iteratorDateTime::Set::iterator
0000s0sDateTime::Set::::mapDateTime::Set::map
0000s0sDateTime::Set::::maxDateTime::Set::max
0000s0sDateTime::Set::::minDateTime::Set::min
0000s0sDateTime::Set::::nextDateTime::Set::next
0000s0sDateTime::Set::::previousDateTime::Set::previous
0000s0sDateTime::Set::::setDateTime::Set::set
0000s0sDateTime::Set::::set_time_zoneDateTime::Set::set_time_zone
0000s0sDateTime::Set::::spanDateTime::Set::span
0000s0sDateTime::Set::::subtractDateTime::Set::subtract
0000s0sDateTime::Set::::subtract_durationDateTime::Set::subtract_duration
0000s0sDateTime::Set::::unionDateTime::Set::union
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package DateTime::Set;
2
3221µs231µs
# spent 21µs (11+10) within DateTime::Set::BEGIN@3 which was called: # once (11µs+10µs) by Koha::Calendar::BEGIN@7 at line 3
use strict;
# spent 21µs making 1 call to DateTime::Set::BEGIN@3 # spent 10µs making 1 call to strict::import
4228µs260µs
# spent 33µs (6+27) within DateTime::Set::BEGIN@4 which was called: # once (6µs+27µs) by Koha::Calendar::BEGIN@7 at line 4
use Carp;
# spent 33µs making 1 call to DateTime::Set::BEGIN@4 # spent 27µs making 1 call to Exporter::import
5227µs280µs
# spent 45µs (10+35) within DateTime::Set::BEGIN@5 which was called: # once (10µs+35µs) by Koha::Calendar::BEGIN@7 at line 5
use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF );
# spent 45µs making 1 call to DateTime::Set::BEGIN@5 # spent 35µs making 1 call to Exporter::import
6334µs228µs
# spent 19µs (11+9) within DateTime::Set::BEGIN@6 which was called: # once (11µs+9µs) by Koha::Calendar::BEGIN@7 at line 6
use DateTime 0.12; # this is for version checking only
# spent 19µs making 1 call to DateTime::Set::BEGIN@6 # spent 9µs making 1 call to version::_VERSION
7219µs15µs
# spent 5µs within DateTime::Set::BEGIN@7 which was called: # once (5µs+0s) by Koha::Calendar::BEGIN@7 at line 7
use DateTime::Duration;
# spent 5µs making 1 call to DateTime::Set::BEGIN@7
82694µs16.01ms
# spent 6.01ms (1.90+4.11) within DateTime::Set::BEGIN@8 which was called: # once (1.90ms+4.11ms) by Koha::Calendar::BEGIN@7 at line 8
use DateTime::Span;
# spent 6.01ms making 1 call to DateTime::Set::BEGIN@8
93764µs314.9ms
# spent 14.8ms (6.29+8.56) within DateTime::Set::BEGIN@9 which was called: # once (6.29ms+8.56ms) by Koha::Calendar::BEGIN@7 at line 9
use Set::Infinite 0.59;
# spent 14.8ms making 1 call to DateTime::Set::BEGIN@9 # spent 17µs making 1 call to Exporter::import # spent 10µs making 1 call to version::_VERSION
102772µs22.44ms
# spent 2.42ms (2.23+192µs) within DateTime::Set::BEGIN@10 which was called: # once (2.23ms+192µs) by Koha::Calendar::BEGIN@7 at line 10
use Set::Infinite::_recurrence;
# spent 2.42ms making 1 call to DateTime::Set::BEGIN@10 # spent 14µs making 1 call to Exporter::import
11
12228µs239µs
# spent 23µs (7+16) within DateTime::Set::BEGIN@12 which was called: # once (7µs+16µs) by Koha::Calendar::BEGIN@7 at line 12
use vars qw( $VERSION );
# spent 23µs making 1 call to DateTime::Set::BEGIN@12 # spent 16µs making 1 call to vars::import
13
14229µs255µs
# spent 30µs (6+25) within DateTime::Set::BEGIN@14 which was called: # once (6µs+25µs) by Koha::Calendar::BEGIN@7 at line 14
use constant INFINITY => 100 ** 100 ** 100 ;
# spent 30µs making 1 call to DateTime::Set::BEGIN@14 # spent 25µs making 1 call to constant::import
15226µs248µs
# spent 27µs (6+21) within DateTime::Set::BEGIN@15 which was called: # once (6µs+21µs) by Koha::Calendar::BEGIN@7 at line 15
use constant NEG_INFINITY => -1 * (100 ** 100 ** 100);
# spent 27µs making 1 call to DateTime::Set::BEGIN@15 # spent 21µs making 1 call to constant::import
16
17
# spent 3µs within DateTime::Set::BEGIN@17 which was called: # once (3µs+0s) by Koha::Calendar::BEGIN@7 at line 19
BEGIN {
1813µs $VERSION = '0.3400';
1913.15ms13µs}
# spent 3µs making 1 call to DateTime::Set::BEGIN@17
20
21
22sub _fix_datetime {
23 # internal function -
24 # (not a class method)
25 #
26 # checks that the parameter is an object, and
27 # also protects the object against mutation
28
29 return $_[0]
30 unless defined $_[0]; # error
31 return $_[0]->clone
32 if ref( $_[0] ); # "immutable" datetime
33 return DateTime::Infinite::Future->new
34 if $_[0] == INFINITY; # Inf
35 return DateTime::Infinite::Past->new
36 if $_[0] == NEG_INFINITY; # -Inf
37 return $_[0]; # error
38}
39
40sub _fix_return_datetime {
41 my ( $dt, $dt_arg ) = @_;
42
43 # internal function -
44 # (not a class method)
45 #
46 # checks that the returned datetime has the same
47 # time zone as the parameter
48
49 # TODO: set locale
50
51 return unless $dt;
52 return unless $dt_arg;
53 if ( $dt_arg->can('time_zone_long_name') &&
54 !( $dt_arg->time_zone_long_name eq 'floating' ) )
55 {
56 $dt->set_time_zone( $dt_arg->time_zone );
57 }
58 return $dt;
59}
60
61sub iterate {
62 # deprecated method - use map() or grep() instead
63 my ( $self, $callback ) = @_;
64 my $class = ref( $self );
65 my $return = $class->empty_set;
66 $return->{set} = $self->{set}->iterate(
67 sub {
68 my $min = $_[0]->min;
69 $callback->( $min->clone ) if ref($min);
70 }
71 );
72 $return;
73}
74
75sub map {
76 my ( $self, $callback ) = @_;
77 my $class = ref( $self );
78 die "The callback parameter to map() must be a subroutine reference"
79 unless ref( $callback ) eq 'CODE';
80 my $return = $class->empty_set;
81 $return->{set} = $self->{set}->iterate(
82 sub {
83 local $_ = $_[0]->min;
84 next unless ref( $_ );
85 $_ = $_->clone;
86 my @list = $callback->();
87 my $set = Set::Infinite::_recurrence->new();
88 $set = $set->union( $_ ) for @list;
89 return $set;
90 }
91 );
92 $return;
93}
94
95sub grep {
96 my ( $self, $callback ) = @_;
97 my $class = ref( $self );
98 die "The callback parameter to grep() must be a subroutine reference"
99 unless ref( $callback ) eq 'CODE';
100 my $return = $class->empty_set;
101 $return->{set} = $self->{set}->iterate(
102 sub {
103 local $_ = $_[0]->min;
104 next unless ref( $_ );
105 $_ = $_->clone;
106 my $result = $callback->();
107 return $_ if $result;
108 return;
109 }
110 );
111 $return;
112}
113
114sub add { return shift->add_duration( DateTime::Duration->new(@_) ) }
115
116sub subtract { return shift->subtract_duration( DateTime::Duration->new(@_) ) }
117
118sub subtract_duration { return $_[0]->add_duration( $_[1]->inverse ) }
119
120sub add_duration {
121 my ( $self, $dur ) = @_;
122 $dur = $dur->clone; # $dur must be "immutable"
123
124 $self->{set} = $self->{set}->iterate(
125 sub {
126 my $min = $_[0]->min;
127 $min->clone->add_duration( $dur ) if ref($min);
128 },
129 backtrack_callback => sub {
130 my ( $min, $max ) = ( $_[0]->min, $_[0]->max );
131 if ( ref($min) )
132 {
133 $min = $min->clone;
134 $min->subtract_duration( $dur );
135 }
136 if ( ref($max) )
137 {
138 $max = $max->clone;
139 $max->subtract_duration( $dur );
140 }
141 return Set::Infinite::_recurrence->new( $min, $max );
142 },
143 );
144 $self;
145}
146
147sub set_time_zone {
148 my ( $self, $tz ) = @_;
149
150 $self->{set} = $self->{set}->iterate(
151 sub {
152 my $min = $_[0]->min;
153 $min->clone->set_time_zone( $tz ) if ref($min);
154 },
155 backtrack_callback => sub {
156 my ( $min, $max ) = ( $_[0]->min, $_[0]->max );
157 if ( ref($min) )
158 {
159 $min = $min->clone;
160 $min->set_time_zone( $tz );
161 }
162 if ( ref($max) )
163 {
164 $max = $max->clone;
165 $max->set_time_zone( $tz );
166 }
167 return Set::Infinite::_recurrence->new( $min, $max );
168 },
169 );
170 $self;
171}
172
173sub set {
174 my $self = shift;
175 my %args = validate( @_,
176 { locale => { type => SCALAR | OBJECT,
177 default => undef },
178 }
179 );
180 $self->{set} = $self->{set}->iterate(
181 sub {
182 my $min = $_[0]->min;
183 $min->clone->set( %args ) if ref($min);
184 },
185 );
186 $self;
187}
188
189sub from_recurrence {
190 my $class = shift;
191
192 my %args = @_;
193 my %param;
194
195 # Parameter renaming, such that we can use either
196 # recurrence => xxx or next => xxx, previous => xxx
197 $param{next} = delete $args{recurrence} || delete $args{next};
198 $param{previous} = delete $args{previous};
199
200 $param{span} = delete $args{span};
201 # they might be specifying a span using begin / end
202 $param{span} = DateTime::Span->new( %args ) if keys %args;
203
204 my $self = {};
205
206 die "Not enough arguments in from_recurrence()"
207 unless $param{next} || $param{previous};
208
209 if ( ! $param{previous} )
210 {
211 my $data = {};
212 $param{previous} =
213 sub {
214 _callback_previous ( _fix_datetime( $_[0] ), $param{next}, $data );
215 }
216 }
217 else
218 {
219 my $previous = $param{previous};
220 $param{previous} =
221 sub {
222 $previous->( _fix_datetime( $_[0] ) );
223 }
224 }
225
226 if ( ! $param{next} )
227 {
228 my $data = {};
229 $param{next} =
230 sub {
231 _callback_next ( _fix_datetime( $_[0] ), $param{previous}, $data );
232 }
233 }
234 else
235 {
236 my $next = $param{next};
237 $param{next} =
238 sub {
239 $next->( _fix_datetime( $_[0] ) );
240 }
241 }
242
243 my ( $min, $max );
244 $max = $param{previous}->( DateTime::Infinite::Future->new );
245 $min = $param{next}->( DateTime::Infinite::Past->new );
246 $max = INFINITY if $max->is_infinite;
247 $min = NEG_INFINITY if $min->is_infinite;
248
249 my $base_set = Set::Infinite::_recurrence->new( $min, $max );
250 $base_set = $base_set->intersection( $param{span}->{set} )
251 if $param{span};
252
253 # warn "base set is $base_set\n";
254
255 my $data = {};
256 $self->{set} =
257 $base_set->_recurrence(
258 $param{next},
259 $param{previous},
260 $data,
261 );
262 bless $self, $class;
263
264 return $self;
265}
266
267sub from_datetimes {
268 my $class = shift;
269 my %args = validate( @_,
270 { dates =>
271 { type => ARRAYREF,
272 },
273 }
274 );
275 my $self = {};
276 $self->{set} = Set::Infinite::_recurrence->new;
277 # possible optimization: sort datetimes and use "push"
278 for( @{ $args{dates} } )
279 {
280 # DateTime::Infinite objects are not welcome here,
281 # but this is not enforced (it does't hurt)
282
283 carp "The 'dates' argument to from_datetimes() must only contain ".
284 "datetime objects"
285 unless UNIVERSAL::can( $_, 'utc_rd_values' );
286
287 $self->{set} = $self->{set}->union( $_->clone );
288 }
289
290 bless $self, $class;
291 return $self;
292}
293
294sub empty_set {
295 my $class = shift;
296
297 return bless { set => Set::Infinite::_recurrence->new }, $class;
298}
299
300sub is_empty_set {
301 my $set = $_[0];
302 $set->{set}->is_null;
303}
304
305sub clone {
306 my $self = bless { %{ $_[0] } }, ref $_[0];
307 $self->{set} = $_[0]->{set}->copy;
308 return $self;
309}
310
311# default callback that returns the
312# "previous" value in a callback recurrence.
313#
314# This is used to simulate a 'previous' callback,
315# when then 'previous' argument in 'from_recurrence' is missing.
316#
317sub _callback_previous {
318 my ($value, $callback_next, $callback_info) = @_;
319 my $previous = $value->clone;
320
321 return $value if $value->is_infinite;
322
323 my $freq = $callback_info->{freq};
324 unless (defined $freq)
325 {
326 # This is called just once, to setup the recurrence frequency
327 my $previous = $callback_next->( $value );
328 my $next = $callback_next->( $previous );
329 $freq = 2 * ( $previous - $next );
330 # save it for future use with this same recurrence
331 $callback_info->{freq} = $freq;
332 }
333
334 $previous->add_duration( $freq );
335 $previous = $callback_next->( $previous );
336 if ($previous >= $value)
337 {
338 # This error happens if the event frequency oscillates widely
339 # (more than 100% of difference from one interval to next)
340 my @freq = $freq->deltas;
341 print STDERR "_callback_previous: Delta components are: @freq\n";
342 warn "_callback_previous: iterator can't find a previous value, got ".
343 $previous->ymd." after ".$value->ymd;
344 }
345 my $previous1;
346 while (1)
347 {
348 $previous1 = $previous->clone;
349 $previous = $callback_next->( $previous );
350 return $previous1 if $previous >= $value;
351 }
352}
353
354# default callback that returns the
355# "next" value in a callback recurrence.
356#
357# This is used to simulate a 'next' callback,
358# when then 'next' argument in 'from_recurrence' is missing.
359#
360sub _callback_next {
361 my ($value, $callback_previous, $callback_info) = @_;
362 my $next = $value->clone;
363
364 return $value if $value->is_infinite;
365
366 my $freq = $callback_info->{freq};
367 unless (defined $freq)
368 {
369 # This is called just once, to setup the recurrence frequency
370 my $next = $callback_previous->( $value );
371 my $previous = $callback_previous->( $next );
372 $freq = 2 * ( $next - $previous );
373 # save it for future use with this same recurrence
374 $callback_info->{freq} = $freq;
375 }
376
377 $next->add_duration( $freq );
378 $next = $callback_previous->( $next );
379 if ($next <= $value)
380 {
381 # This error happens if the event frequency oscillates widely
382 # (more than 100% of difference from one interval to next)
383 my @freq = $freq->deltas;
384 print STDERR "_callback_next: Delta components are: @freq\n";
385 warn "_callback_next: iterator can't find a previous value, got ".
386 $next->ymd." before ".$value->ymd;
387 }
388 my $next1;
389 while (1)
390 {
391 $next1 = $next->clone;
392 $next = $callback_previous->( $next );
393 return $next1 if $next >= $value;
394 }
395}
396
397sub iterator {
398 my $self = shift;
399
400 my %args = @_;
401 my $span;
402 $span = delete $args{span};
403 $span = DateTime::Span->new( %args ) if %args;
404
405 return $self->intersection( $span ) if $span;
406 return $self->clone;
407}
408
409
410# next() gets the next element from an iterator()
411# next( $dt ) returns the next element after a datetime.
412sub next {
413 my $self = shift;
414 return undef unless ref( $self->{set} );
415
416 if ( @_ )
417 {
418 if ( $self->{set}->_is_recurrence )
419 {
420 return _fix_return_datetime(
421 $self->{set}->{param}[0]->( $_[0] ), $_[0] );
422 }
423 else
424 {
425 my $span = DateTime::Span->from_datetimes( after => $_[0] );
426 return _fix_return_datetime(
427 $self->intersection( $span )->next, $_[0] );
428 }
429 }
430
431 my ($head, $tail) = $self->{set}->first;
432 $self->{set} = $tail;
433 return $head->min if defined $head;
434 return $head;
435}
436
437# previous() gets the last element from an iterator()
438# previous( $dt ) returns the previous element before a datetime.
439sub previous {
440 my $self = shift;
441 return undef unless ref( $self->{set} );
442
443 if ( @_ )
444 {
445 if ( $self->{set}->_is_recurrence )
446 {
447 return _fix_return_datetime(
448 $self->{set}->{param}[1]->( $_[0] ), $_[0] );
449 }
450 else
451 {
452 my $span = DateTime::Span->from_datetimes( before => $_[0] );
453 return _fix_return_datetime(
454 $self->intersection( $span )->previous, $_[0] );
455 }
456 }
457
458 my ($head, $tail) = $self->{set}->last;
459 $self->{set} = $tail;
460 return $head->max if defined $head;
461 return $head;
462}
463
464# "current" means less-or-equal to a datetime
465sub current {
466 my $self = shift;
467
468 return undef unless ref( $self->{set} );
469
470 if ( $self->{set}->_is_recurrence )
471 {
472 my $tmp = $self->next( $_[0] );
473 return $self->previous( $tmp );
474 }
475
476 return $_[0] if $self->contains( $_[0] );
477 $self->previous( $_[0] );
478}
479
480sub closest {
481 my $self = shift;
482 # return $_[0] if $self->contains( $_[0] );
483 my $dt1 = $self->current( $_[0] );
484 my $dt2 = $self->next( $_[0] );
485
486 return $dt2 unless defined $dt1;
487 return $dt1 unless defined $dt2;
488
489 my $delta = $_[0] - $dt1;
490 return $dt1 if ( $dt2 - $delta ) >= $_[0];
491
492 return $dt2;
493}
494
495sub as_list {
496 my $self = shift;
497 return undef unless ref( $self->{set} );
498
499 my %args = @_;
500 my $span;
501 $span = delete $args{span};
502 $span = DateTime::Span->new( %args ) if %args;
503
504 my $set = $self->clone;
505 $set = $set->intersection( $span ) if $span;
506
507 return if $set->{set}->is_null; # nothing = empty
508
509 # Note: removing this line means we may end up in an infinite loop!
510 ## return undef if $set->{set}->is_too_complex; # undef = no begin/end
511
512 return undef
513 if $set->max->is_infinite ||
514 $set->min->is_infinite;
515
516 my @result;
517 my $next = $self->min;
518 if ( $span ) {
519 my $next1 = $span->min;
520 $next = $next1 if $next1 && $next1 > $next;
521 $next = $self->current( $next );
522 }
523 my $last = $self->max;
524 if ( $span ) {
525 my $last1 = $span->max;
526 $last = $last1 if $last1 && $last1 < $last;
527 }
528 do {
529 push @result, $next if !$span || $span->contains($next);
530 $next = $self->next( $next );
531 }
532 while $next && $next <= $last;
533 return @result;
534}
535
536sub intersection {
537 my ($set1, $set2) = ( shift, shift );
538 my $class = ref($set1);
539 my $tmp = $class->empty_set();
540 $set2 = $set2->as_set
541 if $set2->can( 'as_set' );
542 $set2 = $class->from_datetimes( dates => [ $set2, @_ ] )
543 unless $set2->can( 'union' );
544 $tmp->{set} = $set1->{set}->intersection( $set2->{set} );
545 return $tmp;
546}
547
548sub intersects {
549 my ($set1, $set2) = ( shift, shift );
550 my $class = ref($set1);
551 $set2 = $set2->as_set
552 if $set2->can( 'as_set' );
553 unless ( $set2->can( 'union' ) )
554 {
555 if ( $set1->{set}->_is_recurrence )
556 {
557 for ( $set2, @_ )
558 {
559 return 1 if $set1->current( $_ ) == $_;
560 }
561 return 0;
562 }
563 $set2 = $class->from_datetimes( dates => [ $set2, @_ ] )
564 }
565 return $set1->{set}->intersects( $set2->{set} );
566}
567
568sub contains {
569 my ($set1, $set2) = ( shift, shift );
570 my $class = ref($set1);
571 $set2 = $set2->as_set
572 if $set2->can( 'as_set' );
573 unless ( $set2->can( 'union' ) )
574 {
575 if ( $set1->{set}->_is_recurrence )
576 {
577 for ( $set2, @_ )
578 {
579 return 0 unless $set1->current( $_ ) == $_;
580 }
581 return 1;
582 }
583 $set2 = $class->from_datetimes( dates => [ $set2, @_ ] )
584 }
585 return $set1->{set}->contains( $set2->{set} );
586}
587
588sub union {
589 my ($set1, $set2) = ( shift, shift );
590 my $class = ref($set1);
591 my $tmp = $class->empty_set();
592 $set2 = $set2->as_set
593 if $set2->can( 'as_set' );
594 $set2 = $class->from_datetimes( dates => [ $set2, @_ ] )
595 unless $set2->can( 'union' );
596 $tmp->{set} = $set1->{set}->union( $set2->{set} );
597 bless $tmp, 'DateTime::SpanSet'
598 if $set2->isa('DateTime::Span') or $set2->isa('DateTime::SpanSet');
599 return $tmp;
600}
601
602sub complement {
603 my ($set1, $set2) = ( shift, shift );
604 my $class = ref($set1);
605 my $tmp = $class->empty_set();
606 if (defined $set2)
607 {
608 $set2 = $set2->as_set
609 if $set2->can( 'as_set' );
610 $set2 = $class->from_datetimes( dates => [ $set2, @_ ] )
611 unless $set2->can( 'union' );
612 # TODO: "compose complement";
613 $tmp->{set} = $set1->{set}->complement( $set2->{set} );
614 }
615 else
616 {
617 $tmp->{set} = $set1->{set}->complement;
618 bless $tmp, 'DateTime::SpanSet';
619 }
620 return $tmp;
621}
622
623sub min {
624 return _fix_datetime( $_[0]->{set}->min );
625}
626
627sub max {
628 return _fix_datetime( $_[0]->{set}->max );
629}
630
631# returns a DateTime::Span
632sub span {
633 my $set = $_[0]->{set}->span;
634 my $self = bless { set => $set }, 'DateTime::Span';
635 return $self;
636}
637
638sub count {
639 my ($self) = shift;
640 return undef unless ref( $self->{set} );
641
642 my %args = @_;
643 my $span;
644 $span = delete $args{span};
645 $span = DateTime::Span->new( %args ) if %args;
646
647 my $set = $self->clone;
648 $set = $set->intersection( $span ) if $span;
649
650 return $set->{set}->count
651 unless $set->{set}->is_too_complex;
652
653 return undef
654 if $set->max->is_infinite ||
655 $set->min->is_infinite;
656
657 my $count = 0;
658 my $iter = $set->iterator;
659 $count++ while $iter->next;
660 return $count;
661}
662
66312µs1;
664
665__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.