Profile of List/MoreUtils.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:26 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/x86_64-linux/List/MoreUtils.pm
Statements | Executed 32 statements in 453µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
33 | 1 | 1 | 585µs | 710µs | List::MoreUtils::::allList::MoreUtils::all (xsub)
39 | 3 | 1 | 131µs | 131µs | List::MoreUtils::::firstidxList::MoreUtils::firstidx (xsub)
1 | 1 | 1 | 74µs | 74µs | List::MoreUtils::::bootstrapList::MoreUtils::bootstrap (xsub)
1 | 1 | 1 | 36µs | 345µs | List::MoreUtils::::BEGIN@9List::MoreUtils::BEGIN@9
1 | 1 | 1 | 28µs | 28µs | List::MoreUtils::::BEGIN@3List::MoreUtils::BEGIN@3
3 | 1 | 1 | 13µs | 13µs | List::MoreUtils::::uniqList::MoreUtils::uniq (xsub)
1 | 1 | 1 | 7µs | 67µs | List::MoreUtils::::BEGIN@8List::MoreUtils::BEGIN@8
1 | 1 | 1 | 6µs | 8µs | List::MoreUtils::::BEGIN@4List::MoreUtils::BEGIN@4
1 | 1 | 1 | 3µs | 3µs | List::MoreUtils::::BEGIN@6List::MoreUtils::BEGIN@6
1 | 1 | 1 | 3µs | 3µs | List::MoreUtils::::BEGIN@5List::MoreUtils::BEGIN@5

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package List::MoreUtils;
2 |  |  |  |  |
3 | 3 | 36µs | 1 | 28µs | # spent 28µs within List::MoreUtils::BEGIN@3 which was called: # once (28µs+0s) by Package::DeprecationManager::BEGIN@10 at line 3 use 5.00503; # spent 28µs making 1 call to List::MoreUtils::BEGIN@3
4 | 3 | 15µs | 2 | 10µs | # spent 8µs (6+2) within List::MoreUtils::BEGIN@4 which was called: # once (6µs+2µs) by Package::DeprecationManager::BEGIN@10 at line 4 use strict; # spent 8µs making 1 call to List::MoreUtils::BEGIN@4 # spent 2µs making 1 call to strict::import
5 | 3 | 18µs | 1 | 3µs | # spent 3µs within List::MoreUtils::BEGIN@5 which was called: # once (3µs+0s) by Package::DeprecationManager::BEGIN@10 at line 5 use Exporter (); # spent 3µs making 1 call to List::MoreUtils::BEGIN@5
6 | 3 | 18µs | 1 | 3µs | # spent 3µs within List::MoreUtils::BEGIN@6 which was called: # once (3µs+0s) by Package::DeprecationManager::BEGIN@10 at line 6 use DynaLoader (); # spent 3µs making 1 call to List::MoreUtils::BEGIN@6
7 |  |  |  |  |
8 | 3 | 104µs | 2 | 128µs | # spent 67µs (7+61) within List::MoreUtils::BEGIN@8 which was called: # once (7µs+61µs) by Package::DeprecationManager::BEGIN@10 at line 8 use vars qw{ $VERSION @ISA @EXPORT_OK %EXPORT_TAGS }; # spent 67µs making 1 call to List::MoreUtils::BEGIN@8 # spent 61µs making 1 call to vars::import
9 |  |  |  |  | # spent 345µs (36+309) within List::MoreUtils::BEGIN@9 which was called: # once (36µs+309µs) by Package::DeprecationManager::BEGIN@10 at line 40 BEGIN {
10 | 1 | 400ns |  |  | $VERSION = '0.33';
11 |  |  |  |  | # $VERSION = eval $VERSION;
12 | 1 | 15µs |  |  | @ISA = qw{ Exporter DynaLoader };
13 | 1 | 8µs |  |  | @EXPORT_OK = qw{
14 |  |  |  |  | any all none notall true false
15 |  |  |  |  | firstidx first_index lastidx last_index
16 |  |  |  |  | insert_after insert_after_string
17 |  |  |  |  | apply indexes
18 |  |  |  |  | after after_incl before before_incl
19 |  |  |  |  | firstval first_value lastval last_value
20 |  |  |  |  | each_array each_arrayref
21 |  |  |  |  | pairwise natatime
22 |  |  |  |  | mesh zip uniq distinct
23 |  |  |  |  | minmax part
24 |  |  |  |  | };
25 | 1 | 900ns |  |  | %EXPORT_TAGS = (
26 |  |  |  |  | all => \@EXPORT_OK,
27 |  |  |  |  | );
28 |  |  |  |  |
29 |  |  |  |  | # Load the XS at compile-time so that redefinition warnings will be
30 |  |  |  |  | # thrown correctly if the XS versions of part or indexes loaded
31 | 1 | 4µs |  |  | eval {
32 |  |  |  |  | # PERL_DL_NONLAZY must be false, or any errors in loading will just
33 |  |  |  |  | # cause the perl code to be tested
34 | 1 | 400ns |  |  | local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
35 |  |  |  |  |
36 | 1 | 6µs | 1 | 309µs | bootstrap List::MoreUtils $VERSION; # spent 309µs making 1 call to DynaLoader::bootstrap
37 | 1 | 800ns |  |  | 1;
38 |  |  |  |  |
39 |  |  |  |  | } unless $ENV{LIST_MOREUTILS_PP};
40 | 1 | 216µs | 1 | 345µs | } # spent 345µs making 1 call to List::MoreUtils::BEGIN@9
41 |  |  |  |  |
42 | 1 | 400ns |  |  | eval <<'END_PERL' unless defined &any;
43 |  |  |  |  |
44 |  |  |  |  | # Use pure scalar boolean return values for compatibility with XS
45 |  |  |  |  | use constant YES => ! 0;
46 |  |  |  |  | use constant NO => ! 1;
47 |  |  |  |  |
48 |  |  |  |  | sub any (&@) {
49 |  |  |  |  | my $f = shift;
50 |  |  |  |  | foreach ( @_ ) {
51 |  |  |  |  | return YES if $f->();
52 |  |  |  |  | }
53 |  |  |  |  | return NO;
54 |  |  |  |  | }
55 |  |  |  |  |
56 |  |  |  |  | sub all (&@) {
57 |  |  |  |  | my $f = shift;
58 |  |  |  |  | foreach ( @_ ) {
59 |  |  |  |  | return NO unless $f->();
60 |  |  |  |  | }
61 |  |  |  |  | return YES;
62 |  |  |  |  | }
63 |  |  |  |  |
64 |  |  |  |  | sub none (&@) {
65 |  |  |  |  | my $f = shift;
66 |  |  |  |  | foreach ( @_ ) {
67 |  |  |  |  | return NO if $f->();
68 |  |  |  |  | }
69 |  |  |  |  | return YES;
70 |  |  |  |  | }
71 |  |  |  |  |
72 |  |  |  |  | sub notall (&@) {
73 |  |  |  |  | my $f = shift;
74 |  |  |  |  | foreach ( @_ ) {
75 |  |  |  |  | return YES unless $f->();
76 |  |  |  |  | }
77 |  |  |  |  | return NO;
78 |  |  |  |  | }
79 |  |  |  |  |
80 |  |  |  |  | sub true (&@) {
81 |  |  |  |  | my $f = shift;
82 |  |  |  |  | my $count = 0;
83 |  |  |  |  | foreach ( @_ ) {
84 |  |  |  |  | $count++ if $f->();
85 |  |  |  |  | }
86 |  |  |  |  | return $count;
87 |  |  |  |  | }
88 |  |  |  |  |
89 |  |  |  |  | sub false (&@) {
90 |  |  |  |  | my $f = shift;
91 |  |  |  |  | my $count = 0;
92 |  |  |  |  | foreach ( @_ ) {
93 |  |  |  |  | $count++ unless $f->();
94 |  |  |  |  | }
95 |  |  |  |  | return $count;
96 |  |  |  |  | }
97 |  |  |  |  |
98 |  |  |  |  | sub firstidx (&@) {
99 |  |  |  |  | my $f = shift;
100 |  |  |  |  | foreach my $i ( 0 .. $#_ ) {
101 |  |  |  |  | local *_ = \$_[$i];
102 |  |  |  |  | return $i if $f->();
103 |  |  |  |  | }
104 |  |  |  |  | return -1;
105 |  |  |  |  | }
106 |  |  |  |  |
107 |  |  |  |  | sub lastidx (&@) {
108 |  |  |  |  | my $f = shift;
109 |  |  |  |  | foreach my $i ( reverse 0 .. $#_ ) {
110 |  |  |  |  | local *_ = \$_[$i];
111 |  |  |  |  | return $i if $f->();
112 |  |  |  |  | }
113 |  |  |  |  | return -1;
114 |  |  |  |  | }
115 |  |  |  |  |
116 |  |  |  |  | sub insert_after (&$\@) {
117 |  |  |  |  | my ($f, $val, $list) = @_;
118 |  |  |  |  | my $c = -1;
119 |  |  |  |  | local *_;
120 |  |  |  |  | foreach my $i ( 0 .. $#$list ) {
121 |  |  |  |  | $_ = $list->[$i];
122 |  |  |  |  | $c = $i, last if $f->();
123 |  |  |  |  | }
124 |  |  |  |  | @$list = (
125 |  |  |  |  | @{$list}[ 0 .. $c ],
126 |  |  |  |  | $val,
127 |  |  |  |  | @{$list}[ $c + 1 .. $#$list ],
128 |  |  |  |  | ) and return 1 if $c != -1;
129 |  |  |  |  | return 0;
130 |  |  |  |  | }
131 |  |  |  |  |
132 |  |  |  |  | sub insert_after_string ($$\@) {
133 |  |  |  |  | my ($string, $val, $list) = @_;
134 |  |  |  |  | my $c = -1;
135 |  |  |  |  | foreach my $i ( 0 .. $#$list ) {
136 |  |  |  |  | local $^W = 0;
137 |  |  |  |  | $c = $i, last if $string eq $list->[$i];
138 |  |  |  |  | }
139 |  |  |  |  | @$list = (
140 |  |  |  |  | @{$list}[ 0 .. $c ],
141 |  |  |  |  | $val,
142 |  |  |  |  | @{$list}[ $c + 1 .. $#$list ],
143 |  |  |  |  | ) and return 1 if $c != -1;
144 |  |  |  |  | return 0;
145 |  |  |  |  | }
146 |  |  |  |  |
147 |  |  |  |  | sub apply (&@) {
148 |  |  |  |  | my $action = shift;
149 |  |  |  |  | &$action foreach my @values = @_;
150 |  |  |  |  | wantarray ? @values : $values[-1];
151 |  |  |  |  | }
152 |  |  |  |  |
153 |  |  |  |  | sub after (&@) {
154 |  |  |  |  | my $test = shift;
155 |  |  |  |  | my $started;
156 |  |  |  |  | my $lag;
157 |  |  |  |  | grep $started ||= do {
158 |  |  |  |  | my $x = $lag;
159 |  |  |  |  | $lag = $test->();
160 |  |  |  |  | $x
161 |  |  |  |  | }, @_;
162 |  |  |  |  | }
163 |  |  |  |  |
164 |  |  |  |  | sub after_incl (&@) {
165 |  |  |  |  | my $test = shift;
166 |  |  |  |  | my $started;
167 |  |  |  |  | grep $started ||= $test->(), @_;
168 |  |  |  |  | }
169 |  |  |  |  |
170 |  |  |  |  | sub before (&@) {
171 |  |  |  |  | my $test = shift;
172 |  |  |  |  | my $more = 1;
173 |  |  |  |  | grep $more &&= ! $test->(), @_;
174 |  |  |  |  | }
175 |  |  |  |  |
176 |  |  |  |  | sub before_incl (&@) {
177 |  |  |  |  | my $test = shift;
178 |  |  |  |  | my $more = 1;
179 |  |  |  |  | my $lag = 1;
180 |  |  |  |  | grep $more &&= do {
181 |  |  |  |  | my $x = $lag;
182 |  |  |  |  | $lag = ! $test->();
183 |  |  |  |  | $x
184 |  |  |  |  | }, @_;
185 |  |  |  |  | }
186 |  |  |  |  |
187 |  |  |  |  | sub indexes (&@) {
188 |  |  |  |  | my $test = shift;
189 |  |  |  |  | grep {
190 |  |  |  |  | local *_ = \$_[$_];
191 |  |  |  |  | $test->()
192 |  |  |  |  | } 0 .. $#_;
193 |  |  |  |  | }
194 |  |  |  |  |
195 |  |  |  |  | sub lastval (&@) {
196 |  |  |  |  | my $test = shift;
197 |  |  |  |  | my $ix;
198 |  |  |  |  | for ( $ix = $#_; $ix >= 0; $ix-- ) {
199 |  |  |  |  | local *_ = \$_[$ix];
200 |  |  |  |  | my $testval = $test->();
201 |  |  |  |  |
202 |  |  |  |  | # Simulate $_ as alias
203 |  |  |  |  | $_[$ix] = $_;
204 |  |  |  |  | return $_ if $testval;
205 |  |  |  |  | }
206 |  |  |  |  | return undef;
207 |  |  |  |  | }
208 |  |  |  |  |
209 |  |  |  |  | sub firstval (&@) {
210 |  |  |  |  | my $test = shift;
211 |  |  |  |  | foreach ( @_ ) {
212 |  |  |  |  | return $_ if $test->();
213 |  |  |  |  | }
214 |  |  |  |  | return undef;
215 |  |  |  |  | }
216 |  |  |  |  |
217 |  |  |  |  | sub pairwise (&\@\@) {
218 |  |  |  |  | my $op = shift;
219 |  |  |  |  |
220 |  |  |  |  | # Symbols for caller's input arrays
221 |  |  |  |  | use vars qw{ @A @B };
222 |  |  |  |  | local ( *A, *B ) = @_;
223 |  |  |  |  |
224 |  |  |  |  | # Localise $a, $b
225 |  |  |  |  | my ( $caller_a, $caller_b ) = do {
226 |  |  |  |  | my $pkg = caller();
227 |  |  |  |  | no strict 'refs';
228 |  |  |  |  | \*{$pkg.'::a'}, \*{$pkg.'::b'};
229 |  |  |  |  | };
230 |  |  |  |  |
231 |  |  |  |  | # Loop iteration limit
232 |  |  |  |  | my $limit = $#A > $#B? $#A : $#B;
233 |  |  |  |  |
234 |  |  |  |  | # This map expression is also the return value
235 |  |  |  |  | local( *$caller_a, *$caller_b );
236 |  |  |  |  | map {
237 |  |  |  |  | # Assign to $a, $b as refs to caller's array elements
238 |  |  |  |  | ( *$caller_a, *$caller_b ) = \( $A[$_], $B[$_] );
239 |  |  |  |  |
240 |  |  |  |  | # Perform the transformation
241 |  |  |  |  | $op->();
242 |  |  |  |  | } 0 .. $limit;
243 |  |  |  |  | }
244 |  |  |  |  |
245 |  |  |  |  | sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
246 |  |  |  |  | return each_arrayref(@_);
247 |  |  |  |  | }
248 |  |  |  |  |
249 |  |  |  |  | sub each_arrayref {
250 |  |  |  |  | my @list = @_; # The list of references to the arrays
251 |  |  |  |  | my $index = 0; # Which one the caller will get next
252 |  |  |  |  | my $max = 0; # Number of elements in longest array
253 |  |  |  |  |
254 |  |  |  |  | # Get the length of the longest input array
255 |  |  |  |  | foreach ( @list ) {
256 |  |  |  |  | unless ( ref $_ eq 'ARRAY' ) {
257 |  |  |  |  | require Carp;
258 |  |  |  |  | Carp::croak("each_arrayref: argument is not an array reference\n");
259 |  |  |  |  | }
260 |  |  |  |  | $max = @$_ if @$_ > $max;
261 |  |  |  |  | }
262 |  |  |  |  |
263 |  |  |  |  | # Return the iterator as a closure wrt the above variables.
264 |  |  |  |  | return sub {
265 |  |  |  |  | if ( @_ ) {
266 |  |  |  |  | my $method = shift;
267 |  |  |  |  | unless ( $method eq 'index' ) {
268 |  |  |  |  | require Carp;
269 |  |  |  |  | Carp::croak("each_array: unknown argument '$method' passed to iterator.");
270 |  |  |  |  | }
271 |  |  |  |  |
272 |  |  |  |  | # Return current (last fetched) index
273 |  |  |  |  | return undef if $index == 0 || $index > $max;
274 |  |  |  |  | return $index - 1;
275 |  |  |  |  | }
276 |  |  |  |  |
277 |  |  |  |  | # No more elements to return
278 |  |  |  |  | return if $index >= $max;
279 |  |  |  |  | my $i = $index++;
280 |  |  |  |  |
281 |  |  |  |  | # Return ith elements
282 |  |  |  |  | return map $_->[$i], @list;
283 |  |  |  |  | }
284 |  |  |  |  | }
285 |  |  |  |  |
286 |  |  |  |  | sub natatime ($@) {
287 |  |  |  |  | my $n = shift;
288 |  |  |  |  | my @list = @_;
289 |  |  |  |  | return sub {
290 |  |  |  |  | return splice @list, 0, $n;
291 |  |  |  |  | }
292 |  |  |  |  | }
293 |  |  |  |  |
294 |  |  |  |  | sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
295 |  |  |  |  | my $max = -1;
296 |  |  |  |  | $max < $#$_ && ( $max = $#$_ ) foreach @_;
297 |  |  |  |  | map {
298 |  |  |  |  | my $ix = $_;
299 |  |  |  |  | map $_->[$ix], @_;
300 |  |  |  |  | } 0 .. $max;
301 |  |  |  |  | }
302 |  |  |  |  |
303 |  |  |  |  | sub uniq (@) {
304 |  |  |  |  | my %seen = ();
305 |  |  |  |  | grep { not $seen{$_}++ } @_;
306 |  |  |  |  | }
307 |  |  |  |  |
308 |  |  |  |  | sub minmax (@) {
309 |  |  |  |  | return unless @_;
310 |  |  |  |  | my $min = my $max = $_[0];
311 |  |  |  |  |
312 |  |  |  |  | for ( my $i = 1; $i < @_; $i += 2 ) {
313 |  |  |  |  | if ( $_[$i-1] <= $_[$i] ) {
314 |  |  |  |  | $min = $_[$i-1] if $min > $_[$i-1];
315 |  |  |  |  | $max = $_[$i] if $max < $_[$i];
316 |  |  |  |  | } else {
317 |  |  |  |  | $min = $_[$i] if $min > $_[$i];
318 |  |  |  |  | $max = $_[$i-1] if $max < $_[$i-1];
319 |  |  |  |  | }
320 |  |  |  |  | }
321 |  |  |  |  |
322 |  |  |  |  | if ( @_ & 1 ) {
323 |  |  |  |  | my $i = $#_;
324 |  |  |  |  | if ($_[$i-1] <= $_[$i]) {
325 |  |  |  |  | $min = $_[$i-1] if $min > $_[$i-1];
326 |  |  |  |  | $max = $_[$i] if $max < $_[$i];
327 |  |  |  |  | } else {
328 |  |  |  |  | $min = $_[$i] if $min > $_[$i];
329 |  |  |  |  | $max = $_[$i-1] if $max < $_[$i-1];
330 |  |  |  |  | }
331 |  |  |  |  | }
332 |  |  |  |  |
333 |  |  |  |  | return ($min, $max);
334 |  |  |  |  | }
335 |  |  |  |  |
336 |  |  |  |  | sub part (&@) {
337 |  |  |  |  | my ($code, @list) = @_;
338 |  |  |  |  | my @parts;
339 |  |  |  |  | push @{ $parts[ $code->($_) ] }, $_ foreach @list;
340 |  |  |  |  | return @parts;
341 |  |  |  |  | }
342 |  |  |  |  |
343 |  |  |  |  | sub _XScompiled {
344 |  |  |  |  | return 0;
345 |  |  |  |  | }
346 |  |  |  |  |
347 |  |  |  |  | END_PERL
348 | 1 | 100ns |  |  | die $@ if $@;
349 |  |  |  |  |
350 |  |  |  |  | # Function aliases
351 | 1 | 1µs |  |  | *first_index = \&firstidx;
352 | 1 | 600ns |  |  | *last_index = \&lastidx;
353 | 1 | 400ns |  |  | *first_value = \&firstval;
354 | 1 | 300ns |  |  | *last_value = \&lastval;
355 | 1 | 300ns |  |  | *zip = \&mesh;
356 | 1 | 300ns |  |  | *distinct = \&uniq;
357 |  |  |  |  |
358 | 1 | 7µs |  |  | 1;
359 |  |  |  |  |
360 |  |  |  |  | __END__
|  |  |  |  | # spent 710µs (585+124) within List::MoreUtils::all which was called 33 times, avg 22µs/call: # 33 times (585µs+124µs) by Class::MOP::Class::_check_metaclass_compatibility at line 217 of Class/MOP/Class.pm, avg 22µs/call sub List::MoreUtils::all; # xsub
|  |  |  |  | # spent 74µs within List::MoreUtils::bootstrap which was called: # once (74µs+0s) by DynaLoader::bootstrap at line 223 of DynaLoader.pm sub List::MoreUtils::bootstrap; # xsub
|  |  |  |  | # spent 131µs within List::MoreUtils::firstidx which was called 39 times, avg 3µs/call: # 13 times (83µs+0s) by Moose::Exporter::_strip_traits at line 496 of Moose/Exporter.pm, avg 6µs/call # 13 times (27µs+0s) by Moose::Exporter::_strip_metaclass at line 510 of Moose/Exporter.pm, avg 2µs/call # 13 times (21µs+0s) by Moose::Exporter::_strip_meta_name at line 522 of Moose/Exporter.pm, avg 2µs/call sub List::MoreUtils::firstidx; # xsub
|  |  |  |  | # spent 13µs within List::MoreUtils::uniq which was called 3 times, avg 4µs/call: # 3 times (13µs+0s) by Moose::Exporter::_follow_also at line 151 of Moose/Exporter.pm, avg 4µs/call sub List::MoreUtils::uniq; # xsub