--- /dev/null
+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;
+
projects / kivitendo-erp.git / blobdiff