1 package Set::Infinite::Arithmetic;
2 # Copyright (c) 2001 Flavio Soibelmann Glock. All rights reserved.
3 # This program is free software; you can redistribute it and/or
4 # modify it under the same terms as Perl itself.
13 use vars qw( @EXPORT @EXPORT_OK $inf );
17 # @EXPORT_OK = qw( %subs_offset2 %Offset_to_value %Value_to_offset %Init_quantizer );
19 $inf = 100**100**100; # $Set::Infinite::inf; doesn't work! (why?)
23 Set::Infinite::Arithmetic - Scalar operations used by quantize() and offset()
27 Flavio Soibelmann Glock - fglock@pucrs.br
31 use vars qw( $day_size $hour_size $minute_size $second_size );
32 $day_size = timegm(0,0,0,2,3,2001) - timegm(0,0,0,1,3,2001);
33 $hour_size = $day_size / 24;
34 $minute_size = $hour_size / 60;
35 $second_size = $minute_size / 60;
37 use vars qw( %_MODE %subs_offset2 %Offset_to_value @week_start %Init_quantizer %Value_to_offset %Offset_to_value );
39 =head2 %_MODE hash of subs
41 $a->offset ( value => [1,2], mode => 'offset', unit => 'days' );
43 $a->offset ( value => [1,2, -5,-4], mode => 'offset', unit => 'days' );
45 note: if mode = circle, then "-5" counts from end (like a Perl negative array index).
47 $a->offset ( value => [1,2], mode => 'offset', unit => 'days', strict => $a );
49 option 'strict' will return intersection($a,offset). Default: none.
53 # return value = ($this, $next, $cmp)
57 &{ $_[0] } ($_[1], $_[3], $_[4] )
60 &{ $_[0] } ($_[2], $_[3], $_[4] )
63 begin => sub { &{ $_[0] } ($_[1], $_[3], $_[4] ) },
64 end => sub { &{ $_[0] } ($_[2], $_[3], $_[4] ) },
66 my ($this, undef) = &{ $_[0] } ($_[1], $_[3], $_[4] );
67 my (undef, $next) = &{ $_[0] } ($_[2], $_[3], $_[4] );
73 =head2 %subs_offset2($object, $offset1, $offset2)
75 &{ $subs_offset2{$unit} } ($object, $offset1, $offset2);
77 A hash of functions that return:
79 ($object+$offset1, $object+$offset2)
83 Returned $object+$offset1, $object+$offset2 may be scalars or objects.
89 # offsets to week-day specified
90 # 0 = first sunday from today (or today if today is sunday)
91 # 1 = first monday from today (or today if today is monday)
92 # 6 = first friday from today (or today if today is friday)
93 # 13 = second friday from today
94 # -1 = last saturday from today (not today, even if today were saturday)
96 my ($self, $index1, $index2) = @_;
97 return ($self, $self) if $self == $inf;
98 # my $class = ref($self);
99 my @date = gmtime( $self );
103 $tmp1 = $index1 - $wday;
105 $tmp1 += 7 if $tmp1 < 0; # it will only happen next week
108 $tmp1 += 7 if $tmp1 < -7; # if will happen this week
111 $tmp2 = $index2 - $wday;
113 $tmp2 += 7 if $tmp2 < 0; # it will only happen next week
116 $tmp2 += 7 if $tmp2 < -7; # if will happen this week
119 # print " [ OFS:weekday $self $tmp1 $tmp2 ] \n";
121 $tmp1 = $self + $tmp1 * $day_size;
122 # $date[3] += $tmp2 - $tmp1;
123 $tmp2 = $self + $tmp2 * $day_size;
128 my ($self, $index, $index2) = @_;
129 return ($self, $self) if $self == $inf;
130 # my $class = ref($self);
131 # print " [ofs:year:$self -- $index]\n";
132 my @date = gmtime( $self );
133 $date[5] += 1900 + $index;
134 my $tmp = timegm(@date);
136 $date[5] += $index2 - $index;
137 my $tmp2 = timegm(@date);
142 my ($self, $index, $index2) = @_;
143 # carp " [ofs:month:$self -- $index -- $inf]";
144 return ($self, $self) if $self == $inf;
145 # my $class = ref($self);
146 my @date = gmtime( $self );
148 my $mon = $date[4] + $index;
149 my $year = $date[5] + 1900;
150 # print " [OFS: month: from $year$mon ]\n";
151 if (($mon > 11) or ($mon < 0)) {
152 my $addyear = floor($mon / 12);
153 $mon = $mon - 12 * $addyear;
157 my $mon2 = $date[4] + $index2;
158 my $year2 = $date[5] + 1900;
159 if (($mon2 > 11) or ($mon2 < 0)) {
160 my $addyear2 = floor($mon2 / 12);
161 $mon2 = $mon2 - 12 * $addyear2;
165 # print " [OFS: month: to $year $mon ]\n";
169 my $tmp = timegm(@date);
173 my $tmp2 = timegm(@date);
178 ( $_[0] + $_[1] * $day_size,
179 $_[0] + $_[2] * $day_size,
183 ( $_[0] + $_[1] * (7 * $day_size),
184 $_[0] + $_[2] * (7 * $day_size),
188 # carp " [ $_[0]+$_[1] hour = ".( $_[0] + $_[1] * $hour_size )." mode=".($_[0]->{mode})." ]";
189 ( $_[0] + $_[1] * $hour_size,
190 $_[0] + $_[2] * $hour_size,
194 ( $_[0] + $_[1] * $minute_size,
195 $_[0] + $_[2] * $minute_size,
199 ( $_[0] + $_[1] * $second_size,
200 $_[0] + $_[2] * $second_size,
211 @week_start = ( 0, -1, -2, -3, 3, 2, 1, 0, -1, -2, -3, 3, 2, 1, 0 );
213 =head2 %Offset_to_value($object, $offset)
215 =head2 %Init_quantizer($object)
217 $Offset_to_value{$unit} ($object, $offset);
219 $Init_quantizer{$unit} ($object);
221 Maps an 'offset value' to a 'value'
223 A hash of functions that return ( int($object) + $offset ) in $unit context.
225 Init_quantizer subroutines must be called before using subs_offset1 functions.
227 int(object)+offset is a scalar.
229 Offset_to_value is optimized for calling it multiple times on the same object,
230 with different offsets. That's why there is a separate initialization
233 $self->{offset} is created on initialization. It is an index used
234 by the memoization cache.
240 my ($self, $index) = @_;
241 my $epoch = timegm( 0,0,0,
242 1,0,$self->{offset} + $self->{quant} * $index);
243 my @time = gmtime($epoch);
244 # print " [QT_D:weekyears:$self->{offset} + $self->{quant} * $index]\n";
246 # print " [QT:weekyears: time = ",join(";", @time )," ]\n";
247 $epoch += ( $week_start[$time[6] + 7 - $self->{wkst}] ) * $day_size;
248 # 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";
250 my $epoch2 = timegm( 0,0,0,
251 1,0,$self->{offset} + $self->{quant} * (1 + $index) );
252 @time = gmtime($epoch2);
253 $epoch2 += ( $week_start[$time[6] + 7 - $self->{wkst}] ) * $day_size;
257 my $index = $_[0]->{offset} + $_[0]->{quant} * $_[1];
258 ( timegm( 0,0,0, 1, 0, $index),
259 timegm( 0,0,0, 1, 0, $index + $_[0]->{quant}) )
262 my $mon = $_[0]->{offset} + $_[0]->{quant} * $_[1];
263 my $year = int($mon / 12);
265 my $tmp = timegm( 0,0,0, 1, $mon, $year);
267 $mon += $year * 12 + $_[0]->{quant};
268 $year = int($mon / 12);
270 ( $tmp, timegm( 0,0,0, 1, $mon, $year) );
273 my $tmp = 3 * $day_size + $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
274 ($tmp, $tmp + $_[0]->{quant})
277 my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
278 ($tmp, $tmp + $_[0]->{quant})
281 my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
282 ($tmp, $tmp + $_[0]->{quant})
285 my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
286 ($tmp, $tmp + $_[0]->{quant})
289 my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
290 ($tmp, $tmp + $_[0]->{quant})
293 my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
294 ($tmp, $tmp + $_[0]->{quant})
299 # Maps an 'offset value' to a 'value'
302 one => sub { floor( $_[1] / $_[0]{quant} ) },
303 seconds => sub { floor( $_[1] / $_[0]{quant} ) },
304 minutes => sub { floor( $_[1] / $_[0]{quant} ) },
305 hours => sub { floor( $_[1] / $_[0]{quant} ) },
306 days => sub { floor( $_[1] / $_[0]{quant} ) },
307 weeks => sub { floor( ($_[1] - 3 * $day_size) / $_[0]{quant} ) },
309 my @date = gmtime( 0 + $_[1] );
310 my $tmp = $date[4] + 12 * (1900 + $date[5]);
311 floor( $tmp / $_[0]{quant} );
314 my @date = gmtime( 0 + $_[1] );
315 my $tmp = $date[5] + 1900;
316 floor( $tmp / $_[0]{quant} );
320 my ($self, $value) = @_;
323 # find out YEAR number
324 @date = gmtime( 0 + $value );
325 my $year = floor( $date[5] + 1900 / $self->{quant} );
327 # what is the EPOCH for this week-year's begin ?
328 my $begin_epoch = timegm( 0,0,0, 1,0,$year);
329 @date = gmtime($begin_epoch);
330 $begin_epoch += ( $week_start[$date[6] + 7 - $self->{wkst}] ) * $day_size;
332 # what is the EPOCH for this week-year's end ?
333 my $end_epoch = timegm( 0,0,0, 1,0,$year+1);
334 @date = gmtime($end_epoch);
335 $end_epoch += ( $week_start[$date[6] + 7 - $self->{wkst}] ) * $day_size;
337 $year-- if $value < $begin_epoch;
338 $year++ if $value >= $end_epoch;
340 # carp " value=$value offset=$year this_epoch=".$begin_epoch;
341 # carp " next_epoch=".$end_epoch;
347 # Initialize quantizer
351 seconds => sub { $_[0]->{quant} *= $second_size },
352 minutes => sub { $_[0]->{quant} *= $minute_size },
353 hours => sub { $_[0]->{quant} *= $hour_size },
354 days => sub { $_[0]->{quant} *= $day_size },
355 weeks => sub { $_[0]->{quant} *= 7 * $day_size },
359 $_[0]->{wkst} = 1 unless defined $_[0]->{wkst};
360 # select which 'cache' to use
361 # $_[0]->{memo} .= $_[0]->{wkst};