File Coverage

blib/lib/Set/Infinite/Arithmetic.pm

Criterion	Covered	Total	%
statement	21	21	100.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	28	28	100.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 - [e-mail]

=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;