← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:02:21 2013

Filename/usr/share/perl5/Set/Infinite/_recurrence.pm
StatementsExecuted 20 statements in 1.65ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11127µs74µsSet::Infinite::_recurrence::::BEGIN@15Set::Infinite::_recurrence::BEGIN@15
11125µs32µsSet::Infinite::_recurrence::::BEGIN@7Set::Infinite::_recurrence::BEGIN@7
11122µs22µsSet::Infinite::_recurrence::::BEGIN@17Set::Infinite::_recurrence::BEGIN@17
11118µs84µsSet::Infinite::_recurrence::::BEGIN@12Set::Infinite::_recurrence::BEGIN@12
11115µs83µsSet::Infinite::_recurrence::::BEGIN@9Set::Infinite::_recurrence::BEGIN@9
11110µs44µsSet::Infinite::_recurrence::::BEGIN@10Set::Infinite::_recurrence::BEGIN@10
0000s0sSet::Infinite::_recurrence::::__ANON__[:104]Set::Infinite::_recurrence::__ANON__[:104]
0000s0sSet::Infinite::_recurrence::::__ANON__[:231]Set::Infinite::_recurrence::__ANON__[:231]
0000s0sSet::Infinite::_recurrence::::__ANON__[:243]Set::Infinite::_recurrence::__ANON__[:243]
0000s0sSet::Infinite::_recurrence::::__ANON__[:264]Set::Infinite::_recurrence::__ANON__[:264]
0000s0sSet::Infinite::_recurrence::::__ANON__[:269]Set::Infinite::_recurrence::__ANON__[:269]
0000s0sSet::Infinite::_recurrence::::__ANON__[:55]Set::Infinite::_recurrence::__ANON__[:55]
0000s0sSet::Infinite::_recurrence::::__ANON__[:74]Set::Infinite::_recurrence::__ANON__[:74]
0000s0sSet::Infinite::_recurrence::::_is_recurrenceSet::Infinite::_recurrence::_is_recurrence
0000s0sSet::Infinite::_recurrence::::_recurrenceSet::Infinite::_recurrence::_recurrence
0000s0sSet::Infinite::_recurrence::::intersectionSet::Infinite::_recurrence::intersection
0000s0sSet::Infinite::_recurrence::::is_foreverSet::Infinite::_recurrence::is_forever
0000s0sSet::Infinite::_recurrence::::unionSet::Infinite::_recurrence::union
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved.
2# This program is free software; you can redistribute it and/or
3# modify it under the same terms as Perl itself.
4
5package Set::Infinite::_recurrence;
6
7352µs239µs
# spent 32µs (25+7) within Set::Infinite::_recurrence::BEGIN@7 which was called: # once (25µs+7µs) by DateTime::Set::BEGIN@11 at line 7
use strict;
# spent 32µs making 1 call to Set::Infinite::_recurrence::BEGIN@7 # spent 7µs making 1 call to strict::import
8
9344µs2151µs
# spent 83µs (15+68) within Set::Infinite::_recurrence::BEGIN@9 which was called: # once (15µs+68µs) by DateTime::Set::BEGIN@11 at line 9
use constant INFINITY => 100 ** 100 ** 100 ;
# spent 83µs making 1 call to Set::Infinite::_recurrence::BEGIN@9 # spent 68µs making 1 call to constant::import
10358µs278µs
# spent 44µs (10+34) within Set::Infinite::_recurrence::BEGIN@10 which was called: # once (10µs+34µs) by DateTime::Set::BEGIN@11 at line 10
use constant NEG_INFINITY => -1 * (100 ** 100 ** 100);
# spent 44µs making 1 call to Set::Infinite::_recurrence::BEGIN@10 # spent 34µs making 1 call to constant::import
11
12363µs2151µs
# spent 84µs (18+66) within Set::Infinite::_recurrence::BEGIN@12 which was called: # once (18µs+66µs) by DateTime::Set::BEGIN@11 at line 12
use vars qw( @ISA $PRETTY_PRINT $max_iterate );
# spent 84µs making 1 call to Set::Infinite::_recurrence::BEGIN@12 # spent 66µs making 1 call to vars::import
13
14127µs@ISA = qw( Set::Infinite );
153414µs3121µs
# spent 74µs (27+47) within Set::Infinite::_recurrence::BEGIN@15 which was called: # once (27µs+47µs) by DateTime::Set::BEGIN@11 at line 15
use Set::Infinite 0.5502;
# spent 74µs making 1 call to Set::Infinite::_recurrence::BEGIN@15 # spent 23µs making 1 call to Exporter::import # spent 23µs making 1 call to UNIVERSAL::VERSION
16
17
# spent 22µs within Set::Infinite::_recurrence::BEGIN@17 which was called: # once (22µs+0s) by DateTime::Set::BEGIN@11 at line 75
BEGIN {
181600ns $PRETTY_PRINT = 1; # enable Set::Infinite debug
191200ns $max_iterate = 20;
20
21 # TODO: inherit %Set::Infinite::_first / _last
22 # in a more "object oriented" way
23
24 $Set::Infinite::_first{_recurrence} =
25 sub {
26 my $self = $_[0];
27 my ($callback_next, $callback_previous) = @{ $self->{param} };
28 my ($min, $min_open) = $self->{parent}->min_a;
29
30 my ( $min1, $min2 );
31 $min1 = $callback_next->( $min );
32 if ( ! $min_open )
33 {
34 $min2 = $callback_previous->( $min1 );
35 $min1 = $min2 if defined $min2 && $min == $min2;
36 }
37
38 my $start = $callback_next->( $min1 );
39 my $end = $self->{parent}->max;
40
41 #print STDERR "set ";
42 #print STDERR $start->datetime
43 # unless $start == INFINITY;
44 #print STDERR " - " ;
45 #print STDERR $end->datetime
46 # unless $end == INFINITY;
47 #print STDERR "\n";
48
49 return ( $self->new( $min1 ), undef )
50 if $start > $end;
51
52 return ( $self->new( $min1 ),
53 $self->new( $start, $end )->
54 _function( '_recurrence', @{ $self->{param} } ) );
5515µs };
56 $Set::Infinite::_last{_recurrence} =
57 sub {
58 my $self = $_[0];
59 my ($callback_next, $callback_previous) = @{ $self->{param} };
60 my ($max, $max_open) = $self->{parent}->max_a;
61
62 my ( $max1, $max2 );
63 $max1 = $callback_previous->( $max );
64 if ( ! $max_open )
65 {
66 $max2 = $callback_next->( $max1 );
67 $max1 = $max2 if $max == $max2;
68 }
69
70 return ( $self->new( $max1 ),
71 $self->new( $self->{parent}->min,
72 $callback_previous->( $max1 ) )->
73 _function( '_recurrence', @{ $self->{param} } ) );
74114µs };
751968µs122µs}
# spent 22µs making 1 call to Set::Infinite::_recurrence::BEGIN@17
76
77# $si->_recurrence(
78# \&callback_next, \&callback_previous )
79#
80# Generates "recurrences" from a callback.
81# These recurrences are simple lists of dates.
82#
83# The recurrence generation is based on an idea from Dave Rolsky.
84#
85
86# use Data::Dumper;
87# use Carp qw(cluck);
88
89sub _recurrence {
90 my $set = shift;
91 my ( $callback_next, $callback_previous, $delta ) = @_;
92
93 $delta->{count} = 0 unless defined $delta->{delta};
94
95 # warn "reusing delta: ". $delta->{count} if defined $delta->{delta};
96 # warn Dumper( $delta );
97
98 if ( $#{ $set->{list} } != 0 || $set->is_too_complex )
99 {
100 return $set->iterate(
101 sub {
102 $_[0]->_recurrence(
103 $callback_next, $callback_previous, $delta )
104 } );
105 }
106 # $set is a span
107 my $result;
108 if ($set->min != NEG_INFINITY && $set->max != INFINITY)
109 {
110 # print STDERR " finite set\n";
111 my ($min, $min_open) = $set->min_a;
112 my ($max, $max_open) = $set->max_a;
113
114 my ( $min1, $min2 );
115 $min1 = $callback_next->( $min );
116 if ( ! $min_open )
117 {
118 $min2 = $callback_previous->( $min1 );
119 $min1 = $min2 if defined $min2 && $min == $min2;
120 }
121
122 $result = $set->new();
123
124 # get "delta" - abort if this will take too much time.
125
126 unless ( defined $delta->{max_delta} )
127 {
128 for ( $delta->{count} .. 10 )
129 {
130 if ( $max_open )
131 {
132 return $result if $min1 >= $max;
133 }
134 else
135 {
136 return $result if $min1 > $max;
137 }
138 push @{ $result->{list} },
139 { a => $min1, b => $min1, open_begin => 0, open_end => 0 };
140 $min2 = $callback_next->( $min1 );
141
142 if ( $delta->{delta} )
143 {
144 $delta->{delta} += $min2 - $min1;
145 }
146 else
147 {
148 $delta->{delta} = $min2 - $min1;
149 }
150 $delta->{count}++;
151 $min1 = $min2;
152 }
153
154 $delta->{max_delta} = $delta->{delta} * 40;
155 }
156
157 if ( $max < $min + $delta->{max_delta} )
158 {
159 for ( 1 .. 200 )
160 {
161 if ( $max_open )
162 {
163 return $result if $min1 >= $max;
164 }
165 else
166 {
167 return $result if $min1 > $max;
168 }
169 push @{ $result->{list} },
170 { a => $min1, b => $min1, open_begin => 0, open_end => 0 };
171 $min1 = $callback_next->( $min1 );
172 }
173 }
174
175 # cluck "give up";
176 }
177
178 # return a "_function", such that we can backtrack later.
179 my $func = $set->_function( '_recurrence', $callback_next, $callback_previous, $delta );
180
181 # removed - returning $result doesn't help on speed
182 ## return $func->_function2( 'union', $result ) if $result;
183
184 return $func;
185}
186
187sub is_forever
188{
189 $#{ $_[0]->{list} } == 0 &&
190 $_[0]->max == INFINITY &&
191 $_[0]->min == NEG_INFINITY
192}
193
194sub _is_recurrence
195{
196 exists $_[0]->{method} &&
197 $_[0]->{method} eq '_recurrence' &&
198 $_[0]->{parent}->is_forever
199}
200
201sub intersection
202{
203 my ($s1, $s2) = (shift,shift);
204
205 if ( exists $s1->{method} && $s1->{method} eq '_recurrence' )
206 {
207 # optimize: recurrence && span
208 return $s1->{parent}->
209 intersection( $s2, @_ )->
210 _recurrence( @{ $s1->{param} } )
211 unless ref($s2) && exists $s2->{method};
212
213 # optimize: recurrence && recurrence
214 if ( $s1->{parent}->is_forever &&
215 ref($s2) && _is_recurrence( $s2 ) )
216 {
217 my ( $next1, $previous1 ) = @{ $s1->{param} };
218 my ( $next2, $previous2 ) = @{ $s2->{param} };
219 return $s1->{parent}->_function( '_recurrence',
220 sub {
221 # intersection of parent 'next' callbacks
222 my ($n1, $n2);
223 my $iterate = 0;
224 $n2 = $next2->( $_[0] );
225 while(1) {
226 $n1 = $next1->( $previous1->( $n2 ) );
227 return $n1 if $n1 == $n2;
228 $n2 = $next2->( $previous2->( $n1 ) );
229 return if $iterate++ == $max_iterate;
230 }
231 },
232 sub {
233 # intersection of parent 'previous' callbacks
234 my ($p1, $p2);
235 my $iterate = 0;
236 $p2 = $previous2->( $_[0] );
237 while(1) {
238 $p1 = $previous1->( $next1->( $p2 ) );
239 return $p1 if $p1 == $p2;
240 $p2 = $previous2->( $next2->( $p1 ) );
241 return if $iterate++ == $max_iterate;
242 }
243 },
244 );
245 }
246 }
247 return $s1->SUPER::intersection( $s2, @_ );
248}
249
250sub union
251{
252 my ($s1, $s2) = (shift,shift);
253 if ( $s1->_is_recurrence &&
254 ref($s2) && _is_recurrence( $s2 ) )
255 {
256 # optimize: recurrence || recurrence
257 my ( $next1, $previous1 ) = @{ $s1->{param} };
258 my ( $next2, $previous2 ) = @{ $s2->{param} };
259 return $s1->{parent}->_function( '_recurrence',
260 sub { # next
261 my $n1 = $next1->( $_[0] );
262 my $n2 = $next2->( $_[0] );
263 return $n1 < $n2 ? $n1 : $n2;
264 },
265 sub { # previous
266 my $p1 = $previous1->( $_[0] );
267 my $p2 = $previous2->( $_[0] );
268 return $p1 > $p2 ? $p1 : $p2;
269 },
270 );
271 }
272 return $s1->SUPER::union( $s2, @_ );
273}
274
275=head1 NAME
276
- -
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.