X-Git-Url: http://wagnertech.de/git?p=kivitendo-erp.git;a=blobdiff_plain;f=modules%2Ffallback%2FSet%2FInfinite%2FArithmetic.pm;fp=modules%2Ffallback%2FSet%2FInfinite%2FArithmetic.pm;h=0000000000000000000000000000000000000000;hp=e1a05c5ae9333e451d702299635301cca2861dff;hb=53593baa211863fbf66540cf1bcc36c8fb37257f;hpb=deb4d2dbb676d7d6f69dfe7815d6e0cb09bd4a44 diff --git a/modules/fallback/Set/Infinite/Arithmetic.pm b/modules/fallback/Set/Infinite/Arithmetic.pm deleted file mode 100644 index e1a05c5ae..000000000 --- a/modules/fallback/Set/Infinite/Arithmetic.pm +++ /dev/null @@ -1,367 +0,0 @@ -package Set::Infinite::Arithmetic; -# Copyright (c) 2001 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. - -use strict; -# use warnings; -require Exporter; -use Carp; -use Time::Local; -use POSIX qw(floor); - -use vars qw( @EXPORT @EXPORT_OK $inf ); - -@EXPORT = qw(); -@EXPORT_OK = qw(); -# @EXPORT_OK = qw( %subs_offset2 %Offset_to_value %Value_to_offset %Init_quantizer ); - -$inf = 100**100**100; # $Set::Infinite::inf; doesn't work! (why?) - -=head2 NAME - -Set::Infinite::Arithmetic - Scalar operations used by quantize() and offset() - -=head2 AUTHOR - -Flavio Soibelmann Glock - fglock@pucrs.br - -=cut - -use vars qw( $day_size $hour_size $minute_size $second_size ); -$day_size = timegm(0,0,0,2,3,2001) - timegm(0,0,0,1,3,2001); -$hour_size = $day_size / 24; -$minute_size = $hour_size / 60; -$second_size = $minute_size / 60; - -use vars qw( %_MODE %subs_offset2 %Offset_to_value @week_start %Init_quantizer %Value_to_offset %Offset_to_value ); - -=head2 %_MODE hash of subs - - $a->offset ( value => [1,2], mode => 'offset', unit => 'days' ); - - $a->offset ( value => [1,2, -5,-4], mode => 'offset', unit => 'days' ); - -note: if mode = circle, then "-5" counts from end (like a Perl negative array index). - - $a->offset ( value => [1,2], mode => 'offset', unit => 'days', strict => $a ); - -option 'strict' will return intersection($a,offset). Default: none. - -=cut - -# return value = ($this, $next, $cmp) -%_MODE = ( - circle => sub { - if ($_[3] >= 0) { - &{ $_[0] } ($_[1], $_[3], $_[4] ) - } - else { - &{ $_[0] } ($_[2], $_[3], $_[4] ) - } - }, - begin => sub { &{ $_[0] } ($_[1], $_[3], $_[4] ) }, - end => sub { &{ $_[0] } ($_[2], $_[3], $_[4] ) }, - offset => sub { - my ($this, undef) = &{ $_[0] } ($_[1], $_[3], $_[4] ); - my (undef, $next) = &{ $_[0] } ($_[2], $_[3], $_[4] ); - ($this, $next); - } -); - - -=head2 %subs_offset2($object, $offset1, $offset2) - - &{ $subs_offset2{$unit} } ($object, $offset1, $offset2); - -A hash of functions that return: - - ($object+$offset1, $object+$offset2) - -in $unit context. - -Returned $object+$offset1, $object+$offset2 may be scalars or objects. - -=cut - -%subs_offset2 = ( - weekdays => sub { - # offsets to week-day specified - # 0 = first sunday from today (or today if today is sunday) - # 1 = first monday from today (or today if today is monday) - # 6 = first friday from today (or today if today is friday) - # 13 = second friday from today - # -1 = last saturday from today (not today, even if today were saturday) - # -2 = last friday - my ($self, $index1, $index2) = @_; - return ($self, $self) if $self == $inf; - # my $class = ref($self); - my @date = gmtime( $self ); - my $wday = $date[6]; - my ($tmp1, $tmp2); - - $tmp1 = $index1 - $wday; - if ($index1 >= 0) { - $tmp1 += 7 if $tmp1 < 0; # it will only happen next week - } - else { - $tmp1 += 7 if $tmp1 < -7; # if will happen this week - } - - $tmp2 = $index2 - $wday; - if ($index2 >= 0) { - $tmp2 += 7 if $tmp2 < 0; # it will only happen next week - } - else { - $tmp2 += 7 if $tmp2 < -7; # if will happen this week - } - - # print " [ OFS:weekday $self $tmp1 $tmp2 ] \n"; - # $date[3] += $tmp1; - $tmp1 = $self + $tmp1 * $day_size; - # $date[3] += $tmp2 - $tmp1; - $tmp2 = $self + $tmp2 * $day_size; - - ($tmp1, $tmp2); - }, - years => sub { - my ($self, $index, $index2) = @_; - return ($self, $self) if $self == $inf; - # my $class = ref($self); - # print " [ofs:year:$self -- $index]\n"; - my @date = gmtime( $self ); - $date[5] += 1900 + $index; - my $tmp = timegm(@date); - - $date[5] += $index2 - $index; - my $tmp2 = timegm(@date); - - ($tmp, $tmp2); - }, - months => sub { - my ($self, $index, $index2) = @_; - # carp " [ofs:month:$self -- $index -- $inf]"; - return ($self, $self) if $self == $inf; - # my $class = ref($self); - my @date = gmtime( $self ); - - my $mon = $date[4] + $index; - my $year = $date[5] + 1900; - # print " [OFS: month: from $year$mon ]\n"; - if (($mon > 11) or ($mon < 0)) { - my $addyear = floor($mon / 12); - $mon = $mon - 12 * $addyear; - $year += $addyear; - } - - my $mon2 = $date[4] + $index2; - my $year2 = $date[5] + 1900; - if (($mon2 > 11) or ($mon2 < 0)) { - my $addyear2 = floor($mon2 / 12); - $mon2 = $mon2 - 12 * $addyear2; - $year2 += $addyear2; - } - - # print " [OFS: month: to $year $mon ]\n"; - - $date[4] = $mon; - $date[5] = $year; - my $tmp = timegm(@date); - - $date[4] = $mon2; - $date[5] = $year2; - my $tmp2 = timegm(@date); - - ($tmp, $tmp2); - }, - days => sub { - ( $_[0] + $_[1] * $day_size, - $_[0] + $_[2] * $day_size, - ) - }, - weeks => sub { - ( $_[0] + $_[1] * (7 * $day_size), - $_[0] + $_[2] * (7 * $day_size), - ) - }, - hours => sub { - # carp " [ $_[0]+$_[1] hour = ".( $_[0] + $_[1] * $hour_size )." mode=".($_[0]->{mode})." ]"; - ( $_[0] + $_[1] * $hour_size, - $_[0] + $_[2] * $hour_size, - ) - }, - minutes => sub { - ( $_[0] + $_[1] * $minute_size, - $_[0] + $_[2] * $minute_size, - ) - }, - seconds => sub { - ( $_[0] + $_[1] * $second_size, - $_[0] + $_[2] * $second_size, - ) - }, - one => sub { - ( $_[0] + $_[1], - $_[0] + $_[2], - ) - }, -); - - -@week_start = ( 0, -1, -2, -3, 3, 2, 1, 0, -1, -2, -3, 3, 2, 1, 0 ); - -=head2 %Offset_to_value($object, $offset) - -=head2 %Init_quantizer($object) - - $Offset_to_value{$unit} ($object, $offset); - - $Init_quantizer{$unit} ($object); - -Maps an 'offset value' to a 'value' - -A hash of functions that return ( int($object) + $offset ) in $unit context. - -Init_quantizer subroutines must be called before using subs_offset1 functions. - -int(object)+offset is a scalar. - -Offset_to_value is optimized for calling it multiple times on the same object, -with different offsets. That's why there is a separate initialization -subroutine. - -$self->{offset} is created on initialization. It is an index used -by the memoization cache. - -=cut - -%Offset_to_value = ( - weekyears => sub { - my ($self, $index) = @_; - my $epoch = timegm( 0,0,0, - 1,0,$self->{offset} + $self->{quant} * $index); - my @time = gmtime($epoch); - # print " [QT_D:weekyears:$self->{offset} + $self->{quant} * $index]\n"; - # year modulo week - # print " [QT:weekyears: time = ",join(";", @time )," ]\n"; - $epoch += ( $week_start[$time[6] + 7 - $self->{wkst}] ) * $day_size; - # print " [QT:weekyears: week=",join(";", gmtime($epoch) )," wkst=$self->{wkst} tbl[",$time[6] + 7 - $self->{wkst},"]=",$week_start[$time[6] + 7 - $self->{wkst}]," ]\n\n"; - - my $epoch2 = timegm( 0,0,0, - 1,0,$self->{offset} + $self->{quant} * (1 + $index) ); - @time = gmtime($epoch2); - $epoch2 += ( $week_start[$time[6] + 7 - $self->{wkst}] ) * $day_size; - ( $epoch, $epoch2 ); - }, - years => sub { - my $index = $_[0]->{offset} + $_[0]->{quant} * $_[1]; - ( timegm( 0,0,0, 1, 0, $index), - timegm( 0,0,0, 1, 0, $index + $_[0]->{quant}) ) - }, - months => sub { - my $mon = $_[0]->{offset} + $_[0]->{quant} * $_[1]; - my $year = int($mon / 12); - $mon -= $year * 12; - my $tmp = timegm( 0,0,0, 1, $mon, $year); - - $mon += $year * 12 + $_[0]->{quant}; - $year = int($mon / 12); - $mon -= $year * 12; - ( $tmp, timegm( 0,0,0, 1, $mon, $year) ); - }, - weeks => sub { - my $tmp = 3 * $day_size + $_[0]->{quant} * ($_[0]->{offset} + $_[1]); - ($tmp, $tmp + $_[0]->{quant}) - }, - days => sub { - my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]); - ($tmp, $tmp + $_[0]->{quant}) - }, - hours => sub { - my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]); - ($tmp, $tmp + $_[0]->{quant}) - }, - minutes => sub { - my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]); - ($tmp, $tmp + $_[0]->{quant}) - }, - seconds => sub { - my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]); - ($tmp, $tmp + $_[0]->{quant}) - }, - one => sub { - my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]); - ($tmp, $tmp + $_[0]->{quant}) - }, -); - - -# Maps an 'offset value' to a 'value' - -%Value_to_offset = ( - one => sub { floor( $_[1] / $_[0]{quant} ) }, - seconds => sub { floor( $_[1] / $_[0]{quant} ) }, - minutes => sub { floor( $_[1] / $_[0]{quant} ) }, - hours => sub { floor( $_[1] / $_[0]{quant} ) }, - days => sub { floor( $_[1] / $_[0]{quant} ) }, - weeks => sub { floor( ($_[1] - 3 * $day_size) / $_[0]{quant} ) }, - months => sub { - my @date = gmtime( 0 + $_[1] ); - my $tmp = $date[4] + 12 * (1900 + $date[5]); - floor( $tmp / $_[0]{quant} ); - }, - years => sub { - my @date = gmtime( 0 + $_[1] ); - my $tmp = $date[5] + 1900; - floor( $tmp / $_[0]{quant} ); - }, - weekyears => sub { - - my ($self, $value) = @_; - my @date; - - # find out YEAR number - @date = gmtime( 0 + $value ); - my $year = floor( $date[5] + 1900 / $self->{quant} ); - - # what is the EPOCH for this week-year's begin ? - my $begin_epoch = timegm( 0,0,0, 1,0,$year); - @date = gmtime($begin_epoch); - $begin_epoch += ( $week_start[$date[6] + 7 - $self->{wkst}] ) * $day_size; - - # what is the EPOCH for this week-year's end ? - my $end_epoch = timegm( 0,0,0, 1,0,$year+1); - @date = gmtime($end_epoch); - $end_epoch += ( $week_start[$date[6] + 7 - $self->{wkst}] ) * $day_size; - - $year-- if $value < $begin_epoch; - $year++ if $value >= $end_epoch; - - # carp " value=$value offset=$year this_epoch=".$begin_epoch; - # carp " next_epoch=".$end_epoch; - - $year; - }, -); - -# Initialize quantizer - -%Init_quantizer = ( - one => sub {}, - seconds => sub { $_[0]->{quant} *= $second_size }, - minutes => sub { $_[0]->{quant} *= $minute_size }, - hours => sub { $_[0]->{quant} *= $hour_size }, - days => sub { $_[0]->{quant} *= $day_size }, - weeks => sub { $_[0]->{quant} *= 7 * $day_size }, - months => sub {}, - years => sub {}, - weekyears => sub { - $_[0]->{wkst} = 1 unless defined $_[0]->{wkst}; - # select which 'cache' to use - # $_[0]->{memo} .= $_[0]->{wkst}; - }, -); - - -1; -