| Filename | /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/PPI/Token/_QuoteEngine/Full.pm |
| Statements | Executed 41704 statements in 73.4ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1061 | 1 | 1 | 35.2ms | 119ms | PPI::Token::_QuoteEngine::Full::_fill |
| 1061 | 1 | 1 | 20.6ms | 24.2ms | PPI::Token::_QuoteEngine::Full::new |
| 956 | 1 | 1 | 10.7ms | 70.3ms | PPI::Token::_QuoteEngine::Full::_fill_braced |
| 105 | 1 | 1 | 1.52ms | 5.88ms | PPI::Token::_QuoteEngine::Full::_fill_normal |
| 1933 | 4 | 1 | 1.50ms | 1.50ms | PPI::Token::_QuoteEngine::Full::CORE:match (opcode) |
| 1 | 1 | 1 | 26µs | 26µs | PPI::Token::_QuoteEngine::Full::BEGIN@11 |
| 1 | 1 | 1 | 11µs | 22µs | PPI::Token::_QuoteEngine::Full::BEGIN@5 |
| 1 | 1 | 1 | 6µs | 58µs | PPI::Token::_QuoteEngine::Full::BEGIN@10 |
| 1 | 1 | 1 | 3µs | 3µs | PPI::Token::_QuoteEngine::Full::_sections |
| 1 | 1 | 1 | 3µs | 3µs | PPI::Token::_QuoteEngine::Full::BEGIN@6 |
| 1 | 1 | 1 | 3µs | 3µs | PPI::Token::_QuoteEngine::Full::BEGIN@7 |
| 1 | 1 | 1 | 2µs | 2µs | PPI::Token::_QuoteEngine::Full::BEGIN@8 |
| 0 | 0 | 0 | 0s | 0s | PPI::Token::_QuoteEngine::Full::_delimiters |
| 0 | 0 | 0 | 0s | 0s | PPI::Token::_QuoteEngine::Full::_modifiers |
| 0 | 0 | 0 | 0s | 0s | PPI::Token::_QuoteEngine::Full::_section_content |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package PPI::Token::_QuoteEngine::Full; | ||||
| 2 | |||||
| 3 | # Full quote engine | ||||
| 4 | |||||
| 5 | 2 | 18µs | 2 | 33µs | # spent 22µs (11+11) within PPI::Token::_QuoteEngine::Full::BEGIN@5 which was called:
# once (11µs+11µs) by PPI::Token::Quote::Literal::BEGIN@33 at line 5 # spent 22µs making 1 call to PPI::Token::_QuoteEngine::Full::BEGIN@5
# spent 11µs making 1 call to strict::import |
| 6 | 2 | 15µs | 1 | 3µs | # spent 3µs within PPI::Token::_QuoteEngine::Full::BEGIN@6 which was called:
# once (3µs+0s) by PPI::Token::Quote::Literal::BEGIN@33 at line 6 # spent 3µs making 1 call to PPI::Token::_QuoteEngine::Full::BEGIN@6 |
| 7 | 2 | 15µs | 1 | 3µs | # spent 3µs within PPI::Token::_QuoteEngine::Full::BEGIN@7 which was called:
# once (3µs+0s) by PPI::Token::Quote::Literal::BEGIN@33 at line 7 # spent 3µs making 1 call to PPI::Token::_QuoteEngine::Full::BEGIN@7 |
| 8 | 2 | 22µs | 1 | 2µs | # spent 2µs within PPI::Token::_QuoteEngine::Full::BEGIN@8 which was called:
# once (2µs+0s) by PPI::Token::Quote::Literal::BEGIN@33 at line 8 # spent 2µs making 1 call to PPI::Token::_QuoteEngine::Full::BEGIN@8 |
| 9 | |||||
| 10 | 2 | 131µs | 2 | 109µs | # spent 58µs (6+51) within PPI::Token::_QuoteEngine::Full::BEGIN@10 which was called:
# once (6µs+51µs) by PPI::Token::Quote::Literal::BEGIN@33 at line 10 # spent 58µs making 1 call to PPI::Token::_QuoteEngine::Full::BEGIN@10
# spent 51µs making 1 call to vars::import |
| 11 | # spent 26µs within PPI::Token::_QuoteEngine::Full::BEGIN@11 which was called:
# once (26µs+0s) by PPI::Token::Quote::Literal::BEGIN@33 at line 48 | ||||
| 12 | 1 | 400ns | $VERSION = '1.215'; | ||
| 13 | 1 | 7µs | @ISA = 'PPI::Token::_QuoteEngine'; | ||
| 14 | |||||
| 15 | # Prototypes for the different braced sections | ||||
| 16 | 1 | 4µs | %sections = ( | ||
| 17 | '(' => { type => '()', _close => ')' }, | ||||
| 18 | '<' => { type => '<>', _close => '>' }, | ||||
| 19 | '[' => { type => '[]', _close => ']' }, | ||||
| 20 | '{' => { type => '{}', _close => '}' }, | ||||
| 21 | ); | ||||
| 22 | |||||
| 23 | # For each quote type, the extra fields that should be set. | ||||
| 24 | # This should give us faster initialization. | ||||
| 25 | 1 | 15µs | %quotes = ( | ||
| 26 | 'q' => { operator => 'q', braced => undef, separator => undef, _sections => 1 }, | ||||
| 27 | 'qq' => { operator => 'qq', braced => undef, separator => undef, _sections => 1 }, | ||||
| 28 | 'qx' => { operator => 'qx', braced => undef, separator => undef, _sections => 1 }, | ||||
| 29 | 'qw' => { operator => 'qw', braced => undef, separator => undef, _sections => 1 }, | ||||
| 30 | 'qr' => { operator => 'qr', braced => undef, separator => undef, _sections => 1, modifiers => 1 }, | ||||
| 31 | 'm' => { operator => 'm', braced => undef, separator => undef, _sections => 1, modifiers => 1 }, | ||||
| 32 | 's' => { operator => 's', braced => undef, separator => undef, _sections => 2, modifiers => 1 }, | ||||
| 33 | 'tr' => { operator => 'tr', braced => undef, separator => undef, _sections => 2, modifiers => 1 }, | ||||
| 34 | |||||
| 35 | # Y is the little used varient of tr | ||||
| 36 | 'y' => { operator => 'y', braced => undef, separator => undef, _sections => 2, modifiers => 1 }, | ||||
| 37 | |||||
| 38 | '/' => { operator => undef, braced => 0, separator => '/', _sections => 1, modifiers => 1 }, | ||||
| 39 | |||||
| 40 | # Angle brackets quotes mean "readline(*FILEHANDLE)" | ||||
| 41 | '<' => { operator => undef, braced => 1, separator => undef, _sections => 1, }, | ||||
| 42 | |||||
| 43 | # The final ( and kind of depreciated ) "first match only" one is not | ||||
| 44 | # used yet, since I'm not sure on the context differences between | ||||
| 45 | # this and the trinary operator, but its here for completeness. | ||||
| 46 | '?' => { operator => undef, braced => 0, separator => '?', _sections => 1, modifiers => 1 }, | ||||
| 47 | ); | ||||
| 48 | 1 | 961µs | 1 | 26µs | } # spent 26µs making 1 call to PPI::Token::_QuoteEngine::Full::BEGIN@11 |
| 49 | |||||
| 50 | =pod | ||||
| 51 | |||||
| 52 | =begin testing new 90 | ||||
| 53 | |||||
| 54 | # Verify that Token::Quote, Token::QuoteLike and Token::Regexp | ||||
| 55 | # do not have ->new functions | ||||
| 56 | my $RE_SYMBOL = qr/\A(?!\d)\w+\z/; | ||||
| 57 | foreach my $name ( qw{Token::Quote Token::QuoteLike Token::Regexp} ) { | ||||
| 58 | no strict 'refs'; | ||||
| 59 | my @functions = sort | ||||
| 60 | grep { defined &{"${name}::$_"} } | ||||
| 61 | grep { /$RE_SYMBOL/o } | ||||
| 62 | keys %{"PPI::${name}::"}; | ||||
| 63 | is( scalar(grep { $_ eq 'new' } @functions), 0, | ||||
| 64 | "$name does not have a new function" ); | ||||
| 65 | } | ||||
| 66 | |||||
| 67 | # This primarily to ensure that qw() with non-balanced types | ||||
| 68 | # are treated the same as those with balanced types. | ||||
| 69 | SCOPE: { | ||||
| 70 | my @seps = ( undef, undef, '/', '#', ',' ); | ||||
| 71 | my @types = ( '()', '<>', '//', '##', ',,' ); | ||||
| 72 | my @braced = ( qw{ 1 1 0 0 0 } ); | ||||
| 73 | my $i = 0; | ||||
| 74 | for my $q ('qw()', 'qw<>', 'qw//', 'qw##', 'qw,,') { | ||||
| 75 | my $d = PPI::Document->new(\$q); | ||||
| 76 | my $o = $d->{children}->[0]->{children}->[0]; | ||||
| 77 | my $s = $o->{sections}->[0]; | ||||
| 78 | is( $o->{operator}, 'qw', "$q correct operator" ); | ||||
| 79 | is( $o->{_sections}, 1, "$q correct _sections" ); | ||||
| 80 | is( $o->{braced}, $braced[$i], "$q correct braced" ); | ||||
| 81 | is( $o->{separator}, $seps[$i], "$q correct seperator" ); | ||||
| 82 | is( $o->{content}, $q, "$q correct content" ); | ||||
| 83 | is( $s->{position}, 3, "$q correct position" ); | ||||
| 84 | is( $s->{type}, $types[$i], "$q correct type" ); | ||||
| 85 | is( $s->{size}, 0, "$q correct size" ); | ||||
| 86 | $i++; | ||||
| 87 | } | ||||
| 88 | } | ||||
| 89 | |||||
| 90 | SCOPE: { | ||||
| 91 | my @stuff = ( qw-( ) < > / / -, '#', '#', ',',',' ); | ||||
| 92 | my @seps = ( undef, undef, '/', '#', ',' ); | ||||
| 93 | my @types = ( '()', '<>', '//', '##', ',,' ); | ||||
| 94 | my @braced = ( qw{ 1 1 0 0 0 } ); | ||||
| 95 | my @secs = ( qw{ 1 1 0 0 0 } ); | ||||
| 96 | my $i = 0; | ||||
| 97 | while ( @stuff ) { | ||||
| 98 | my $opener = shift @stuff; | ||||
| 99 | my $closer = shift @stuff; | ||||
| 100 | my $d = PPI::Document->new(\"qw$opener"); | ||||
| 101 | my $o = $d->{children}->[0]->{children}->[0]; | ||||
| 102 | my $s = $o->{sections}->[0]; | ||||
| 103 | is( $o->{operator}, 'qw', "qw$opener correct operator" ); | ||||
| 104 | is( $o->{_sections}, $secs[$i], "qw$opener correct _sections" ); | ||||
| 105 | is( $o->{braced}, $braced[$i], "qw$opener correct braced" ); | ||||
| 106 | is( $o->{separator}, $seps[$i], "qw$opener correct seperator" ); | ||||
| 107 | is( $o->{content}, "qw$opener", "qw$opener correct content" ); | ||||
| 108 | if ( $secs[$i] ) { | ||||
| 109 | is( $s->{type}, "$opener$closer", "qw$opener correct type" ); | ||||
| 110 | } | ||||
| 111 | $i++; | ||||
| 112 | } | ||||
| 113 | } | ||||
| 114 | |||||
| 115 | SCOPE: { | ||||
| 116 | foreach ( | ||||
| 117 | [ '/foo/i', 'foo', undef, { i => 1 }, [ '//' ] ], | ||||
| 118 | [ 'm<foo>x', 'foo', undef, { x => 1 }, [ '<>' ] ], | ||||
| 119 | [ 's{foo}[bar]g', 'foo', 'bar', { g => 1 }, [ '{}', '[]' ] ], | ||||
| 120 | [ 'tr/fo/ba/', 'fo', 'ba', {}, [ '//', '//' ] ], | ||||
| 121 | [ 'qr{foo}smx', 'foo', undef, { s => 1, m => 1, x => 1 }, | ||||
| 122 | [ '{}' ] ], | ||||
| 123 | ) { | ||||
| 124 | my ( $code, $match, $subst, $mods, $delims ) = @{ $_ }; | ||||
| 125 | my $doc = PPI::Document->new( \$code ); | ||||
| 126 | $doc or warn "'$code' did not create a document"; | ||||
| 127 | my $obj = $doc->child( 0 )->child( 0 ); | ||||
| 128 | is( $obj->_section_content( 0 ), $match, "$code correct match" ); | ||||
| 129 | is( $obj->_section_content( 1 ), $subst, "$code correct subst" ); | ||||
| 130 | is_deeply( { $obj->_modifiers() }, $mods, "$code correct modifiers" ); | ||||
| 131 | is_deeply( [ $obj->_delimiters() ], $delims, "$code correct delimiters" ); | ||||
| 132 | } | ||||
| 133 | } | ||||
| 134 | |||||
| 135 | =end testing | ||||
| 136 | |||||
| 137 | =cut | ||||
| 138 | |||||
| 139 | # spent 24.2ms (20.6+3.63) within PPI::Token::_QuoteEngine::Full::new which was called 1061 times, avg 23µs/call:
# 1061 times (20.6ms+3.63ms) by PPI::Tokenizer::_new_token at line 623 of PPI/Tokenizer.pm, avg 23µs/call | ||||
| 140 | 1061 | 398µs | my $class = shift; | ||
| 141 | 1061 | 483µs | my $init = defined $_[0] | ||
| 142 | ? shift | ||||
| 143 | : Carp::croak("::Full->new called without init string"); | ||||
| 144 | |||||
| 145 | # Create the token | ||||
| 146 | ### This manual SUPER'ing ONLY works because none of | ||||
| 147 | ### Token::Quote, Token::QuoteLike and Token::Regexp | ||||
| 148 | ### implement a new function of their own. | ||||
| 149 | 1061 | 5.43ms | 2122 | 3.61ms | my $self = PPI::Token::new( $class, $init ) or return undef; # spent 2.87ms making 1061 calls to PPI::Token::new, avg 3µs/call
# spent 738µs making 1061 calls to PPI::Util::TRUE, avg 696ns/call |
| 150 | |||||
| 151 | # Do we have a prototype for the intializer? If so, add the extra fields | ||||
| 152 | 1061 | 673µs | my $options = $quotes{$init} or return $self->_error( | ||
| 153 | "Unknown quote type '$init'" | ||||
| 154 | ); | ||||
| 155 | 1061 | 2.42ms | foreach ( keys %$options ) { | ||
| 156 | 4456 | 3.23ms | $self->{$_} = $options->{$_}; | ||
| 157 | } | ||||
| 158 | |||||
| 159 | # Set up the modifiers hash if needed | ||||
| 160 | 1061 | 449µs | $self->{modifiers} = {} if $self->{modifiers}; | ||
| 161 | |||||
| 162 | # Handle the special < base | ||||
| 163 | 1061 | 308µs | 5 | 22µs | if ( $init eq '<' ) { # spent 22µs making 5 calls to Clone::clone, avg 4µs/call |
| 164 | $self->{sections}->[0] = Clone::clone( $sections{'<'} ); | ||||
| 165 | } | ||||
| 166 | |||||
| 167 | 1061 | 2.70ms | $self; | ||
| 168 | } | ||||
| 169 | |||||
| 170 | # spent 119ms (35.2+83.8) within PPI::Token::_QuoteEngine::Full::_fill which was called 1061 times, avg 112µs/call:
# 1061 times (35.2ms+83.8ms) by PPI::Token::_QuoteEngine::__TOKENIZER__on_char at line 51 of PPI/Token/_QuoteEngine.pm, avg 112µs/call | ||||
| 171 | 1061 | 229µs | my $class = shift; | ||
| 172 | 1061 | 141µs | my $t = shift; | ||
| 173 | 1061 | 3.01ms | 1061 | 564µs | my $self = $t->{token} # spent 564µs making 1061 calls to PPI::Util::TRUE, avg 532ns/call |
| 174 | or Carp::croak("::Full->_fill called without current token"); | ||||
| 175 | |||||
| 176 | # Load in the operator stuff if needed | ||||
| 177 | 1061 | 743µs | if ( $self->{operator} ) { | ||
| 178 | # In an operator based quote-like, handle the gap between the | ||||
| 179 | # operator and the opening separator. | ||||
| 180 | 1055 | 7.15ms | 1055 | 753µs | if ( substr( $t->{line}, $t->{line_cursor}, 1 ) =~ /\s/ ) { # spent 753µs making 1055 calls to PPI::Token::_QuoteEngine::Full::CORE:match, avg 714ns/call |
| 181 | # Go past the gap | ||||
| 182 | my $gap = $self->_scan_quote_like_operator_gap( $t ); | ||||
| 183 | return undef unless defined $gap; | ||||
| 184 | if ( ref $gap ) { | ||||
| 185 | # End of file | ||||
| 186 | $self->{content} .= $$gap; | ||||
| 187 | return 0; | ||||
| 188 | } | ||||
| 189 | $self->{content} .= $gap; | ||||
| 190 | } | ||||
| 191 | |||||
| 192 | # The character we are now on is the separator. Capture, | ||||
| 193 | # and advance into the first section. | ||||
| 194 | 1055 | 953µs | my $sep = substr( $t->{line}, $t->{line_cursor}++, 1 ); | ||
| 195 | 1055 | 464µs | $self->{content} .= $sep; | ||
| 196 | |||||
| 197 | # Determine if these are normal or braced type sections | ||||
| 198 | 1055 | 999µs | if ( my $section = $sections{$sep} ) { | ||
| 199 | 951 | 362µs | $self->{braced} = 1; | ||
| 200 | 951 | 8.83ms | 951 | 5.57ms | $self->{sections}->[0] = Clone::clone($section); # spent 5.57ms making 951 calls to Clone::clone, avg 6µs/call |
| 201 | } else { | ||||
| 202 | 104 | 44µs | $self->{braced} = 0; | ||
| 203 | 104 | 70µs | $self->{separator} = $sep; | ||
| 204 | } | ||||
| 205 | } | ||||
| 206 | |||||
| 207 | # Parse different based on whether we are normal or braced | ||||
| 208 | 1061 | 2.43ms | 1061 | 76.2ms | my $rv = $self->{braced} # spent 70.3ms making 956 calls to PPI::Token::_QuoteEngine::Full::_fill_braced, avg 74µs/call
# spent 5.88ms making 105 calls to PPI::Token::_QuoteEngine::Full::_fill_normal, avg 56µs/call |
| 209 | ? $self->_fill_braced($t) | ||||
| 210 | : $self->_fill_normal($t); | ||||
| 211 | 1061 | 159µs | return $rv if !$rv; | ||
| 212 | |||||
| 213 | # Return now unless it has modifiers ( i.e. s/foo//eieio ) | ||||
| 214 | 1061 | 6.34ms | return 1 unless $self->{modifiers}; | ||
| 215 | |||||
| 216 | # Check for modifiers | ||||
| 217 | 212 | 25µs | my $char; | ||
| 218 | 212 | 38µs | my $len = 0; | ||
| 219 | 212 | 1.41ms | 212 | 252µs | while ( ($char = substr( $t->{line}, $t->{line_cursor} + 1, 1 )) =~ /[^\W\d_]/ ) { # spent 252µs making 212 calls to PPI::Token::_QuoteEngine::Full::CORE:match, avg 1µs/call |
| 220 | 646 | 59µs | $len++; | ||
| 221 | 646 | 239µs | $self->{content} .= $char; | ||
| 222 | 646 | 573µs | $self->{modifiers}->{lc $char} = 1; | ||
| 223 | 646 | 2.08ms | 646 | 479µs | $t->{line_cursor}++; # spent 479µs making 646 calls to PPI::Token::_QuoteEngine::Full::CORE:match, avg 741ns/call |
| 224 | } | ||||
| 225 | } | ||||
| 226 | |||||
| 227 | # Handle the content parsing path for normally seperated | ||||
| 228 | # spent 5.88ms (1.52+4.36) within PPI::Token::_QuoteEngine::Full::_fill_normal which was called 105 times, avg 56µs/call:
# 105 times (1.52ms+4.36ms) by PPI::Token::_QuoteEngine::Full::_fill at line 208, avg 56µs/call | ||||
| 229 | 105 | 40µs | my $self = shift; | ||
| 230 | 105 | 18µs | my $t = shift; | ||
| 231 | |||||
| 232 | # Get the content up to the next separator | ||||
| 233 | 105 | 259µs | 105 | 4.11ms | my $string = $self->_scan_for_unescaped_character( $t, $self->{separator} ); # spent 4.11ms making 105 calls to PPI::Token::_QuoteEngine::_scan_for_unescaped_character, avg 39µs/call |
| 234 | 105 | 28µs | return undef unless defined $string; | ||
| 235 | 105 | 29µs | if ( ref $string ) { | ||
| 236 | # End of file | ||||
| 237 | $self->{content} .= $$string; | ||||
| 238 | if ( length($$string) > 1 ) { | ||||
| 239 | # Complete the properties for the first section | ||||
| 240 | my $str = $$string; | ||||
| 241 | chop $str; | ||||
| 242 | $self->{sections}->[0] = { | ||||
| 243 | position => length($self->{content}), | ||||
| 244 | size => length($string), | ||||
| 245 | type => "$self->{separator}$self->{separator}", | ||||
| 246 | }; | ||||
| 247 | } else { | ||||
| 248 | # No sections at all | ||||
| 249 | $self->{_sections} = 0; | ||||
| 250 | } | ||||
| 251 | return 0; | ||||
| 252 | } | ||||
| 253 | |||||
| 254 | # Complete the properties of the first section | ||||
| 255 | 105 | 485µs | $self->{sections}->[0] = { | ||
| 256 | position => length $self->{content}, | ||||
| 257 | size => length($string) - 1, | ||||
| 258 | type => "$self->{separator}$self->{separator}", | ||||
| 259 | }; | ||||
| 260 | 105 | 73µs | $self->{content} .= $string; | ||
| 261 | |||||
| 262 | # We are done if there is only one section | ||||
| 263 | 105 | 306µs | return 1 if $self->{_sections} == 1; | ||
| 264 | |||||
| 265 | # There are two sections. | ||||
| 266 | |||||
| 267 | # Advance into the next section | ||||
| 268 | 13 | 4µs | $t->{line_cursor}++; | ||
| 269 | |||||
| 270 | # Get the content up to the end separator | ||||
| 271 | 13 | 26µs | 13 | 249µs | $string = $self->_scan_for_unescaped_character( $t, $self->{separator} ); # spent 249µs making 13 calls to PPI::Token::_QuoteEngine::_scan_for_unescaped_character, avg 19µs/call |
| 272 | 13 | 3µs | return undef unless defined $string; | ||
| 273 | 13 | 2µs | if ( ref $string ) { | ||
| 274 | # End of file | ||||
| 275 | $self->{content} .= $$string; | ||||
| 276 | return 0; | ||||
| 277 | } | ||||
| 278 | |||||
| 279 | # Complete the properties of the second section | ||||
| 280 | 13 | 34µs | $self->{sections}->[1] = { | ||
| 281 | position => length($self->{content}), | ||||
| 282 | size => length($string) - 1 | ||||
| 283 | }; | ||||
| 284 | 13 | 10µs | $self->{content} .= $string; | ||
| 285 | |||||
| 286 | 13 | 4.44ms | 1; | ||
| 287 | } | ||||
| 288 | |||||
| 289 | # Handle content parsing for matching crace seperated | ||||
| 290 | # spent 70.3ms (10.7+59.6) within PPI::Token::_QuoteEngine::Full::_fill_braced which was called 956 times, avg 74µs/call:
# 956 times (10.7ms+59.6ms) by PPI::Token::_QuoteEngine::Full::_fill at line 208, avg 74µs/call | ||||
| 291 | 956 | 286µs | my $self = shift; | ||
| 292 | 956 | 186µs | my $t = shift; | ||
| 293 | |||||
| 294 | # Get the content up to the close character | ||||
| 295 | 956 | 493µs | my $section = $self->{sections}->[0]; | ||
| 296 | 956 | 2.13ms | 956 | 59.1ms | my $brace_str = $self->_scan_for_brace_character( $t, $section->{_close} ); # spent 59.1ms making 956 calls to PPI::Token::_QuoteEngine::_scan_for_brace_character, avg 62µs/call |
| 297 | 956 | 189µs | return undef unless defined $brace_str; | ||
| 298 | 956 | 202µs | if ( ref $brace_str ) { | ||
| 299 | # End of file | ||||
| 300 | $self->{content} .= $$brace_str; | ||||
| 301 | return 0; | ||||
| 302 | } | ||||
| 303 | |||||
| 304 | # Complete the properties of the first section | ||||
| 305 | 956 | 943µs | $section->{position} = length $self->{content}; | ||
| 306 | 956 | 543µs | $section->{size} = length($brace_str) - 1; | ||
| 307 | 956 | 648µs | $self->{content} .= $brace_str; | ||
| 308 | 956 | 872µs | delete $section->{_close}; | ||
| 309 | |||||
| 310 | # We are done if there is only one section | ||||
| 311 | 956 | 7.21ms | return 1 if $self->{_sections} == 1; | ||
| 312 | |||||
| 313 | # There are two sections. | ||||
| 314 | |||||
| 315 | # Is there a gap between the sections. | ||||
| 316 | 20 | 18µs | my $char = substr( $t->{line}, ++$t->{line_cursor}, 1 ); | ||
| 317 | 20 | 64µs | 20 | 12µs | if ( $char =~ /\s/ ) { # spent 12µs making 20 calls to PPI::Token::_QuoteEngine::Full::CORE:match, avg 625ns/call |
| 318 | # Go past the gap | ||||
| 319 | my $gap_str = $self->_scan_quote_like_operator_gap( $t ); | ||||
| 320 | return undef unless defined $gap_str; | ||||
| 321 | if ( ref $gap_str ) { | ||||
| 322 | # End of file | ||||
| 323 | $self->{content} .= $$gap_str; | ||||
| 324 | return 0; | ||||
| 325 | } | ||||
| 326 | $self->{content} .= $gap_str; | ||||
| 327 | $char = substr( $t->{line}, $t->{line_cursor}, 1 ); | ||||
| 328 | } | ||||
| 329 | |||||
| 330 | 20 | 10µs | $section = $sections{$char}; | ||
| 331 | |||||
| 332 | 20 | 8µs | if ( $section ) { | ||
| 333 | # It's a brace | ||||
| 334 | |||||
| 335 | # Initialize the second section | ||||
| 336 | 20 | 9µs | $self->{content} .= $char; | ||
| 337 | 20 | 55µs | $section = $self->{sections}->[1] = { %$section }; | ||
| 338 | |||||
| 339 | # Advance into the second region | ||||
| 340 | 20 | 5µs | $t->{line_cursor}++; | ||
| 341 | 20 | 13µs | $section->{position} = length($self->{content}); | ||
| 342 | 20 | 8µs | $section->{size} = 0; | ||
| 343 | |||||
| 344 | # Get the content up to the close character | ||||
| 345 | 20 | 39µs | 20 | 541µs | $brace_str = $self->_scan_for_brace_character( $t, $section->{_close} ); # spent 541µs making 20 calls to PPI::Token::_QuoteEngine::_scan_for_brace_character, avg 27µs/call |
| 346 | 20 | 4µs | return undef unless defined $brace_str; | ||
| 347 | 20 | 9µs | if ( ref $brace_str ) { | ||
| 348 | # End of file | ||||
| 349 | $self->{content} .= $$brace_str; | ||||
| 350 | $section->{size} = length($$brace_str); | ||||
| 351 | delete $section->{_close}; | ||||
| 352 | return 0; | ||||
| 353 | } else { | ||||
| 354 | # Complete the properties for the second section | ||||
| 355 | 20 | 12µs | $self->{content} .= $brace_str; | ||
| 356 | 20 | 10µs | $section->{size} = length($brace_str) - 1; | ||
| 357 | 20 | 17µs | delete $section->{_close}; | ||
| 358 | } | ||||
| 359 | } elsif ( $char =~ m/ \A [^\w\s] \z /smx ) { | ||||
| 360 | # It is some other delimiter (weird, but possible) | ||||
| 361 | |||||
| 362 | # Add the delimiter to the content. | ||||
| 363 | $self->{content} .= $char; | ||||
| 364 | |||||
| 365 | # Advance into the next section | ||||
| 366 | $t->{line_cursor}++; | ||||
| 367 | |||||
| 368 | # Get the content up to the end separator | ||||
| 369 | my $string = $self->_scan_for_unescaped_character( $t, $char ); | ||||
| 370 | return undef unless defined $string; | ||||
| 371 | if ( ref $string ) { | ||||
| 372 | # End of file | ||||
| 373 | $self->{content} .= $$string; | ||||
| 374 | return 0; | ||||
| 375 | } | ||||
| 376 | |||||
| 377 | # Complete the properties of the second section | ||||
| 378 | $self->{sections}->[1] = { | ||||
| 379 | position => length($self->{content}), | ||||
| 380 | size => length($string) - 1, | ||||
| 381 | type => "$char$char", | ||||
| 382 | }; | ||||
| 383 | $self->{content} .= $string; | ||||
| 384 | |||||
| 385 | } else { | ||||
| 386 | |||||
| 387 | # Error, it has to be a delimiter of some sort. | ||||
| 388 | # Although this will result in a REALLY illegal regexp, | ||||
| 389 | # we allow it anyway. | ||||
| 390 | |||||
| 391 | # Create a null second section | ||||
| 392 | $self->{sections}->[1] = { | ||||
| 393 | position => length($self->{content}), | ||||
| 394 | size => 0, | ||||
| 395 | type => '', | ||||
| 396 | }; | ||||
| 397 | |||||
| 398 | # Attach an error to the token and move on | ||||
| 399 | $self->{_error} = "No second section of regexp, or does not start with a balanced character"; | ||||
| 400 | |||||
| 401 | # Roll back the cursor one char and return signalling end of regexp | ||||
| 402 | $t->{line_cursor}--; | ||||
| 403 | return 0; | ||||
| 404 | } | ||||
| 405 | |||||
| 406 | 20 | 50µs | 1; | ||
| 407 | } | ||||
| 408 | |||||
| - - | |||||
| 413 | ##################################################################### | ||||
| 414 | # Additional methods to find out about the quote | ||||
| 415 | |||||
| 416 | # In a scalar context, get the number of sections | ||||
| 417 | # In an array context, get the section information | ||||
| 418 | 1 | 7µs | # spent 3µs within PPI::Token::_QuoteEngine::Full::_sections which was called:
# once (3µs+0s) by PPI::Token::Quote::Literal::string at line 72 of PPI/Token/Quote/Literal.pm | ||
| 419 | |||||
| 420 | # Get a section's content | ||||
| 421 | sub _section_content { | ||||
| 422 | my ( $self, $inx ) = @_; | ||||
| 423 | $self->{sections} or return; | ||||
| 424 | my $sect = $self->{sections}[$inx] or return; | ||||
| 425 | return substr $self->content(), $sect->{position}, $sect->{size}; | ||||
| 426 | } | ||||
| 427 | |||||
| 428 | # Get the modifiers if any. | ||||
| 429 | # In list context, return the modifier hash. | ||||
| 430 | # In scalar context, clone the hash and return a reference to it. | ||||
| 431 | # If there are no modifiers, simply return. | ||||
| 432 | sub _modifiers { | ||||
| 433 | my ( $self ) = @_; | ||||
| 434 | $self->{modifiers} or return; | ||||
| 435 | wantarray and return %{ $self->{modifiers} }; | ||||
| 436 | return +{ %{ $self->{modifiers} } }; | ||||
| 437 | } | ||||
| 438 | |||||
| 439 | # Get the delimiters, or at least give it a good try to get them. | ||||
| 440 | sub _delimiters { | ||||
| 441 | my ( $self ) = @_; | ||||
| 442 | $self->{sections} or return; | ||||
| 443 | my @delims; | ||||
| 444 | foreach my $sect ( @{ $self->{sections} } ) { | ||||
| 445 | if ( exists $sect->{type} ) { | ||||
| 446 | push @delims, $sect->{type}; | ||||
| 447 | } else { | ||||
| 448 | my $content = $self->content(); | ||||
| 449 | push @delims, | ||||
| 450 | substr( $content, $sect->{position} - 1, 1 ) . | ||||
| 451 | substr( $content, $sect->{position} + $sect->{size}, 1 ); | ||||
| 452 | } | ||||
| 453 | } | ||||
| 454 | return @delims; | ||||
| 455 | } | ||||
| 456 | |||||
| 457 | 1 | 2µs | 1; | ||
| 458 | |||||
| 459 | =pod | ||||
| 460 | |||||
| 461 | =head1 SUPPORT | ||||
| 462 | |||||
| 463 | See the L<support section|PPI/SUPPORT> in the main module. | ||||
| 464 | |||||
| 465 | =head1 AUTHOR | ||||
| 466 | |||||
| 467 | Adam Kennedy E<lt>adamk@cpan.orgE<gt> | ||||
| 468 | |||||
| 469 | =head1 COPYRIGHT | ||||
| 470 | |||||
| 471 | Copyright 2001 - 2011 Adam Kennedy. | ||||
| 472 | |||||
| 473 | This program is free software; you can redistribute | ||||
| 474 | it and/or modify it under the same terms as Perl itself. | ||||
| 475 | |||||
| 476 | The full text of the license can be found in the | ||||
| 477 | LICENSE file included with this module. | ||||
| 478 | |||||
| 479 | =cut | ||||
# spent 1.50ms within PPI::Token::_QuoteEngine::Full::CORE:match which was called 1933 times, avg 774ns/call:
# 1055 times (753µs+0s) by PPI::Token::_QuoteEngine::Full::_fill at line 180, avg 714ns/call
# 646 times (479µs+0s) by PPI::Token::_QuoteEngine::Full::_fill at line 223, avg 741ns/call
# 212 times (252µs+0s) by PPI::Token::_QuoteEngine::Full::_fill at line 219, avg 1µs/call
# 20 times (12µs+0s) by PPI::Token::_QuoteEngine::Full::_fill_braced at line 317, avg 625ns/call |