X-Git-Url: http://wagnertech.de/git?p=kivitendo-erp.git;a=blobdiff_plain;f=modules%2Ffallback%2FSet%2FInfinite%2F_recurrence.pm;fp=modules%2Ffallback%2FSet%2FInfinite%2F_recurrence.pm;h=0000000000000000000000000000000000000000;hp=376e168be0ae2de37bb67cd3dbab88e83386e073;hb=53593baa211863fbf66540cf1bcc36c8fb37257f;hpb=deb4d2dbb676d7d6f69dfe7815d6e0cb09bd4a44 diff --git a/modules/fallback/Set/Infinite/_recurrence.pm b/modules/fallback/Set/Infinite/_recurrence.pm deleted file mode 100644 index 376e168be..000000000 --- a/modules/fallback/Set/Infinite/_recurrence.pm +++ /dev/null @@ -1,404 +0,0 @@ -# Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved. -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. - -package Set::Infinite::_recurrence; - -use strict; - -use constant INFINITY => 100 ** 100 ** 100 ; -use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); - -use vars qw( @ISA $PRETTY_PRINT $max_iterate ); - -@ISA = qw( Set::Infinite ); -use Set::Infinite 0.5502; - -BEGIN { - $PRETTY_PRINT = 1; # enable Set::Infinite debug - $max_iterate = 20; - - # TODO: inherit %Set::Infinite::_first / _last - # in a more "object oriented" way - - $Set::Infinite::_first{_recurrence} = - sub { - my $self = $_[0]; - my ($callback_next, $callback_previous) = @{ $self->{param} }; - my ($min, $min_open) = $self->{parent}->min_a; - - my ( $min1, $min2 ); - $min1 = $callback_next->( $min ); - if ( ! $min_open ) - { - $min2 = $callback_previous->( $min1 ); - $min1 = $min2 if defined $min2 && $min == $min2; - } - - my $start = $callback_next->( $min1 ); - my $end = $self->{parent}->max; - - #print STDERR "set "; - #print STDERR $start->datetime - # unless $start == INFINITY; - #print STDERR " - " ; - #print STDERR $end->datetime - # unless $end == INFINITY; - #print STDERR "\n"; - - return ( $self->new( $min1 ), undef ) - if $start > $end; - - return ( $self->new( $min1 ), - $self->new( $start, $end )-> - _function( '_recurrence', @{ $self->{param} } ) ); - }; - $Set::Infinite::_last{_recurrence} = - sub { - my $self = $_[0]; - my ($callback_next, $callback_previous) = @{ $self->{param} }; - my ($max, $max_open) = $self->{parent}->max_a; - - my ( $max1, $max2 ); - $max1 = $callback_previous->( $max ); - if ( ! $max_open ) - { - $max2 = $callback_next->( $max1 ); - $max1 = $max2 if $max == $max2; - } - - return ( $self->new( $max1 ), - $self->new( $self->{parent}->min, - $callback_previous->( $max1 ) )-> - _function( '_recurrence', @{ $self->{param} } ) ); - }; -} - -# $si->_recurrence( -# \&callback_next, \&callback_previous ) -# -# Generates "recurrences" from a callback. -# These recurrences are simple lists of dates. -# -# The recurrence generation is based on an idea from Dave Rolsky. -# - -# use Data::Dumper; -# use Carp qw(cluck); - -sub _recurrence { - my $set = shift; - my ( $callback_next, $callback_previous, $delta ) = @_; - - $delta->{count} = 0 unless defined $delta->{delta}; - - # warn "reusing delta: ". $delta->{count} if defined $delta->{delta}; - # warn Dumper( $delta ); - - if ( $#{ $set->{list} } != 0 || $set->is_too_complex ) - { - return $set->iterate( - sub { - $_[0]->_recurrence( - $callback_next, $callback_previous, $delta ) - } ); - } - # $set is a span - my $result; - if ($set->min != NEG_INFINITY && $set->max != INFINITY) - { - # print STDERR " finite set\n"; - my ($min, $min_open) = $set->min_a; - my ($max, $max_open) = $set->max_a; - - my ( $min1, $min2 ); - $min1 = $callback_next->( $min ); - if ( ! $min_open ) - { - $min2 = $callback_previous->( $min1 ); - $min1 = $min2 if defined $min2 && $min == $min2; - } - - $result = $set->new(); - - # get "delta" - abort if this will take too much time. - - unless ( defined $delta->{max_delta} ) - { - for ( $delta->{count} .. 10 ) - { - if ( $max_open ) - { - return $result if $min1 >= $max; - } - else - { - return $result if $min1 > $max; - } - push @{ $result->{list} }, - { a => $min1, b => $min1, open_begin => 0, open_end => 0 }; - $min2 = $callback_next->( $min1 ); - - if ( $delta->{delta} ) - { - $delta->{delta} += $min2 - $min1; - } - else - { - $delta->{delta} = $min2 - $min1; - } - $delta->{count}++; - $min1 = $min2; - } - - $delta->{max_delta} = $delta->{delta} * 40; - } - - if ( $max < $min + $delta->{max_delta} ) - { - for ( 1 .. 200 ) - { - if ( $max_open ) - { - return $result if $min1 >= $max; - } - else - { - return $result if $min1 > $max; - } - push @{ $result->{list} }, - { a => $min1, b => $min1, open_begin => 0, open_end => 0 }; - $min1 = $callback_next->( $min1 ); - } - } - - # cluck "give up"; - } - - # return a "_function", such that we can backtrack later. - my $func = $set->_function( '_recurrence', $callback_next, $callback_previous, $delta ); - - # removed - returning $result doesn't help on speed - ## return $func->_function2( 'union', $result ) if $result; - - return $func; -} - -sub is_forever -{ - $#{ $_[0]->{list} } == 0 && - $_[0]->max == INFINITY && - $_[0]->min == NEG_INFINITY -} - -sub _is_recurrence -{ - exists $_[0]->{method} && - $_[0]->{method} eq '_recurrence' && - $_[0]->{parent}->is_forever -} - -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 - -=item * _recurrence ( \&next, \&previous ) - -Creates a recurrence set. The set is defined inside a 'base set'. - - $recurrence = $base_set->_recurrence ( \&next, \&previous ); - -The recurrence functions take one argument, and return the 'next' or -the 'previous' occurence. - -Example: defines the set of all 'integer numbers': - - use strict; - - use Set::Infinite::_recurrence; - use POSIX qw(floor); - - # define the recurrence span - my $forever = Set::Infinite::_recurrence->new( - Set::Infinite::_recurrence::NEG_INFINITY, - Set::Infinite::_recurrence::INFINITY - ); - - my $recurrence = $forever->_recurrence( - sub { # next - floor( $_[0] + 1 ) - }, - sub { # previous - my $tmp = floor( $_[0] ); - $tmp < $_[0] ? $tmp : $_[0] - 1 - }, - ); - - print "sample recurrence ", - $recurrence->intersection( -5, 5 ), "\n"; - # sample recurrence -5,-4,-3,-2,-1,0,1,2,3,4,5 - - { - my $x = 234.567; - print "next occurence after $x = ", - $recurrence->{param}[0]->( $x ), "\n"; # 235 - print "previous occurence before $x = ", - $recurrence->{param}[2]->( $x ), "\n"; # 234 - } - - { - my $x = 234; - print "next occurence after $x = ", - $recurrence->{param}[0]->( $x ), "\n"; # 235 - print "previous occurence before $x = ", - $recurrence->{param}[2]->( $x ), "\n"; # 233 - } - -=item * is_forever - -Returns true if the set is a single span, -ranging from -Infinity to Infinity. - -=item * _is_recurrence - -Returns true if the set is an unbounded recurrence, -ranging from -Infinity to Infinity. - -=back - -=head1 CONSTANTS - -=over 4 - -=item * INFINITY - -The C value. - -=item * NEG_INFINITY - -The C<-Infinity> value. - -=back - -=head1 SUPPORT - -Support is offered through the C mailing list. - -Please report bugs using rt.cpan.org - -=head1 AUTHOR - -Flavio Soibelmann Glock - -The recurrence generation algorithm is based on an idea from Dave Rolsky. - -=head1 COPYRIGHT - -Copyright (c) 2003 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 - -DateTime::Set - -For details on the Perl DateTime Suite project please see -L. - -=cut -