Payment-Helfer: Rechnen mit undefinierten Werten vermeiden
[kivitendo-erp.git] / modules / fallback / DateTime / Set.pm
1
2 package DateTime::Set;
3
4 use strict;
5 use Carp;
6 use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF );
7 use DateTime 0.12;  # this is for version checking only
8 use DateTime::Duration;
9 use DateTime::Span;
10 use Set::Infinite 0.59;
11 use Set::Infinite::_recurrence;
12
13 use vars qw( $VERSION );
14
15 use constant INFINITY     =>       100 ** 100 ** 100 ;
16 use constant NEG_INFINITY => -1 * (100 ** 100 ** 100);
17
18 BEGIN {
19     $VERSION = '0.28';
20 }
21
22
23 sub _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
41 sub _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
62 sub 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
76 sub 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
96 sub 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
115 sub add { return shift->add_duration( DateTime::Duration->new(@_) ) }
116
117 sub subtract { return shift->subtract_duration( DateTime::Duration->new(@_) ) }
118
119 sub subtract_duration { return $_[0]->add_duration( $_[1]->inverse ) }
120
121 sub 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
148 sub 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
174 sub 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
190 sub 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
268 sub 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
295 sub empty_set {
296     my $class = shift;
297
298     return bless { set => Set::Infinite::_recurrence->new }, $class;
299 }
300
301 sub 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 #
313 sub _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 #
356 sub _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
393 sub 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.
408 sub 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.
435 sub 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
461 sub 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
476 sub 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
491 sub 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
532 sub 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
544 sub 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
564 sub 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
584 sub 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
598 sub 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
619 sub min { 
620     return _fix_datetime( $_[0]->{set}->min );
621 }
622
623 sub max { 
624     return _fix_datetime( $_[0]->{set}->max );
625 }
626
627 # returns a DateTime::Span
628 sub span {
629   my $set = $_[0]->{set}->span;
630   my $self = bless { set => $set }, 'DateTime::Span';
631   return $self;
632 }
633
634 sub 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
659 1;
660
661 __END__
662
663 =head1 NAME
664
665 DateTime::Set - Datetime sets and set math
666
667 =head1 SYNOPSIS
668
669     use DateTime;
670     use DateTime::Set;
671
672     $date1 = DateTime->new( year => 2002, month => 3, day => 11 );
673     $set1 = DateTime::Set->from_datetimes( dates => [ $date1 ] );
674     #  set1 = 2002-03-11
675
676     $date2 = DateTime->new( year => 2003, month => 4, day => 12 );
677     $set2 = DateTime::Set->from_datetimes( dates => [ $date1, $date2 ] );
678     #  set2 = 2002-03-11, and 2003-04-12
679
680     $date3 = DateTime->new( year => 2003, month => 4, day => 1 );
681     print $set2->next( $date3 )->ymd;      # 2003-04-12
682     print $set2->previous( $date3 )->ymd;  # 2002-03-11
683     print $set2->current( $date3 )->ymd;   # 2002-03-11
684     print $set2->closest( $date3 )->ymd;   # 2003-04-12
685
686     # a 'monthly' recurrence:
687     $set = DateTime::Set->from_recurrence( 
688         recurrence => sub {
689             return $_[0] if $_[0]->is_infinite;
690             return $_[0]->truncate( to => 'month' )->add( months => 1 )
691         },
692         span => $date_span1,    # optional span
693     );
694
695     $set = $set1->union( $set2 );         # like "OR", "insert", "both"
696     $set = $set1->complement( $set2 );    # like "delete", "remove"
697     $set = $set1->intersection( $set2 );  # like "AND", "while"
698     $set = $set1->complement;             # like "NOT", "negate", "invert"
699
700     if ( $set1->intersects( $set2 ) ) { ...  # like "touches", "interferes"
701     if ( $set1->contains( $set2 ) ) { ...    # like "is-fully-inside"
702
703     # data extraction 
704     $date = $set1->min;           # first date of the set
705     $date = $set1->max;           # last date of the set
706
707     $iter = $set1->iterator;
708     while ( $dt = $iter->next ) {
709         print $dt->ymd;
710     };
711
712 =head1 DESCRIPTION
713
714 DateTime::Set is a module for datetime sets.  It can be used to handle
715 two different types of sets.
716
717 The first is a fixed set of predefined datetime objects.  For example,
718 if we wanted to create a set of datetimes containing the birthdays of
719 people in our family for the current year.
720
721 The second type of set that it can handle is one based on a
722 recurrence, such as "every Wednesday", or "noon on the 15th day of
723 every month".  This type of set can have fixed starting and ending
724 datetimes, but neither is required.  So our "every Wednesday set"
725 could be "every Wednesday from the beginning of time until the end of
726 time", or "every Wednesday after 2003-03-05 until the end of time", or
727 "every Wednesday between 2003-03-05 and 2004-01-07".
728
729 This module also supports set math operations, so you do things like
730 create a new set from the union or difference of two sets, check
731 whether a datetime is a member of a given set, etc.
732
733 This is different from a C<DateTime::Span>, which handles a continuous
734 range as opposed to individual datetime points. There is also a module
735 C<DateTime::SpanSet> to handle sets of spans.
736
737 =head1 METHODS
738
739 =over 4
740
741 =item * from_datetimes
742
743 Creates a new set from a list of datetimes.
744
745    $dates = DateTime::Set->from_datetimes( dates => [ $dt1, $dt2, $dt3 ] );
746
747 The datetimes can be objects from class C<DateTime>, or from a
748 C<DateTime::Calendar::*> class.
749
750 C<DateTime::Infinite::*> objects are not valid set members.
751
752 =item * from_recurrence
753
754 Creates a new set specified via a "recurrence" callback.
755
756     $months = DateTime::Set->from_recurrence( 
757         span => $dt_span_this_year,    # optional span
758         recurrence => sub { 
759             return $_[0]->truncate( to => 'month' )->add( months => 1 ) 
760         }, 
761     );
762
763 The C<span> parameter is optional. It must be a C<DateTime::Span> object.
764
765 The span can also be specified using C<begin> / C<after> and C<before>
766 / C<end> parameters, as in the C<DateTime::Span> constructor.  In this
767 case, if there is a C<span> parameter it will be ignored.
768
769     $months = DateTime::Set->from_recurrence(
770         after => $dt_now,
771         recurrence => sub {
772             return $_[0]->truncate( to => 'month' )->add( months => 1 );
773         },
774     );
775
776 The recurrence function will be passed a single parameter, a datetime
777 object. The parameter can be an object from class C<DateTime>, or from
778 one of the C<DateTime::Calendar::*> classes.  The parameter can also
779 be a C<DateTime::Infinite::Future> or a C<DateTime::Infinite::Past>
780 object.
781
782 The recurrence must return the I<next> event after that object.  There
783 is no guarantee as to what the returned object will be set to, only
784 that it will be greater than the object passed to the recurrence.
785
786 If there are no more datetimes after the given parameter, then the
787 recurrence function should return C<DateTime::Infinite::Future>.
788
789 It is ok to modify the parameter C<$_[0]> inside the recurrence
790 function.  There are no side-effects.
791
792 For example, if you wanted a recurrence that generated datetimes in
793 increments of 30 seconds, it would look like this:
794
795   sub every_30_seconds {
796       my $dt = shift;
797       if ( $dt->second < 30 ) {
798           return $dt->truncate( to => 'minute' )->add( seconds => 30 );
799       } else {
800           return $dt->truncate( to => 'minute' )->add( minutes => 1 );
801       }
802   }
803
804 Note that this recurrence takes leap seconds into account.  Consider
805 using C<truncate()> in this manner to avoid complicated arithmetic
806 problems!
807
808 It is also possible to create a recurrence by specifying either or both
809 of 'next' and 'previous' callbacks.
810
811 The callbacks can return C<DateTime::Infinite::Future> and
812 C<DateTime::Infinite::Past> objects, in order to define I<bounded
813 recurrences>.  In this case, both 'next' and 'previous' callbacks must
814 be defined:
815
816     # "monthly from $dt until forever"
817
818     my $months = DateTime::Set->from_recurrence(
819         next => sub {
820             return $dt if $_[0] < $dt;
821             $_[0]->truncate( to => 'month' );
822             $_[0]->add( months => 1 );
823             return $_[0];
824         },
825         previous => sub {
826             my $param = $_[0]->clone;
827             $_[0]->truncate( to => 'month' );
828             $_[0]->subtract( months => 1 ) if $_[0] == $param;
829             return $_[0] if $_[0] >= $dt;
830             return DateTime::Infinite::Past->new;
831         },
832     );
833
834 Bounded recurrences are easier to write using C<span> parameters. See above.
835
836 See also C<DateTime::Event::Recurrence> and the other
837 C<DateTime::Event::*> factory modules for generating specialized
838 recurrences, such as sunrise and sunset times, and holidays.
839
840 =item * empty_set
841
842 Creates a new empty set.
843
844     $set = DateTime::Set->empty_set;
845     print "empty set" unless defined $set->max;
846
847 =item * clone
848
849 This object method returns a replica of the given object.
850
851 C<clone> is useful if you want to apply a transformation to a set,
852 but you want to keep the previous value:
853
854     $set2 = $set1->clone;
855     $set2->add_duration( year => 1 );  # $set1 is unaltered
856
857 =item * add_duration( $duration )
858
859 This method adds the specified duration to every element of the set.
860
861     $dt_dur = new DateTime::Duration( year => 1 );
862     $set->add_duration( $dt_dur );
863
864 The original set is modified. If you want to keep the old values use:
865
866     $new_set = $set->clone->add_duration( $dt_dur );
867
868 =item * add
869
870 This method is syntactic sugar around the C<add_duration()> method.
871
872     $meetings_2004 = $meetings_2003->clone->add( years => 1 );
873
874 =item * subtract_duration( $duration_object )
875
876 When given a C<DateTime::Duration> object, this method simply calls
877 C<invert()> on that object and passes that new duration to the
878 C<add_duration> method.
879
880 =item * subtract( DateTime::Duration->new parameters )
881
882 Like C<add()>, this is syntactic sugar for the C<subtract_duration()>
883 method.
884
885 =item * set_time_zone( $tz )
886
887 This method will attempt to apply the C<set_time_zone> method to every 
888 datetime in the set.
889
890 =item * set( locale => .. )
891
892 This method can be used to change the C<locale> of a datetime set.
893
894 =item * min
895
896 =item * max
897
898 The first and last C<DateTime> in the set.  These methods may return
899 C<undef> if the set is empty.  It is also possible that these methods
900 may return a C<DateTime::Infinite::Past> or
901 C<DateTime::Infinite::Future> object.
902
903 These methods return just a I<copy> of the actual boundary value.
904 If you modify the result, the set will not be modified.
905
906 =item * span
907
908 Returns the total span of the set, as a C<DateTime::Span> object.
909
910 =item * iterator / next / previous
911
912 These methods can be used to iterate over the datetimes in a set.
913
914     $iter = $set1->iterator;
915     while ( $dt = $iter->next ) {
916         print $dt->ymd;
917     }
918
919     # iterate backwards
920     $iter = $set1->iterator;
921     while ( $dt = $iter->previous ) {
922         print $dt->ymd;
923     }
924
925 The boundaries of the iterator can be limited by passing it a C<span>
926 parameter.  This should be a C<DateTime::Span> object which delimits
927 the iterator's boundaries.  Optionally, instead of passing an object,
928 you can pass any parameters that would work for one of the
929 C<DateTime::Span> class's constructors, and an object will be created
930 for you.
931
932 Obviously, if the span you specify is not restricted both at the start
933 and end, then your iterator may iterate forever, depending on the
934 nature of your set.  User beware!
935
936 The C<next()> or C<previous()> method will return C<undef> when there
937 are no more datetimes in the iterator.
938
939 =item * as_list
940
941 Returns the set elements as a list of C<DateTime> objects.  Just as
942 with the C<iterator()> method, the C<as_list()> method can be limited
943 by a span.
944
945   my @dt = $set->as_list( span => $span );
946
947 Applying C<as_list()> to a large recurrence set is a very expensive
948 operation, both in CPU time and in the memory used.  If you I<really>
949 need to extract elements from a large set, you can limit the set with
950 a shorter span:
951
952     my @short_list = $large_set->as_list( span => $short_span );
953
954 For I<infinite> sets, C<as_list()> will return C<undef>.  Please note
955 that this is explicitly not an empty list, since an empty list is a
956 valid return value for empty sets!
957
958 =item * count
959
960 Returns a count of C<DateTime> objects in the set.  Just as with the
961 C<iterator()> method, the C<count()> method can be limited by a span.
962
963   defined( my $n = $set->count) or die "can't count";
964
965   my $n = $set->count( span => $span );
966   die "can't count" unless defined $n;
967
968 Applying C<count()> to a large recurrence set is a very expensive
969 operation, both in CPU time and in the memory used.  If you I<really>
970 need to count elements from a large set, you can limit the set with a
971 shorter span:
972
973     my $count = $large_set->count( span => $short_span );
974
975 For I<infinite> sets, C<count()> will return C<undef>.  Please note
976 that this is explicitly not a scalar zero, since a zero count is a
977 valid return value for empty sets!
978
979 =item * union
980
981 =item * intersection
982
983 =item * complement
984
985 These set operation methods can accept a C<DateTime> list, a
986 C<DateTime::Set>, a C<DateTime::Span>, or a C<DateTime::SpanSet>
987 object as an argument.
988
989     $set = $set1->union( $set2 );         # like "OR", "insert", "both"
990     $set = $set1->complement( $set2 );    # like "delete", "remove"
991     $set = $set1->intersection( $set2 );  # like "AND", "while"
992     $set = $set1->complement;             # like "NOT", "negate", "invert"
993
994 The C<union> of a C<DateTime::Set> with a C<DateTime::Span> or a
995 C<DateTime::SpanSet> object returns a C<DateTime::SpanSet> object.
996
997 If C<complement> is called without any arguments, then the result is a
998 C<DateTime::SpanSet> object representing the spans between each of the
999 set's elements.  If complement is given an argument, then the return
1000 value is a C<DateTime::Set> object representing the I<set difference>
1001 between the sets.
1002
1003 All other operations will always return a C<DateTime::Set>.
1004
1005 =item * intersects
1006
1007 =item * contains
1008
1009 These set operations result in a boolean value.
1010
1011     if ( $set1->intersects( $set2 ) ) { ...  # like "touches", "interferes"
1012     if ( $set1->contains( $dt ) ) { ...    # like "is-fully-inside"
1013
1014 These methods can accept a C<DateTime> list, a C<DateTime::Set>, a
1015 C<DateTime::Span>, or a C<DateTime::SpanSet> object as an argument.
1016
1017 =item * previous
1018
1019 =item * next
1020
1021 =item * current
1022
1023 =item * closest
1024
1025   my $dt = $set->next( $dt );
1026   my $dt = $set->previous( $dt );
1027   my $dt = $set->current( $dt );
1028   my $dt = $set->closest( $dt );
1029
1030 These methods are used to find a set member relative to a given
1031 datetime.
1032
1033 The C<current()> method returns C<$dt> if $dt is an event, otherwise
1034 it returns the previous event.
1035
1036 The C<closest()> method returns C<$dt> if $dt is an event, otherwise
1037 it returns the closest event (previous or next).
1038
1039 All of these methods may return C<undef> if there is no matching
1040 datetime in the set.
1041
1042 These methods will try to set the returned value to the same time zone
1043 as the argument, unless the argument has a 'floating' time zone.
1044
1045 =item * map ( sub { ... } )
1046
1047     # example: remove the hour:minute:second information
1048     $set = $set2->map( 
1049         sub {
1050             return $_->truncate( to => day );
1051         }
1052     );
1053
1054     # example: postpone or antecipate events which 
1055     #          match datetimes within another set
1056     $set = $set2->map(
1057         sub {
1058             return $_->add( days => 1 ) while $holidays->contains( $_ );
1059         }
1060     );
1061
1062 This method is the "set" version of Perl "map".
1063
1064 It evaluates a subroutine for each element of the set (locally setting
1065 "$_" to each datetime) and returns the set composed of the results of
1066 each such evaluation.
1067
1068 Like Perl "map", each element of the set may produce zero, one, or
1069 more elements in the returned value.
1070
1071 Unlike Perl "map", changing "$_" does not change the original
1072 set. This means that calling map in void context has no effect.
1073
1074 The callback subroutine may be called later in the program, due to
1075 lazy evaluation.  So don't count on subroutine side-effects. For
1076 example, a C<print> inside the subroutine may happen later than you
1077 expect.
1078
1079 The callback return value is expected to be within the span of the
1080 C<previous> and the C<next> element in the original set.  This is a
1081 limitation of the backtracking algorithm used in the C<Set::Infinite>
1082 library.
1083
1084 For example: given the set C<[ 2001, 2010, 2015 ]>, the callback
1085 result for the value C<2010> is expected to be within the span C<[
1086 2001 .. 2015 ]>.
1087
1088 =item * grep ( sub { ... } )
1089
1090     # example: filter out any sundays
1091     $set = $set2->grep( 
1092         sub {
1093             return ( $_->day_of_week != 7 );
1094         }
1095     );
1096
1097 This method is the "set" version of Perl "grep".
1098
1099 It evaluates a subroutine for each element of the set (locally setting
1100 "$_" to each datetime) and returns the set consisting of those
1101 elements for which the expression evaluated to true.
1102
1103 Unlike Perl "grep", changing "$_" does not change the original
1104 set. This means that calling grep in void context has no effect.
1105
1106 Changing "$_" does change the resulting set.
1107
1108 The callback subroutine may be called later in the program, due to
1109 lazy evaluation.  So don't count on subroutine side-effects. For
1110 example, a C<print> inside the subroutine may happen later than you
1111 expect.
1112
1113 =item * iterate ( sub { ... } )
1114
1115 I<deprecated method - please use "map" or "grep" instead.>
1116
1117 =back
1118
1119 =head1 SUPPORT
1120
1121 Support is offered through the C<datetime@perl.org> mailing list.
1122
1123 Please report bugs using rt.cpan.org
1124
1125 =head1 AUTHOR
1126
1127 Flavio Soibelmann Glock <fglock@pucrs.br>
1128
1129 The API was developed together with Dave Rolsky and the DateTime
1130 Community.
1131
1132 =head1 COPYRIGHT
1133
1134 Copyright (c) 2003-2006 Flavio Soibelmann Glock. All rights reserved.
1135 This program is free software; you can distribute it and/or modify it
1136 under the same terms as Perl itself.
1137
1138 The full text of the license can be found in the LICENSE file included
1139 with this module.
1140
1141 =head1 SEE ALSO
1142
1143 Set::Infinite
1144
1145 For details on the Perl DateTime Suite project please see
1146 L<http://datetime.perl.org>.
1147
1148 =cut
1149