Filename | /usr/share/perl5/Set/Infinite/Arithmetic.pm |
Statements | Executed 36 statements in 2.59ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 23µs | 29µs | BEGIN@6 | Set::Infinite::Arithmetic::
1 | 1 | 1 | 16µs | 81µs | BEGIN@11 | Set::Infinite::Arithmetic::
1 | 1 | 1 | 16µs | 58µs | BEGIN@10 | Set::Infinite::Arithmetic::
1 | 1 | 1 | 13µs | 73µs | BEGIN@31 | Set::Infinite::Arithmetic::
1 | 1 | 1 | 12µs | 136µs | BEGIN@37 | Set::Infinite::Arithmetic::
1 | 1 | 1 | 11µs | 73µs | BEGIN@13 | Set::Infinite::Arithmetic::
1 | 1 | 1 | 10µs | 54µs | BEGIN@9 | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:126] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:140] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:176] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:181] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:186] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:192] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:197] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:202] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:207] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:255] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:260] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:271] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:275] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:279] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:283] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:287] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:291] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:295] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:302] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:303] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:304] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:305] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:306] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:307] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:312] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:317] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:344] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:350] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:351] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:352] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:353] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:354] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:355] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:356] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:357] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:362] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:62] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:63] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:64] | Set::Infinite::Arithmetic::
0 | 0 | 0 | 0s | 0s | __ANON__[:69] | Set::Infinite::Arithmetic::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
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. | ||||
5 | |||||
6 | 3 | 37µs | 2 | 35µs | # spent 29µs (23+6) within Set::Infinite::Arithmetic::BEGIN@6 which was called:
# once (23µs+6µs) by Set::Infinite::BEGIN@18 at line 6 # spent 29µs making 1 call to Set::Infinite::Arithmetic::BEGIN@6
# spent 6µs making 1 call to strict::import |
7 | # use warnings; | ||||
8 | 1 | 800ns | require Exporter; | ||
9 | 3 | 31µs | 2 | 98µs | # spent 54µs (10+44) within Set::Infinite::Arithmetic::BEGIN@9 which was called:
# once (10µs+44µs) by Set::Infinite::BEGIN@18 at line 9 # spent 54µs making 1 call to Set::Infinite::Arithmetic::BEGIN@9
# spent 44µs making 1 call to Exporter::import |
10 | 3 | 37µs | 2 | 101µs | # spent 58µs (16+42) within Set::Infinite::Arithmetic::BEGIN@10 which was called:
# once (16µs+42µs) by Set::Infinite::BEGIN@18 at line 10 # spent 58µs making 1 call to Set::Infinite::Arithmetic::BEGIN@10
# spent 42µs making 1 call to Exporter::import |
11 | 3 | 41µs | 2 | 146µs | # spent 81µs (16+65) within Set::Infinite::Arithmetic::BEGIN@11 which was called:
# once (16µs+65µs) by Set::Infinite::BEGIN@18 at line 11 # spent 81µs making 1 call to Set::Infinite::Arithmetic::BEGIN@11
# spent 65µs making 1 call to POSIX::import |
12 | |||||
13 | 3 | 97µs | 2 | 135µs | # spent 73µs (11+62) within Set::Infinite::Arithmetic::BEGIN@13 which was called:
# once (11µs+62µs) by Set::Infinite::BEGIN@18 at line 13 # spent 73µs making 1 call to Set::Infinite::Arithmetic::BEGIN@13
# spent 62µs making 1 call to vars::import |
14 | |||||
15 | 1 | 1µs | @EXPORT = qw(); | ||
16 | 1 | 300ns | @EXPORT_OK = qw(); | ||
17 | # @EXPORT_OK = qw( %subs_offset2 %Offset_to_value %Value_to_offset %Init_quantizer ); | ||||
18 | |||||
19 | 1 | 700ns | $inf = 100**100**100; # $Set::Infinite::inf; doesn't work! (why?) | ||
20 | |||||
21 | =head2 NAME | ||||
22 | |||||
- - | |||||
31 | 3 | 80µs | 2 | 132µs | # spent 73µs (13+60) within Set::Infinite::Arithmetic::BEGIN@31 which was called:
# once (13µs+60µs) by Set::Infinite::BEGIN@18 at line 31 # spent 73µs making 1 call to Set::Infinite::Arithmetic::BEGIN@31
# spent 60µs making 1 call to vars::import |
32 | 1 | 7µs | 2 | 60µs | $day_size = timegm(0,0,0,2,3,2001) - timegm(0,0,0,1,3,2001); # spent 60µs making 2 calls to Time::Local::timegm, avg 30µs/call |
33 | 1 | 1µs | $hour_size = $day_size / 24; | ||
34 | 1 | 700ns | $minute_size = $hour_size / 60; | ||
35 | 1 | 400ns | $second_size = $minute_size / 60; | ||
36 | |||||
37 | 3 | 2.12ms | 2 | 260µs | # spent 136µs (12+124) within Set::Infinite::Arithmetic::BEGIN@37 which was called:
# once (12µs+124µs) by Set::Infinite::BEGIN@18 at line 37 # spent 136µs making 1 call to Set::Infinite::Arithmetic::BEGIN@37
# spent 124µs making 1 call to vars::import |
38 | |||||
39 | =head2 %_MODE hash of subs | ||||
40 | |||||
- - | |||||
53 | # return value = ($this, $next, $cmp) | ||||
54 | %_MODE = ( | ||||
55 | circle => sub { | ||||
56 | if ($_[3] >= 0) { | ||||
57 | &{ $_[0] } ($_[1], $_[3], $_[4] ) | ||||
58 | } | ||||
59 | else { | ||||
60 | &{ $_[0] } ($_[2], $_[3], $_[4] ) | ||||
61 | } | ||||
62 | }, | ||||
63 | begin => sub { &{ $_[0] } ($_[1], $_[3], $_[4] ) }, | ||||
64 | end => sub { &{ $_[0] } ($_[2], $_[3], $_[4] ) }, | ||||
65 | offset => sub { | ||||
66 | my ($this, undef) = &{ $_[0] } ($_[1], $_[3], $_[4] ); | ||||
67 | my (undef, $next) = &{ $_[0] } ($_[2], $_[3], $_[4] ); | ||||
68 | ($this, $next); | ||||
69 | } | ||||
70 | 1 | 11µs | ); | ||
71 | |||||
72 | |||||
73 | =head2 %subs_offset2($object, $offset1, $offset2) | ||||
74 | |||||
- - | |||||
87 | %subs_offset2 = ( | ||||
88 | weekdays => sub { | ||||
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) | ||||
95 | # -2 = last friday | ||||
96 | my ($self, $index1, $index2) = @_; | ||||
97 | return ($self, $self) if $self == $inf; | ||||
98 | # my $class = ref($self); | ||||
99 | my @date = gmtime( $self ); | ||||
100 | my $wday = $date[6]; | ||||
101 | my ($tmp1, $tmp2); | ||||
102 | |||||
103 | $tmp1 = $index1 - $wday; | ||||
104 | if ($index1 >= 0) { | ||||
105 | $tmp1 += 7 if $tmp1 < 0; # it will only happen next week | ||||
106 | } | ||||
107 | else { | ||||
108 | $tmp1 += 7 if $tmp1 < -7; # if will happen this week | ||||
109 | } | ||||
110 | |||||
111 | $tmp2 = $index2 - $wday; | ||||
112 | if ($index2 >= 0) { | ||||
113 | $tmp2 += 7 if $tmp2 < 0; # it will only happen next week | ||||
114 | } | ||||
115 | else { | ||||
116 | $tmp2 += 7 if $tmp2 < -7; # if will happen this week | ||||
117 | } | ||||
118 | |||||
119 | # print " [ OFS:weekday $self $tmp1 $tmp2 ] \n"; | ||||
120 | # $date[3] += $tmp1; | ||||
121 | $tmp1 = $self + $tmp1 * $day_size; | ||||
122 | # $date[3] += $tmp2 - $tmp1; | ||||
123 | $tmp2 = $self + $tmp2 * $day_size; | ||||
124 | |||||
125 | ($tmp1, $tmp2); | ||||
126 | }, | ||||
127 | years => sub { | ||||
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); | ||||
135 | |||||
136 | $date[5] += $index2 - $index; | ||||
137 | my $tmp2 = timegm(@date); | ||||
138 | |||||
139 | ($tmp, $tmp2); | ||||
140 | }, | ||||
141 | months => sub { | ||||
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 ); | ||||
147 | |||||
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; | ||||
154 | $year += $addyear; | ||||
155 | } | ||||
156 | |||||
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; | ||||
162 | $year2 += $addyear2; | ||||
163 | } | ||||
164 | |||||
165 | # print " [OFS: month: to $year $mon ]\n"; | ||||
166 | |||||
167 | $date[4] = $mon; | ||||
168 | $date[5] = $year; | ||||
169 | my $tmp = timegm(@date); | ||||
170 | |||||
171 | $date[4] = $mon2; | ||||
172 | $date[5] = $year2; | ||||
173 | my $tmp2 = timegm(@date); | ||||
174 | |||||
175 | ($tmp, $tmp2); | ||||
176 | }, | ||||
177 | days => sub { | ||||
178 | ( $_[0] + $_[1] * $day_size, | ||||
179 | $_[0] + $_[2] * $day_size, | ||||
180 | ) | ||||
181 | }, | ||||
182 | weeks => sub { | ||||
183 | ( $_[0] + $_[1] * (7 * $day_size), | ||||
184 | $_[0] + $_[2] * (7 * $day_size), | ||||
185 | ) | ||||
186 | }, | ||||
187 | hours => sub { | ||||
188 | # carp " [ $_[0]+$_[1] hour = ".( $_[0] + $_[1] * $hour_size )." mode=".($_[0]->{mode})." ]"; | ||||
189 | ( $_[0] + $_[1] * $hour_size, | ||||
190 | $_[0] + $_[2] * $hour_size, | ||||
191 | ) | ||||
192 | }, | ||||
193 | minutes => sub { | ||||
194 | ( $_[0] + $_[1] * $minute_size, | ||||
195 | $_[0] + $_[2] * $minute_size, | ||||
196 | ) | ||||
197 | }, | ||||
198 | seconds => sub { | ||||
199 | ( $_[0] + $_[1] * $second_size, | ||||
200 | $_[0] + $_[2] * $second_size, | ||||
201 | ) | ||||
202 | }, | ||||
203 | one => sub { | ||||
204 | ( $_[0] + $_[1], | ||||
205 | $_[0] + $_[2], | ||||
206 | ) | ||||
207 | }, | ||||
208 | 1 | 36µs | ); | ||
209 | |||||
210 | |||||
211 | 1 | 2µs | @week_start = ( 0, -1, -2, -3, 3, 2, 1, 0, -1, -2, -3, 3, 2, 1, 0 ); | ||
212 | |||||
213 | =head2 %Offset_to_value($object, $offset) | ||||
214 | |||||
- - | |||||
238 | %Offset_to_value = ( | ||||
239 | weekyears => sub { | ||||
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"; | ||||
245 | # year modulo week | ||||
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"; | ||||
249 | |||||
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; | ||||
254 | ( $epoch, $epoch2 ); | ||||
255 | }, | ||||
256 | years => sub { | ||||
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}) ) | ||||
260 | }, | ||||
261 | months => sub { | ||||
262 | my $mon = $_[0]->{offset} + $_[0]->{quant} * $_[1]; | ||||
263 | my $year = int($mon / 12); | ||||
264 | $mon -= $year * 12; | ||||
265 | my $tmp = timegm( 0,0,0, 1, $mon, $year); | ||||
266 | |||||
267 | $mon += $year * 12 + $_[0]->{quant}; | ||||
268 | $year = int($mon / 12); | ||||
269 | $mon -= $year * 12; | ||||
270 | ( $tmp, timegm( 0,0,0, 1, $mon, $year) ); | ||||
271 | }, | ||||
272 | weeks => sub { | ||||
273 | my $tmp = 3 * $day_size + $_[0]->{quant} * ($_[0]->{offset} + $_[1]); | ||||
274 | ($tmp, $tmp + $_[0]->{quant}) | ||||
275 | }, | ||||
276 | days => sub { | ||||
277 | my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]); | ||||
278 | ($tmp, $tmp + $_[0]->{quant}) | ||||
279 | }, | ||||
280 | hours => sub { | ||||
281 | my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]); | ||||
282 | ($tmp, $tmp + $_[0]->{quant}) | ||||
283 | }, | ||||
284 | minutes => sub { | ||||
285 | my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]); | ||||
286 | ($tmp, $tmp + $_[0]->{quant}) | ||||
287 | }, | ||||
288 | seconds => sub { | ||||
289 | my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]); | ||||
290 | ($tmp, $tmp + $_[0]->{quant}) | ||||
291 | }, | ||||
292 | one => sub { | ||||
293 | my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]); | ||||
294 | ($tmp, $tmp + $_[0]->{quant}) | ||||
295 | }, | ||||
296 | 1 | 27µs | ); | ||
297 | |||||
298 | |||||
299 | # Maps an 'offset value' to a 'value' | ||||
300 | |||||
301 | %Value_to_offset = ( | ||||
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} ) }, | ||||
308 | months => sub { | ||||
309 | my @date = gmtime( 0 + $_[1] ); | ||||
310 | my $tmp = $date[4] + 12 * (1900 + $date[5]); | ||||
311 | floor( $tmp / $_[0]{quant} ); | ||||
312 | }, | ||||
313 | years => sub { | ||||
314 | my @date = gmtime( 0 + $_[1] ); | ||||
315 | my $tmp = $date[5] + 1900; | ||||
316 | floor( $tmp / $_[0]{quant} ); | ||||
317 | }, | ||||
318 | weekyears => sub { | ||||
319 | |||||
320 | my ($self, $value) = @_; | ||||
321 | my @date; | ||||
322 | |||||
323 | # find out YEAR number | ||||
324 | @date = gmtime( 0 + $value ); | ||||
325 | my $year = floor( $date[5] + 1900 / $self->{quant} ); | ||||
326 | |||||
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; | ||||
331 | |||||
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; | ||||
336 | |||||
337 | $year-- if $value < $begin_epoch; | ||||
338 | $year++ if $value >= $end_epoch; | ||||
339 | |||||
340 | # carp " value=$value offset=$year this_epoch=".$begin_epoch; | ||||
341 | # carp " next_epoch=".$end_epoch; | ||||
342 | |||||
343 | $year; | ||||
344 | }, | ||||
345 | 1 | 18µs | ); | ||
346 | |||||
347 | # Initialize quantizer | ||||
348 | |||||
349 | %Init_quantizer = ( | ||||
350 | one => sub {}, | ||||
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 }, | ||||
356 | months => sub {}, | ||||
357 | years => sub {}, | ||||
358 | weekyears => sub { | ||||
359 | $_[0]->{wkst} = 1 unless defined $_[0]->{wkst}; | ||||
360 | # select which 'cache' to use | ||||
361 | # $_[0]->{memo} .= $_[0]->{wkst}; | ||||
362 | }, | ||||
363 | 1 | 23µs | ); | ||
364 | |||||
365 | |||||
366 | 1 | 24µs | 1; | ||
367 |