| Filename | /usr/lib/perl5/Template/Parser.pm | 
| Statements | Executed 328231 statements in 450ms | 
| Calls | P | F | Exclusive Time | Inclusive Time | Subroutine | 
|---|---|---|---|---|---|
| 8 | 1 | 1 | 314ms | 442ms | Template::Parser::_parse | 
| 8 | 1 | 1 | 45.0ms | 116ms | Template::Parser::split_text | 
| 1035 | 1 | 1 | 40.2ms | 52.0ms | Template::Parser::tokenise_directive | 
| 1 | 1 | 1 | 26.4ms | 26.5ms | Template::Parser::BEGIN@41 | 
| 3759 | 9 | 1 | 15.3ms | 15.3ms | Template::Parser::CORE:subst (opcode) | 
| 5916 | 7 | 1 | 12.9ms | 12.9ms | Template::Parser::CORE:match (opcode) | 
| 1 | 1 | 1 | 9.80ms | 10.3ms | Template::Parser::BEGIN@40 | 
| 626 | 1 | 1 | 9.49ms | 10.8ms | Template::Parser::location | 
| 3116 | 1 | 1 | 7.07ms | 7.07ms | Template::Parser::__ANON__[:864] | 
| 4148 | 5 | 1 | 3.74ms | 3.74ms | Template::Parser::CORE:regcomp (opcode) | 
| 8 | 1 | 1 | 717µs | 558ms | Template::Parser::parse | 
| 27 | 1 | 1 | 563µs | 563µs | Template::Parser::block_label | 
| 27 | 1 | 1 | 436µs | 998µs | Template::Parser::leave_block | 
| 27 | 1 | 1 | 287µs | 287µs | Template::Parser::enter_block | 
| 1 | 1 | 1 | 155µs | 197µs | Template::Parser::new | 
| 9 | 2 | 1 | 119µs | 119µs | Template::Parser::CORE:qr (opcode) | 
| 1 | 1 | 1 | 116µs | 126µs | Template::Parser::BEGIN@35 | 
| 1 | 1 | 1 | 87µs | 351µs | Template::Parser::BEGIN@44 | 
| 1 | 1 | 1 | 30µs | 34µs | Template::Parser::interpolate_text | 
| 1 | 1 | 1 | 28µs | 28µs | Template::Parser::new_style | 
| 1 | 1 | 1 | 25µs | 65µs | Template::Parser::BEGIN@36 | 
| 1 | 1 | 1 | 24µs | 228µs | Template::Parser::BEGIN@37 | 
| 1 | 1 | 1 | 23µs | 842µs | Template::Parser::BEGIN@39 | 
| 1 | 1 | 1 | 15µs | 86µs | Template::Parser::BEGIN@46 | 
| 1 | 1 | 1 | 13µs | 56µs | Template::Parser::BEGIN@45 | 
| 1 | 1 | 1 | 12µs | 47µs | Template::Parser::BEGIN@47 | 
| 2 | 1 | 1 | 3µs | 3µs | Template::Parser::CORE:substcont (opcode) | 
| 0 | 0 | 0 | 0s | 0s | Template::Parser::_dump | 
| 0 | 0 | 0 | 0s | 0s | Template::Parser::_parse_error | 
| 0 | 0 | 0 | 0s | 0s | Template::Parser::add_metadata | 
| 0 | 0 | 0 | 0s | 0s | Template::Parser::define_block | 
| 0 | 0 | 0 | 0s | 0s | Template::Parser::in_block | 
| 0 | 0 | 0 | 0s | 0s | Template::Parser::old_style | 
| 0 | 0 | 0 | 0s | 0s | Template::Parser::pop_defblock | 
| 0 | 0 | 0 | 0s | 0s | Template::Parser::push_defblock | 
| Line | State ments | Time on line | Calls | Time in subs | Code | 
|---|---|---|---|---|---|
| 1 | #============================================================= -*-Perl-*- | ||||
| 2 | # | ||||
| 3 | # Template::Parser | ||||
| 4 | # | ||||
| 5 | # DESCRIPTION | ||||
| 6 | # This module implements a LALR(1) parser and assocated support | ||||
| 7 | # methods to parse template documents into the appropriate "compiled" | ||||
| 8 | # format. Much of the parser DFA code (see _parse() method) is based | ||||
| 9 | # on Francois Desarmenien's Parse::Yapp module. Kudos to him. | ||||
| 10 | # | ||||
| 11 | # AUTHOR | ||||
| 12 | # Andy Wardley <abw@wardley.org> | ||||
| 13 | # | ||||
| 14 | # COPYRIGHT | ||||
| 15 | # Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved. | ||||
| 16 | # | ||||
| 17 | # This module is free software; you can redistribute it and/or | ||||
| 18 | # modify it under the same terms as Perl itself. | ||||
| 19 | # | ||||
| 20 | # The following copyright notice appears in the Parse::Yapp | ||||
| 21 | # documentation. | ||||
| 22 | # | ||||
| 23 | # The Parse::Yapp module and its related modules and shell | ||||
| 24 | # scripts are copyright (c) 1998 Francois Desarmenien, | ||||
| 25 | # France. All rights reserved. | ||||
| 26 | # | ||||
| 27 | # You may use and distribute them under the terms of either | ||||
| 28 | # the GNU General Public License or the Artistic License, as | ||||
| 29 | # specified in the Perl README file. | ||||
| 30 | # | ||||
| 31 | #============================================================================ | ||||
| 32 | |||||
| 33 | package Template::Parser; | ||||
| 34 | |||||
| 35 | 3 | 66µs | 2 | 136µs | # spent 126µs (116+10) within Template::Parser::BEGIN@35 which was called:
#    once (116µs+10µs) by Template::Config::load at line 35 # spent   126µs making 1 call to Template::Parser::BEGIN@35
# spent    10µs making 1 call to strict::import | 
| 36 | 3 | 61µs | 2 | 106µs | # spent 65µs (25+40) within Template::Parser::BEGIN@36 which was called:
#    once (25µs+40µs) by Template::Config::load at line 36 # spent    65µs making 1 call to Template::Parser::BEGIN@36
# spent    40µs making 1 call to warnings::import | 
| 37 | 3 | 67µs | 2 | 433µs | # spent 228µs (24+205) within Template::Parser::BEGIN@37 which was called:
#    once (24µs+205µs) by Template::Config::load at line 37 # spent   228µs making 1 call to Template::Parser::BEGIN@37
# spent   205µs making 1 call to base::import | 
| 38 | |||||
| 39 | 3 | 157µs | 2 | 1.66ms | # spent 842µs (23+819) within Template::Parser::BEGIN@39 which was called:
#    once (23µs+819µs) by Template::Config::load at line 39 # spent   842µs making 1 call to Template::Parser::BEGIN@39
# spent   819µs making 1 call to Exporter::import | 
| 40 | 3 | 376µs | 1 | 10.3ms | # spent 10.3ms (9.80+495µs) within Template::Parser::BEGIN@40 which was called:
#    once (9.80ms+495µs) by Template::Config::load at line 40 # spent  10.3ms making 1 call to Template::Parser::BEGIN@40 | 
| 41 | 3 | 947µs | 1 | 26.5ms | # spent 26.5ms (26.4+160µs) within Template::Parser::BEGIN@41 which was called:
#    once (26.4ms+160µs) by Template::Config::load at line 41 # spent  26.5ms making 1 call to Template::Parser::BEGIN@41 | 
| 42 | |||||
| 43 | # parser state constants | ||||
| 44 | 3 | 61µs | 2 | 615µs | # spent 351µs (87+264) within Template::Parser::BEGIN@44 which was called:
#    once (87µs+264µs) by Template::Config::load at line 44 # spent   351µs making 1 call to Template::Parser::BEGIN@44
# spent   264µs making 1 call to constant::import | 
| 45 | 3 | 61µs | 2 | 100µs | # spent 56µs (13+44) within Template::Parser::BEGIN@45 which was called:
#    once (13µs+44µs) by Template::Config::load at line 45 # spent    56µs making 1 call to Template::Parser::BEGIN@45
# spent    44µs making 1 call to constant::import | 
| 46 | 3 | 41µs | 2 | 157µs | # spent 86µs (15+71) within Template::Parser::BEGIN@46 which was called:
#    once (15µs+71µs) by Template::Config::load at line 46 # spent    86µs making 1 call to Template::Parser::BEGIN@46
# spent    71µs making 1 call to constant::import | 
| 47 | 3 | 5.26ms | 2 | 83µs | # spent 47µs (12+35) within Template::Parser::BEGIN@47 which was called:
#    once (12µs+35µs) by Template::Config::load at line 47 # spent    47µs making 1 call to Template::Parser::BEGIN@47
# spent    35µs making 1 call to constant::import | 
| 48 | |||||
| 49 | 1 | 1µs | our $VERSION = 2.89; | ||
| 50 | 1 | 1µs | our $DEBUG = 0 unless defined $DEBUG; | ||
| 51 | 1 | 800ns | our $ERROR = ''; | ||
| 52 | |||||
| 53 | |||||
| 54 | #======================================================================== | ||||
| 55 | # -- COMMON TAG STYLES -- | ||||
| 56 | #======================================================================== | ||||
| 57 | |||||
| 58 | 1 | 17µs | our $TAG_STYLE = { | ||
| 59 | 'default' => [ '\[%', '%\]' ], | ||||
| 60 | 'template1' => [ '[\[%]%', '%[\]%]' ], | ||||
| 61 | 'metatext' => [ '%%', '%%' ], | ||||
| 62 | 'html' => [ '<!--', '-->' ], | ||||
| 63 | 'mason' => [ '<%', '>' ], | ||||
| 64 | 'asp' => [ '<%', '%>' ], | ||||
| 65 | 'php' => [ '<\?', '\?>' ], | ||||
| 66 | 'star' => [ '\[\*', '\*\]' ], | ||||
| 67 | }; | ||||
| 68 | 1 | 4µs | $TAG_STYLE->{ template } = $TAG_STYLE->{ tt2 } = $TAG_STYLE->{ default }; | ||
| 69 | |||||
| 70 | |||||
| 71 | our $DEFAULT_STYLE = { | ||||
| 72 | START_TAG => $TAG_STYLE->{ default }->[0], | ||||
| 73 | 1 | 10µs | END_TAG => $TAG_STYLE->{ default }->[1], | ||
| 74 | # TAG_STYLE => 'default', | ||||
| 75 | ANYCASE => 0, | ||||
| 76 | INTERPOLATE => 0, | ||||
| 77 | PRE_CHOMP => 0, | ||||
| 78 | POST_CHOMP => 0, | ||||
| 79 | V1DOLLAR => 0, | ||||
| 80 | EVAL_PERL => 0, | ||||
| 81 | }; | ||||
| 82 | |||||
| 83 | 1 | 4µs | our $QUOTED_ESCAPES = { | ||
| 84 | n => "\n", | ||||
| 85 | r => "\r", | ||||
| 86 | t => "\t", | ||||
| 87 | }; | ||||
| 88 | |||||
| 89 | # note that '-' must come first so Perl doesn't think it denotes a range | ||||
| 90 | 1 | 79µs | 1 | 56µs | our $CHOMP_FLAGS  = qr/[-=~+]/; # spent    56µs making 1 call to Template::Parser::CORE:qr | 
| 91 | |||||
| - - | |||||
| 94 | #======================================================================== | ||||
| 95 | # ----- PUBLIC METHODS ----- | ||||
| 96 | #======================================================================== | ||||
| 97 | |||||
| 98 | #------------------------------------------------------------------------ | ||||
| 99 | # new(\%config) | ||||
| 100 | # | ||||
| 101 | # Constructor method. | ||||
| 102 | #------------------------------------------------------------------------ | ||||
| 103 | |||||
| 104 | # spent 197µs (155+43) within Template::Parser::new which was called:
#    once (155µs+43µs) by Template::Config::parser at line 103 of Template/Config.pm | ||||
| 105 | 1 | 2µs | my $class = shift; | ||
| 106 | 1 | 6µs | my $config = $_[0] && ref($_[0]) eq 'HASH' ? shift(@_) : { @_ }; | ||
| 107 | 1 | 2µs | my ($tagstyle, $debug, $start, $end, $defaults, $grammar, $hash, $key, $udef); | ||
| 108 | |||||
| 109 | my $self = bless { | ||||
| 110 | START_TAG => undef, | ||||
| 111 | END_TAG => undef, | ||||
| 112 | TAG_STYLE => 'default', | ||||
| 113 | ANYCASE => 0, | ||||
| 114 | INTERPOLATE => 0, | ||||
| 115 | PRE_CHOMP => 0, | ||||
| 116 | POST_CHOMP => 0, | ||||
| 117 | V1DOLLAR => 0, | ||||
| 118 | EVAL_PERL => 0, | ||||
| 119 | FILE_INFO => 1, | ||||
| 120 | GRAMMAR => undef, | ||||
| 121 | _ERROR => '', | ||||
| 122 | IN_BLOCK => [ ], | ||||
| 123 | 1 | 35µs | FACTORY => $config->{ FACTORY } || 'Template::Directive', | ||
| 124 | }, $class; | ||||
| 125 | |||||
| 126 | # update self with any relevant keys in config | ||||
| 127 | 1 | 6µs | foreach $key (keys %$self) { | ||
| 128 | 14 | 10µs | $self->{ $key } = $config->{ $key } if defined $config->{ $key }; | ||
| 129 | } | ||||
| 130 | 1 | 3µs | $self->{ FILEINFO } = [ ]; | ||
| 131 | |||||
| 132 | # DEBUG config item can be a bitmask | ||||
| 133 | 1 | 4µs | if (defined ($debug = $config->{ DEBUG })) { | ||
| 134 | $self->{ DEBUG } = $debug & ( Template::Constants::DEBUG_PARSER | ||||
| 135 | | Template::Constants::DEBUG_FLAGS ); | ||||
| 136 | $self->{ DEBUG_DIRS } = $debug & Template::Constants::DEBUG_DIRS; | ||||
| 137 | } | ||||
| 138 | # package variable can be set to 1 to support previous behaviour | ||||
| 139 | elsif ($DEBUG == 1) { | ||||
| 140 | $self->{ DEBUG } = Template::Constants::DEBUG_PARSER; | ||||
| 141 | $self->{ DEBUG_DIRS } = 0; | ||||
| 142 | } | ||||
| 143 | # otherwise let $DEBUG be a bitmask | ||||
| 144 | else { | ||||
| 145 | 1 | 5µs | $self->{ DEBUG } = $DEBUG & ( Template::Constants::DEBUG_PARSER | ||
| 146 | | Template::Constants::DEBUG_FLAGS ); | ||||
| 147 | 1 | 4µs | $self->{ DEBUG_DIRS } = $DEBUG & Template::Constants::DEBUG_DIRS; | ||
| 148 | } | ||||
| 149 | |||||
| 150 | 1 | 3µs | $grammar = $self->{ GRAMMAR } ||= do { | ||
| 151 | 1 | 2µs | require Template::Grammar; | ||
| 152 | 1 | 6µs | 1 | 15µs | Template::Grammar->new();         # spent    15µs making 1 call to Template::Grammar::new | 
| 153 | }; | ||||
| 154 | |||||
| 155 | # build a FACTORY object to include any NAMESPACE definitions, | ||||
| 156 | # but only if FACTORY isn't already an object | ||||
| 157 | 1 | 1µs | if ($config->{ NAMESPACE } && ! ref $self->{ FACTORY }) { | ||
| 158 | my $fclass = $self->{ FACTORY }; | ||||
| 159 | $self->{ FACTORY } = $fclass->new( NAMESPACE => $config->{ NAMESPACE } ) | ||||
| 160 | || return $class->error($fclass->error()); | ||||
| 161 | } | ||||
| 162 | |||||
| 163 | # load grammar rules, states and lex table | ||||
| 164 | 1 | 6µs | @$self{ qw( LEXTABLE STATES RULES ) } | ||
| 165 | = @$grammar{ qw( LEXTABLE STATES RULES ) }; | ||||
| 166 | |||||
| 167 | 1 | 5µs | 1 | 28µs | $self->new_style($config)     # spent    28µs making 1 call to Template::Parser::new_style | 
| 168 | || return $class->error($self->error()); | ||||
| 169 | |||||
| 170 | 1 | 6µs | return $self; | ||
| 171 | } | ||||
| 172 | |||||
| 173 | #----------------------------------------------------------------------- | ||||
| 174 | # These methods are used to track nested IF and WHILE blocks. Each | ||||
| 175 | # generated if/while block is given a label indicating the directive | ||||
| 176 | # type and nesting depth, e.g. FOR0, WHILE1, FOR2, WHILE3, etc. The | ||||
| 177 | # NEXT and LAST directives use the innermost label, e.g. last WHILE3; | ||||
| 178 | #----------------------------------------------------------------------- | ||||
| 179 | |||||
| 180 | # spent 287µs within Template::Parser::enter_block which was called 27 times, avg 11µs/call:
# 27 times (287µs+0s) by Template::Grammar::__ANON__[Parser.yp:167] at line 167 of Parser.yp, avg 11µs/call | ||||
| 181 | 27 | 53µs | my ($self, $name) = @_; | ||
| 182 | 27 | 102µs | my $blocks = $self->{ IN_BLOCK }; | ||
| 183 | 27 | 214µs | push(@{ $self->{ IN_BLOCK } }, $name); | ||
| 184 | } | ||||
| 185 | |||||
| 186 | # spent 998µs (436+562) within Template::Parser::leave_block which was called 27 times, avg 37µs/call:
# 27 times (436µs+562µs) by Template::Grammar::__ANON__[Parser.yp:168] at line 168 of Parser.yp, avg 37µs/call | ||||
| 187 | 27 | 69µs | my $self = shift; | ||
| 188 | 27 | 137µs | 27 | 563µs | my $label = $self->block_label;     # spent   563µs making 27 calls to Template::Parser::block_label, avg 21µs/call | 
| 189 | 27 | 55µs | pop(@{ $self->{ IN_BLOCK } }); | ||
| 190 | 27 | 124µs | return $label; | ||
| 191 | } | ||||
| 192 | |||||
| 193 | sub in_block { | ||||
| 194 | my ($self, $name) = @_; | ||||
| 195 | my $blocks = $self->{ IN_BLOCK }; | ||||
| 196 | return @$blocks && $blocks->[-1] eq $name; | ||||
| 197 | } | ||||
| 198 | |||||
| 199 | # spent 563µs within Template::Parser::block_label which was called 27 times, avg 21µs/call:
# 27 times (563µs+0s) by Template::Parser::leave_block at line 188, avg 21µs/call | ||||
| 200 | 27 | 40µs | my ($self, $prefix, $suffix) = @_; | ||
| 201 | 27 | 143µs | my $blocks = $self->{ IN_BLOCK }; | ||
| 202 | 27 | 135µs | my $name = @$blocks | ||
| 203 | ? $blocks->[-1] . scalar @$blocks | ||||
| 204 | : undef; | ||||
| 205 | 27 | 329µs | return join('', grep { defined $_ } $prefix, $name, $suffix); | ||
| 206 | } | ||||
| 207 | |||||
| - - | |||||
| 210 | #------------------------------------------------------------------------ | ||||
| 211 | # new_style(\%config) | ||||
| 212 | # | ||||
| 213 | # Install a new (stacked) parser style. This feature is currently | ||||
| 214 | # experimental but should mimic the previous behaviour with regard to | ||||
| 215 | # TAG_STYLE, START_TAG, END_TAG, etc. | ||||
| 216 | #------------------------------------------------------------------------ | ||||
| 217 | |||||
| 218 | # spent 28µs within Template::Parser::new_style which was called:
#    once (28µs+0s) by Template::Parser::new at line 167 | ||||
| 219 | 1 | 2µs | my ($self, $config) = @_; | ||
| 220 | 1 | 4µs | my $styles = $self->{ STYLE } ||= [ ]; | ||
| 221 | 1 | 1µs | my ($tagstyle, $tags, $start, $end, $key); | ||
| 222 | |||||
| 223 | # clone new style from previous or default style | ||||
| 224 | 1 | 6µs | my $style = { %{ $styles->[-1] || $DEFAULT_STYLE } }; | ||
| 225 | |||||
| 226 | # expand START_TAG and END_TAG from specified TAG_STYLE | ||||
| 227 | 1 | 2µs | if ($tagstyle = $config->{ TAG_STYLE }) { | ||
| 228 | return $self->error("Invalid tag style: $tagstyle") | ||||
| 229 | unless defined ($tags = $TAG_STYLE->{ $tagstyle }); | ||||
| 230 | ($start, $end) = @$tags; | ||||
| 231 | $config->{ START_TAG } ||= $start; | ||||
| 232 | $config->{ END_TAG } ||= $end; | ||||
| 233 | } | ||||
| 234 | |||||
| 235 | 1 | 3µs | foreach $key (keys %$DEFAULT_STYLE) { | ||
| 236 | 8 | 6µs | $style->{ $key } = $config->{ $key } if defined $config->{ $key }; | ||
| 237 | } | ||||
| 238 | 1 | 2µs | push(@$styles, $style); | ||
| 239 | 1 | 48µs | return $style; | ||
| 240 | } | ||||
| 241 | |||||
| 242 | |||||
| 243 | #------------------------------------------------------------------------ | ||||
| 244 | # old_style() | ||||
| 245 | # | ||||
| 246 | # Pop the current parser style and revert to the previous one. See | ||||
| 247 | # new_style(). ** experimental ** | ||||
| 248 | #------------------------------------------------------------------------ | ||||
| 249 | |||||
| 250 | sub old_style { | ||||
| 251 | my $self = shift; | ||||
| 252 | my $styles = $self->{ STYLE }; | ||||
| 253 | return $self->error('only 1 parser style remaining') | ||||
| 254 | unless (@$styles > 1); | ||||
| 255 | pop @$styles; | ||||
| 256 | return $styles->[-1]; | ||||
| 257 | } | ||||
| 258 | |||||
| 259 | |||||
| 260 | #------------------------------------------------------------------------ | ||||
| 261 | # parse($text, $data) | ||||
| 262 | # | ||||
| 263 | # Parses the text string, $text and returns a hash array representing | ||||
| 264 | # the compiled template block(s) as Perl code, in the format expected | ||||
| 265 | # by Template::Document. | ||||
| 266 | #------------------------------------------------------------------------ | ||||
| 267 | |||||
| 268 | # spent 558ms (717µs+558) within Template::Parser::parse which was called 8 times, avg 69.8ms/call:
# 8 times (717µs+558ms) by Template::Provider::_compile at line 844 of Template/Provider.pm, avg 69.8ms/call | ||||
| 269 | 8 | 47µs | my ($self, $text, $info) = @_; | ||
| 270 | 8 | 9µs | my ($tokens, $block); | ||
| 271 | |||||
| 272 | $info->{ DEBUG } = $self->{ DEBUG_DIRS } | ||||
| 273 | 8 | 46µs | unless defined $info->{ DEBUG }; | ||
| 274 | |||||
| 275 | # print "info: { ", join(', ', map { "$_ => $info->{ $_ }" } keys %$info), " }\n"; | ||||
| 276 | |||||
| 277 | # store for blocks defined in the template (see define_block()) | ||||
| 278 | 8 | 26µs | my $defblock = $self->{ DEFBLOCK } = { }; | ||
| 279 | 8 | 28µs | my $metadata = $self->{ METADATA } = [ ]; | ||
| 280 | 8 | 25µs | $self->{ DEFBLOCKS } = [ ]; | ||
| 281 | |||||
| 282 | 8 | 21µs | $self->{ _ERROR } = ''; | ||
| 283 | |||||
| 284 | # split file into TEXT/DIRECTIVE chunks | ||||
| 285 | 8 | 56µs | 16 | 116ms | $tokens = $self->split_text($text)     # spent   116ms making 8 calls to Template::Parser::split_text, avg 14.5ms/call
    # spent    18µs making 8 calls to Regexp::DESTROY, avg 2µs/call | 
