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