← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:48 2015

Filename/usr/lib/x86_64-linux-gnu/perl5/5.20/List/MoreUtils.pm
StatementsExecuted 27 statements in 431µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11167µs67µsList::MoreUtils::::bootstrapList::MoreUtils::bootstrap (xsub)
11123µs612µsList::MoreUtils::::BEGIN@9List::MoreUtils::BEGIN@9
11114µs14µsList::MoreUtils::::BEGIN@3List::MoreUtils::BEGIN@3
1118µs56µsList::MoreUtils::::BEGIN@8List::MoreUtils::BEGIN@8
1116µs16µsList::MoreUtils::::BEGIN@4List::MoreUtils::BEGIN@4
1113µs3µsList::MoreUtils::::BEGIN@5List::MoreUtils::BEGIN@5
1112µs2µsList::MoreUtils::::BEGIN@6List::MoreUtils::BEGIN@6
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
3240µs114µs
# spent 14µs within List::MoreUtils::BEGIN@3 which was called: # once (14µs+0s) by DateTime::Locale::Base::BEGIN@8 at line 3
use 5.00503;
# spent 14µs making 1 call to List::MoreUtils::BEGIN@3
4218µs225µs
# spent 16µs (6+10) within List::MoreUtils::BEGIN@4 which was called: # once (6µs+10µs) by DateTime::Locale::Base::BEGIN@8 at line 4
use strict;
# spent 16µs making 1 call to List::MoreUtils::BEGIN@4 # spent 10µs making 1 call to strict::import
5216µs13µs
# spent 3µs within List::MoreUtils::BEGIN@5 which was called: # once (3µs+0s) by DateTime::Locale::Base::BEGIN@8 at line 5
use Exporter ();
# spent 3µs making 1 call to List::MoreUtils::BEGIN@5
6225µs12µs
# spent 2µs within List::MoreUtils::BEGIN@6 which was called: # once (2µs+0s) by DateTime::Locale::Base::BEGIN@8 at line 6
use DynaLoader ();
# spent 2µs making 1 call to List::MoreUtils::BEGIN@6
7
82102µs2105µs
# spent 56µs (8+49) within List::MoreUtils::BEGIN@8 which was called: # once (8µs+49µs) by DateTime::Locale::Base::BEGIN@8 at line 8
use vars qw{ $VERSION @ISA @EXPORT_OK %EXPORT_TAGS };
# spent 56µs making 1 call to List::MoreUtils::BEGIN@8 # spent 49µs making 1 call to vars::import
9
# spent 612µs (23+589) within List::MoreUtils::BEGIN@9 which was called: # once (23µs+589µs) by DateTime::Locale::Base::BEGIN@8 at line 40
BEGIN {
101300ns $VERSION = '0.33';
11 # $VERSION = eval $VERSION;
1218µs @ISA = qw{ Exporter DynaLoader };
1312µ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 };
2511µs %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
3113µs eval {
32 # PERL_DL_NONLAZY must be false, or any errors in loading will just
33 # cause the perl code to be tested
341400ns local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
35
3617µs1589µs bootstrap List::MoreUtils $VERSION;
# spent 589µs making 1 call to DynaLoader::bootstrap
371300ns 1;
38
39 } unless $ENV{LIST_MOREUTILS_PP};
401203µs1612µs}
# spent 612µs making 1 call to List::MoreUtils::BEGIN@9
41
421400nseval <<'END_PERL' unless defined &any;
43
44# Use pure scalar boolean return values for compatibility with XS
45use constant YES => ! 0;
46use constant NO => ! 1;
47
48sub any (&@) {
49 my $f = shift;
50 foreach ( @_ ) {
51 return YES if $f->();
52 }
53 return NO;
54}
55
56sub all (&@) {
57 my $f = shift;
58 foreach ( @_ ) {
59 return NO unless $f->();
60 }
61 return YES;
62}
63
64sub none (&@) {
65 my $f = shift;
66 foreach ( @_ ) {
67 return NO if $f->();
68 }
69 return YES;
70}
71
72sub notall (&@) {
73 my $f = shift;
74 foreach ( @_ ) {
75 return YES unless $f->();
76 }
77 return NO;
78}
79
80sub true (&@) {
81 my $f = shift;
82 my $count = 0;
83 foreach ( @_ ) {
84 $count++ if $f->();
85 }
86 return $count;
87}
88
89sub false (&@) {
90 my $f = shift;
91 my $count = 0;
92 foreach ( @_ ) {
93 $count++ unless $f->();
94 }
95 return $count;
96}
97
98sub firstidx (&@) {
99 my $f = shift;
100 foreach my $i ( 0 .. $#_ ) {
101 local *_ = \$_[$i];
102 return $i if $f->();
103 }
104 return -1;
105}
106
107sub 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
116sub 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
132sub 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
147sub apply (&@) {
148 my $action = shift;
149 &$action foreach my @values = @_;
150 wantarray ? @values : $values[-1];
151}
152
153sub 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
164sub after_incl (&@) {
165 my $test = shift;
166 my $started;
167 grep $started ||= $test->(), @_;
168}
169
170sub before (&@) {
171 my $test = shift;
172 my $more = 1;
173 grep $more &&= ! $test->(), @_;
174}
175
176sub 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
187sub indexes (&@) {
188 my $test = shift;
189 grep {
190 local *_ = \$_[$_];
191 $test->()
192 } 0 .. $#_;
193}
194
195sub 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
209sub firstval (&@) {
210 my $test = shift;
211 foreach ( @_ ) {
212 return $_ if $test->();
213 }
214 return undef;
215}
216
217sub 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
245sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
246 return each_arrayref(@_);
247}
248
249sub 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
286sub natatime ($@) {
287 my $n = shift;
288 my @list = @_;
289 return sub {
290 return splice @list, 0, $n;
291 }
292}
293
294sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
295 my $max = -1;
296 $max < $#$_ && ( $max = $#$_ ) foreach @_;
297 map {
298 my $ix = $_;
299 map $_->[$ix], @_;
300 } 0 .. $max;
301}
302
303sub uniq (@) {
304 my %seen = ();
305 grep { not $seen{$_}++ } @_;
306}
307
308sub 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
336sub part (&@) {
337 my ($code, @list) = @_;
338 my @parts;
339 push @{ $parts[ $code->($_) ] }, $_ foreach @list;
340 return @parts;
341}
342
343sub _XScompiled {
344 return 0;
345}
346
347END_PERL
3481100nsdie $@ if $@;
349
350# Function aliases
35111µs*first_index = \&firstidx;
3521200ns*last_index = \&lastidx;
3531200ns*first_value = \&firstval;
3541200ns*last_value = \&lastval;
3551100ns*zip = \&mesh;
3561100ns*distinct = \&uniq;
357
35814µs1;
359
360__END__
 
# spent 67µs within List::MoreUtils::bootstrap which was called: # once (67µs+0s) by DynaLoader::bootstrap at line 210 of DynaLoader.pm
sub List::MoreUtils::bootstrap; # xsub
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.