| 286 | || return undef; ## RETURN ## | ||||
| 287 | |||||
| 288 | 8 | 26µs | push(@{ $self->{ FILEINFO } }, $info); | ||
| 289 | |||||
| 290 | # parse chunks | ||||
| 291 | 8 | 94µs | 8 | 442ms | $block = $self->_parse($tokens, $info);     # spent   442ms making 8 calls to Template::Parser::_parse, avg 55.2ms/call | 
| 292 | |||||
| 293 | 8 | 21µs | pop(@{ $self->{ FILEINFO } }); | ||
| 294 | |||||
| 295 | 8 | 6µs | return undef unless $block; ## RETURN ## | ||
| 296 | |||||
| 297 | $self->debug("compiled main template document block:\n$block") | ||||
| 298 | 8 | 31µs | if $self->{ DEBUG } & Template::Constants::DEBUG_PARSER; | ||
| 299 | |||||
| 300 | return { | ||||
| 301 | 8 | 140µs | BLOCK => $block, | ||
| 302 | DEFBLOCKS => $defblock, | ||||
| 303 | METADATA => { @$metadata }, | ||||
| 304 | }; | ||||
| 305 | } | ||||
| 306 | |||||
| - - | |||||
| 309 | #------------------------------------------------------------------------ | ||||
| 310 | # split_text($text) | ||||
| 311 | # | ||||
| 312 | # Split input template text into directives and raw text chunks. | ||||
| 313 | #------------------------------------------------------------------------ | ||||
| 314 | |||||
| 315 | # spent 116ms (45.0+71.0) within Template::Parser::split_text which was called 8 times, avg 14.5ms/call:
# 8 times (45.0ms+71.0ms) by Template::Parser::parse at line 285, avg 14.5ms/call | ||||
| 316 | 8 | 49µs | my ($self, $text) = @_; | ||
| 317 | 8 | 26µs | my ($pre, $dir, $prelines, $dirlines, $postlines, $chomp, $tags, @tags); | ||
| 318 | 8 | 24µs | my $style = $self->{ STYLE }->[-1]; | ||
| 319 | 8 | 56µs | my ($start, $end, $prechomp, $postchomp, $interp ) = | ||
| 320 | @$style{ qw( START_TAG END_TAG PRE_CHOMP POST_CHOMP INTERPOLATE ) }; | ||||
| 321 | 8 | 131µs | 8 | 63µs | my $tags_dir = $self->{ANYCASE} ? qr<TAGS>i : qr<TAGS>;     # spent    63µs making 8 calls to Template::Parser::CORE:qr, avg 8µs/call | 
| 322 | |||||
| 323 | 8 | 13µs | my @tokens = (); | ||
| 324 | 8 | 5µs | my $line = 1; | ||
| 325 | |||||
| 326 | return \@tokens ## RETURN ## | ||||
| 327 | 8 | 16µs | unless defined $text && length $text; | ||
| 328 | |||||
| 329 | # extract all directives from the text | ||||
| 330 | 8 | 271µs | 16 | 181µs | while ($text =~ s/     # spent   102µs making 8 calls to Template::Parser::CORE:subst, avg 13µs/call
    # spent    79µs making 8 calls to Template::Parser::CORE:regcomp, avg 10µs/call | 
| 331 | ^(.*?) # $1 - start of line up to directive | ||||
| 332 | (?: | ||||
| 333 | $start # start of tag | ||||
| 334 | (.*?) # $2 - tag contents | ||||
| 335 | $end # end of tag | ||||
| 336 | ) | ||||
| 337 | //sx) { | ||||
| 338 | |||||
| 339 | 1035 | 2.37ms | ($pre, $dir) = ($1, $2); | ||
| 340 | 1035 | 479µs | $pre = '' unless defined $pre; | ||
| 341 | 1035 | 288µs | $dir = '' unless defined $dir; | ||
| 342 | |||||
| 343 | 1035 | 1.31ms | $prelines = ($pre =~ tr/\n//); # newlines in preceeding text | ||
| 344 | 1035 | 551µs | $dirlines = ($dir =~ tr/\n//); # newlines in directive tag | ||
| 345 | 1035 | 297µs | $postlines = 0; # newlines chomped after tag | ||
| 346 | |||||
| 347 | 1035 | 1.64ms | for ($dir) { | ||
| 348 | 1035 | 3.89ms | 1035 | 761µs | if (/^\#/) {             # spent   761µs making 1035 calls to Template::Parser::CORE:match, avg 735ns/call | 
| 349 | # comment out entire directive except for any end chomp flag | ||||
| 350 | $dir = ($dir =~ /($CHOMP_FLAGS)$/o) ? $1 : ''; | ||||
| 351 | } | ||||
| 352 | else { | ||||
| 353 | 1035 | 6.65ms | 2070 | 2.59ms | s/^($CHOMP_FLAGS)?\s*//so;                 # spent  2.23ms making 1035 calls to Template::Parser::CORE:subst, avg 2µs/call
                # spent   363µs making 1035 calls to Template::Parser::CORE:regcomp, avg 350ns/call | 
| 354 | # PRE_CHOMP: process whitespace before tag | ||||
| 355 | 1035 | 1.08ms | $chomp = $1 ? $1 : $prechomp; | ||
| 356 | 1035 | 883µs | $chomp =~ tr/-=~+/1230/; | ||
| 357 | 1035 | 638µs | if ($chomp && $pre) { | ||
| 358 | # chomp off whitespace and newline preceding directive | ||||
| 359 | if ($chomp == CHOMP_ALL) { | ||||
| 360 | $pre =~ s{ (\r?\n|^) [^\S\n]* \z }{}mx; | ||||
| 361 | } | ||||
| 362 | elsif ($chomp == CHOMP_COLLAPSE) { | ||||
| 363 | $pre =~ s{ (\s+) \z }{ }x; | ||||
| 364 | } | ||||
| 365 | elsif ($chomp == CHOMP_GREEDY) { | ||||
| 366 | $pre =~ s{ (\s+) \z }{}x; | ||||
| 367 | } | ||||
| 368 | } | ||||
| 369 | } | ||||
| 370 | |||||
| 371 | # POST_CHOMP: process whitespace after tag | ||||
| 372 | 1035 | 11.5ms | 2070 | 7.37ms | s/\s*($CHOMP_FLAGS)?\s*$//so;             # spent  6.96ms making 1035 calls to Template::Parser::CORE:subst, avg 7µs/call
            # spent   417µs making 1035 calls to Template::Parser::CORE:regcomp, avg 403ns/call | 
| 373 | 1035 | 1.11ms | $chomp = $1 ? $1 : $postchomp; | ||
| 374 | 1035 | 771µs | $chomp =~ tr/-=~+/1230/; | ||
| 375 | 1035 | 1.97ms | if ($chomp) { | ||
| 376 | if ($chomp == CHOMP_ALL) { | ||||
| 377 | $text =~ s{ ^ ([^\S\n]* \n) }{}x | ||||
| 378 | && $postlines++; | ||||
| 379 | } | ||||
| 380 | elsif ($chomp == CHOMP_COLLAPSE) { | ||||
| 381 | $text =~ s{ ^ (\s+) }{ }x | ||||
| 382 | && ($postlines += $1=~y/\n//); | ||||
| 383 | } | ||||
| 384 | # any trailing whitespace | ||||
| 385 | elsif ($chomp == CHOMP_GREEDY) { | ||||
| 386 | $text =~ s{ ^ (\s+) }{}x | ||||
| 387 | && ($postlines += $1=~y/\n//); | ||||
| 388 | } | ||||
| 389 | } | ||||
| 390 | } | ||||
| 391 | |||||
| 392 | # any text preceding the directive can now be added | ||||
| 393 | 1035 | 1.73ms | if (length $pre) { | ||
| 394 | push(@tokens, $interp | ||||
| 395 | ? [ $pre, $line, 'ITEXT' ] | ||||
| 396 | : ('TEXT', $pre) ); | ||||
| 397 | } | ||||
| 398 | 1035 | 644µs | $line += $prelines; | ||
| 399 | |||||
| 400 | # and now the directive, along with line number information | ||||
| 401 | 1035 | 844µs | if (length $dir) { | ||
| 402 | # the TAGS directive is a compile-time switch | ||||
| 403 | 1035 | 6.66ms | 2070 | 1.85ms | if ($dir =~ /^$tags_dir\s+(.*)/) {             # spent  1.38ms making 1035 calls to Template::Parser::CORE:regcomp, avg 1µs/call
            # spent   476µs making 1035 calls to Template::Parser::CORE:match, avg 460ns/call | 
| 404 | my @tags = split(/\s+/, $1); | ||||
| 405 | if (scalar @tags > 1) { | ||||
| 406 | ($start, $end) = map { quotemeta($_) } @tags; | ||||
| 407 | } | ||||
| 408 | elsif ($tags = $TAG_STYLE->{ $tags[0] }) { | ||||
| 409 | ($start, $end) = @$tags; | ||||
| 410 | } | ||||
| 411 | else { | ||||
| 412 | warn "invalid TAGS style: $tags[0]\n"; | ||||
| 413 | } | ||||
| 414 | } | ||||
| 415 | else { | ||||
| 416 | # DIRECTIVE is pushed as: | ||||
| 417 | # [ $dirtext, $line_no(s), \@tokens ] | ||||
| 418 | 1035 | 5.20ms | 1035 | 52.0ms | push(@tokens,                 # spent  52.0ms making 1035 calls to Template::Parser::tokenise_directive, avg 50µs/call | 
| 419 | [ $dir, | ||||
| 420 | ($dirlines | ||||
| 421 | ? sprintf("%d-%d", $line, $line + $dirlines) | ||||
| 422 | : $line), | ||||
| 423 | $self->tokenise_directive($dir) ]); | ||||
| 424 | } | ||||
| 425 | } | ||||
| 426 | |||||
| 427 | # update line counter to include directive lines and any extra | ||||
| 428 | # newline chomped off the start of the following text | ||||
| 429 | 1035 | 12.0ms | 2070 | 6.18ms | $line += $dirlines + $postlines;         # spent  4.68ms making 1035 calls to Template::Parser::CORE:subst, avg 5µs/call
        # spent  1.50ms making 1035 calls to Template::Parser::CORE:regcomp, avg 1µs/call | 
| 430 | } | ||||
| 431 | |||||
| 432 | # anything remaining in the string is plain text | ||||
| 433 | 8 | 24µs | push(@tokens, $interp | ||
| 434 | ? [ $text, $line, 'ITEXT' ] | ||||
| 435 | : ( 'TEXT', $text) ) | ||||
| 436 | if length $text; | ||||
| 437 | |||||
| 438 | 8 | 184µs | return \@tokens; ## RETURN ## | ||
| 439 | } | ||||
| 440 | |||||
| 441 | |||||
| 442 | |||||
| 443 | #------------------------------------------------------------------------ | ||||
| 444 | # interpolate_text($text, $line) | ||||
| 445 | # | ||||
| 446 | # Examines $text looking for any variable references embedded like | ||||
| 447 | # $this or like ${ this }. | ||||
| 448 | #------------------------------------------------------------------------ | ||||
| 449 | |||||
| 450 | # spent 34µs (30+4) within Template::Parser::interpolate_text which was called:
#    once (30µs+4µs) by Template::Parser::tokenise_directive at line 583 | ||||
| 451 | 1 | 2µs | my ($self, $text, $line) = @_; | ||
| 452 | 1 | 800ns | my @tokens = (); | ||
| 453 | 1 | 600ns | my ($pre, $var, $dir); | ||
| 454 | |||||
| 455 | |||||
| 456 | 1 | 8µs | 1 | 3µs | while ($text =~    # spent     3µs making 1 call to Template::Parser::CORE:match | 
| 457 | / | ||||
| 458 | ( (?: \\. | [^\$] ){1,3000} ) # escaped or non-'$' character [$1] | ||||
| 459 | | | ||||
| 460 | ( \$ (?: # embedded variable [$2] | ||||
| 461 | (?: \{ ([^\}]*) \} ) # ${ ... } [$3] | ||||
| 462 | | | ||||
| 463 | ([\w\.]+) # $word [$4] | ||||
| 464 | ) | ||||
| 465 | ) | ||||
| 466 | /gx) { | ||||
| 467 | |||||
| 468 | 1 | 3µs | ($pre, $var, $dir) = ($1, $3 || $4, $2); | ||
| 469 | |||||
| 470 | # preceding text | ||||
| 471 | 1 | 2µs | if (defined($pre) && length($pre)) { | ||
| 472 | 1 | 1µs | $line += $pre =~ tr/\n//; | ||
| 473 | 1 | 4µs | 1 | 600ns | $pre =~ s/\\\$/\$/g;             # spent   600ns making 1 call to Template::Parser::CORE:subst | 
| 474 | 1 | 2µs | push(@tokens, 'TEXT', $pre); | ||
| 475 | } | ||||
| 476 | # $variable reference | ||||
| 477 | 1 | 5µs | 1 | 500ns | if ($var) {         # spent   500ns making 1 call to Template::Parser::CORE:match | 
| 478 | $line += $dir =~ tr/\n/ /; | ||||
| 479 | push(@tokens, [ $dir, $line, $self->tokenise_directive($var) ]); | ||||
| 480 | } | ||||
| 481 | # other '$' reference - treated as text | ||||
| 482 | elsif ($dir) { | ||||
| 483 | $line += $dir =~ tr/\n//; | ||||
| 484 | push(@tokens, 'TEXT', $dir); | ||||
| 485 | } | ||||
| 486 | } | ||||
| 487 | |||||
| 488 | 1 | 8µs | return \@tokens; | ||
| 489 | } | ||||
| 490 | |||||
| - - | |||||
| 493 | #------------------------------------------------------------------------ | ||||
| 494 | # tokenise_directive($text) | ||||
| 495 | # | ||||
| 496 | # Called by the private _parse() method when it encounters a DIRECTIVE | ||||
| 497 | # token in the list provided by the split_text() or interpolate_text() | ||||
| 498 | # methods. The directive text is passed by parameter. | ||||
| 499 | # | ||||
| 500 | # The method splits the directive into individual tokens as recognised | ||||
| 501 | # by the parser grammar (see Template::Grammar for details). It | ||||
| 502 | # constructs a list of tokens each represented by 2 elements, as per | ||||
| 503 | # split_text() et al. The first element contains the token type, the | ||||
| 504 | # second the token itself. | ||||
| 505 | # | ||||
| 506 | # The method tokenises the string using a complex (but fast) regex. | ||||
| 507 | # For a deeper understanding of the regex magic at work here, see | ||||
| 508 | # Jeffrey Friedl's excellent book "Mastering Regular Expressions", | ||||
| 509 | # from O'Reilly, ISBN 1-56592-257-3 | ||||
| 510 | # | ||||
| 511 | # Returns a reference to the list of chunks (each one being 2 elements) | ||||
| 512 | # identified in the directive text. On error, the internal _ERROR string | ||||
| 513 | # is set and undef is returned. | ||||
| 514 | #------------------------------------------------------------------------ | ||||
| 515 | |||||
| 516 | # spent 52.0ms (40.2+11.8) within Template::Parser::tokenise_directive which was called 1035 times, avg 50µs/call:
# 1035 times (40.2ms+11.8ms) by Template::Parser::split_text at line 418, avg 50µs/call | ||||
| 517 | 1035 | 1.19ms | my ($self, $text, $line) = @_; | ||
| 518 | 1035 | 563µs | my ($token, $uctoken, $type, $lookup); | ||
| 519 | 1035 | 1.09ms | my $lextable = $self->{ LEXTABLE }; | ||
| 520 | 1035 | 795µs | my $style = $self->{ STYLE }->[-1]; | ||
| 521 | 1035 | 1.53ms | my ($anycase, $start, $end) = @$style{ qw( ANYCASE START_TAG END_TAG ) }; | ||
| 522 | 1035 | 596µs | my @tokens = ( ); | ||
| 523 | |||||
| 524 | 1035 | 7.83ms | 1036 | 4.36ms | while ($text =~     # spent  4.36ms making 1036 calls to Template::Parser::CORE:match, avg 4µs/call | 
| 525 | / | ||||
| 526 | # strip out any comments | ||||
| 527 | (\#[^\n]*) | ||||
| 528 | | | ||||
| 529 | # a quoted phrase matches in $3 | ||||
| 530 | (["']) # $2 - opening quote, ' or " | ||||
| 531 | ( # $3 - quoted text buffer | ||||
| 532 | (?: # repeat group (no backreference) | ||||
| 533 | \\\\ # an escaped backslash \\ | ||||
| 534 | | # ...or... | ||||
| 535 | \\\2 # an escaped quote \" or \' (match $1) | ||||
| 536 | | # ...or... | ||||
| 537 | . # any other character | ||||
| 538 | | \n | ||||
| 539 | )*? # non-greedy repeat | ||||
| 540 | ) # end of $3 | ||||
| 541 | \2 # match opening quote | ||||
| 542 | | | ||||
| 543 | # an unquoted number matches in $4 | ||||
| 544 | (-?\d+(?:\.\d+)?) # numbers | ||||
| 545 | | | ||||
| 546 | # filename matches in $5 | ||||
| 547 | ( \/?\w+(?:(?:\/|::?)\w*)+ | \/\w+) | ||||
| 548 | | | ||||
| 549 | # an identifier matches in $6 | ||||
| 550 | (\w+) # variable identifier | ||||
| 551 | | | ||||
| 552 | # an unquoted word or symbol matches in $7 | ||||
| 553 | ( [(){}\[\]:;,\/\\] # misc parenthesis and symbols | ||||
| 554 | # | \-> # arrow operator (for future?) | ||||
| 555 | | [+\-*] # math operations | ||||
| 556 | | \$\{? # dollar with option left brace | ||||
| 557 | | => # like '=' | ||||
| 558 | | [=!<>]?= | [!<>] # eqality tests | ||||
| 559 | | &&? | \|\|? # boolean ops | ||||
| 560 | | \.\.? # n..n sequence | ||||
| 561 | | \S+ # something unquoted | ||||
| 562 | ) # end of $7 | ||||
| 563 | /gmxo) { | ||||
| 564 | |||||
| 565 | # ignore comments to EOL | ||||
| 566 | 2791 | 2.50ms | next if $1; | ||
| 567 | |||||
| 568 | # quoted string | ||||
| 569 | 2791 | 6.78ms | if (defined ($token = $3)) { | ||
| 570 | # double-quoted string may include $variable references | ||||
| 571 | 37 | 78µs | if ($2 eq '"') { | ||
| 572 | 18 | 102µs | 18 | 27µs | if ($token =~ /[\$\\]/) {                 # spent    27µs making 18 calls to Template::Parser::CORE:match, avg 2µs/call | 
| 573 | 1 | 900ns | $type = 'QUOTED'; | ||
| 574 | # unescape " and \ but leave \$ escaped so that | ||||
| 575 | # interpolate_text() doesn't incorrectly treat it | ||||
| 576 | # as a variable reference | ||||
| 577 | # $token =~ s/\\([\\"])/$1/g; | ||||
| 578 | 1 | 2µs | for ($token) { | ||
| 579 | 1 | 22µs | 3 | 7µs | s/\\([^\$nrt])/$1/g;                                 # spent     3µs making 1 call to Template::Parser::CORE:subst
                                # spent     3µs making 2 calls to Template::Parser::CORE:substcont, avg 2µs/call | 
| 580 | 1 | 6µs | 1 | 600ns | s/\\([nrt])/$QUOTED_ESCAPES->{ $1 }/ge;                                 # spent   600ns making 1 call to Template::Parser::CORE:subst | 
| 581 | } | ||||
| 582 | push(@tokens, ('"') x 2, | ||||
| 583 | 1 | 12µs | 1 | 34µs | @{ $self->interpolate_text($token) },                                   # spent    34µs making 1 call to Template::Parser::interpolate_text | 
| 584 | ('"') x 2); | ||||
| 585 | 1 | 2µs | next; | ||
| 586 | } | ||||
| 587 | else { | ||||
| 588 | 17 | 13µs | $type = 'LITERAL'; | ||
| 589 | 17 | 79µs | 17 | 25µs | $token =~ s['][\\']g;                     # spent    25µs making 17 calls to Template::Parser::CORE:subst, avg 1µs/call | 
| 590 | 17 | 34µs | $token = "'$token'"; | ||
| 591 | } | ||||
| 592 | } | ||||
| 593 | else { | ||||
| 594 | 19 | 17µs | $type = 'LITERAL'; | ||
| 595 | 19 | 74µs | $token = "'$token'"; | ||
| 596 | } | ||||
| 597 | } | ||||
| 598 | # number | ||||
| 599 | elsif (defined ($token = $4)) { | ||||
| 600 | $type = 'NUMBER'; | ||||
| 601 | } | ||||
| 602 | elsif (defined($token = $5)) { | ||||
| 603 | $type = 'FILENAME'; | ||||
| 604 | } | ||||
| 605 | elsif (defined($token = $6)) { | ||||
| 606 | # Fold potential keywords to UPPER CASE if the ANYCASE option is | ||||
| 607 | # set, unless (we've got some preceeding tokens and) the previous | ||||
| 608 | # token is a DOT op. This prevents the 'last' in 'data.last' | ||||
| 609 | # from being interpreted as the LAST keyword. | ||||
| 610 | 1780 | 809µs | $uctoken = | ||
| 611 | ($anycase && (! @tokens || $tokens[-2] ne 'DOT')) | ||||
| 612 | ? uc $token | ||||
| 613 | : $token; | ||||
| 614 | 1780 | 2.30ms | if (defined ($type = $lextable->{ $uctoken })) { | ||
| 615 | $token = $uctoken; | ||||
| 616 | } | ||||
| 617 | else { | ||||
| 618 | 1020 | 497µs | $type = 'IDENT'; | ||
| 619 | } | ||||
| 620 | } | ||||
| 621 | elsif (defined ($token = $7)) { | ||||
| 622 | # reserved words may be in lower case unless case sensitive | ||||
| 623 | 966 | 405µs | $uctoken = $anycase ? uc $token : $token; | ||
| 624 | 966 | 1.02ms | unless (defined ($type = $lextable->{ $uctoken })) { | ||
| 625 | $type = 'UNQUOTED'; | ||||
| 626 | } | ||||
| 627 | } | ||||
| 628 | |||||
| 629 | 2790 | 19.7ms | 2790 | 7.31ms | push(@tokens, $type, $token);         # spent  7.31ms making 2790 calls to Template::Parser::CORE:match, avg 3µs/call | 
| 630 | |||||
| 631 | # print(STDERR " +[ $type, $token ]\n") | ||||
| 632 | # if $DEBUG; | ||||
| 633 | } | ||||
| 634 | |||||
| 635 | # print STDERR "tokenise directive() returning:\n [ @tokens ]\n" | ||||
| 636 | # if $DEBUG; | ||||
| 637 | |||||
| 638 | 1035 | 4.66ms | return \@tokens; ## RETURN ## | ||
| 639 | } | ||||
| 640 | |||||
| 641 | |||||
| 642 | #------------------------------------------------------------------------ | ||||
| 643 | # define_block($name, $block) | ||||
| 644 | # | ||||
| 645 | # Called by the parser 'defblock' rule when a BLOCK definition is | ||||
| 646 | # encountered in the template. The name of the block is passed in the | ||||
| 647 | # first parameter and a reference to the compiled block is passed in | ||||
| 648 | # the second. This method stores the block in the $self->{ DEFBLOCK } | ||||
| 649 | # hash which has been initialised by parse() and will later be used | ||||
| 650 | # by the same method to call the store() method on the calling cache | ||||
| 651 | # to define the block "externally". | ||||
| 652 | #------------------------------------------------------------------------ | ||||
| 653 | |||||
| 654 | sub define_block { | ||||
| 655 | my ($self, $name, $block) = @_; | ||||
| 656 | my $defblock = $self->{ DEFBLOCK } | ||||
| 657 | || return undef; | ||||
| 658 | |||||
| 659 | $self->debug("compiled block '$name':\n$block") | ||||
| 660 | if $self->{ DEBUG } & Template::Constants::DEBUG_PARSER; | ||||
| 661 | |||||
| 662 | $defblock->{ $name } = $block; | ||||
| 663 | |||||
| 664 | return undef; | ||||
| 665 | } | ||||
| 666 | |||||
| 667 | sub push_defblock { | ||||
| 668 | my $self = shift; | ||||
| 669 | my $stack = $self->{ DEFBLOCK_STACK } ||= []; | ||||
| 670 | push(@$stack, $self->{ DEFBLOCK } ); | ||||
| 671 | $self->{ DEFBLOCK } = { }; | ||||
| 672 | } | ||||
| 673 | |||||
| 674 | sub pop_defblock { | ||||
| 675 | my $self = shift; | ||||
| 676 | my $defs = $self->{ DEFBLOCK }; | ||||
| 677 | my $stack = $self->{ DEFBLOCK_STACK } || return $defs; | ||||
| 678 | return $defs unless @$stack; | ||||
| 679 | $self->{ DEFBLOCK } = pop @$stack; | ||||
| 680 | return $defs; | ||||
| 681 | } | ||||
| 682 | |||||
| 683 | |||||
| 684 | #------------------------------------------------------------------------ | ||||
| 685 | # add_metadata(\@setlist) | ||||
| 686 | #------------------------------------------------------------------------ | ||||
| 687 | |||||
| 688 | sub add_metadata { | ||||
| 689 | my ($self, $setlist) = @_; | ||||
| 690 | my $metadata = $self->{ METADATA } | ||||
| 691 | || return undef; | ||||
| 692 | |||||
| 693 | push(@$metadata, @$setlist); | ||||
| 694 | |||||
| 695 | return undef; | ||||
| 696 | } | ||||
| 697 | |||||
| 698 | |||||
| 699 | #------------------------------------------------------------------------ | ||||
| 700 | # location() | ||||
| 701 | # | ||||
| 702 | # Return Perl comment indicating current parser file and line | ||||
| 703 | #------------------------------------------------------------------------ | ||||
| 704 | |||||
| 705 | # spent 10.8ms (9.49+1.27) within Template::Parser::location which was called 626 times, avg 17µs/call:
# 626 times (9.49ms+1.27ms) by Template::Grammar::__ANON__[Parser.yp:79] at line 78 of Parser.yp, avg 17µs/call | ||||
| 706 | 626 | 503µs | my $self = shift; | ||
| 707 | 626 | 667µs | return "\n" unless $self->{ FILE_INFO }; | ||
| 708 | 626 | 734µs | my $line = ${ $self->{ LINE } }; | ||
| 709 | 626 | 711µs | my $info = $self->{ FILEINFO }->[-1]; | ||
| 710 | my $file = $info->{ path } || $info->{ name } | ||||
| 711 | 626 | 842µs | || '(unknown template)'; | ||
| 712 | 626 | 3.87ms | 626 | 1.27ms | $line =~ s/\-.*$//; # might be 'n-n'     # spent  1.27ms making 626 calls to Template::Parser::CORE:subst, avg 2µs/call | 
| 713 | 626 | 259µs | $line ||= 1; | ||
| 714 | 626 | 3.73ms | return "#line $line \"$file\"\n"; | ||
| 715 | } | ||||
| 716 | |||||
| 717 | |||||
| 718 | #======================================================================== | ||||
| 719 | # ----- PRIVATE METHODS ----- | ||||
| 720 | #======================================================================== | ||||
| 721 | |||||
| 722 | #------------------------------------------------------------------------ | ||||
| 723 | # _parse(\@tokens, \@info) | ||||
| 724 | # | ||||
| 725 | # Parses the list of input tokens passed by reference and returns a | ||||
| 726 | # Template::Directive::Block object which contains the compiled | ||||
| 727 | # representation of the template. | ||||
| 728 | # | ||||
| 729 | # This is the main parser DFA loop. See embedded comments for | ||||
| 730 | # further details. | ||||
| 731 | # | ||||
| 732 | # On error, undef is returned and the internal _ERROR field is set to | ||||
| 733 | # indicate the error. This can be retrieved by calling the error() | ||||
| 734 | # method. | ||||
| 735 | #------------------------------------------------------------------------ | ||||
| 736 | |||||
| 737 | # spent 442ms (314+128) within Template::Parser::_parse which was called 8 times, avg 55.2ms/call:
# 8 times (314ms+128ms) by Template::Parser::parse at line 291, avg 55.2ms/call | ||||
| 738 | 8 | 14µs | my ($self, $tokens, $info) = @_; | ||
| 739 | 8 | 9µs | my ($token, $value, $text, $line, $inperl); | ||
| 740 | 8 | 10µs | my ($state, $stateno, $status, $action, $lookup, $coderet, @codevars); | ||
| 741 | 8 | 4µs | my ($lhs, $len, $code); # rule contents | ||
| 742 | 8 | 18µs | my $stack = [ [ 0, undef ] ]; # DFA stack | ||
| 743 | |||||
| 744 | # DEBUG | ||||
| 745 | # local $" = ', '; | ||||
| 746 | |||||
| 747 | # retrieve internal rule and state tables | ||||
| 748 | 8 | 22µs | my ($states, $rules) = @$self{ qw( STATES RULES ) }; | ||
| 749 | |||||
| 750 | # call the grammar set_factory method to install emitter factory | ||||
| 751 | 8 | 60µs | 8 | 42µs | $self->{ GRAMMAR }->install_factory($self->{ FACTORY });     # spent    42µs making 8 calls to Template::Grammar::install_factory, avg 5µs/call | 
| 752 | |||||
| 753 | 8 | 7µs | $line = $inperl = 0; | ||
| 754 | 8 | 15µs | $self->{ LINE } = \$line; | ||
| 755 | 8 | 24µs | $self->{ FILE } = $info->{ name }; | ||
| 756 | 8 | 25µs | $self->{ INPERL } = \$inperl; | ||
| 757 | |||||
| 758 | 8 | 8µs | $status = CONTINUE; | ||
| 759 | 8 | 5µs | my $in_string = 0; | ||
| 760 | |||||
| 761 | 8 | 35.4ms | while(1) { | ||
| 762 | # get state number and state | ||||
| 763 | 15865 | 9.72ms | $stateno = $stack->[-1]->[0]; | ||
| 764 | 15865 | 9.02ms | $state = $states->[$stateno]; | ||
| 765 | |||||
| 766 | # see if any lookaheads exist for the current state | ||||
| 767 | 15865 | 15.3ms | if (exists $state->{'ACTIONS'}) { | ||
| 768 | |||||
| 769 | # get next token and expand any directives (i.e. token is an | ||||
| 770 | # array ref) onto the front of the token list | ||||
| 771 | 7708 | 7.03ms | while (! defined $token && @$tokens) { | ||
| 772 | 5777 | 4.66ms | $token = shift(@$tokens); | ||
| 773 | 5777 | 7.40ms | if (ref $token) { | ||
| 774 | 1035 | 2.47ms | ($text, $line, $token) = @$token; | ||
| 775 | 1035 | 834µs | if (ref $token) { | ||
| 776 | 1035 | 1.27ms | if ($info->{ DEBUG } && ! $in_string) { | ||
| 777 | # - - - - - - - - - - - - - - - - - - - - - - - - - | ||||
| 778 | # This is gnarly. Look away now if you're easily | ||||
| 779 | # frightened. We're pushing parse tokens onto the | ||||
| 780 | # pending list to simulate a DEBUG directive like so: | ||||
| 781 | # [% DEBUG msg line='20' text='INCLUDE foo' %] | ||||
| 782 | # - - - - - - - - - - - - - - - - - - - - - - - - - | ||||
| 783 | my $dtext = $text; | ||||
| 784 | $dtext =~ s[(['\\])][\\$1]g; | ||||
| 785 | unshift(@$tokens, | ||||
| 786 | DEBUG => 'DEBUG', | ||||
| 787 | IDENT => 'msg', | ||||
| 788 | IDENT => 'line', | ||||
| 789 | ASSIGN => '=', | ||||
| 790 | LITERAL => "'$line'", | ||||
| 791 | IDENT => 'text', | ||||
| 792 | ASSIGN => '=', | ||||
| 793 | LITERAL => "'$dtext'", | ||||
| 794 | IDENT => 'file', | ||||
| 795 | ASSIGN => '=', | ||||
| 796 | LITERAL => "'$info->{ name }'", | ||||
| 797 | (';') x 2, | ||||
| 798 | @$token, | ||||
| 799 | (';') x 2); | ||||
| 800 | } | ||||
| 801 | else { | ||||
| 802 | 1035 | 3.95ms | unshift(@$tokens, @$token, (';') x 2); | ||
| 803 | } | ||||
| 804 | 1035 | 561µs | $token = undef; # force redo | ||
| 805 | } | ||||
| 806 | elsif ($token eq 'ITEXT') { | ||||
| 807 | if ($inperl) { | ||||
| 808 | # don't perform interpolation in PERL blocks | ||||
| 809 | $token = 'TEXT'; | ||||
| 810 | $value = $text; | ||||
| 811 | } | ||||
| 812 | else { | ||||
| 813 | unshift(@$tokens, | ||||
| 814 | @{ $self->interpolate_text($text, $line) }); | ||||
| 815 | $token = undef; # force redo | ||||
| 816 | } | ||||
| 817 | } | ||||
| 818 | } | ||||
| 819 | else { | ||||
| 820 | # toggle string flag to indicate if we're crossing | ||||
| 821 | # a string boundary | ||||
| 822 | 4742 | 2.42ms | $in_string = ! $in_string if $token eq '"'; | ||
| 823 | 4742 | 3.08ms | $value = shift(@$tokens); | ||
| 824 | } | ||||
| 825 | }; | ||||
| 826 | # clear undefined token to avoid 'undefined variable blah blah' | ||||
| 827 | # warnings and let the parser logic pick it up in a minute | ||||
| 828 | 7708 | 2.04ms | $token = '' unless defined $token; | ||
| 829 | |||||
| 830 | # get the next state for the current lookahead token | ||||
| 831 | 7708 | 10.5ms | $action = defined ($lookup = $state->{'ACTIONS'}->{ $token }) | ||
| 832 | ? $lookup | ||||
| 833 | : defined ($lookup = $state->{'DEFAULT'}) | ||||
| 834 | ? $lookup | ||||
| 835 | : undef; | ||||
| 836 | } | ||||
| 837 | else { | ||||
| 838 | # no lookahead actions | ||||
| 839 | 8157 | 5.50ms | $action = $state->{'DEFAULT'}; | ||
| 840 | } | ||||
| 841 | |||||
| 842 | # ERROR: no ACTION | ||||
| 843 | 15865 | 4.61ms | last unless defined $action; | ||
| 844 | |||||
| 845 | # - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||||
| 846 | # shift (+ive ACTION) | ||||
| 847 | # - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||||
| 848 | 15865 | 6.83ms | if ($action > 0) { | ||
| 849 | 4750 | 6.09ms | push(@$stack, [ $action, $value ]); | ||
| 850 | 4750 | 2.16ms | $token = $value = undef; | ||
| 851 | 4750 | 2.65ms | redo; | ||
| 852 | }; | ||||
| 853 | |||||
| 854 | # - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||||
| 855 | # reduce (-ive ACTION) | ||||
| 856 | # - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||||
| 857 | 11115 | 26.6ms | ($lhs, $len, $code) = @{ $rules->[ -$action ] }; | ||
| 858 | |||||
| 859 | # no action imples ACCEPTance | ||||
| 860 | 11115 | 2.80ms | $action | ||
| 861 | or $status = ACCEPT; | ||||
| 862 | |||||
| 863 | # use dummy sub if code ref doesn't exist | ||||
| 864 | 3116 | 11.2ms | # spent 7.07ms within Template::Parser::__ANON__[/usr/lib/perl5/Template/Parser.pm:864] which was called 3116 times, avg 2µs/call:
# 3116 times (7.07ms+0s) by Template::Parser::_parse at line 872, avg 2µs/call | ||
| 865 | 11115 | 11.2ms | unless $code; | ||
| 866 | |||||
| 867 | @codevars = $len | ||||
| 868 | 11115 | 44.7ms | ? map { $_->[1] } @$stack[ -$len .. -1 ] | ||
| 869 | : (); | ||||
| 870 | |||||
| 871 | 11115 | 9.03ms | eval { | ||
| 872 | 11115 | 35.5ms | 11115 | 128ms | $coderet = &$code( $self, @codevars );             # spent  51.5ms making  914 calls to Template::Grammar::__ANON__[Parser.yp:76], avg 56µs/call
            # spent  16.7ms making  626 calls to Template::Grammar::__ANON__[Parser.yp:79], avg 27µs/call
            # spent  9.74ms making  643 calls to Template::Grammar::__ANON__[Parser.yp:305], avg 15µs/call
            # spent  7.64ms making  416 calls to Template::Grammar::__ANON__[Parser.yp:67], avg 18µs/call
            # spent  7.07ms making 3116 calls to Template::Parser::__ANON__[Template/Parser.pm:864], avg 2µs/call
            # spent  6.84ms making  273 calls to Template::Grammar::__ANON__[Parser.yp:141], avg 25µs/call
            # spent  4.66ms making 1124 calls to Template::Grammar::__ANON__[Parser.yp:72], avg 4µs/call
            # spent  3.34ms making  236 calls to Template::Grammar::__ANON__[Parser.yp:90], avg 14µs/call
            # spent  3.13ms making  919 calls to Template::Grammar::__ANON__[Parser.yp:345], avg 3µs/call
            # spent  2.83ms making  915 calls to Template::Grammar::__ANON__[Parser.yp:341], avg 3µs/call
            # spent  2.72ms making   27 calls to Template::Grammar::__ANON__[Parser.yp:168], avg 101µs/call
            # spent  2.50ms making   74 calls to Template::Grammar::__ANON__[Parser.yp:229], avg 34µs/call
            # spent  1.51ms making  416 calls to Template::Grammar::__ANON__[Parser.yp:73], avg 4µs/call
            # spent  1.10ms making  273 calls to Template::Grammar::__ANON__[Parser.yp:334], avg 4µs/call
            # spent  1.08ms making  276 calls to Template::Grammar::__ANON__[Parser.yp:364], avg 4µs/call
            # spent  1.03ms making   67 calls to Template::Grammar::__ANON__[Parser.yp:109], avg 15µs/call
            # spent   595µs making  192 calls to Template::Grammar::__ANON__[Parser.yp:152], avg 3µs/call
            # spent   570µs making   27 calls to Template::Grammar::__ANON__[Parser.yp:167], avg 21µs/call
            # spent   507µs making    8 calls to Template::Grammar::__ANON__[Parser.yp:64], avg 63µs/call
            # spent   400µs making  113 calls to Template::Grammar::__ANON__[Parser.yp:387], avg 4µs/call
            # spent   349µs making   93 calls to Template::Grammar::__ANON__[Parser.yp:151], avg 4µs/call
            # spent   306µs making   12 calls to Template::Grammar::__ANON__[Parser.yp:144], avg 25µs/call
            # spent   303µs making   74 calls to Template::Grammar::__ANON__[Parser.yp:416], avg 4µs/call
            # spent   274µs making   79 calls to Template::Grammar::__ANON__[Parser.yp:407], avg 3µs/call
            # spent   232µs making   82 calls to Template::Grammar::__ANON__[Parser.yp:412], avg 3µs/call
            # spent   211µs making    8 calls to Template::Grammar::__ANON__[Parser.yp:118], avg 26µs/call
            # spent   126µs making   23 calls to Template::Grammar::__ANON__[Parser.yp:357], avg 5µs/call
            # spent   123µs making   27 calls to Template::Grammar::__ANON__[Parser.yp:176], avg 5µs/call
            # spent   119µs making    3 calls to Template::Grammar::__ANON__[Parser.yp:115], avg 40µs/call
            # spent    72µs making    4 calls to Template::Grammar::__ANON__[Parser.yp:342], avg 18µs/call
            # spent    41µs making   12 calls to Template::Grammar::__ANON__[Parser.yp:359], avg 3µs/call
            # spent    34µs making    9 calls to Template::Grammar::__ANON__[Parser.yp:360], avg 4µs/call
            # spent    33µs making    1 call to Template::Grammar::__ANON__[Parser.yp:307]
            # spent    29µs making    9 calls to Template::Grammar::__ANON__[Parser.yp:382], avg 3µs/call
            # spent    29µs making    4 calls to Template::Grammar::__ANON__[Parser.yp:150], avg 7µs/call
            # spent    27µs making    1 call to Template::Grammar::__ANON__[Parser.yp:440]
            # spent    19µs making    1 call to Template::Grammar::__ANON__[Parser.yp:68]
            # spent    18µs making    1 call to Template::Grammar::__ANON__[Parser.yp:145]
            # spent    10µs making    3 calls to Template::Grammar::__ANON__[Parser.yp:408], avg 3µs/call
            # spent     9µs making    4 calls to Template::Grammar::__ANON__[Parser.yp:312], avg 2µs/call
            # spent     8µs making    3 calls to Template::Grammar::__ANON__[Parser.yp:374], avg 3µs/call
            # spent     5µs making    3 calls to Template::Grammar::__ANON__[Parser.yp:386], avg 2µs/call
            # spent     4µs making    1 call to Template::Grammar::__ANON__[Parser.yp:435]
            # spent     4µs making    1 call to Template::Grammar::__ANON__[Parser.yp:361]
            # spent     3µs making    1 call to Template::Grammar::__ANON__[Parser.yp:436]
            # spent     3µs making    1 call to Template::Grammar::__ANON__[Parser.yp:299] | 
| 873 | }; | ||||
| 874 | 11115 | 3.42ms | if ($@) { | ||
| 875 | my $err = $@; | ||||
| 876 | chomp $err; | ||||
| 877 | return $self->_parse_error($err); | ||||
| 878 | } | ||||
| 879 | |||||
| 880 | # reduce stack by $len | ||||
| 881 | 11115 | 13.8ms | splice(@$stack, -$len, $len); | ||
| 882 | |||||
| 883 | # ACCEPT | ||||
| 884 | 11115 | 4.28ms | return $coderet ## RETURN ## | ||
| 885 | if $status == ACCEPT; | ||||
| 886 | |||||
| 887 | # ABORT | ||||
| 888 | return undef ## RETURN ## | ||||
| 889 | 11107 | 2.82ms | if $status == ABORT; | ||
| 890 | |||||
| 891 | # ERROR | ||||
| 892 | last | ||||
| 893 | 11107 | 4.46ms | if $status == ERROR; | ||
| 894 | } | ||||
| 895 | continue { | ||||
| 896 | push(@$stack, [ $states->[ $stack->[-1][0] ]->{'GOTOS'}->{ $lhs }, | ||||
| 897 | $coderet ]), | ||||
| 898 | } | ||||
| 899 | |||||
| 900 | # ERROR ## RETURN ## | ||||
| 901 | return $self->_parse_error('unexpected end of input') | ||||
| 902 | unless defined $value; | ||||
| 903 | |||||
| 904 | # munge text of last directive to make it readable | ||||
| 905 | # $text =~ s/\n/\\n/g; | ||||
| 906 | |||||
| 907 | return $self->_parse_error("unexpected end of directive", $text) | ||||
| 908 | if $value eq ';'; # end of directive SEPARATOR | ||||
| 909 | |||||
| 910 | return $self->_parse_error("unexpected token ($value)", $text); | ||||
| 911 | } | ||||
| 912 | |||||
| - - | |||||
| 915 | #------------------------------------------------------------------------ | ||||
| 916 | # _parse_error($msg, $dirtext) | ||||
| 917 | # | ||||
| 918 | # Method used to handle errors encountered during the parse process | ||||
| 919 | # in the _parse() method. | ||||
| 920 | #------------------------------------------------------------------------ | ||||
| 921 | |||||
| 922 | sub _parse_error { | ||||
| 923 | my ($self, $msg, $text) = @_; | ||||
| 924 | my $line = $self->{ LINE }; | ||||
| 925 | $line = ref($line) ? $$line : $line; | ||||
| 926 | $line = 'unknown' unless $line; | ||||
| 927 | |||||
| 928 | $msg .= "\n [% $text %]" | ||||
| 929 | if defined $text; | ||||
| 930 | |||||
| 931 | return $self->error("line $line: $msg"); | ||||
| 932 | } | ||||
| 933 | |||||
| 934 | |||||
| 935 | #------------------------------------------------------------------------ | ||||
| 936 | # _dump() | ||||
| 937 | # | ||||
| 938 | # Debug method returns a string representing the internal state of the | ||||
| 939 | # object. | ||||
| 940 | #------------------------------------------------------------------------ | ||||
| 941 | |||||
| 942 | sub _dump { | ||||
| 943 | my $self = shift; | ||||
| 944 | my $output = "[Template::Parser] {\n"; | ||||
| 945 | my $format = " %-16s => %s\n"; | ||||
| 946 | my $key; | ||||
| 947 | |||||
| 948 | foreach $key (qw( START_TAG END_TAG TAG_STYLE ANYCASE INTERPOLATE | ||||
| 949 | PRE_CHOMP POST_CHOMP V1DOLLAR )) { | ||||
| 950 | my $val = $self->{ $key }; | ||||
| 951 | $val = '<undef>' unless defined $val; | ||||
| 952 | $output .= sprintf($format, $key, $val); | ||||
| 953 | } | ||||
| 954 | |||||
| 955 | $output .= '}'; | ||||
| 956 | return $output; | ||||
| 957 | } | ||||
| 958 | |||||
| 959 | |||||
| 960 | 1 | 20µs | 1; | ||
| 961 | |||||
| 962 | __END__ | ||||
| # spent 12.9ms within Template::Parser::CORE:match which was called 5916 times, avg 2µs/call:
# 2790 times (7.31ms+0s) by Template::Parser::tokenise_directive at line 629, avg 3µs/call
# 1036 times (4.36ms+0s) by Template::Parser::tokenise_directive at line 524, avg 4µs/call
# 1035 times (761µs+0s) by Template::Parser::split_text at line 348, avg 735ns/call
# 1035 times (476µs+0s) by Template::Parser::split_text at line 403, avg 460ns/call
#   18 times (27µs+0s) by Template::Parser::tokenise_directive at line 572, avg 2µs/call
#       once (3µs+0s) by Template::Parser::interpolate_text at line 456
#       once (500ns+0s) by Template::Parser::interpolate_text at line 477 | |||||
| sub Template::Parser::CORE:qr; # opcode | |||||
| # spent 3.74ms within Template::Parser::CORE:regcomp which was called 4148 times, avg 902ns/call:
# 1035 times (1.50ms+0s) by Template::Parser::split_text at line 429, avg 1µs/call
# 1035 times (1.38ms+0s) by Template::Parser::split_text at line 403, avg 1µs/call
# 1035 times (417µs+0s) by Template::Parser::split_text at line 372, avg 403ns/call
# 1035 times (363µs+0s) by Template::Parser::split_text at line 353, avg 350ns/call
#    8 times (79µs+0s) by Template::Parser::split_text at line 330, avg 10µs/call | |||||
| # spent 15.3ms within Template::Parser::CORE:subst which was called 3759 times, avg 4µs/call:
# 1035 times (6.96ms+0s) by Template::Parser::split_text at line 372, avg 7µs/call
# 1035 times (4.68ms+0s) by Template::Parser::split_text at line 429, avg 5µs/call
# 1035 times (2.23ms+0s) by Template::Parser::split_text at line 353, avg 2µs/call
#  626 times (1.27ms+0s) by Template::Parser::location at line 712, avg 2µs/call
#   17 times (25µs+0s) by Template::Parser::tokenise_directive at line 589, avg 1µs/call
#    8 times (102µs+0s) by Template::Parser::split_text at line 330, avg 13µs/call
#       once (3µs+0s) by Template::Parser::tokenise_directive at line 579
#       once (600ns+0s) by Template::Parser::tokenise_directive at line 580
#       once (600ns+0s) by Template::Parser::interpolate_text at line 473 | |||||
| # spent 3µs within Template::Parser::CORE:substcont which was called 2 times, avg 2µs/call:
# 2 times (3µs+0s) by Template::Parser::tokenise_directive at line 579, avg 2µs/call |