X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=modules%2Ffallback%2FDateTime%2FSet.pm;fp=modules%2Ffallback%2FDateTime%2FSet.pm;h=05fac96e9184fd83c36619194b01ae3e9dad1212;hb=03fc848dccbb1c0100b1f72a899b7087234b7029;hp=0000000000000000000000000000000000000000;hpb=782fd7884fb686cd2e336756dadeb4ab5d05a415;p=kivitendo-erp.git diff --git a/modules/fallback/DateTime/Set.pm b/modules/fallback/DateTime/Set.pm new file mode 100644 index 000000000..05fac96e9 --- /dev/null +++ b/modules/fallback/DateTime/Set.pm @@ -0,0 +1,1149 @@ + +package DateTime::Set; + +use strict; +use Carp; +use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF ); +use DateTime 0.12; # this is for version checking only +use DateTime::Duration; +use DateTime::Span; +use Set::Infinite 0.59; +use Set::Infinite::_recurrence; + +use vars qw( $VERSION ); + +use constant INFINITY => 100 ** 100 ** 100 ; +use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); + +BEGIN { + $VERSION = '0.28'; +} + + +sub _fix_datetime { + # internal function - + # (not a class method) + # + # checks that the parameter is an object, and + # also protects the object against mutation + + return $_[0] + unless defined $_[0]; # error + return $_[0]->clone + if ref( $_[0] ); # "immutable" datetime + return DateTime::Infinite::Future->new + if $_[0] == INFINITY; # Inf + return DateTime::Infinite::Past->new + if $_[0] == NEG_INFINITY; # -Inf + return $_[0]; # error +} + +sub _fix_return_datetime { + my ( $dt, $dt_arg ) = @_; + + # internal function - + # (not a class method) + # + # checks that the returned datetime has the same + # time zone as the parameter + + # TODO: set locale + + return unless $dt; + return unless $dt_arg; + if ( $dt_arg->can('time_zone_long_name') && + !( $dt_arg->time_zone_long_name eq 'floating' ) ) + { + $dt->set_time_zone( $dt_arg->time_zone ); + } + return $dt; +} + +sub iterate { + # deprecated method - use map() or grep() instead + my ( $self, $callback ) = @_; + my $class = ref( $self ); + my $return = $class->empty_set; + $return->{set} = $self->{set}->iterate( + sub { + my $min = $_[0]->min; + $callback->( $min->clone ) if ref($min); + } + ); + $return; +} + +sub map { + my ( $self, $callback ) = @_; + my $class = ref( $self ); + die "The callback parameter to map() must be a subroutine reference" + unless ref( $callback ) eq 'CODE'; + my $return = $class->empty_set; + $return->{set} = $self->{set}->iterate( + sub { + local $_ = $_[0]->min; + next unless ref( $_ ); + $_ = $_->clone; + my @list = $callback->(); + my $set = Set::Infinite::_recurrence->new(); + $set = $set->union( $_ ) for @list; + return $set; + } + ); + $return; +} + +sub grep { + my ( $self, $callback ) = @_; + my $class = ref( $self ); + die "The callback parameter to grep() must be a subroutine reference" + unless ref( $callback ) eq 'CODE'; + my $return = $class->empty_set; + $return->{set} = $self->{set}->iterate( + sub { + local $_ = $_[0]->min; + next unless ref( $_ ); + $_ = $_->clone; + my $result = $callback->(); + return $_ if $result; + return; + } + ); + $return; +} + +sub add { return shift->add_duration( DateTime::Duration->new(@_) ) } + +sub subtract { return shift->subtract_duration( DateTime::Duration->new(@_) ) } + +sub subtract_duration { return $_[0]->add_duration( $_[1]->inverse ) } + +sub add_duration { + my ( $self, $dur ) = @_; + $dur = $dur->clone; # $dur must be "immutable" + + $self->{set} = $self->{set}->iterate( + sub { + my $min = $_[0]->min; + $min->clone->add_duration( $dur ) if ref($min); + }, + backtrack_callback => sub { + my ( $min, $max ) = ( $_[0]->min, $_[0]->max ); + if ( ref($min) ) + { + $min = $min->clone; + $min->subtract_duration( $dur ); + } + if ( ref($max) ) + { + $max = $max->clone; + $max->subtract_duration( $dur ); + } + return Set::Infinite::_recurrence->new( $min, $max ); + }, + ); + $self; +} + +sub set_time_zone { + my ( $self, $tz ) = @_; + + $self->{set} = $self->{set}->iterate( + sub { + my $min = $_[0]->min; + $min->clone->set_time_zone( $tz ) if ref($min); + }, + backtrack_callback => sub { + my ( $min, $max ) = ( $_[0]->min, $_[0]->max ); + if ( ref($min) ) + { + $min = $min->clone; + $min->set_time_zone( $tz ); + } + if ( ref($max) ) + { + $max = $max->clone; + $max->set_time_zone( $tz ); + } + return Set::Infinite::_recurrence->new( $min, $max ); + }, + ); + $self; +} + +sub set { + my $self = shift; + my %args = validate( @_, + { locale => { type => SCALAR | OBJECT, + default => undef }, + } + ); + $self->{set} = $self->{set}->iterate( + sub { + my $min = $_[0]->min; + $min->clone->set( %args ) if ref($min); + }, + ); + $self; +} + +sub from_recurrence { + my $class = shift; + + my %args = @_; + my %param; + + # Parameter renaming, such that we can use either + # recurrence => xxx or next => xxx, previous => xxx + $param{next} = delete $args{recurrence} || delete $args{next}; + $param{previous} = delete $args{previous}; + + $param{span} = delete $args{span}; + # they might be specifying a span using begin / end + $param{span} = DateTime::Span->new( %args ) if keys %args; + + my $self = {}; + + die "Not enough arguments in from_recurrence()" + unless $param{next} || $param{previous}; + + if ( ! $param{previous} ) + { + my $data = {}; + $param{previous} = + sub { + _callback_previous ( _fix_datetime( $_[0] ), $param{next}, $data ); + } + } + else + { + my $previous = $param{previous}; + $param{previous} = + sub { + $previous->( _fix_datetime( $_[0] ) ); + } + } + + if ( ! $param{next} ) + { + my $data = {}; + $param{next} = + sub { + _callback_next ( _fix_datetime( $_[0] ), $param{previous}, $data ); + } + } + else + { + my $next = $param{next}; + $param{next} = + sub { + $next->( _fix_datetime( $_[0] ) ); + } + } + + my ( $min, $max ); + $max = $param{previous}->( DateTime::Infinite::Future->new ); + $min = $param{next}->( DateTime::Infinite::Past->new ); + $max = INFINITY if $max->is_infinite; + $min = NEG_INFINITY if $min->is_infinite; + + my $base_set = Set::Infinite::_recurrence->new( $min, $max ); + $base_set = $base_set->intersection( $param{span}->{set} ) + if $param{span}; + + # warn "base set is $base_set\n"; + + my $data = {}; + $self->{set} = + $base_set->_recurrence( + $param{next}, + $param{previous}, + $data, + ); + bless $self, $class; + + return $self; +} + +sub from_datetimes { + my $class = shift; + my %args = validate( @_, + { dates => + { type => ARRAYREF, + }, + } + ); + my $self = {}; + $self->{set} = Set::Infinite::_recurrence->new; + # possible optimization: sort datetimes and use "push" + for( @{ $args{dates} } ) + { + # DateTime::Infinite objects are not welcome here, + # but this is not enforced (it does't hurt) + + carp "The 'dates' argument to from_datetimes() must only contain ". + "datetime objects" + unless UNIVERSAL::can( $_, 'utc_rd_values' ); + + $self->{set} = $self->{set}->union( $_->clone ); + } + + bless $self, $class; + return $self; +} + +sub empty_set { + my $class = shift; + + return bless { set => Set::Infinite::_recurrence->new }, $class; +} + +sub clone { + my $self = bless { %{ $_[0] } }, ref $_[0]; + $self->{set} = $_[0]->{set}->copy; + return $self; +} + +# default callback that returns the +# "previous" value in a callback recurrence. +# +# This is used to simulate a 'previous' callback, +# when then 'previous' argument in 'from_recurrence' is missing. +# +sub _callback_previous { + my ($value, $callback_next, $callback_info) = @_; + my $previous = $value->clone; + + return $value if $value->is_infinite; + + my $freq = $callback_info->{freq}; + unless (defined $freq) + { + # This is called just once, to setup the recurrence frequency + my $previous = $callback_next->( $value ); + my $next = $callback_next->( $previous ); + $freq = 2 * ( $previous - $next ); + # save it for future use with this same recurrence + $callback_info->{freq} = $freq; + } + + $previous->add_duration( $freq ); + $previous = $callback_next->( $previous ); + if ($previous >= $value) + { + # This error happens if the event frequency oscilates widely + # (more than 100% of difference from one interval to next) + my @freq = $freq->deltas; + print STDERR "_callback_previous: Delta components are: @freq\n"; + warn "_callback_previous: iterator can't find a previous value, got ". + $previous->ymd." after ".$value->ymd; + } + my $previous1; + while (1) + { + $previous1 = $previous->clone; + $previous = $callback_next->( $previous ); + return $previous1 if $previous >= $value; + } +} + +# default callback that returns the +# "next" value in a callback recurrence. +# +# This is used to simulate a 'next' callback, +# when then 'next' argument in 'from_recurrence' is missing. +# +sub _callback_next { + my ($value, $callback_previous, $callback_info) = @_; + my $next = $value->clone; + + return $value if $value->is_infinite; + + my $freq = $callback_info->{freq}; + unless (defined $freq) + { + # This is called just once, to setup the recurrence frequency + my $next = $callback_previous->( $value ); + my $previous = $callback_previous->( $next ); + $freq = 2 * ( $next - $previous ); + # save it for future use with this same recurrence + $callback_info->{freq} = $freq; + } + + $next->add_duration( $freq ); + $next = $callback_previous->( $next ); + if ($next <= $value) + { + # This error happens if the event frequency oscilates widely + # (more than 100% of difference from one interval to next) + my @freq = $freq->deltas; + print STDERR "_callback_next: Delta components are: @freq\n"; + warn "_callback_next: iterator can't find a previous value, got ". + $next->ymd." before ".$value->ymd; + } + my $next1; + while (1) + { + $next1 = $next->clone; + $next = $callback_previous->( $next ); + return $next1 if $next >= $value; + } +} + +sub iterator { + my $self = shift; + + my %args = @_; + my $span; + $span = delete $args{span}; + $span = DateTime::Span->new( %args ) if %args; + + return $self->intersection( $span ) if $span; + return $self->clone; +} + + +# next() gets the next element from an iterator() +# next( $dt ) returns the next element after a datetime. +sub next { + my $self = shift; + return undef unless ref( $self->{set} ); + + if ( @_ ) + { + if ( $self->{set}->_is_recurrence ) + { + return _fix_return_datetime( + $self->{set}->{param}[0]->( $_[0] ), $_[0] ); + } + else + { + my $span = DateTime::Span->from_datetimes( after => $_[0] ); + return _fix_return_datetime( + $self->intersection( $span )->next, $_[0] ); + } + } + + my ($head, $tail) = $self->{set}->first; + $self->{set} = $tail; + return $head->min if defined $head; + return $head; +} + +# previous() gets the last element from an iterator() +# previous( $dt ) returns the previous element before a datetime. +sub previous { + my $self = shift; + return undef unless ref( $self->{set} ); + + if ( @_ ) + { + if ( $self->{set}->_is_recurrence ) + { + return _fix_return_datetime( + $self->{set}->{param}[1]->( $_[0] ), $_[0] ); + } + else + { + my $span = DateTime::Span->from_datetimes( before => $_[0] ); + return _fix_return_datetime( + $self->intersection( $span )->previous, $_[0] ); + } + } + + my ($head, $tail) = $self->{set}->last; + $self->{set} = $tail; + return $head->max if defined $head; + return $head; +} + +# "current" means less-or-equal to a datetime +sub current { + my $self = shift; + + return undef unless ref( $self->{set} ); + + if ( $self->{set}->_is_recurrence ) + { + my $tmp = $self->next( $_[0] ); + return $self->previous( $tmp ); + } + + return $_[0] if $self->contains( $_[0] ); + $self->previous( $_[0] ); +} + +sub closest { + my $self = shift; + # return $_[0] if $self->contains( $_[0] ); + my $dt1 = $self->current( $_[0] ); + my $dt2 = $self->next( $_[0] ); + + return $dt2 unless defined $dt1; + return $dt1 unless defined $dt2; + + my $delta = $_[0] - $dt1; + return $dt1 if ( $dt2 - $delta ) >= $_[0]; + + return $dt2; +} + +sub as_list { + my $self = shift; + return undef unless ref( $self->{set} ); + + my %args = @_; + my $span; + $span = delete $args{span}; + $span = DateTime::Span->new( %args ) if %args; + + my $set = $self->clone; + $set = $set->intersection( $span ) if $span; + + return if $set->{set}->is_null; # nothing = empty + + # Note: removing this line means we may end up in an infinite loop! + ## return undef if $set->{set}->is_too_complex; # undef = no begin/end + + return undef + if $set->max->is_infinite || + $set->min->is_infinite; + + my @result; + my $next = $self->min; + if ( $span ) { + my $next1 = $span->min; + $next = $next1 if $next1 && $next1 > $next; + $next = $self->current( $next ); + } + my $last = $self->max; + if ( $span ) { + my $last1 = $span->max; + $last = $last1 if $last1 && $last1 < $last; + } + do { + push @result, $next if !$span || $span->contains($next); + $next = $self->next( $next ); + } + while $next && $next <= $last; + return @result; +} + +sub intersection { + my ($set1, $set2) = ( shift, shift ); + my $class = ref($set1); + my $tmp = $class->empty_set(); + $set2 = $set2->as_set + if $set2->can( 'as_set' ); + $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) + unless $set2->can( 'union' ); + $tmp->{set} = $set1->{set}->intersection( $set2->{set} ); + return $tmp; +} + +sub intersects { + my ($set1, $set2) = ( shift, shift ); + my $class = ref($set1); + $set2 = $set2->as_set + if $set2->can( 'as_set' ); + unless ( $set2->can( 'union' ) ) + { + if ( $set1->{set}->_is_recurrence ) + { + for ( $set2, @_ ) + { + return 1 if $set1->current( $_ ) == $_; + } + return 0; + } + $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) + } + return $set1->{set}->intersects( $set2->{set} ); +} + +sub contains { + my ($set1, $set2) = ( shift, shift ); + my $class = ref($set1); + $set2 = $set2->as_set + if $set2->can( 'as_set' ); + unless ( $set2->can( 'union' ) ) + { + if ( $set1->{set}->_is_recurrence ) + { + for ( $set2, @_ ) + { + return 0 unless $set1->current( $_ ) == $_; + } + return 1; + } + $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) + } + return $set1->{set}->contains( $set2->{set} ); +} + +sub union { + my ($set1, $set2) = ( shift, shift ); + my $class = ref($set1); + my $tmp = $class->empty_set(); + $set2 = $set2->as_set + if $set2->can( 'as_set' ); + $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) + unless $set2->can( 'union' ); + $tmp->{set} = $set1->{set}->union( $set2->{set} ); + bless $tmp, 'DateTime::SpanSet' + if $set2->isa('DateTime::Span') or $set2->isa('DateTime::SpanSet'); + return $tmp; +} + +sub complement { + my ($set1, $set2) = ( shift, shift ); + my $class = ref($set1); + my $tmp = $class->empty_set(); + if (defined $set2) + { + $set2 = $set2->as_set + if $set2->can( 'as_set' ); + $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) + unless $set2->can( 'union' ); + # TODO: "compose complement"; + $tmp->{set} = $set1->{set}->complement( $set2->{set} ); + } + else + { + $tmp->{set} = $set1->{set}->complement; + bless $tmp, 'DateTime::SpanSet'; + } + return $tmp; +} + +sub min { + return _fix_datetime( $_[0]->{set}->min ); +} + +sub max { + return _fix_datetime( $_[0]->{set}->max ); +} + +# returns a DateTime::Span +sub span { + my $set = $_[0]->{set}->span; + my $self = bless { set => $set }, 'DateTime::Span'; + return $self; +} + +sub count { + my ($self) = shift; + return undef unless ref( $self->{set} ); + + my %args = @_; + my $span; + $span = delete $args{span}; + $span = DateTime::Span->new( %args ) if %args; + + my $set = $self->clone; + $set = $set->intersection( $span ) if $span; + + return $set->{set}->count + unless $set->{set}->is_too_complex; + + return undef + if $set->max->is_infinite || + $set->min->is_infinite; + + my $count = 0; + my $iter = $set->iterator; + $count++ while $iter->next; + return $count; +} + +1; + +__END__ + +=head1 NAME + +DateTime::Set - Datetime sets and set math + +=head1 SYNOPSIS + + use DateTime; + use DateTime::Set; + + $date1 = DateTime->new( year => 2002, month => 3, day => 11 ); + $set1 = DateTime::Set->from_datetimes( dates => [ $date1 ] ); + # set1 = 2002-03-11 + + $date2 = DateTime->new( year => 2003, month => 4, day => 12 ); + $set2 = DateTime::Set->from_datetimes( dates => [ $date1, $date2 ] ); + # set2 = 2002-03-11, and 2003-04-12 + + $date3 = DateTime->new( year => 2003, month => 4, day => 1 ); + print $set2->next( $date3 )->ymd; # 2003-04-12 + print $set2->previous( $date3 )->ymd; # 2002-03-11 + print $set2->current( $date3 )->ymd; # 2002-03-11 + print $set2->closest( $date3 )->ymd; # 2003-04-12 + + # a 'monthly' recurrence: + $set = DateTime::Set->from_recurrence( + recurrence => sub { + return $_[0] if $_[0]->is_infinite; + return $_[0]->truncate( to => 'month' )->add( months => 1 ) + }, + span => $date_span1, # optional span + ); + + $set = $set1->union( $set2 ); # like "OR", "insert", "both" + $set = $set1->complement( $set2 ); # like "delete", "remove" + $set = $set1->intersection( $set2 ); # like "AND", "while" + $set = $set1->complement; # like "NOT", "negate", "invert" + + if ( $set1->intersects( $set2 ) ) { ... # like "touches", "interferes" + if ( $set1->contains( $set2 ) ) { ... # like "is-fully-inside" + + # data extraction + $date = $set1->min; # first date of the set + $date = $set1->max; # last date of the set + + $iter = $set1->iterator; + while ( $dt = $iter->next ) { + print $dt->ymd; + }; + +=head1 DESCRIPTION + +DateTime::Set is a module for datetime sets. It can be used to handle +two different types of sets. + +The first is a fixed set of predefined datetime objects. For example, +if we wanted to create a set of datetimes containing the birthdays of +people in our family for the current year. + +The second type of set that it can handle is one based on a +recurrence, such as "every Wednesday", or "noon on the 15th day of +every month". This type of set can have fixed starting and ending +datetimes, but neither is required. So our "every Wednesday set" +could be "every Wednesday from the beginning of time until the end of +time", or "every Wednesday after 2003-03-05 until the end of time", or +"every Wednesday between 2003-03-05 and 2004-01-07". + +This module also supports set math operations, so you do things like +create a new set from the union or difference of two sets, check +whether a datetime is a member of a given set, etc. + +This is different from a C, which handles a continuous +range as opposed to individual datetime points. There is also a module +C to handle sets of spans. + +=head1 METHODS + +=over 4 + +=item * from_datetimes + +Creates a new set from a list of datetimes. + + $dates = DateTime::Set->from_datetimes( dates => [ $dt1, $dt2, $dt3 ] ); + +The datetimes can be objects from class C, or from a +C class. + +C objects are not valid set members. + +=item * from_recurrence + +Creates a new set specified via a "recurrence" callback. + + $months = DateTime::Set->from_recurrence( + span => $dt_span_this_year, # optional span + recurrence => sub { + return $_[0]->truncate( to => 'month' )->add( months => 1 ) + }, + ); + +The C parameter is optional. It must be a C object. + +The span can also be specified using C / C and C +/ C parameters, as in the C constructor. In this +case, if there is a C parameter it will be ignored. + + $months = DateTime::Set->from_recurrence( + after => $dt_now, + recurrence => sub { + return $_[0]->truncate( to => 'month' )->add( months => 1 ); + }, + ); + +The recurrence function will be passed a single parameter, a datetime +object. The parameter can be an object from class C, or from +one of the C classes. The parameter can also +be a C or a C +object. + +The recurrence must return the I event after that object. There +is no guarantee as to what the returned object will be set to, only +that it will be greater than the object passed to the recurrence. + +If there are no more datetimes after the given parameter, then the +recurrence function should return C. + +It is ok to modify the parameter C<$_[0]> inside the recurrence +function. There are no side-effects. + +For example, if you wanted a recurrence that generated datetimes in +increments of 30 seconds, it would look like this: + + sub every_30_seconds { + my $dt = shift; + if ( $dt->second < 30 ) { + return $dt->truncate( to => 'minute' )->add( seconds => 30 ); + } else { + return $dt->truncate( to => 'minute' )->add( minutes => 1 ); + } + } + +Note that this recurrence takes leap seconds into account. Consider +using C in this manner to avoid complicated arithmetic +problems! + +It is also possible to create a recurrence by specifying either or both +of 'next' and 'previous' callbacks. + +The callbacks can return C and +C objects, in order to define I. In this case, both 'next' and 'previous' callbacks must +be defined: + + # "monthly from $dt until forever" + + my $months = DateTime::Set->from_recurrence( + next => sub { + return $dt if $_[0] < $dt; + $_[0]->truncate( to => 'month' ); + $_[0]->add( months => 1 ); + return $_[0]; + }, + previous => sub { + my $param = $_[0]->clone; + $_[0]->truncate( to => 'month' ); + $_[0]->subtract( months => 1 ) if $_[0] == $param; + return $_[0] if $_[0] >= $dt; + return DateTime::Infinite::Past->new; + }, + ); + +Bounded recurrences are easier to write using C parameters. See above. + +See also C and the other +C factory modules for generating specialized +recurrences, such as sunrise and sunset times, and holidays. + +=item * empty_set + +Creates a new empty set. + + $set = DateTime::Set->empty_set; + print "empty set" unless defined $set->max; + +=item * clone + +This object method returns a replica of the given object. + +C is useful if you want to apply a transformation to a set, +but you want to keep the previous value: + + $set2 = $set1->clone; + $set2->add_duration( year => 1 ); # $set1 is unaltered + +=item * add_duration( $duration ) + +This method adds the specified duration to every element of the set. + + $dt_dur = new DateTime::Duration( year => 1 ); + $set->add_duration( $dt_dur ); + +The original set is modified. If you want to keep the old values use: + + $new_set = $set->clone->add_duration( $dt_dur ); + +=item * add + +This method is syntactic sugar around the C method. + + $meetings_2004 = $meetings_2003->clone->add( years => 1 ); + +=item * subtract_duration( $duration_object ) + +When given a C object, this method simply calls +C on that object and passes that new duration to the +C method. + +=item * subtract( DateTime::Duration->new parameters ) + +Like C, this is syntactic sugar for the C +method. + +=item * set_time_zone( $tz ) + +This method will attempt to apply the C method to every +datetime in the set. + +=item * set( locale => .. ) + +This method can be used to change the C of a datetime set. + +=item * min + +=item * max + +The first and last C in the set. These methods may return +C if the set is empty. It is also possible that these methods +may return a C or +C object. + +These methods return just a I of the actual boundary value. +If you modify the result, the set will not be modified. + +=item * span + +Returns the total span of the set, as a C object. + +=item * iterator / next / previous + +These methods can be used to iterate over the datetimes in a set. + + $iter = $set1->iterator; + while ( $dt = $iter->next ) { + print $dt->ymd; + } + + # iterate backwards + $iter = $set1->iterator; + while ( $dt = $iter->previous ) { + print $dt->ymd; + } + +The boundaries of the iterator can be limited by passing it a C +parameter. This should be a C object which delimits +the iterator's boundaries. Optionally, instead of passing an object, +you can pass any parameters that would work for one of the +C class's constructors, and an object will be created +for you. + +Obviously, if the span you specify is not restricted both at the start +and end, then your iterator may iterate forever, depending on the +nature of your set. User beware! + +The C or C method will return C when there +are no more datetimes in the iterator. + +=item * as_list + +Returns the set elements as a list of C objects. Just as +with the C method, the C method can be limited +by a span. + + my @dt = $set->as_list( span => $span ); + +Applying C to a large recurrence set is a very expensive +operation, both in CPU time and in the memory used. If you I +need to extract elements from a large set, you can limit the set with +a shorter span: + + my @short_list = $large_set->as_list( span => $short_span ); + +For I sets, C will return C. Please note +that this is explicitly not an empty list, since an empty list is a +valid return value for empty sets! + +=item * count + +Returns a count of C objects in the set. Just as with the +C method, the C method can be limited by a span. + + defined( my $n = $set->count) or die "can't count"; + + my $n = $set->count( span => $span ); + die "can't count" unless defined $n; + +Applying C to a large recurrence set is a very expensive +operation, both in CPU time and in the memory used. If you I +need to count elements from a large set, you can limit the set with a +shorter span: + + my $count = $large_set->count( span => $short_span ); + +For I sets, C will return C. Please note +that this is explicitly not a scalar zero, since a zero count is a +valid return value for empty sets! + +=item * union + +=item * intersection + +=item * complement + +These set operation methods can accept a C list, a +C, a C, or a C +object as an argument. + + $set = $set1->union( $set2 ); # like "OR", "insert", "both" + $set = $set1->complement( $set2 ); # like "delete", "remove" + $set = $set1->intersection( $set2 ); # like "AND", "while" + $set = $set1->complement; # like "NOT", "negate", "invert" + +The C of a C with a C or a +C object returns a C object. + +If C is called without any arguments, then the result is a +C object representing the spans between each of the +set's elements. If complement is given an argument, then the return +value is a C object representing the I +between the sets. + +All other operations will always return a C. + +=item * intersects + +=item * contains + +These set operations result in a boolean value. + + if ( $set1->intersects( $set2 ) ) { ... # like "touches", "interferes" + if ( $set1->contains( $dt ) ) { ... # like "is-fully-inside" + +These methods can accept a C list, a C, a +C, or a C object as an argument. + +=item * previous + +=item * next + +=item * current + +=item * closest + + my $dt = $set->next( $dt ); + my $dt = $set->previous( $dt ); + my $dt = $set->current( $dt ); + my $dt = $set->closest( $dt ); + +These methods are used to find a set member relative to a given +datetime. + +The C method returns C<$dt> if $dt is an event, otherwise +it returns the previous event. + +The C method returns C<$dt> if $dt is an event, otherwise +it returns the closest event (previous or next). + +All of these methods may return C if there is no matching +datetime in the set. + +These methods will try to set the returned value to the same time zone +as the argument, unless the argument has a 'floating' time zone. + +=item * map ( sub { ... } ) + + # example: remove the hour:minute:second information + $set = $set2->map( + sub { + return $_->truncate( to => day ); + } + ); + + # example: postpone or antecipate events which + # match datetimes within another set + $set = $set2->map( + sub { + return $_->add( days => 1 ) while $holidays->contains( $_ ); + } + ); + +This method is the "set" version of Perl "map". + +It evaluates a subroutine for each element of the set (locally setting +"$_" to each datetime) and returns the set composed of the results of +each such evaluation. + +Like Perl "map", each element of the set may produce zero, one, or +more elements in the returned value. + +Unlike Perl "map", changing "$_" does not change the original +set. This means that calling map in void context has no effect. + +The callback subroutine may be called later in the program, due to +lazy evaluation. So don't count on subroutine side-effects. For +example, a C inside the subroutine may happen later than you +expect. + +The callback return value is expected to be within the span of the +C and the C element in the original set. This is a +limitation of the backtracking algorithm used in the C +library. + +For example: given the set C<[ 2001, 2010, 2015 ]>, the callback +result for the value C<2010> is expected to be within the span C<[ +2001 .. 2015 ]>. + +=item * grep ( sub { ... } ) + + # example: filter out any sundays + $set = $set2->grep( + sub { + return ( $_->day_of_week != 7 ); + } + ); + +This method is the "set" version of Perl "grep". + +It evaluates a subroutine for each element of the set (locally setting +"$_" to each datetime) and returns the set consisting of those +elements for which the expression evaluated to true. + +Unlike Perl "grep", changing "$_" does not change the original +set. This means that calling grep in void context has no effect. + +Changing "$_" does change the resulting set. + +The callback subroutine may be called later in the program, due to +lazy evaluation. So don't count on subroutine side-effects. For +example, a C inside the subroutine may happen later than you +expect. + +=item * iterate ( sub { ... } ) + +I + +=back + +=head1 SUPPORT + +Support is offered through the C mailing list. + +Please report bugs using rt.cpan.org + +=head1 AUTHOR + +Flavio Soibelmann Glock + +The API was developed together with Dave Rolsky and the DateTime +Community. + +=head1 COPYRIGHT + +Copyright (c) 2003-2006 Flavio Soibelmann Glock. All rights reserved. +This program is free software; you can distribute it and/or modify it +under the same terms as Perl itself. + +The full text of the license can be found in the LICENSE file included +with this module. + +=head1 SEE ALSO + +Set::Infinite + +For details on the Perl DateTime Suite project please see +L. + +=cut +