← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:13 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/PPIx/Regexp/Node.pm
StatementsExecuted 20 statements in 1.14ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11112µs26µsPPIx::Regexp::Node::::BEGIN@125PPIx::Regexp::Node::BEGIN@125
11112µs39µsPPIx::Regexp::Node::::BEGIN@39PPIx::Regexp::Node::BEGIN@39
11111µs22µsPPIx::Regexp::Node::::BEGIN@34PPIx::Regexp::Node::BEGIN@34
1118µs2.76msPPIx::Regexp::Node::::BEGIN@37PPIx::Regexp::Node::BEGIN@37
1117µs11µsPPIx::Regexp::Node::::BEGIN@35PPIx::Regexp::Node::BEGIN@35
1117µs25µsPPIx::Regexp::Node::::BEGIN@41PPIx::Regexp::Node::BEGIN@41
1117µs24µsPPIx::Regexp::Node::::BEGIN@40PPIx::Regexp::Node::BEGIN@40
1116µs25µsPPIx::Regexp::Node::::BEGIN@42PPIx::Regexp::Node::BEGIN@42
0000s0sPPIx::Regexp::Node::::__ANON__[:164]PPIx::Regexp::Node::__ANON__[:164]
0000s0sPPIx::Regexp::Node::::__PPIX_LEXER__finalizePPIx::Regexp::Node::__PPIX_LEXER__finalize
0000s0sPPIx::Regexp::Node::::__PPIX_LEXER__record_capture_numberPPIx::Regexp::Node::__PPIX_LEXER__record_capture_number
0000s0sPPIx::Regexp::Node::::_find_routinePPIx::Regexp::Node::_find_routine
0000s0sPPIx::Regexp::Node::::_navPPIx::Regexp::Node::_nav
0000s0sPPIx::Regexp::Node::::_newPPIx::Regexp::Node::_new
0000s0sPPIx::Regexp::Node::::childPPIx::Regexp::Node::child
0000s0sPPIx::Regexp::Node::::childrenPPIx::Regexp::Node::children
0000s0sPPIx::Regexp::Node::::containsPPIx::Regexp::Node::contains
0000s0sPPIx::Regexp::Node::::contentPPIx::Regexp::Node::content
0000s0sPPIx::Regexp::Node::::findPPIx::Regexp::Node::find
0000s0sPPIx::Regexp::Node::::find_firstPPIx::Regexp::Node::find_first
0000s0sPPIx::Regexp::Node::::find_parentsPPIx::Regexp::Node::find_parents
0000s0sPPIx::Regexp::Node::::first_elementPPIx::Regexp::Node::first_element
0000s0sPPIx::Regexp::Node::::last_elementPPIx::Regexp::Node::last_element
0000s0sPPIx::Regexp::Node::::perl_version_introducedPPIx::Regexp::Node::perl_version_introduced
0000s0sPPIx::Regexp::Node::::perl_version_removedPPIx::Regexp::Node::perl_version_removed
0000s0sPPIx::Regexp::Node::::schildPPIx::Regexp::Node::schild
0000s0sPPIx::Regexp::Node::::schildrenPPIx::Regexp::Node::schildren
0000s0sPPIx::Regexp::Node::::tokensPPIx::Regexp::Node::tokens
0000s0sPPIx::Regexp::Node::::unescaped_contentPPIx::Regexp::Node::unescaped_content
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1=head1 NAME
2
3PPIx::Regexp::Node - Represent a container
4
5=head1 SYNOPSIS
6
7 use PPIx::Regexp::Dumper;
8 PPIx::Regexp::Dumper->new( 'qr{(foo)}' )->print();
9
10=head1 INHERITANCE
11
12C<PPIx::Regexp::Node> is a
13L<PPIx::Regexp::Element|PPIx::Regexp::Element>.
14
15C<PPIx::Regexp::Node> is the parent of L<PPIx::Regexp|PPIx::Regexp>,
16L<PPIx::Regexp::Node::Range|PPIx::Regexp::Node::Range> and
17L<PPIx::Regexp::Structure|PPIx::Regexp::Structure>.
18
19=head1 DESCRIPTION
20
21This class represents a structural element that contains other classes.
22It is an abstract class, not instantiated by the lexer.
23
24=head1 METHODS
25
26This class provides the following public methods. Methods not documented
27here are private, and unsupported in the sense that the author reserves
28the right to change or remove them without notice.
29
30=cut
31
32package PPIx::Regexp::Node;
33
34224µs234µs
# spent 22µs (11+11) within PPIx::Regexp::Node::BEGIN@34 which was called: # once (11µs+11µs) by base::import at line 34
use strict;
# spent 22µs making 1 call to PPIx::Regexp::Node::BEGIN@34 # spent 11µs making 1 call to strict::import
35221µs216µs
# spent 11µs (7+4) within PPIx::Regexp::Node::BEGIN@35 which was called: # once (7µs+4µs) by base::import at line 35
use warnings;
# spent 11µs making 1 call to PPIx::Regexp::Node::BEGIN@35 # spent 4µs making 1 call to warnings::import
36
37225µs22.76ms
# spent 2.76ms (8µs+2.75) within PPIx::Regexp::Node::BEGIN@37 which was called: # once (8µs+2.75ms) by base::import at line 37
use base qw{ PPIx::Regexp::Element };
# spent 2.76ms making 1 call to PPIx::Regexp::Node::BEGIN@37 # spent 2.75ms making 1 call to base::import, recursion: max depth 1, sum of overlapping time 2.75ms
38
39223µs246µs
# spent 39µs (12+27) within PPIx::Regexp::Node::BEGIN@39 which was called: # once (12µs+27µs) by base::import at line 39
use List::Util qw{ max };
# spent 39µs making 1 call to PPIx::Regexp::Node::BEGIN@39 # spent 7µs making 1 call to List::Util::import
40221µs242µs
# spent 24µs (7+18) within PPIx::Regexp::Node::BEGIN@40 which was called: # once (7µs+18µs) by base::import at line 40
use PPIx::Regexp::Constant qw{ MINIMUM_PERL };
# spent 24µs making 1 call to PPIx::Regexp::Node::BEGIN@40 # spent 18µs making 1 call to Exporter::import
41220µs242µs
# spent 25µs (7+18) within PPIx::Regexp::Node::BEGIN@41 which was called: # once (7µs+18µs) by base::import at line 41
use PPIx::Regexp::Util qw{ __instance };
# spent 25µs making 1 call to PPIx::Regexp::Node::BEGIN@41 # spent 18µs making 1 call to Exporter::import
422219µs243µs
# spent 25µs (6+18) within PPIx::Regexp::Node::BEGIN@42 which was called: # once (6µs+18µs) by base::import at line 42
use Scalar::Util qw{ refaddr };
# spent 25µs making 1 call to PPIx::Regexp::Node::BEGIN@42 # spent 18µs making 1 call to Exporter::import
43
441600nsour $VERSION = '0.036';
45
46sub _new {
47 my ( $class, @children ) = @_;
48 ref $class and $class = ref $class;
49 foreach my $elem ( @children ) {
50 __instance( $elem, 'PPIx::Regexp::Element' ) or return;
51 }
52 my $self = {
53 children => \@children,
54 };
55 bless $self, $class;
56 foreach my $elem ( @children ) {
57 $elem->_parent( $self );
58 }
59 return $self;
60}
61
62=head2 child
63
64 my $kid = $node->child( 0 );
65
66This method returns the child at the given index. The indices start from
67zero, and negative indices are from the end of the list, so that
68C<< $node->child( -1 ) >> returns the last child of the node.
69
70=cut
71
72sub child {
73 my ( $self, $inx ) = @_;
74 defined $inx or $inx = 0;
75 return $self->{children}[$inx];
76}
77
78=head2 children
79
80This method returns the children of the Node. If called in scalar
81context it returns the number of children.
82
83=cut
84
85sub children {
86 my ( $self ) = @_;
87 return @{ $self->{children} };
88}
89
90=head2 contains
91
92 print $node->contains( $elem ) ? "yes\n" : "no\n";
93
94This method returns true if the given element is contained in the node,
95or false otherwise.
96
97=cut
98
99sub contains {
100 my ( $self, $elem ) = @_;
101 __instance( $elem, 'PPIx::Regexp::Element' ) or return;
102
103 my $addr = refaddr( $self );
104
105 while ( $elem = $elem->parent() ) {
106 $addr == refaddr( $elem ) and return 1;
107 }
108
109 return;
110}
111
112sub content {
113 my ( $self ) = @_;
114 return join( '', map{ $_->content() } $self->elements() );
115}
116
117=head2 elements
118
119This method returns the elements in the Node. For a
120C<PPIx::Regexp::Node> proper, it is the same as C<children()>.
121
122=cut
123
124{
1253781µs240µs
# spent 26µs (12+14) within PPIx::Regexp::Node::BEGIN@125 which was called: # once (12µs+14µs) by base::import at line 125
no warnings qw{ once };
# spent 26µs making 1 call to PPIx::Regexp::Node::BEGIN@125 # spent 14µs making 1 call to warnings::unimport
12611µs *elements = \&children;
127}
128
129=head2 find
130
131 my $rslt = $node->find( 'PPIx::Regexp::Token::Literal' );
132 my $rslt = $node->find( 'Token::Literal' );
133 my $rslt = $node->find( sub {
134 return $_[1]->isa( 'PPIx::Regexp::Token::Literal' )
135 && $_[1]->ordinal < ord(' ');
136 } );
137
138This method finds things.
139
140If given a string as argument, it is assumed to be a class name
141(possibly without the leading 'PPIx::Regexp::'), and all elements of the
142given class are found.
143
144If given a code reference, that code reference is called once for each
145element, and passed C<$self> and the element. The code should return
146true to accept the element, false to reject it, and ( for subclasses of
147C<PPIx::Regexp::Node>) C<undef> to prevent recursion into the node. If
148the code throws an exception, you get nothing back from this method.
149
150Either way, the return is a reference to the list of things found, a
151false (but defined) value if nothing was found, or C<undef> if an error
152occurred.
153
154=cut
155
156sub _find_routine {
157 my ( $want ) = @_;
158 ref $want eq 'CODE' and return $want;
159 ref $want and return;
160 $want =~ m/ \A PPIx::Regexp:: /smx
161 or $want = 'PPIx::Regexp::' . $want;
162 return sub {
163 return __instance( $_[1], $want ) ? 1 : 0;
164 };
165}
166
167sub find {
168 my ( $self, $want ) = @_;
169
170 $want = _find_routine( $want ) or return;
171
172 my @found;
173
174 # We use a recursion to find what we want. PPI::Node uses an
175 # iteration.
176 foreach my $elem ( $self->elements() ) {
177 my $rslt = eval { $want->( $self, $elem ) }
178 and push @found, $elem;
179 $@ and return;
180
181 __instance( $elem, 'PPIx::Regexp::Node' ) or next;
182 defined $rslt or next;
183 $rslt = $elem->find( $want )
184 and push @found, @{ $rslt };
185 }
186
187 return @found ? \@found : 0;
188
189}
190
191=head2 find_parents
192
193 my $rslt = $node->find_parents( sub {
194 return $_[1]->isa( 'PPIx::Regexp::Token::Operator' )
195 && $_[1]->content() eq '|';
196 } );
197
198This convenience method takes the same arguments as C<find>, but instead
199of the found objects themselves returns their parents. No parent will
200appear more than once in the output.
201
202The return is a reference to the array of parents if any were found. If
203none were found the return is false but defined. If an error occurred
204the return is C<undef>.
205
206=cut
207
208sub find_parents {
209 my ( $self, $want ) = @_;
210
211 my $found;
212 $found = $self->find( $want ) or return $found;
213
214 my %parents;
215 my @rslt;
216 foreach my $elem ( @{ $found } ) {
217 my $dad = $elem->parent() or next;
218 $parents{ refaddr( $dad ) }++
219 or push @rslt, $dad;
220 }
221
222 return \@rslt;
223}
224
225=head2 find_first
226
227This method has the same arguments as L</find>, but returns either a
228reference to the first element found, a false (but defined) value if no
229elements were found, or C<undef> if an error occurred.
230
231=cut
232
233sub find_first {
234 my ( $self, $want ) = @_;
235
236 $want = _find_routine( $want ) or return;
237
238 # We use a recursion to find what we want. PPI::Node uses an
239 # iteration.
240 foreach my $elem ( $self->elements() ) {
241 my $rslt = eval { $want->( $self, $elem ) }
242 and return $elem;
243 $@ and return;
244
245 __instance( $elem, 'PPIx::Regexp::Node' ) or next;
246 defined $rslt or next;
247
248 defined( $rslt = $elem->find_first( $want ) )
249 or return;
250 $rslt and return $rslt;
251 }
252
253 return 0;
254
255}
256
257=head2 first_element
258
259This method returns the first element in the node.
260
261=cut
262
263sub first_element {
264 my ( $self ) = @_;
265 return $self->{children}[0];
266}
267
268=head2 last_element
269
270This method returns the last element in the node.
271
272=cut
273
274sub last_element {
275 my ( $self ) = @_;
276 return $self->{children}[-1];
277}
278
279=head2 perl_version_introduced
280
281This method returns the maximum value of C<perl_version_introduced>
282returned by any of its elements. In other words, it returns the minimum
283version of Perl under which this node is valid. If there are no
284elements, 5.000 is returned, since that is the minimum value of Perl
285supported by this package.
286
287=cut
288
289sub perl_version_introduced {
290 my ( $self ) = @_;
291 return max( MINIMUM_PERL,
292 map { $_->perl_version_introduced() } $self->elements() );
293}
294
295=head2 perl_version_removed
296
297This method returns the minimum defined value of C<perl_version_removed>
298returned by any of the node's elements. In other words, it returns the
299lowest version of Perl in which this node is C<not> valid. If there are
300no elements, or if no element has a defined C<perl_version_removed>,
301C<undef> is returned.
302
303=cut
304
305sub perl_version_removed {
306 my ( $self ) = @_;
307 my $max;
308 foreach my $elem ( $self->elements() ) {
309 if ( defined ( my $ver = $elem->perl_version_removed() ) ) {
310 if ( defined $max ) {
311 $ver < $max and $max = $ver;
312 } else {
313 $max = $ver;
314 }
315 }
316 }
317 return $max;
318}
319
320=head2 schild
321
322This method returns the significant child at the given index; that is,
323C<< $node->schild(0) >> returns the first significant child,
324C<< $node->schild(1) >> returns the second significant child, and so on.
325Negative indices count from the end.
326
327=cut
328
329sub schild {
330 my ( $self, $inx ) = @_;
331 defined $inx or $inx = 0;
332
333 my $kids = $self->{children};
334
335 if ( $inx >= 0 ) {
336
337 my $loc = 0;
338
339 while ( exists $kids->[$loc] ) {
340 $kids->[$loc]->significant() or next;
341 --$inx >= 0 and next;
342 return $kids->[$loc];
343 } continue {
344 $loc++;
345 }
346
347 } else {
348
349 my $loc = -1;
350
351 while ( exists $kids->[$loc] ) {
352 $kids->[$loc]->significant() or next;
353 $inx++ < -1 and next;
354 return $kids->[$loc];
355 } continue {
356 --$loc;
357 }
358
359 }
360
361 return;
362}
363
364=head2 schildren
365
366This method returns the significant children of the node.
367
368=cut
369
370sub schildren {
371 my ( $self ) = @_;
372 if ( wantarray ) {
373 return ( grep { $_->significant() } @{ $self->{children} } );
374 } elsif ( defined wantarray ) {
375 my $kids = 0;
376 foreach ( @{ $self->{children} } ) {
377 $_->significant() and $kids++;
378 }
379 return $kids;
380 } else {
381 return;
382 }
383}
384
385sub tokens {
386 my ( $self ) = @_;
387 return ( map { $_->tokens() } $self->elements() );
388}
389
390sub unescaped_content {
391 my ( $self ) = @_;
392 return join '', map { $_->unescaped_content() } $self->elements();
393}
394
395# Help for nav();
396sub _nav {
397 my ( $self, $child ) = @_;
398 refaddr( $child->parent() ) == refaddr( $self )
399 or return;
400 my ( $method, $inx ) = $child->_my_inx()
401 or return;
402
403 return ( $method => [ $inx ] );
404}
405
406# Called by the lexer once it has done its worst to all the tokens.
407# Called as a method with no arguments. The return is the number of
408# parse failures discovered when finalizing.
409sub __PPIX_LEXER__finalize {
410 my ( $self ) = @_;
411 my $rslt = 0;
412 foreach my $elem ( $self->elements() ) {
413 $rslt += $elem->__PPIX_LEXER__finalize();
414 }
415 return $rslt;
416}
417
418# Called by the lexer to record the capture number.
419sub __PPIX_LEXER__record_capture_number {
420 my ( $self, $number ) = @_;
421 foreach my $kid ( $self->children() ) {
422 $number = $kid->__PPIX_LEXER__record_capture_number( $number );
423 }
424 return $number;
425}
426
42713µs1;
428
429__END__
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.