+++ /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