← 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 17:10:45 2013
Reported on Tue Oct 15 17:12:24 2013

Filename/usr/lib/perl5/List/MoreUtils.pm
StatementsExecuted 27 statements in 694µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11181µs81µsList::MoreUtils::::bootstrapList::MoreUtils::bootstrap (xsub)
11133µs33µsList::MoreUtils::::BEGIN@3List::MoreUtils::BEGIN@3
11116µs22µsList::MoreUtils::::BEGIN@4List::MoreUtils::BEGIN@4
11111µs89µsList::MoreUtils::::BEGIN@10List::MoreUtils::BEGIN@10
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package List::MoreUtils;
2
3353µs133µs
# spent 33µs within List::MoreUtils::BEGIN@3 which was called: # once (33µs+0s) by C4::SQLHelper::BEGIN@23 at line 3
use 5.00503;
# spent 33µs making 1 call to List::MoreUtils::BEGIN@3
43118µs227µs
# spent 22µs (16+6) within List::MoreUtils::BEGIN@4 which was called: # once (16µs+6µs) by C4::SQLHelper::BEGIN@23 at line 4
use strict;
# spent 22µs making 1 call to List::MoreUtils::BEGIN@4 # spent 6µs making 1 call to strict::import
5
61900nsrequire Exporter;
71600nsrequire DynaLoader;
8
9
103462µs2167µs
# spent 89µs (11+78) within List::MoreUtils::BEGIN@10 which was called: # once (11µs+78µs) by C4::SQLHelper::BEGIN@23 at line 10
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
# spent 89µs making 1 call to List::MoreUtils::BEGIN@10 # spent 78µs making 1 call to vars::import
11114µs@ISA = qw(Exporter DynaLoader);
12
1315µs%EXPORT_TAGS = (
14 all => [ qw(any all none notall true false firstidx first_index lastidx
15 last_index insert_after insert_after_string apply after after_incl before
16 before_incl indexes firstval first_value lastval last_value each_array
17 each_arrayref pairwise natatime mesh zip uniq minmax part bsearch) ],
18);
19
2019µs@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
21
221400ns$VERSION = '0.25_02';
23
2412µseval {
251300ns local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
2618µs1298µs bootstrap List::MoreUtils $VERSION;
# spent 298µs making 1 call to DynaLoader::bootstrap
271700ns 1;
28} if not $ENV{LIST_MOREUTILS_PP};
29
301900nseval <<'EOP' if not defined &any;
31
32require POSIX;
33
34sub any (&@) {
35 my $f = shift;
36 return if ! @_;
37 for (@_) {
38 return 1 if $f->();
39 }
40 return 0;
41}
42
43sub all (&@) {
44 my $f = shift;
45 return if ! @_;
46 for (@_) {
47 return 0 if ! $f->();
48 }
49 return 1;
50}
51
52sub none (&@) {
53 my $f = shift;
54 return 1 if ! @_;
55 for (@_) {
56 return 0 if $f->();
57 }
58 return 1;
59}
60
61sub notall (&@) {
62 my $f = shift;
63 return if ! @_;
64 for (@_) {
65 return 1 if ! $f->();
66 }
67 return 0;
68}
69
70sub true (&@) {
71 my $f = shift;
72 my $count = 0;
73 for (@_) {
74 $count++ if $f->();
75 }
76 return $count;
77}
78
79sub false (&@) {
80 my $f = shift;
81 my $count = 0;
82 for (@_) {
83 $count++ if ! $f->();
84 }
85 return $count;
86}
87
88sub firstidx (&@) {
89 my $f = shift;
90 for my $i (0 .. $#_) {
91 local *_ = \$_[$i];
92 return $i if $f->();
93 }
94 return -1;
95}
96
97sub lastidx (&@) {
98 my $f = shift;
99 for my $i (reverse 0 .. $#_) {
100 local *_ = \$_[$i];
101 return $i if $f->();
102 }
103 return -1;
104}
105
106sub insert_after (&$\@) {
107 my ($code, $val, $list) = @_;
108 my $c = -1;
109 local *_;
110 for my $i (0 .. $#$list) {
111 $_ = $list->[$i];
112 $c = $i, last if $code->();
113 }
114 @$list = (@{$list}[0..$c], $val, @{$list}[$c+1..$#$list]) and return 1 if $c != -1;
115 return 0;
116}
117
118sub insert_after_string ($$\@) {
119 my ($string, $val, $list) = @_;
120 my $c = -1;
121 for my $i (0 .. $#$list) {
122 local $^W = 0;
123 $c = $i, last if $string eq $list->[$i];
124 }
125 @$list = (@{$list}[0..$c], $val, @{$list}[$c+1..$#$list]) and return 1 if $c != -1;
126 return 0;
127}
128
129sub apply (&@) {
130 my $action = shift;
131 &$action for my @values = @_;
132 wantarray ? @values : $values[-1];
133}
134
135sub after (&@)
136{
137 my $test = shift;
138 my $started;
139 my $lag;
140 grep $started ||= do { my $x=$lag; $lag=$test->(); $x}, @_;
141}
142
143sub after_incl (&@)
144{
145 my $test = shift;
146 my $started;
147 grep $started ||= $test->(), @_;
148}
149
150sub before (&@)
151{
152 my $test = shift;
153 my $keepgoing=1;
154 grep $keepgoing &&= !$test->(), @_;
155}
156
157sub before_incl (&@)
158{
159 my $test = shift;
160 my $keepgoing=1;
161 my $lag=1;
162 grep $keepgoing &&= do { my $x=$lag; $lag=!$test->(); $x}, @_;
163}
164
165sub indexes (&@)
166{
167 my $test = shift;
168 grep {local *_=\$_[$_]; $test->()} 0..$#_;
169}
170
171sub lastval (&@)
172{
173 my $test = shift;
174 my $ix;
175 for ($ix=$#_; $ix>=0; $ix--)
176 {
177 local *_ = \$_[$ix];
178 my $testval = $test->();
179 $_[$ix] = $_; # simulate $_ as alias
180 return $_ if $testval;
181 }
182 return undef;
183}
184
185sub firstval (&@)
186{
187 my $test = shift;
188 foreach (@_)
189 {
190 return $_ if $test->();
191 }
192 return undef;
193}
194
195sub pairwise(&\@\@)
196{
197 my $op = shift;
198 use vars qw/@A @B/;
199 local (*A, *B) = @_; # syms for caller's input arrays
200
201 # Localise $a, $b
202 my ($caller_a, $caller_b) = do
203 {
204 my $pkg = caller();
205 no strict 'refs';
206 \*{$pkg.'::a'}, \*{$pkg.'::b'};
207 };
208
209 my $limit = $#A > $#B? $#A : $#B; # loop iteration limit
210
211 local(*$caller_a, *$caller_b);
212 map # This map expression is also the return value.
213 {
214 # assign to $a, $b as refs to caller's array elements
215 (*$caller_a, *$caller_b) = \($A[$_], $B[$_]);
216 $op->(); # perform the transformation
217 } 0 .. $limit;
218}
219
220sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
221{
222 return each_arrayref(@_);
223}
224
225sub each_arrayref
226{
227 my @arr_list = @_; # The list of references to the arrays
228 my $index = 0; # Which one the caller will get next
229 my $max_num = 0; # Number of elements in longest array
230
231 # Get the length of the longest input array
232 foreach (@arr_list)
233 {
234 unless (ref($_) eq 'ARRAY')
235 {
236 require Carp;
237 Carp::croak "each_arrayref: argument is not an array reference\n";
238 }
239 $max_num = @$_ if @$_ > $max_num;
240 }
241
242 # Return the iterator as a closure wrt the above variables.
243 return sub
244 {
245 if (@_)
246 {
247 my $method = shift;
248 if ($method eq 'index')
249 {
250 # Return current (last fetched) index
251 return undef if $index == 0 || $index > $max_num;
252 return $index-1;
253 }
254 else
255 {
256 require Carp;
257 Carp::croak "each_array: unknown argument '$method' passed to iterator.";
258 }
259 }
260
261 return if $index >= $max_num; # No more elements to return
262 my $i = $index++;
263 return map $_->[$i], @arr_list; # Return ith elements
264 }
265}
266
267sub natatime ($@)
268{
269 my $n = shift;
270 my @list = @_;
271
272 return sub
273 {
274 return splice @list, 0, $n;
275 }
276}
277
278sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
279 my $max = -1;
280 $max < $#$_ && ($max = $#$_) for @_;
281
282 map { my $ix = $_; map $_->[$ix], @_; } 0..$max;
283}
284
285sub uniq (@) {
286 my %h;
287 my $ref = \1;
288 map { $h{defined $_ ? $_ : $ref}++ == 0 ? $_ : () } @_;
289}
290
291sub minmax (@) {
292 return if ! @_;
293 my $min = my $max = $_[0];
294
295 for (my $i = 1; $i < @_; $i += 2) {
296 if ($_[$i-1] <= $_[$i]) {
297 $min = $_[$i-1] if $min > $_[$i-1];
298 $max = $_[$i] if $max < $_[$i];
299 } else {
300 $min = $_[$i] if $min > $_[$i];
301 $max = $_[$i-1] if $max < $_[$i-1];
302 }
303 }
304
305 if (@_ & 1) {
306 my $i = $#_;
307 if ($_[$i-1] <= $_[$i]) {
308 $min = $_[$i-1] if $min > $_[$i-1];
309 $max = $_[$i] if $max < $_[$i];
310 } else {
311 $min = $_[$i] if $min > $_[$i];
312 $max = $_[$i-1] if $max < $_[$i-1];
313 }
314 }
315
316 return ($min, $max);
317}
318
319sub part(&@) {
320 my ($code, @list) = @_;
321 my @parts;
322 push @{ $parts[$code->($_)] }, $_ for @list;
323 return @parts;
324}
325
326sub bsearch(&@) {
327 my $code = shift;
328
329 my $rc;
330 my $i = 0;
331 my $j = @_;
332 do {
333 my $k = int(($i + $j) / 2);
334
335 return if $k >= @_;
336
337 local *_ = \$_[$k];
338 $rc = $code->();
339
340 $rc == 0 and
341 return wantarray ? $_ : 1;
342
343 if ($rc < 0) {
344 $i = $k + 1;
345 } else {
346 $j = $k - 1;
347 }
348 } until $i > $j;
349
350 return;
351}
352
353sub _XScompiled {
354 return 0;
355}
356
357EOP
3581200nsdie $@ if $@;
359
36011µs*first_index = \&firstidx;
3611600ns*last_index = \&lastidx;
3621400ns*first_value = \&firstval;
3631600ns*last_value = \&lastval;
3641400ns*zip = \&mesh;
365
366116µs1;
367__END__
 
# spent 81µs within List::MoreUtils::bootstrap which was called: # once (81µs+0s) by DynaLoader::bootstrap at line 215 of DynaLoader.pm
sub List::MoreUtils::bootstrap; # xsub
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.