view release on metacpan or  search on metacpan

lib/Set/Infinite/_recurrence.pm  view on Meta::CPAN

    $_[0]->max == INFINITY &&
    $_[0]->min == NEG_INFINITY
}

sub _is_recurrence 
{
    exists $_[0]->{method}           && 
    $_[0]->{method} eq '_recurrence' &&
    $_[0]->{parent}->is_forever
}

sub intersects
{
    my ($s1, $s2) = (shift,shift);

    if ( exists $s1->{method} && $s1->{method} eq '_recurrence' )
    {
        # recurrence && span
        unless ( ref($s2) && exists $s2->{method} ) {
            my $intersection = $s1->intersection($s2, @_);
            my $min = $intersection->min;
            return 1 if defined $min && $min != NEG_INFINITY && $min != INFINITY;
            my $max = $intersection->max;
            return 1 if defined $max && $max != NEG_INFINITY && $max != INFINITY;
        }

        # recurrence && recurrence
        if ( $s1->{parent}->is_forever && 
            ref($s2) && _is_recurrence( $s2 ) )
        {
            my $intersection = $s1->intersection($s2, @_);
            my $min = $intersection->min;
            return 1 if defined $min && $min != NEG_INFINITY && $min != INFINITY;
            my $max = $intersection->max;
            return 1 if defined $max && $max != NEG_INFINITY && $max != INFINITY;
        }
    }
    return $s1->SUPER::intersects( $s2, @_ );
}

sub intersection
{
    my ($s1, $s2) = (shift,shift);

    if ( exists $s1->{method} && $s1->{method} eq '_recurrence' )
    {
        # optimize: recurrence && span
        return $s1->{parent}->
            intersection( $s2, @_ )->
            _recurrence( @{ $s1->{param} } )
                unless ref($s2) && exists $s2->{method};

        # optimize: recurrence && recurrence
        if ( $s1->{parent}->is_forever && 
            ref($s2) && _is_recurrence( $s2 ) )
        {
            my ( $next1, $previous1 ) = @{ $s1->{param} };
            my ( $next2, $previous2 ) = @{ $s2->{param} };
            return $s1->{parent}->_function( '_recurrence', 
                  sub {
                               # intersection of parent 'next' callbacks
                               my ($n1, $n2);
                               my $iterate = 0;
                               $n2 = $next2->( $_[0] );
                               while(1) { 
                                   $n1 = $next1->( $previous1->( $n2 ) );
                                   return $n1 if $n1 == $n2;
                                   $n2 = $next2->( $previous2->( $n1 ) );
                                   return if $iterate++ == $max_iterate;
                               }
                  },
                  sub {
                               # intersection of parent 'previous' callbacks
                               my ($p1, $p2);
                               my $iterate = 0;
                               $p2 = $previous2->( $_[0] );
                               while(1) { 
                                   $p1 = $previous1->( $next1->( $p2 ) );
                                   return $p1 if $p1 == $p2;
                                   $p2 = $previous2->( $next2->( $p1 ) ); 
                                   return if $iterate++ == $max_iterate;
                               }
                  },
               );
        }
    }
    return $s1->SUPER::intersection( $s2, @_ );
}

sub union
{
    my ($s1, $s2) = (shift,shift);
    if ( $s1->_is_recurrence &&
         ref($s2) && _is_recurrence( $s2 ) )
    {
        # optimize: recurrence || recurrence
        my ( $next1, $previous1 ) = @{ $s1->{param} };
        my ( $next2, $previous2 ) = @{ $s2->{param} };
        return $s1->{parent}->_function( '_recurrence',
                  sub {  # next
                               my $n1 = $next1->( $_[0] );
                               my $n2 = $next2->( $_[0] );
                               return $n1 < $n2 ? $n1 : $n2;
                  },
                  sub {  # previous
                               my $p1 = $previous1->( $_[0] );
                               my $p2 = $previous2->( $_[0] );
                               return $p1 > $p2 ? $p1 : $p2;
                  },
               );
    }
    return $s1->SUPER::union( $s2, @_ );
}

=head1 NAME

Set::Infinite::_recurrence - Extends Set::Infinite with recurrence functions

=head1 SYNOPSIS

    $recurrence = $base_set->_recurrence ( \&next, \&previous );

=head1 DESCRIPTION

This is an internal class used by the DateTime::Set module.
The API is subject to change.

It provides all functionality provided by Set::Infinite, plus the ability
to define recurrences with arbitrary objects, such as dates.

=head1 METHODS

=over 4