line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
## no critic (ProhibitUnusedPrivateSubroutines) |
2
|
|
|
|
|
|
|
package Text::Template::Simple::Base::Parser; |
3
|
62
|
|
|
62
|
|
518
|
use strict; |
|
62
|
|
|
|
|
140
|
|
|
62
|
|
|
|
|
2776
|
|
4
|
62
|
|
|
62
|
|
455
|
use warnings; |
|
62
|
|
|
|
|
155
|
|
|
62
|
|
|
|
|
8175
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.86'; |
7
|
|
|
|
|
|
|
|
8
|
62
|
|
|
62
|
|
389
|
use Text::Template::Simple::Util qw(:all); |
|
62
|
|
|
|
|
299
|
|
|
62
|
|
|
|
|
30936
|
|
9
|
62
|
|
|
62
|
|
543
|
use Text::Template::Simple::Constants qw(:all); |
|
62
|
|
|
|
|
141
|
|
|
62
|
|
|
|
|
58481
|
|
10
|
62
|
|
|
62
|
|
1801
|
use constant MAPKEY_NUM => 5; |
|
62
|
|
|
|
|
178
|
|
|
62
|
|
|
|
|
282321
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my %INTERNAL = __PACKAGE__->_set_internal_templates; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub _needs_object { |
15
|
274
|
|
|
274
|
|
525
|
my $self = shift; |
16
|
274
|
|
|
|
|
601
|
$self->[NEEDS_OBJECT]++; |
17
|
274
|
|
|
|
|
2107
|
return $self; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub _internal { |
21
|
280
|
|
|
280
|
|
1013
|
my $self = shift; |
22
|
280
|
|
33
|
|
|
846
|
my $id = shift || fatal('tts.base.parser._internal.id'); |
23
|
280
|
|
33
|
|
|
47998
|
my $rv = $INTERNAL{ $id } || fatal('tts.base.parser._internal.id'); |
24
|
280
|
50
|
|
|
|
942
|
LOG( INTERNAL => "TEMPLATE: $id" ) if DEBUG; |
25
|
280
|
|
|
|
|
1651
|
return $rv; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub _parse { |
29
|
502
|
|
|
502
|
|
1177
|
my($self, $raw, $opt) = @_; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# $opt-> |
32
|
|
|
|
|
|
|
# map_keys: code sections are hash keys |
33
|
|
|
|
|
|
|
# as_is : i.e.: do not parse -> static include |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
#$self->[NEEDS_OBJECT] = 0; # reset |
36
|
|
|
|
|
|
|
|
37
|
502
|
|
|
|
|
2036
|
my($ds, $de) = @{ $self->[DELIMITERS] }; |
|
502
|
|
|
|
|
1724
|
|
38
|
502
|
100
|
|
|
|
3877
|
my $faker = $self->[INSIDE_INCLUDE] ? $self->_output_buffer_var |
39
|
|
|
|
|
|
|
: $self->[FAKER] |
40
|
|
|
|
|
|
|
; |
41
|
502
|
|
|
|
|
14914
|
my $buf_hash = $self->[FAKER_HASH]; |
42
|
502
|
|
|
|
|
3713
|
my($mko, $mkc) = $self->_parse_mapkeys( $opt->{map_keys}, $faker, $buf_hash ); |
43
|
|
|
|
|
|
|
|
44
|
502
|
50
|
|
|
|
1961
|
LOG( RAW => $raw ) if DEBUG > DEBUG_LEVEL_INSANE; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
my $h = { |
47
|
410
|
|
|
410
|
|
2470
|
raw => sub { ";$faker .= q~$_[0]~;" }, |
48
|
498
|
|
|
498
|
|
5445
|
capture => sub { ";$faker .= sub {" . $_[0] . '}->();'; }, |
49
|
70
|
|
|
70
|
|
325
|
code => sub { $_[0] . q{;} }, |
50
|
502
|
|
|
|
|
34969
|
}; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# little hack to convert delims into escaped delims for static inclusion |
53
|
502
|
100
|
|
|
|
2977
|
$raw =~ s{\Q$ds}{$ds!}xmsg if $opt->{as_is}; |
54
|
|
|
|
|
|
|
|
55
|
502
|
|
|
|
|
2495
|
my($code, $inside) = $self->_walk( $raw, $opt, $h, $mko, $mkc ); |
56
|
|
|
|
|
|
|
|
57
|
502
|
|
100
|
|
|
2280
|
$self->[FILENAME] ||= '<ANON>'; |
58
|
|
|
|
|
|
|
|
59
|
502
|
0
|
|
|
|
1691
|
fatal( |
|
|
50
|
|
|
|
|
|
60
|
|
|
|
|
|
|
'tts.base.parser._parse.unbalanced', |
61
|
|
|
|
|
|
|
abs($inside), |
62
|
|
|
|
|
|
|
($inside > 0 ? 'opening' : 'closing'), |
63
|
|
|
|
|
|
|
$self->[FILENAME] |
64
|
|
|
|
|
|
|
) if $inside; |
65
|
|
|
|
|
|
|
|
66
|
502
|
|
|
|
|
3840
|
return $self->_wrapper( $code, $opt->{cache_id}, $faker, $opt->{map_keys}, $h ); |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub _walk { |
70
|
502
|
|
|
502
|
|
1273
|
my($self, $raw, $opt, $h, $mko, $mkc) = @_; |
71
|
502
|
|
|
|
|
1769
|
my $uth = $self->[USER_THANDLER]; |
72
|
502
|
|
|
|
|
1172
|
my $code = EMPTY_STRING; |
73
|
502
|
|
|
|
|
1517
|
my $inside = 0; |
74
|
502
|
|
|
|
|
6320
|
my $toke = $self->connector('Tokenizer')->new( |
75
|
502
|
|
|
|
|
2655
|
@{ $self->[DELIMITERS] }, |
76
|
|
|
|
|
|
|
$self->[PRE_CHOMP], |
77
|
|
|
|
|
|
|
$self->[POST_CHOMP] |
78
|
|
|
|
|
|
|
); |
79
|
|
|
|
|
|
|
|
80
|
502
|
100
|
|
988
|
|
2576
|
my $is_raw = sub { my($id) = @_; T_RAW == $id || T_NOTADELIM == $id }; |
|
988
|
|
|
|
|
1554
|
|
|
988
|
|
|
|
|
11872
|
|
81
|
502
|
100
|
|
286
|
|
2453
|
my $is_inc = sub { my($id) = @_; T_DYNAMIC == $id || T_STATIC == $id }; |
|
286
|
|
|
|
|
667
|
|
|
286
|
|
|
|
|
8631
|
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# fetch and walk the tree |
84
|
502
|
|
|
|
|
8041
|
PARSER: foreach my $token ( @{ $toke->tokenize( $raw, $opt->{map_keys} ) } ) { |
|
502
|
|
|
|
|
2881
|
|
85
|
2190
|
|
|
|
|
4027
|
my($str, $id, $chomp, undef) = @{ $token }; |
|
2190
|
|
|
|
|
6147
|
|
86
|
|
|
|
|
|
|
|
87
|
2190
|
50
|
|
|
|
6863
|
LOG( TOKEN => $toke->_visualize_tid($id) . " => $str" ) |
88
|
|
|
|
|
|
|
if DEBUG >= DEBUG_LEVEL_VERBOSE; |
89
|
|
|
|
|
|
|
|
90
|
2190
|
100
|
100
|
|
|
16560
|
next PARSER if T_DISCARD == $id || T_COMMENT == $id; |
91
|
|
|
|
|
|
|
|
92
|
2164
|
100
|
|
|
|
5717
|
if ( T_DELIMSTART == $id ) { $inside++; next PARSER; } |
|
588
|
|
|
|
|
986
|
|
|
588
|
|
|
|
|
4081
|
|
93
|
1576
|
100
|
|
|
|
3865
|
if ( T_DELIMEND == $id ) { $inside--; next PARSER; } |
|
588
|
|
|
|
|
4007
|
|
|
588
|
|
|
|
|
2068
|
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
$code .= $is_raw->($id) ? $h->{raw }->( $self->_chomp( $str, $chomp ) ) |
96
|
|
|
|
|
|
|
: T_COMMAND == $id ? $h->{raw }->( $self->_parse_command( $str ) ) |
97
|
988
|
50
|
|
|
|
2603
|
: T_CODE == $id ? $h->{code }->( $str ) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
98
|
|
|
|
|
|
|
: T_CAPTURE == $id ? $h->{capture}->( $str ) |
99
|
|
|
|
|
|
|
: $is_inc->($id) ? $h->{capture}->( $self->_walk_inc( $opt, $id, $str) ) |
100
|
|
|
|
|
|
|
: T_MAPKEY == $id ? $self->_walk_mapkey( $mko, $mkc, $str ) |
101
|
|
|
|
|
|
|
: $self->_walk_unknown( $h, $uth, $id, $str ) |
102
|
|
|
|
|
|
|
; |
103
|
|
|
|
|
|
|
} |
104
|
502
|
|
|
|
|
15847
|
return $code, $inside; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub _walk_mapkey { |
108
|
12
|
|
|
12
|
|
29
|
my($self, $mko, $mkc, $str) = @_; |
109
|
12
|
50
|
|
|
|
104
|
return sprintf $mko, $mkc ? ( ($str) x MAPKEY_NUM ) : $str; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub _walk_inc { |
113
|
274
|
|
|
274
|
|
699
|
my($self, $opt, $id, $str) = @_; |
114
|
274
|
|
|
|
|
11893
|
return $self->_needs_object->include($id, $str, $opt); |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub _walk_unknown { |
118
|
0
|
|
|
0
|
|
0
|
my($self, $h, $uth, $id, $str) = @_; |
119
|
0
|
0
|
|
|
|
0
|
if ( DEBUG ) { |
120
|
0
|
0
|
|
|
|
0
|
LOG( |
121
|
|
|
|
|
|
|
$uth ? ( USER_THANDLER => "$id" ) |
122
|
|
|
|
|
|
|
: ( UNKNOWN_TOKEN => "Adding unknown token as RAW: $id($str)" ) |
123
|
|
|
|
|
|
|
); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
0
|
0
|
|
|
|
0
|
return $uth ? $uth->( $self, $id ,$str, $h ) : $h->{raw}->( $str ); |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub _parse_command { |
130
|
2
|
|
|
2
|
|
3
|
my $self = shift; |
131
|
2
|
|
|
|
|
3
|
my $str = shift; |
132
|
2
|
|
|
|
|
15
|
my($head, $raw_block) = split m{;}xms, $str, 2; |
133
|
2
|
|
|
|
|
10
|
my @buf = split RE_PIPE_SPLIT, q{|} . trim($head); |
134
|
2
|
|
|
|
|
4
|
shift @buf; |
135
|
2
|
|
|
|
|
5
|
my %com = map { trim $_ } @buf; |
|
4
|
|
|
|
|
8
|
|
136
|
|
|
|
|
|
|
|
137
|
2
|
50
|
|
|
|
12
|
if ( DEBUG >= DEBUG_LEVEL_INSANE ) { |
138
|
0
|
|
|
|
|
0
|
require Data::Dumper; |
139
|
0
|
|
|
|
|
0
|
LOG( |
140
|
|
|
|
|
|
|
PARSE_COMMAND => Data::Dumper::Dumper( |
141
|
|
|
|
|
|
|
{ |
142
|
|
|
|
|
|
|
string => $str, |
143
|
|
|
|
|
|
|
header => $head, |
144
|
|
|
|
|
|
|
raw => $raw_block, |
145
|
|
|
|
|
|
|
command => \%com, |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
) |
148
|
|
|
|
|
|
|
); |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
2
|
50
|
|
|
|
13
|
if ( $com{FILTER} ) { |
152
|
|
|
|
|
|
|
# embed into the template & NEEDS_OBJECT++ ??? |
153
|
2
|
|
|
|
|
10
|
my $old = $self->[FILENAME]; |
154
|
2
|
|
|
|
|
6
|
$self->[FILENAME] = '<ANON BLOCK>'; |
155
|
2
|
|
|
|
|
22
|
$self->_call_filters( \$raw_block, split RE_FILTER_SPLIT, $com{FILTER} ); |
156
|
2
|
|
|
|
|
5
|
$self->[FILENAME] = $old; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
2
|
|
|
|
|
8
|
return $raw_block; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub _chomp { |
163
|
|
|
|
|
|
|
# remove the unnecessary white space |
164
|
408
|
|
|
408
|
|
1071
|
my($self, $str, $chomp) = @_; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# NEXT: discard: left; right -> left |
167
|
|
|
|
|
|
|
# PREV: discard: right; left -> right |
168
|
408
|
|
|
|
|
756
|
my($next, $prev) = @{ $chomp }; |
|
408
|
|
|
|
|
926
|
|
169
|
408
|
|
100
|
|
|
1682
|
$next ||= CHOMP_NONE; |
170
|
408
|
|
100
|
|
|
1703
|
$prev ||= CHOMP_NONE; |
171
|
|
|
|
|
|
|
|
172
|
408
|
|
100
|
|
|
1897
|
my $left_collapse = ( $next & COLLAPSE_ALL ) || ( $next & COLLAPSE_RIGHT); |
173
|
408
|
|
100
|
|
|
1825
|
my $left_chomp = ( $next & CHOMP_ALL ) || ( $next & CHOMP_RIGHT ); |
174
|
|
|
|
|
|
|
|
175
|
408
|
|
100
|
|
|
1600
|
my $right_collapse = ( $prev & COLLAPSE_ALL ) || ( $prev & COLLAPSE_LEFT ); |
176
|
408
|
|
100
|
|
|
1667
|
my $right_chomp = ( $prev & CHOMP_ALL ) || ( $prev & CHOMP_LEFT ); |
177
|
|
|
|
|
|
|
|
178
|
408
|
100
|
|
|
|
1378
|
$str = $left_collapse ? ltrim($str, q{ }) |
|
|
100
|
|
|
|
|
|
179
|
|
|
|
|
|
|
: $left_chomp ? ltrim($str) |
180
|
|
|
|
|
|
|
: $str |
181
|
|
|
|
|
|
|
; |
182
|
|
|
|
|
|
|
|
183
|
408
|
100
|
|
|
|
1193
|
$str = $right_collapse ? rtrim($str, q{ }) |
|
|
100
|
|
|
|
|
|
184
|
|
|
|
|
|
|
: $right_chomp ? rtrim($str) |
185
|
|
|
|
|
|
|
: $str |
186
|
|
|
|
|
|
|
; |
187
|
|
|
|
|
|
|
|
188
|
408
|
|
|
|
|
13363
|
return $str; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
sub _wrapper { |
192
|
|
|
|
|
|
|
# this'll be tricky to re-implement around a template |
193
|
502
|
|
|
502
|
|
1319
|
my($self, $code, $cache_id, $faker, $map_keys, $h) = @_; |
194
|
502
|
|
|
|
|
1607
|
my $buf_hash = $self->[FAKER_HASH]; |
195
|
502
|
|
|
|
|
1099
|
my $wrapper = EMPTY_STRING; |
196
|
502
|
100
|
|
|
|
1580
|
my $inside_inc = $self->[INSIDE_INCLUDE] != RESET_FIELD ? 1 : 0; |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
# build the anonymous sub |
199
|
502
|
100
|
|
|
|
1673
|
if ( ! $inside_inc ) { |
200
|
|
|
|
|
|
|
# don't duplicate these if we're including something |
201
|
498
|
|
|
|
|
12179
|
$wrapper .= 'package ' . DUMMY_CLASS . q{;}; |
202
|
498
|
50
|
|
|
|
1849
|
$wrapper .= 'use strict;' if $self->[STRICT]; |
203
|
|
|
|
|
|
|
} |
204
|
502
|
|
|
|
|
1069
|
$wrapper .= 'sub { '; |
205
|
502
|
|
|
|
|
2355
|
$wrapper .= sprintf q~local $0 = '%s';~, escape( q{'} => $self->[FILENAME] ); |
206
|
502
|
100
|
|
|
|
2508
|
if ( $self->[NEEDS_OBJECT] ) { |
207
|
418
|
|
|
|
|
629
|
--$self->[NEEDS_OBJECT]; |
208
|
418
|
|
|
|
|
1800
|
$wrapper .= 'my ' . $self->[FAKER_SELF] . ' = shift;'; |
209
|
|
|
|
|
|
|
} |
210
|
502
|
100
|
|
|
|
1691
|
$wrapper .= $self->[HEADER].q{;} if $self->[HEADER]; |
211
|
502
|
|
|
|
|
1356
|
$wrapper .= "my $faker = '';"; |
212
|
502
|
100
|
|
|
|
3187
|
$wrapper .= $self->_add_stack( $cache_id ) if $self->[STACK]; |
213
|
502
|
100
|
|
|
|
1343
|
$wrapper .= "my $buf_hash = {\@_};" if $map_keys; |
214
|
502
|
100
|
|
|
|
1421
|
$wrapper .= $self->_add_sigwarn if $self->[CAPTURE_WARNINGS]; |
215
|
502
|
|
|
|
|
1899
|
$wrapper .= "\n#line 1 " . $self->[FILENAME] . "\n"; |
216
|
502
|
|
|
|
|
1539
|
$wrapper .= $code . q{;}; |
217
|
502
|
100
|
|
|
|
2010
|
$wrapper .= $self->_dump_sigwarn($h) if $self->[CAPTURE_WARNINGS]; |
218
|
502
|
|
|
|
|
1286
|
$wrapper .= "return $faker;"; |
219
|
502
|
|
|
|
|
9921
|
$wrapper .= '}'; |
220
|
|
|
|
|
|
|
# make this a capture sub if we're including |
221
|
502
|
100
|
|
|
|
1372
|
$wrapper .= '->()' if $inside_inc; |
222
|
|
|
|
|
|
|
|
223
|
502
|
50
|
|
|
|
1543
|
LOG( COMPILED => $self->_mini_compiler( |
224
|
|
|
|
|
|
|
$self->_internal('fragment'), |
225
|
|
|
|
|
|
|
{ FRAGMENT => $self->_tidy($wrapper) } |
226
|
|
|
|
|
|
|
) |
227
|
|
|
|
|
|
|
) if DEBUG >= DEBUG_LEVEL_VERBOSE; |
228
|
|
|
|
|
|
|
#LOG( OUTPUT => $wrapper ); |
229
|
|
|
|
|
|
|
# reset |
230
|
502
|
|
|
|
|
1282
|
$self->[DEEP_RECURSION] = 0; # reset |
231
|
502
|
|
|
|
|
10171
|
return $wrapper; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub _parse_mapkeys { |
235
|
502
|
|
|
502
|
|
2324
|
my($self, $map_keys, $faker, $buf_hash) = @_; |
236
|
502
|
100
|
|
|
|
3008
|
return( undef, undef ) if ! $map_keys; |
237
|
|
|
|
|
|
|
|
238
|
4
|
|
|
|
|
17
|
my $mkc = $map_keys eq 'check'; |
239
|
4
|
|
|
|
|
10
|
my $mki = $map_keys eq 'init'; |
240
|
4
|
50
|
|
|
|
24
|
my $t = $mki ? 'map_keys_init' |
|
|
50
|
|
|
|
|
|
241
|
|
|
|
|
|
|
: $mkc ? 'map_keys_check' |
242
|
|
|
|
|
|
|
: 'map_keys_default' |
243
|
|
|
|
|
|
|
; |
244
|
4
|
|
|
|
|
67
|
my $mko = $self->_mini_compiler( |
245
|
|
|
|
|
|
|
$self->_internal( $t ) => { |
246
|
|
|
|
|
|
|
BUF => $faker, |
247
|
|
|
|
|
|
|
HASH => $buf_hash, |
248
|
|
|
|
|
|
|
KEY => '%s', |
249
|
|
|
|
|
|
|
} => { |
250
|
|
|
|
|
|
|
flatten => 1, |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
); |
253
|
4
|
|
|
|
|
27
|
return $mko, $mkc; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub _add_sigwarn { |
257
|
2
|
|
|
2
|
|
3
|
my $self = shift; |
258
|
2
|
|
|
|
|
11
|
$self->[FAKER_WARN] = $self->_output_buffer_var('array'); |
259
|
2
|
|
|
|
|
29
|
my $rv = $self->_mini_compiler( |
260
|
|
|
|
|
|
|
$self->_internal('add_sigwarn'), |
261
|
|
|
|
|
|
|
{ BUF => $self->[FAKER_WARN] }, |
262
|
|
|
|
|
|
|
{ flatten => 1 } |
263
|
|
|
|
|
|
|
); |
264
|
2
|
|
|
|
|
10
|
return $rv; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
sub _dump_sigwarn { |
268
|
2
|
|
|
2
|
|
3
|
my $self = shift; |
269
|
2
|
|
|
|
|
4
|
my $h = shift; |
270
|
2
|
|
|
|
|
9
|
my $rv = $h->{capture}->( |
271
|
|
|
|
|
|
|
$self->_mini_compiler( |
272
|
|
|
|
|
|
|
$self->_internal('dump_sigwarn'), |
273
|
|
|
|
|
|
|
{ BUF => $self->[FAKER_WARN] }, |
274
|
|
|
|
|
|
|
{ flatten => 1 } |
275
|
|
|
|
|
|
|
) |
276
|
|
|
|
|
|
|
); |
277
|
2
|
|
|
|
|
14
|
return $rv; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
sub _add_stack { |
281
|
8
|
|
|
8
|
|
15
|
my $self = shift; |
282
|
8
|
|
50
|
|
|
43
|
my $cs_name = shift || '<ANON TEMPLATE>'; |
283
|
8
|
|
50
|
|
|
31
|
my $stack = $self->[STACK] || EMPTY_STRING; |
284
|
|
|
|
|
|
|
|
285
|
8
|
50
|
|
|
|
35
|
return if lc($stack) eq 'off'; |
286
|
|
|
|
|
|
|
|
287
|
8
|
50
|
33
|
|
|
72
|
my $check = ($stack eq '1' || $stack eq 'yes' || $stack eq 'on') |
288
|
|
|
|
|
|
|
? 'string' |
289
|
|
|
|
|
|
|
: $stack |
290
|
|
|
|
|
|
|
; |
291
|
|
|
|
|
|
|
|
292
|
8
|
|
|
|
|
33
|
my($type, $channel) = split m{:}xms, $check; |
293
|
8
|
0
|
|
|
|
27
|
$channel = ! $channel ? 'warn' |
|
|
50
|
|
|
|
|
|
294
|
|
|
|
|
|
|
: $channel eq 'buffer' ? $self->[FAKER] . ' .= ' |
295
|
|
|
|
|
|
|
: 'warn' |
296
|
|
|
|
|
|
|
; |
297
|
|
|
|
|
|
|
|
298
|
8
|
|
|
|
|
19
|
foreach my $e ( $cs_name, $type, $channel ) { |
299
|
24
|
|
|
|
|
55
|
$e =~ s{'}{\\'}xmsg; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
8
|
|
|
|
|
51
|
return "$channel stack( { type => '$type', name => '$cs_name' } );"; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub _set_internal_templates { |
306
|
|
|
|
|
|
|
return |
307
|
|
|
|
|
|
|
# we need string eval in this template to catch syntax errors |
308
|
62
|
|
|
62
|
|
914
|
sub_include => <<'TEMPLATE_CONSTANT', |
309
|
|
|
|
|
|
|
<%OBJECT%>->_compile( |
310
|
|
|
|
|
|
|
do { |
311
|
|
|
|
|
|
|
local $@; |
312
|
|
|
|
|
|
|
my $file = eval '<%INCLUDE%>'; |
313
|
|
|
|
|
|
|
my $rv; |
314
|
|
|
|
|
|
|
if ( my $e = $@ ) { |
315
|
|
|
|
|
|
|
chomp $e; |
316
|
|
|
|
|
|
|
$file ||= '<%INCLUDE%>'; |
317
|
|
|
|
|
|
|
my $m = "The parameter ($file) is not a file. " |
318
|
|
|
|
|
|
|
. "Error from sub-include ($file): $e"; |
319
|
|
|
|
|
|
|
$rv = [ ERROR => '<%ERROR_TITLE%> ' . $m ] |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
else { |
322
|
|
|
|
|
|
|
$rv = $file; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
$rv; |
325
|
|
|
|
|
|
|
}, |
326
|
|
|
|
|
|
|
<%PARAMS%>, |
327
|
|
|
|
|
|
|
{ |
328
|
|
|
|
|
|
|
_sub_inc => '<%TYPE%>', |
329
|
|
|
|
|
|
|
_filter => '<%FILTER%>', |
330
|
|
|
|
|
|
|
_share => [<%SHARE%>], |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
) |
333
|
|
|
|
|
|
|
TEMPLATE_CONSTANT |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
no_monolith => <<'TEMPLATE_CONSTANT', |
336
|
|
|
|
|
|
|
<%OBJECT%>->compile( |
337
|
|
|
|
|
|
|
q~<%FILE%>~, |
338
|
|
|
|
|
|
|
undef, |
339
|
|
|
|
|
|
|
{ |
340
|
|
|
|
|
|
|
chkmt => 1, |
341
|
|
|
|
|
|
|
_sub_inc => q~<%TYPE%>~, |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
); |
344
|
|
|
|
|
|
|
TEMPLATE_CONSTANT |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
# see _parse() |
347
|
|
|
|
|
|
|
map_keys_check => <<'TEMPLATE_CONSTANT', |
348
|
|
|
|
|
|
|
<%BUF%> .= exists <%HASH%>->{"<%KEY%>"} |
349
|
|
|
|
|
|
|
? ( |
350
|
|
|
|
|
|
|
defined <%HASH%>->{"<%KEY%>"} |
351
|
|
|
|
|
|
|
? <%HASH%>->{"<%KEY%>"} |
352
|
|
|
|
|
|
|
: "[ERROR] Key not defined: <%KEY%>" |
353
|
|
|
|
|
|
|
) |
354
|
|
|
|
|
|
|
: "[ERROR] Invalid key: <%KEY%>" |
355
|
|
|
|
|
|
|
; |
356
|
|
|
|
|
|
|
TEMPLATE_CONSTANT |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
map_keys_init => <<'TEMPLATE_CONSTANT', |
359
|
|
|
|
|
|
|
<%BUF%> .= <%HASH%>->{"<%KEY%>"} || ''; |
360
|
|
|
|
|
|
|
TEMPLATE_CONSTANT |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
map_keys_default => <<'TEMPLATE_CONSTANT', |
363
|
|
|
|
|
|
|
<%BUF%> .= <%HASH%>->{"<%KEY%>"}; |
364
|
|
|
|
|
|
|
TEMPLATE_CONSTANT |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
add_sigwarn => <<'TEMPLATE_CONSTANT', |
367
|
|
|
|
|
|
|
my <%BUF%>; |
368
|
|
|
|
|
|
|
local $SIG{__WARN__} = sub { |
369
|
|
|
|
|
|
|
push @{ <%BUF%> }, $_[0]; |
370
|
|
|
|
|
|
|
}; |
371
|
|
|
|
|
|
|
TEMPLATE_CONSTANT |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
dump_sigwarn => <<'TEMPLATE_CONSTANT', |
374
|
|
|
|
|
|
|
join("\n", |
375
|
|
|
|
|
|
|
map { |
376
|
|
|
|
|
|
|
s{ \A \s+ }{}xms; |
377
|
|
|
|
|
|
|
s{ \s+ \z }{}xms; |
378
|
|
|
|
|
|
|
"[warning] $_\n" |
379
|
|
|
|
|
|
|
} @{ <%BUF%> } |
380
|
|
|
|
|
|
|
); |
381
|
|
|
|
|
|
|
TEMPLATE_CONSTANT |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
compile_error => <<'TEMPLATE_CONSTANT', |
384
|
|
|
|
|
|
|
Error compiling code fragment (cache id: <%CID%>): |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
<%ERROR%> |
387
|
|
|
|
|
|
|
------------------------------- |
388
|
|
|
|
|
|
|
PARSED CODE (VERBATIM): |
389
|
|
|
|
|
|
|
------------------------------- |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
<%PARSED%> |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
------------------------------- |
394
|
|
|
|
|
|
|
PARSED CODE (tidied): |
395
|
|
|
|
|
|
|
------------------------------- |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
<%TIDIED%> |
398
|
|
|
|
|
|
|
TEMPLATE_CONSTANT |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
fragment => <<'TEMPLATE_CONSTANT', |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
# BEGIN TIDIED FRAGMENT |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
<%FRAGMENT%> |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# END TIDIED FRAGMENT |
407
|
|
|
|
|
|
|
TEMPLATE_CONSTANT |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
disk_cache_comment => <<'TEMPLATE_CONSTANT', |
410
|
|
|
|
|
|
|
# !!! W A R N I N G W A R N I N G W A R N I N G !!! |
411
|
|
|
|
|
|
|
# This file was automatically generated by <%NAME%> on <%DATE%>. |
412
|
|
|
|
|
|
|
# This file is a compiled template cache. |
413
|
|
|
|
|
|
|
# Any changes you make here will be lost. |
414
|
|
|
|
|
|
|
# |
415
|
|
|
|
|
|
|
TEMPLATE_CONSTANT |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
1; |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
__END__ |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
=head1 NAME |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
Text::Template::Simple::Base::Parser - Base class for Text::Template::Simple |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=head1 SYNOPSIS |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
Private module. |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
=head1 DESCRIPTION |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
This document describes version C<0.86> of C<Text::Template::Simple::Base::Parser> |
433
|
|
|
|
|
|
|
released on C<5 March 2012>. |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
Private module. |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
=begin CHOMPING |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
The tokenizer uses a cursor to mark the chomping around a RAW token. Only RAW |
440
|
|
|
|
|
|
|
tokens can be chomped. Basically, a RAW token can be imagined like this: |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
_________ |
443
|
|
|
|
|
|
|
|N| |P| |
444
|
|
|
|
|
|
|
|E| STR |R| |
445
|
|
|
|
|
|
|
|X| |E| |
446
|
|
|
|
|
|
|
|T| |V| |
447
|
|
|
|
|
|
|
--------- |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
It'll have two labels on sides and the content in the center. When a chomp |
450
|
|
|
|
|
|
|
directive is placed to the left delimiter, this affects the previous RAW token |
451
|
|
|
|
|
|
|
and when it is placed to the right delimiter, it'll affect the next RAW token. |
452
|
|
|
|
|
|
|
If the previous or next is not raw, nothing will happen. You need to swap sides |
453
|
|
|
|
|
|
|
when handling the chomping. i.e.: left chomping affects the right side of the |
454
|
|
|
|
|
|
|
RAW, and right chomping affects the left side of the RAW. _chomp() method in |
455
|
|
|
|
|
|
|
the parser swaps sides to handle chomping. See Text::Template::Simple::Tokenizer |
456
|
|
|
|
|
|
|
to have an idea on how pre-parsing happens. |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
=end CHOMPING |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=head1 AUTHOR |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
Burak Gursoy <burak@cpan.org>. |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
=head1 COPYRIGHT |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
Copyright 2004 - 2012 Burak Gursoy. All rights reserved. |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
=head1 LICENSE |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
471
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.12.3 or, |
472
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
=cut |