← 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/Element.pm
StatementsExecuted 22 statements in 1.24ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111322µs840µsPPIx::Regexp::Element::::BEGIN@43PPIx::Regexp::Element::BEGIN@43
111237µs430µsPPIx::Regexp::Element::::BEGIN@40PPIx::Regexp::Element::BEGIN@40
11112µs23µsPPIx::Regexp::Element::::BEGIN@33PPIx::Regexp::Element::BEGIN@33
11110µs10µsPPIx::Regexp::Element::::BEGIN@36PPIx::Regexp::Element::BEGIN@36
1119µs175µsPPIx::Regexp::Element::::BEGIN@39PPIx::Regexp::Element::BEGIN@39
1118µs38µsPPIx::Regexp::Element::::BEGIN@38PPIx::Regexp::Element::BEGIN@38
1117µs30µsPPIx::Regexp::Element::::BEGIN@41PPIx::Regexp::Element::BEGIN@41
1117µs11µsPPIx::Regexp::Element::::BEGIN@34PPIx::Regexp::Element::BEGIN@34
0000s0sPPIx::Regexp::Element::::DESTROYPPIx::Regexp::Element::DESTROY
0000s0sPPIx::Regexp::Element::::__ANON__[:407]PPIx::Regexp::Element::__ANON__[:407]
0000s0sPPIx::Regexp::Element::::__PPIX_LEXER__record_capture_numberPPIx::Regexp::Element::__PPIX_LEXER__record_capture_number
0000s0sPPIx::Regexp::Element::::__errorPPIx::Regexp::Element::__error
0000s0sPPIx::Regexp::Element::::__impose_defaultsPPIx::Regexp::Element::__impose_defaults
0000s0sPPIx::Regexp::Element::::_my_inxPPIx::Regexp::Element::_my_inx
0000s0sPPIx::Regexp::Element::::_parentPPIx::Regexp::Element::_parent
0000s0sPPIx::Regexp::Element::::_parent_keysPPIx::Regexp::Element::_parent_keys
0000s0sPPIx::Regexp::Element::::ancestor_ofPPIx::Regexp::Element::ancestor_of
0000s0sPPIx::Regexp::Element::::can_be_quantifiedPPIx::Regexp::Element::can_be_quantified
0000s0sPPIx::Regexp::Element::::classPPIx::Regexp::Element::class
0000s0sPPIx::Regexp::Element::::commentPPIx::Regexp::Element::comment
0000s0sPPIx::Regexp::Element::::contentPPIx::Regexp::Element::content
0000s0sPPIx::Regexp::Element::::descendant_ofPPIx::Regexp::Element::descendant_of
0000s0sPPIx::Regexp::Element::::errorPPIx::Regexp::Element::error
0000s0sPPIx::Regexp::Element::::is_quantifierPPIx::Regexp::Element::is_quantifier
0000s0sPPIx::Regexp::Element::::modifier_assertedPPIx::Regexp::Element::modifier_asserted
0000s0sPPIx::Regexp::Element::::navPPIx::Regexp::Element::nav
0000s0sPPIx::Regexp::Element::::next_siblingPPIx::Regexp::Element::next_sibling
0000s0sPPIx::Regexp::Element::::parentPPIx::Regexp::Element::parent
0000s0sPPIx::Regexp::Element::::perl_version_introducedPPIx::Regexp::Element::perl_version_introduced
0000s0sPPIx::Regexp::Element::::perl_version_removedPPIx::Regexp::Element::perl_version_removed
0000s0sPPIx::Regexp::Element::::previous_siblingPPIx::Regexp::Element::previous_sibling
0000s0sPPIx::Regexp::Element::::significantPPIx::Regexp::Element::significant
0000s0sPPIx::Regexp::Element::::snext_siblingPPIx::Regexp::Element::snext_sibling
0000s0sPPIx::Regexp::Element::::sprevious_siblingPPIx::Regexp::Element::sprevious_sibling
0000s0sPPIx::Regexp::Element::::tokensPPIx::Regexp::Element::tokens
0000s0sPPIx::Regexp::Element::::topPPIx::Regexp::Element::top
0000s0sPPIx::Regexp::Element::::unescaped_contentPPIx::Regexp::Element::unescaped_content
0000s0sPPIx::Regexp::Element::::whitespacePPIx::Regexp::Element::whitespace
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::Element - Base of the PPIx::Regexp hierarchy.
4
5=head1 SYNOPSIS
6
7No user-serviceable parts inside.
8
9=head1 INHERITANCE
10
11C<PPIx::Regexp::Element> is not descended from any other class.
12
13C<PPIx::Regexp::Element> is the parent of
14L<PPIx::Regexp::Node|PPIx::Regexp::Node> and
15L<PPIx::Regexp::Token|PPIx::Regexp::Token>.
16
17=head1 DESCRIPTION
18
19This class is the base of the L<PPIx::Regexp|PPIx::Regexp>
20object hierarchy. It provides the same kind of navigational
21functionality that is provided by L<PPI::Element|PPI::Element>.
22
23=head1 METHODS
24
25This class provides the following public methods. Methods not documented
26here are private, and unsupported in the sense that the author reserves
27the right to change or remove them without notice.
28
29=cut
30
31package PPIx::Regexp::Element;
32
33219µs235µs
# spent 23µs (12+11) within PPIx::Regexp::Element::BEGIN@33 which was called: # once (12µs+11µs) by base::import at line 33
use strict;
# spent 23µs making 1 call to PPIx::Regexp::Element::BEGIN@33 # spent 11µs making 1 call to strict::import
34219µs216µs
# spent 11µs (7+4) within PPIx::Regexp::Element::BEGIN@34 which was called: # once (7µs+4µs) by base::import at line 34
use warnings;
# spent 11µs making 1 call to PPIx::Regexp::Element::BEGIN@34 # spent 4µs making 1 call to warnings::import
35
36240µs110µs
# spent 10µs within PPIx::Regexp::Element::BEGIN@36 which was called: # once (10µs+0s) by base::import at line 36
use 5.006;
# spent 10µs making 1 call to PPIx::Regexp::Element::BEGIN@36
37
38226µs268µs
# spent 38µs (8+30) within PPIx::Regexp::Element::BEGIN@38 which was called: # once (8µs+30µs) by base::import at line 38
use Carp;
# spent 38µs making 1 call to PPIx::Regexp::Element::BEGIN@38 # spent 30µs making 1 call to Exporter::import
39225µs2340µs
# spent 175µs (9+166) within PPIx::Regexp::Element::BEGIN@39 which was called: # once (9µs+166µs) by base::import at line 39
use List::MoreUtils qw{ firstidx };
# spent 175µs making 1 call to PPIx::Regexp::Element::BEGIN@39 # spent 166µs making 1 call to Exporter::Tiny::import
40286µs2457µs
# spent 430µs (237+194) within PPIx::Regexp::Element::BEGIN@40 which was called: # once (237µs+194µs) by base::import at line 40
use PPIx::Regexp::Util qw{ __instance };
# spent 430µs making 1 call to PPIx::Regexp::Element::BEGIN@40 # spent 27µs making 1 call to Exporter::import
41222µs254µs
# spent 30µs (7+23) within PPIx::Regexp::Element::BEGIN@41 which was called: # once (7µs+23µs) by base::import at line 41
use Scalar::Util qw{ refaddr weaken };
# spent 30µs making 1 call to PPIx::Regexp::Element::BEGIN@41 # spent 23µs making 1 call to Exporter::import
42
432993µs2882µs
# spent 840µs (322+517) within PPIx::Regexp::Element::BEGIN@43 which was called: # once (322µs+517µs) by base::import at line 43
use PPIx::Regexp::Constant qw{ MINIMUM_PERL TOKEN_UNKNOWN };
# spent 840µs making 1 call to PPIx::Regexp::Element::BEGIN@43 # spent 43µs making 1 call to Exporter::import
44
451500nsour $VERSION = '0.036';
46
47=head2 ancestor_of
48
49This method returns true if the object is an ancestor of the argument,
50and false otherwise. By the definition of this method, C<$self> is its
51own ancestor.
52
53=cut
54
55sub ancestor_of {
56 my ( $self, $elem ) = @_;
57 __instance( $elem, __PACKAGE__ ) or return;
58 my $addr = refaddr( $self );
59 while ( $addr != refaddr( $elem ) ) {
60 $elem = $elem->_parent() or return;
61 }
62 return 1;
63}
64
65=head2 can_be_quantified
66
67 $token->can_be_quantified()
68 and print "This element can be quantified.\n";
69
70This method returns true if the element can be quantified.
71
72=cut
73
74sub can_be_quantified { return 1; }
75
76
77=head2 class
78
79This method returns the class name of the element. It is the same as
80C<ref $self>.
81
82=cut
83
84sub class {
85 my ( $self ) = @_;
86 return ref $self;
87}
88
89=head2 comment
90
91This method returns true if the element is a comment and false
92otherwise.
93
94=cut
95
96sub comment {
97 return;
98}
99
100=head2 content
101
102This method returns the content of the element.
103
104=cut
105
106sub content {
107 return;
108}
109
110=head2 descendant_of
111
112This method returns true if the object is a descendant of the argument,
113and false otherwise. By the definition of this method, C<$self> is its
114own descendant.
115
116=cut
117
118sub descendant_of {
119 my ( $self, $node ) = @_;
120 __instance( $node, __PACKAGE__ ) or return;
121 return $node->ancestor_of( $self );
122}
123
124=head2 error
125
126 say $token->error();
127
128If an element is one of the classes that represents a parse error, this
129method B<may> return a brief message saying why. Otherwise it will
130return C<undef>.
131
132=cut
133
134sub error {
135 my ( $self ) = @_;
136 return $self->{error};
137}
138
139
140=head2 is_quantifier
141
142 $token->is_quantifier()
143 and print "This element is a quantifier.\n";
144
145This method returns true if the element is a quantifier. You can not
146tell this from the element's class, because a right curly bracket may
147represent a quantifier for the purposes of figuring out whether a
148greediness token is possible.
149
150=cut
151
152sub is_quantifier { return; }
153
154=head2 modifier_asserted
155
156 $token->modifier_asserted( 'i' )
157 and print "Matched without regard to case.\n";
158
159This method returns true if the given modifier is in effect for the
160element, and false otherwise.
161
162What it does is to walk backwards from the element until it finds a
163modifier object that specifies the modifier, whether asserted or
164negated. and returns the specified value. If nobody specifies the
165modifier, it returns C<undef>.
166
167This method will not work reliably if called on tokenizer output.
168
169=cut
170
171sub modifier_asserted {
172 my ( $self, $modifier ) = @_;
173
174 defined $modifier
175 or croak 'Modifier must be defined';
176
177 my $elem = $self;
178
179 while ( $elem ) {
180 if ( $elem->can( '__ducktype_modifier_asserted' ) ) {
181 my $val;
182 defined( $val = $elem->__ducktype_modifier_asserted( $modifier ) )
183 and return $val;
184 }
185 if ( my $prev = $elem->sprevious_sibling() ) {
186 $elem = $prev;
187 } else {
188 $elem = $elem->parent();
189 }
190 }
191
192 return;
193}
194
195=head2 next_sibling
196
197This method returns the element's next sibling, or nothing if there is
198none.
199
200=cut
201
202sub next_sibling {
203 my ( $self ) = @_;
204 my ( $method, $inx ) = $self->_my_inx()
205 or return;
206 return $self->_parent()->$method( $inx + 1 );
207}
208
209=head2 parent
210
211This method returns the parent of the element, or undef if there is
212none.
213
214=cut
215
216sub parent {
217 my ( $self ) = @_;
218 return $self->_parent();
219}
220
221=head2 perl_version_introduced
222
223This method returns the version of Perl in which the element was
224introduced. This will be at least 5.000. Before 5.006 I am relying on
225the F<perldelta>, F<perlre>, and F<perlop> documentation, since I have
226been unable to build earlier Perls. Since I have found no documentation
227before 5.003, I assume that anything found in 5.003 is also in 5.000.
228
229Since this all depends on my ability to read and understand masses of
230documentation, the results of this method should be viewed with caution,
231if not downright skepticism.
232
233There are also cases which are ambiguous in various ways. For those see
234L<PPIx::Regexp/RESTRICTIONS>, and especially
235L<PPIx::Regexp/Changes in Syntax>.
236
237=cut
238
239sub perl_version_introduced {
240 return MINIMUM_PERL;
241}
242
243=head2 perl_version_removed
244
245This method returns the version of Perl in which the element was
246removed. If the element is still valid the return is C<undef>.
247
248All the I<caveats> to
249L<perl_version_introduced()|/perl_version_introduced> apply here also,
250though perhaps less severely since although many features have been
251introduced since 5.0, few have been removed.
252
253=cut
254
255sub perl_version_removed {
256 return undef; ## no critic (ProhibitExplicitReturnUndef)
257}
258
259=head2 previous_sibling
260
261This method returns the element's previous sibling, or nothing if there
262is none.
263
264=cut
265
266sub previous_sibling {
267 my ( $self ) = @_;
268 my ( $method, $inx ) = $self->_my_inx()
269 or return;
270 $inx or return;
271 return $self->_parent()->$method( $inx - 1 );
272}
273
274=head2 significant
275
276This method returns true if the element is significant and false
277otherwise.
278
279=cut
280
281sub significant {
282 return 1;
283}
284
285=head2 snext_sibling
286
287This method returns the element's next significant sibling, or nothing
288if there is none.
289
290=cut
291
292sub snext_sibling {
293 my ( $self ) = @_;
294 my $sib = $self;
295 while ( defined ( $sib = $sib->next_sibling() ) ) {
296 $sib->significant() and return $sib;
297 }
298 return;
299}
300
301=head2 sprevious_sibling
302
303This method returns the element's previous significant sibling, or
304nothing if there is none.
305
306=cut
307
308sub sprevious_sibling {
309 my ( $self ) = @_;
310 my $sib = $self;
311 while ( defined ( $sib = $sib->previous_sibling() ) ) {
312 $sib->significant() and return $sib;
313 }
314 return;
315}
316
317=head2 tokens
318
319This method returns all tokens contained in the element.
320
321=cut
322
323sub tokens {
324 my ( $self ) = @_;
325 return $self;
326}
327
328=head2 top
329
330This method returns the top of the hierarchy.
331
332=cut
333
334sub top {
335 my ( $self ) = @_;
336 my $kid = $self;
337 while ( defined ( my $parent = $kid->_parent() ) ) {
338 $kid = $parent;
339 }
340 return $kid;
341}
342
343=head2 unescaped_content
344
345This method returns the content of the element, unescaped.
346
347=cut
348
349sub unescaped_content {
350 return;
351}
352
353=head2 whitespace
354
355This method returns true if the element is whitespace and false
356otherwise.
357
358=cut
359
360sub whitespace {
361 return;
362}
363
364=head2 nav
365
366This method returns navigation information from the top of the hierarchy
367to this node. The return is a list of names of methods and references to
368their argument lists. The idea is that given C<$elem> which is somewhere
369under C<$top>,
370
371 my @nav = $elem->nav();
372 my $obj = $top;
373 while ( @nav ) {
374 my $method = shift @nav;
375 my $args = shift @nav;
376 $obj = $obj->$method( @{ $args } ) or die;
377 }
378 # At this point, $obj should contain the same object
379 # as $elem.
380
381=cut
382
383sub nav {
384 my ( $self ) = @_;
385 __instance( $self, __PACKAGE__ ) or return;
386
387 # We do not use $self->parent() here because PPIx::Regexp overrides
388 # this to return the (possibly) PPI object that initiated us.
389 my $parent = $self->_parent() or return;
390
391 return ( $parent->nav(), $parent->_nav( $self ) );
392}
393
394# Find our location and index among the parent's children. If not found,
395# just returns.
396
397{
39822µs my %method_map = (
399 children => 'child',
400 );
401 sub _my_inx {
402 my ( $self ) = @_;
403 my $parent = $self->_parent() or return;
404 my $addr = refaddr( $self );
405 foreach my $method ( qw{ children start type finish } ) {
406 $parent->can( $method ) or next;
407 my $inx = firstidx { refaddr $_ == $addr } $parent->$method();
408 $inx < 0 and next;
409 return ( $method_map{$method} || $method, $inx );
410 }
411 return;
412 }
413}
414
415{
4162300ns my %parent;
417
418 # no-argument form returns the parent; one-argument sets it.
419 sub _parent {
420 my ( $self, @arg ) = @_;
421 my $addr = refaddr( $self );
422 if ( @arg ) {
423 my $parent = shift @arg;
424 if ( defined $parent ) {
425 __instance( $parent, __PACKAGE__ ) or return;
426 weaken(
427 $parent{$addr} = $parent );
428 } else {
429 delete $parent{$addr};
430 }
431 }
432 return $parent{$addr};
433 }
434
435 sub _parent_keys {
436 return scalar keys %parent;
437 }
438
439}
440
441# $self->__impose_defaults( $arg, \%default );
442#
443# This method can be called in __PPIX_TOKEN__post_make() to supply
444# defaults for attributes. It returns nothing.
445#
446# The arguments are hash references, which are taken in left-to-right
447# order, with the, with the first extant value being used.
448
449sub __impose_defaults {
450 my ( $self, @args ) = @_;
451 foreach my $arg ( @args ) {
452 ref $arg eq 'HASH'
453 or next;
454 foreach my $key ( keys %{ $arg } ) {
455 exists $self->{$key}
456 or $self->{$key} = $arg->{$key};
457 }
458 }
459 return;
460}
461
462# Bless into TOKEN_UNKNOWN, record error message, return 1.
463sub __error {
464 my ( $self, $msg ) = @_;
465 $self->isa( 'PPIx::Token::Node' )
466 and confess 'Programming error - __error() must be overridden',
467 ' for class ', ref $self;
468 defined $msg
469 or $msg = 'Was ' . ref $self;
470 $self->{error} = $msg;
471 bless $self, TOKEN_UNKNOWN;
472 return 1;
473}
474
475# Called by the lexer to record the capture number.
476sub __PPIX_LEXER__record_capture_number {
477 my ( $self, $number ) = @_;
478 return $number;
479}
480
481sub DESTROY {
482 $_[0]->_parent( undef );
483 return;
484}
485
48613µs1;
487
488__END__
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.