← 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/Structure.pm
StatementsExecuted 16 statements in 977µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11112µs23µsPPIx::Regexp::Structure::::BEGIN@45PPIx::Regexp::Structure::BEGIN@45
1118µs28µsPPIx::Regexp::Structure::::BEGIN@50PPIx::Regexp::Structure::BEGIN@50
1117µs11µsPPIx::Regexp::Structure::::BEGIN@46PPIx::Regexp::Structure::BEGIN@46
1117µs58µsPPIx::Regexp::Structure::::BEGIN@48PPIx::Regexp::Structure::BEGIN@48
1117µs25µsPPIx::Regexp::Structure::::BEGIN@51PPIx::Regexp::Structure::BEGIN@51
1117µs25µsPPIx::Regexp::Structure::::BEGIN@53PPIx::Regexp::Structure::BEGIN@53
1116µs24µsPPIx::Regexp::Structure::::BEGIN@52PPIx::Regexp::Structure::BEGIN@52
0000s0sPPIx::Regexp::Structure::::__errorPPIx::Regexp::Structure::__error
0000s0sPPIx::Regexp::Structure::::_check_for_interpolated_matchPPIx::Regexp::Structure::_check_for_interpolated_match
0000s0sPPIx::Regexp::Structure::::_newPPIx::Regexp::Structure::_new
0000s0sPPIx::Regexp::Structure::::elementsPPIx::Regexp::Structure::elements
0000s0sPPIx::Regexp::Structure::::finishPPIx::Regexp::Structure::finish
0000s0sPPIx::Regexp::Structure::::first_elementPPIx::Regexp::Structure::first_element
0000s0sPPIx::Regexp::Structure::::last_elementPPIx::Regexp::Structure::last_element
0000s0sPPIx::Regexp::Structure::::startPPIx::Regexp::Structure::start
0000s0sPPIx::Regexp::Structure::::typePPIx::Regexp::Structure::type
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::Structure - Represent a structure.
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::Structure> is a
13L<PPIx::Regexp::Node|PPIx::Regexp::Node>.
14
15C<PPIx::Regexp::Structure> is the parent of
16L<PPIx::Regexp::Structure::Assertion|PPIx::Regexp::Structure::Assertion>,
17L<PPIx::Regexp::Structure::BranchReset|PPIx::Regexp::Structure::BranchReset>,
18L<PPIx::Regexp::Structure::Capture|PPIx::Regexp::Structure::Capture>,
19L<PPIx::Regexp::Structure::CharClass|PPIx::Regexp::Structure::CharClass>,
20L<PPIx::Regexp::Structure::Code|PPIx::Regexp::Structure::Code>,
21L<PPIx::Regexp::Structure::Main|PPIx::Regexp::Structure::Main>,
22L<PPIx::Regexp::Structure::Modifier|PPIx::Regexp::Structure::Modifier>,
23L<PPIx::Regexp::Structure::Quantifier|PPIx::Regexp::Structure::Quantifier>,
24L<PPIx::Regexp::Structure::Subexpression|PPIx::Regexp::Structure::Subexpression>,
25L<PPIx::Regexp::Structure::Switch|PPIx::Regexp::Structure::Switch> and
26L<PPIx::Regexp::Structure::Unknown|PPIx::Regexp::Structure::Unknown>.
27
28=head1 DESCRIPTION
29
30This class represents a bracketed construction of some sort. The
31brackets considered part of the structure, but not inside it. So the
32C<elements()> method returns the brackets if they are defined, but the
33C<children()> method does not.
34
35=head1 METHODS
36
37This class provides the following public methods. Methods not documented
38here are private, and unsupported in the sense that the author reserves
39the right to change or remove them without notice.
40
41=cut
42
43package PPIx::Regexp::Structure;
44
45220µs235µs
# spent 23µs (12+11) within PPIx::Regexp::Structure::BEGIN@45 which was called: # once (12µs+11µs) by PPIx::Regexp::Lexer::BEGIN@44 at line 45
use strict;
# spent 23µs making 1 call to PPIx::Regexp::Structure::BEGIN@45 # spent 11µs making 1 call to strict::import
46220µs216µs
# spent 11µs (7+4) within PPIx::Regexp::Structure::BEGIN@46 which was called: # once (7µs+4µs) by PPIx::Regexp::Lexer::BEGIN@44 at line 46
use warnings;
# spent 11µs making 1 call to PPIx::Regexp::Structure::BEGIN@46 # spent 4µs making 1 call to warnings::import
47
48224µs2109µs
# spent 58µs (7+51) within PPIx::Regexp::Structure::BEGIN@48 which was called: # once (7µs+51µs) by PPIx::Regexp::Lexer::BEGIN@44 at line 48
use base qw{ PPIx::Regexp::Node };
# spent 58µs making 1 call to PPIx::Regexp::Structure::BEGIN@48 # spent 51µs making 1 call to base::import
49
50221µs250µs
# spent 28µs (8+21) within PPIx::Regexp::Structure::BEGIN@50 which was called: # once (8µs+21µs) by PPIx::Regexp::Lexer::BEGIN@44 at line 50
use Carp qw{ confess };
# spent 28µs making 1 call to PPIx::Regexp::Structure::BEGIN@50 # spent 21µs making 1 call to Exporter::import
51219µs242µs
# spent 25µs (7+18) within PPIx::Regexp::Structure::BEGIN@51 which was called: # once (7µs+18µs) by PPIx::Regexp::Lexer::BEGIN@44 at line 51
use PPIx::Regexp::Constant qw{ STRUCTURE_UNKNOWN };
# spent 25µs making 1 call to PPIx::Regexp::Structure::BEGIN@51 # spent 18µs making 1 call to Exporter::import
52220µs241µs
# spent 24µs (6+17) within PPIx::Regexp::Structure::BEGIN@52 which was called: # once (6µs+17µs) by PPIx::Regexp::Lexer::BEGIN@44 at line 52
use PPIx::Regexp::Util qw{ __instance };
# spent 24µs making 1 call to PPIx::Regexp::Structure::BEGIN@52 # spent 17µs making 1 call to Exporter::import
532850µs244µs
# spent 25µs (7+19) within PPIx::Regexp::Structure::BEGIN@53 which was called: # once (7µs+19µs) by PPIx::Regexp::Lexer::BEGIN@44 at line 53
use Scalar::Util qw{ refaddr };
# spent 25µs making 1 call to PPIx::Regexp::Structure::BEGIN@53 # spent 18µs making 1 call to Exporter::import
54
551700nsour $VERSION = '0.036';
56
57sub _new {
58 my ( $class, @args ) = @_;
59 my %brkt;
60 if ( ref $args[0] eq 'HASH' ) {
61 %brkt = %{ shift @args };
62 foreach my $key ( qw{ start type finish } ) {
63 ref $brkt{$key} eq 'ARRAY' or $brkt{$key} = [ $brkt{$key} ];
64 }
65 } else {
66 $brkt{finish} = [ @args ? pop @args : () ];
67 $brkt{start} = [ @args ? shift @args : () ];
68 while ( @args && ! $args[0]->significant() ) {
69 push @{ $brkt{start} }, shift @args;
70 }
71 $brkt{type} = [];
72 if ( __instance( $args[0], 'PPIx::Regexp::Token::GroupType' ) ) {
73 push @{ $brkt{type} }, shift @args;
74 while ( @args && ! $args[0]->significant() ) {
75 push @{ $brkt{type} }, shift @args;
76 }
77 }
78 }
79
80 $class->_check_for_interpolated_match( \%brkt, \@args );
81
82 my $self = $class->SUPER::_new( @args )
83 or return;
84
85 if ( __instance( $brkt{type}[0], 'PPIx::Regexp::Token::GroupType' ) ) {
86 ( my $reclass = ref $brkt{type}[0] ) =~
87 s/ Token::GroupType /Structure/smx;
88 $reclass->can( 'start' )
89 or confess "Programming error - $reclass not loaded";
90 bless $self, $reclass;
91 }
92
93 foreach my $key ( qw{ start type finish } ) {
94 $self->{$key} = [];
95 ref $brkt{$key} eq 'ARRAY'
96 or confess "Programming error - '$brkt{$key}' not an ARRAY";
97 foreach my $val ( @{ $brkt{$key} } ) {
98 defined $val or next;
99 __instance( $val, 'PPIx::Regexp::Element' )
100 or confess "Programming error - '$val' not a ",
101 "PPIx::Regexp::Element";
102 push @{ $self->{$key} }, $val;
103 $val->_parent( $self );
104 }
105 }
106 return $self;
107}
108
109sub elements {
110 my ( $self ) = @_;
111
112 if ( wantarray ) {
113 return (
114 @{ $self->{start} },
115 @{ $self->{type} },
116 @{ $self->{children} },
117 @{ $self->{finish} },
118 );
119 } elsif ( defined wantarray ) {
120 my $size = scalar @{ $self->{start} };
121 $size += scalar @{ $self->{type} };
122 $size += scalar @{ $self->{children} };
123 $size += scalar @{ $self->{finish} };
124 return $size;
125 } else {
126 return;
127 }
128}
129
130=head2 finish
131
132 my $elem = $struct->finish();
133 my @elem = $struct->finish();
134 my $elem = $struct->finish( 0 );
135
136Returns the finishing structure element. This is included in the
137C<elements> but not in the C<children>.
138
139The finishing element is actually an array, though it should never have
140more than one element. Calling C<finish> in list context gets you all
141elements of the array. Calling it in scalar context gets you an element
142of the array, defaulting to element 0 if no argument is passed.
143
144=cut
145
146sub finish {
147 my ( $self, $inx ) = @_;
148 wantarray and return @{ $self->{finish} };
149 return $self->{finish}[ defined $inx ? $inx : 0 ];
150}
151
152sub first_element {
153 my ( $self ) = @_;
154
155 $self->{start}[0] and return $self->{start}[0];
156
157 $self->{type}[0] and return $self->{type}[0];
158
159 if ( my $elem = $self->SUPER::first_element() ) {
160 return $elem;
161 }
162
163 $self->{finish}[0] and return $self->{finish}[0];
164
165 return;
166}
167
168sub last_element {
169 my ( $self ) = @_;
170
171 $self->{finish}[-1] and return $self->{finish}[-1];
172
173 if ( my $elem = $self->SUPER::last_element() ) {
174 return $elem;
175 }
176
177 $self->{type}[-1] and return $self->{type}[-1];
178
179 $self->{start}[-1] and return $self->{start}[-1];
180
181 return;
182}
183
184=head2 start
185
186 my $elem = $struct->start();
187 my @elem = $struct->start();
188 my $elem = $struct->start( 0 );
189
190Returns the starting structure element. This is included in the
191C<elements> but not in the C<children>.
192
193The starting element is actually an array. The first element (element 0)
194is the actual starting delimiter. Subsequent elements, if any, are
195insignificant elements (comments or white space) absorbed into the start
196element for ease of parsing subsequent elements.
197
198Calling C<start> in list context gets you all elements of the array.
199Calling it in scalar context gets you an element of the array,
200defaulting to element 0 if no argument is passed.
201
202=cut
203
204sub start {
205 my ( $self, $inx ) = @_;
206 wantarray and return @{ $self->{start} };
207 return $self->{start}[ defined $inx ? $inx : 0 ];
208}
209
210=head2 type
211
212 my $elem = $struct->type();
213 my @elem = $struct->type();
214 my $elem = $struct->type( 0 );
215
216Returns the group type if any. This will be the leading
217L<PPIx::Regexp::Token::GroupType|PPIx::Regexp::Token::GroupType>
218token if any. This is included in C<elements> but not in C<children>.
219
220The type is actually an array. The first element (element 0) is the
221actual type determiner. Subsequent elements, if any, are insignificant
222elements (comments or white space) absorbed into the type element for
223consistency with the way the start element is handled.
224
225Calling C<type> in list context gets you all elements of the array.
226Calling it in scalar context gets you an element of the array,
227defaulting to element 0 if no argument is passed.
228
229=cut
230
231sub type {
232 my ( $self, $inx ) = @_;
233 wantarray and return @{ $self->{type} };
234 return $self->{type}[ defined $inx ? $inx : 0 ];
235}
236
237# Check for things like (?$foo:...) or (?$foo)
238sub _check_for_interpolated_match {
239 my ( $class, $brkt, $args ) = @_;
240
241 # Everything we are interested in begins with a literal '?' followed
242 # by an interpolation.
243 __instance( $args->[0], 'PPIx::Regexp::Token::Unknown' )
244 and $args->[0]->content() eq '?'
245 and __instance( $args->[1], 'PPIx::Regexp::Token::Interpolation' )
246 or return;
247
248 my $hiwater = 2; # Record how far we got into the arguments for
249 # subsequent use detecting things like
250 # (?$foo).
251
252 # If we have a literal ':' as the third argument:
253 # GroupType::Modifier, rebless the ':' so we know not to match
254 # against it, and splice all three tokens into the type.
255 if ( __instance( $args->[2], 'PPIx::Regexp::Token::Literal' )
256 && $args->[2]->content() eq ':' ) {
257
258 # Rebless the '?' as a GroupType::Modifier.
259 bless $args->[0], 'PPIx::Regexp::Token::GroupType::Modifier';
260 # Note that we do _not_ want __PPIX_TOKEN__post_make here.
261
262 # Rebless the ':' as a GroupType, just so it does not look like
263 # something to match against.
264 bless $args->[2], 'PPIx::Regexp::Token::GroupType';
265
266 # Shove our three significant tokens into the type.
267 push @{ $brkt->{type} }, splice @{ $args }, 0, 3;
268
269 # Stuff all the immediately-following insignificant tokens into
270 # the type as well.
271 while ( @{ $args } && ! $args->[0]->significant() ) {
272 push @{ $brkt->{type} }, shift @{ $args };
273 }
274
275 # Return to the caller, since we have done all the damage we
276 # can.
277 return;
278 }
279
280 # If we have a literal '-' as the third argument, we might have
281 # something like (?$on-$off:$foo).
282 if ( __instance( $args->[2], 'PPIx::Regexp::Token::Literal' )
283 && $args->[2]->content() eq '-'
284 && __instance( $args->[3], 'PPIx::Regexp::Token::Interpolation' )
285 ) {
286 $hiwater = 4;
287
288 if ( __instance( $args->[4], 'PPIx::Regexp::Token::Literal' )
289 && $args->[4]->content() eq ':' ) {
290
291 # Rebless the '?' as a GroupType::Modifier.
292 bless $args->[0], 'PPIx::Regexp::Token::GroupType::Modifier';
293 # Note that we do _not_ want __PPIX_TOKEN__post_make here.
294
295 # Rebless the '-' and ':' as GroupType, just so they do not
296 # look like something to match against.
297 bless $args->[2], 'PPIx::Regexp::Token::GroupType';
298 bless $args->[4], 'PPIx::Regexp::Token::GroupType';
299
300 # Shove our five significant tokens into the type.
301 push @{ $brkt->{type} }, splice @{ $args }, 0, 5;
302
303 # Stuff all the immediately-following insignificant tokens
304 # into the type as well.
305 while ( @{ $args } && ! $args->[0]->significant() ) {
306 push @{ $brkt->{type} }, shift @{ $args };
307 }
308
309 # Return to the caller, since we have done all the damage we
310 # can.
311 return;
312 }
313 }
314
315 # If the group contains _any_ significant tokens at this point, we
316 # do _not_ have something like (?$foo).
317 foreach my $inx ( $hiwater .. $#$args ) {
318 $args->[$inx]->significant() and return;
319 }
320
321 # Rebless the '?' as a GroupType::Modifier.
322 bless $args->[0], 'PPIx::Regexp::Token::GroupType::Modifier';
323 # Note that we do _not_ want __PPIX_TOKEN__post_make here.
324
325 # Shove all the contents of $args into type, using splice to leave
326 # @{ $args } empty after we do this.
327 push @{ $brkt->{type} }, splice @{ $args };
328
329 # We have done all the damage we can.
330 return;
331}
332
333sub __error {
334 my ( $self, $msg ) = @_;
335 defined $msg
336 or $msg = 'Was class ' . ref $self;
337 $self->{error} = $msg;
338 bless $self, STRUCTURE_UNKNOWN;
339 return 1;
340}
341
34212µs1;
343
344__END__
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.