← 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:00 2013

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