X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=modules%2Ffallback%2FDateTime%2FSet.pm;fp=modules%2Ffallback%2FDateTime%2FSet.pm;h=0000000000000000000000000000000000000000;hb=53593baa211863fbf66540cf1bcc36c8fb37257f;hp=05fac96e9184fd83c36619194b01ae3e9dad1212;hpb=deb4d2dbb676d7d6f69dfe7815d6e0cb09bd4a44;p=kivitendo-erp.git diff --git a/modules/fallback/DateTime/Set.pm b/modules/fallback/DateTime/Set.pm deleted file mode 100644 index 05fac96e9..000000000 --- a/modules/fallback/DateTime/Set.pm +++ /dev/null @@ -1,1149 +0,0 @@ - -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 -