line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
## no critic (ProhibitUnusedPrivateSubroutines) |
2
|
|
|
|
|
|
|
package Text::Template::Simple::Base::Compiler; |
3
|
62
|
|
|
62
|
|
502
|
use strict; |
|
62
|
|
|
|
|
155
|
|
|
62
|
|
|
|
|
2972
|
|
4
|
62
|
|
|
62
|
|
363
|
use warnings; |
|
62
|
|
|
|
|
218
|
|
|
62
|
|
|
|
|
3442
|
|
5
|
|
|
|
|
|
|
|
6
|
62
|
|
|
62
|
|
539
|
use Text::Template::Simple::Util qw(:all); |
|
62
|
|
|
|
|
133
|
|
|
62
|
|
|
|
|
26385
|
|
7
|
62
|
|
|
62
|
|
788
|
use Text::Template::Simple::Constants qw(:all); |
|
62
|
|
|
|
|
141
|
|
|
62
|
|
|
|
|
207795
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.86'; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub _init_compile_opts { |
12
|
506
|
|
|
506
|
|
1164
|
my $self = shift; |
13
|
506
|
|
100
|
|
|
2321
|
my $opt = shift || {}; |
14
|
|
|
|
|
|
|
|
15
|
506
|
50
|
|
|
|
2445
|
fatal('tts.base.compiler._compile.opt') if ! ishref( $opt ); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# set defaults |
18
|
506
|
|
100
|
|
|
3788
|
$opt->{id} ||= EMPTY_STRING; # id is AUTO |
19
|
506
|
|
100
|
|
|
4196
|
$opt->{map_keys} ||= 0; # use normal behavior |
20
|
506
|
|
100
|
|
|
2093
|
$opt->{chkmt} ||= 0; # check mtime of file template? |
21
|
506
|
|
100
|
|
|
1914
|
$opt->{_sub_inc} ||= 0; # are we called from a dynamic include op? |
22
|
506
|
|
100
|
|
|
3291
|
$opt->{_filter} ||= EMPTY_STRING; # any filters? |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# first element is the shared names. if it's not defined, then there |
25
|
|
|
|
|
|
|
# are no shared variables from top level |
26
|
506
|
100
|
100
|
|
|
3849
|
if ( isaref($opt->{_share}) && ! defined $opt->{_share}[0] ) { |
27
|
12
|
|
|
|
|
35
|
delete $opt->{_share}; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
506
|
|
100
|
|
|
3575
|
$opt->{as_is} = $opt->{_sub_inc} && $opt->{_sub_inc} == T_STATIC; |
31
|
|
|
|
|
|
|
|
32
|
506
|
|
|
|
|
1972
|
return $opt; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub _validate_chkmt { |
36
|
250
|
|
|
250
|
|
678
|
my($self, $chkmt_ref, $tmpx) = @_; |
37
|
250
|
|
|
|
|
955
|
${$chkmt_ref} = $self->[TYPE] eq 'FILE' |
38
|
|
|
|
|
|
|
? (stat $tmpx)[STAT_MTIME] |
39
|
250
|
100
|
|
|
|
11098
|
: do { |
40
|
2
|
50
|
|
|
|
11
|
DEBUG && LOG( DISABLE_MT => |
41
|
|
|
|
|
|
|
'Disabling chkmt. Template is not a file'); |
42
|
2
|
|
|
|
|
6
|
0; |
43
|
|
|
|
|
|
|
}; |
44
|
250
|
|
|
|
|
648
|
return; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub _compile_cache { |
48
|
18
|
|
|
18
|
|
49
|
my($self, $tmp, $opt, $id_ref, $code_ref) = @_; |
49
|
18
|
|
|
|
|
45
|
my $method = $opt->{id}; |
50
|
18
|
|
66
|
|
|
80
|
my $auto_id = ! $method || $method eq 'AUTO'; |
51
|
18
|
100
|
|
|
|
83
|
${ $id_ref } = $self->connector('Cache::ID')->new->generate( |
|
18
|
|
|
|
|
53
|
|
52
|
|
|
|
|
|
|
$auto_id ? ( $tmp ) : ( $method, 'custom' ) |
53
|
|
|
|
|
|
|
); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# prevent overwriting the compiled version in cache |
56
|
|
|
|
|
|
|
# since we need the non-compiled version |
57
|
18
|
50
|
|
|
|
90
|
${ $id_ref } .= '_1' if $opt->{as_is}; |
|
0
|
|
|
|
|
0
|
|
58
|
|
|
|
|
|
|
|
59
|
18
|
|
|
|
|
118
|
${ $code_ref } = $self->cache->hit( ${$id_ref}, $opt->{chkmt} ); |
|
18
|
|
|
|
|
47
|
|
|
18
|
|
|
|
|
139
|
|
60
|
18
|
50
|
33
|
|
|
78
|
LOG( CACHE_HIT => ${$id_ref} ) if DEBUG && ${$code_ref}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
61
|
18
|
|
|
|
|
51
|
return; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub _compile { |
65
|
506
|
|
|
506
|
|
2830
|
my $self = shift; |
66
|
506
|
|
33
|
|
|
3411
|
my $tmpx = shift || fatal('tts.base.compiler._compile.notmp'); |
67
|
506
|
|
100
|
|
|
3103
|
my $param = shift || []; |
68
|
506
|
|
|
|
|
2678
|
my $opt = $self->_init_compile_opts( shift ); |
69
|
|
|
|
|
|
|
|
70
|
506
|
50
|
|
|
|
2119
|
fatal('tts.base.compiler._compile.param') if ! isaref($param); |
71
|
|
|
|
|
|
|
|
72
|
506
|
|
|
|
|
5063
|
my $tmp = $self->_examine( $tmpx ); |
73
|
502
|
50
|
|
|
|
2212
|
return $tmp if $self->[TYPE] eq 'ERROR'; |
74
|
|
|
|
|
|
|
|
75
|
502
|
100
|
|
|
|
2054
|
if ( $opt->{_sub_inc} ) { |
76
|
|
|
|
|
|
|
# TODO:generate a single error handler for includes, merge with _include() |
77
|
|
|
|
|
|
|
# tmpx is a "file" included from an upper level compile() |
78
|
266
|
|
|
|
|
1381
|
my $etitle = $self->_include_error( T_DYNAMIC ); |
79
|
266
|
|
|
|
|
1200
|
my $exists = $self->io->file_exists( $tmpx ); |
80
|
266
|
50
|
|
|
|
4812
|
return $etitle . " '$tmpx' is not a file" if not $exists; |
81
|
|
|
|
|
|
|
# TODO: remove this second call somehow, reduce to a single call |
82
|
266
|
|
|
|
|
1394
|
$tmp = $self->_examine( $exists ); # re-examine |
83
|
266
|
|
|
|
|
976
|
$self->[NEEDS_OBJECT]++; # interpolated includes will need that |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
502
|
100
|
|
|
|
14972
|
$self->_validate_chkmt( \$opt->{chkmt}, $tmpx ) if $opt->{chkmt}; |
87
|
|
|
|
|
|
|
|
88
|
502
|
50
|
33
|
|
|
2003
|
LOG( COMPILE => $opt->{id} ) if DEBUG && defined $opt->{id}; |
89
|
|
|
|
|
|
|
|
90
|
502
|
|
|
|
|
1260
|
my $cache_id = EMPTY_STRING; |
91
|
|
|
|
|
|
|
|
92
|
502
|
|
|
|
|
1452
|
my($CODE); |
93
|
502
|
100
|
|
|
|
1747
|
$self->_compile_cache( $tmp, $opt, \$cache_id, \$CODE ) if $self->[CACHE]; |
94
|
|
|
|
|
|
|
|
95
|
502
|
|
|
|
|
4212
|
$self->cache->id( $cache_id ); # if $cache_id; |
96
|
502
|
100
|
|
|
|
2792
|
$self->[FILENAME] = $self->[TYPE] eq 'FILE' ? $tmpx : $self->cache->id; |
97
|
|
|
|
|
|
|
|
98
|
502
|
100
|
|
|
|
5653
|
my($shead, @sparam) = $opt->{_share} ? @{$opt->{_share}} : (); |
|
6
|
|
|
|
|
25
|
|
99
|
|
|
|
|
|
|
|
100
|
502
|
50
|
33
|
|
|
1482
|
LOG( |
101
|
|
|
|
|
|
|
SHARED_VARS => "Adding shared variables ($shead) from a dynamic include" |
102
|
|
|
|
|
|
|
) if DEBUG && $shead; |
103
|
|
|
|
|
|
|
|
104
|
502
|
100
|
|
|
|
3182
|
$CODE = $self->_cache_miss( $cache_id, $shead, \@sparam, $opt, $tmp ) if ! $CODE; |
105
|
|
|
|
|
|
|
|
106
|
502
|
|
|
|
|
1098
|
my @args; |
107
|
502
|
100
|
|
|
|
1914
|
push @args, $self if $self->[NEEDS_OBJECT]; # must be the first |
108
|
502
|
100
|
|
|
|
1880
|
push @args, @sparam if @sparam; |
109
|
502
|
100
|
|
|
|
1669
|
push @args, @{ $self->[ADD_ARGS] } if $self->[ADD_ARGS]; |
|
12
|
|
|
|
|
512
|
|
110
|
502
|
|
|
|
|
896
|
push @args, @{ $param }; |
|
502
|
|
|
|
|
1177
|
|
111
|
502
|
|
|
|
|
16798
|
my $out = $CODE->( @args ); |
112
|
|
|
|
|
|
|
|
113
|
500
|
100
|
|
|
|
20107
|
$self->_call_filters( \$out, split RE_FILTER_SPLIT, $opt->{_filter} ) |
114
|
|
|
|
|
|
|
if $opt->{_filter}; |
115
|
|
|
|
|
|
|
|
116
|
500
|
|
|
|
|
20859
|
return $out; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub _cache_miss { |
120
|
498
|
|
|
498
|
|
1330
|
my($self, $cache_id, $shead, $sparam, $opt, $tmp) = @_; |
121
|
|
|
|
|
|
|
# we have a cache miss; parse and compile |
122
|
498
|
50
|
|
|
|
1542
|
LOG( CACHE_MISS => $cache_id ) if DEBUG; |
123
|
|
|
|
|
|
|
|
124
|
498
|
|
|
|
|
1142
|
my $restore_header; |
125
|
498
|
100
|
|
|
|
2266
|
if ( $shead ) { |
126
|
6
|
|
|
|
|
14
|
my $param_x = join q{,}, ('shift') x @{ $sparam }; |
|
6
|
|
|
|
|
128
|
|
127
|
6
|
|
|
|
|
29
|
my $shared = sprintf q~my(%s) = (%s);~, $shead, $param_x; |
128
|
6
|
|
|
|
|
16
|
$restore_header = $self->[HEADER]; |
129
|
6
|
|
50
|
|
|
48
|
$self->[HEADER] = $shared . q{;} . ( $self->[HEADER] || EMPTY_STRING ); |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
498
|
|
|
|
|
826
|
my %popt = ( %{ $opt }, cache_id => $cache_id, as_is => $opt->{as_is} ); |
|
498
|
|
|
|
|
5591
|
|
133
|
498
|
|
|
|
|
6901
|
my $parsed = $self->_parse( $tmp, \%popt ); |
134
|
498
|
|
|
|
|
4042
|
my $CODE = $self->cache->populate( $cache_id, $parsed, $opt->{chkmt} ); |
135
|
498
|
100
|
|
|
|
1420
|
$self->[HEADER] = $restore_header if $shead; |
136
|
498
|
|
|
|
|
11645
|
return $CODE; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub _call_filters { |
140
|
4
|
|
|
4
|
|
12
|
my($self, $oref, @filters) = @_; |
141
|
4
|
|
|
|
|
10
|
my $fname = $self->[FILENAME]; |
142
|
|
|
|
|
|
|
|
143
|
4
|
|
|
|
|
10
|
APPLY_FILTERS: foreach my $filter ( @filters ) { |
144
|
6
|
|
|
|
|
93
|
my $fref = DUMMY_CLASS->can( 'filter_' . $filter ); |
145
|
6
|
50
|
|
|
|
22
|
if ( ! $fref ) { |
146
|
0
|
|
|
|
|
0
|
${$oref} .= "\n[ filter warning ] Can not apply undefined filter" |
|
0
|
|
|
|
|
0
|
|
147
|
|
|
|
|
|
|
. " $filter to $fname\n"; |
148
|
0
|
|
|
|
|
0
|
next; |
149
|
|
|
|
|
|
|
} |
150
|
6
|
|
|
|
|
23
|
$fref->( $self, $oref ); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
4
|
|
|
|
|
57
|
return; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub _wrap_compile { |
157
|
500
|
|
|
500
|
|
939
|
my $self = shift; |
158
|
500
|
50
|
|
|
|
2478
|
my $parsed = shift or fatal('tts.base.compiler._wrap_compile.parsed'); |
159
|
500
|
50
|
33
|
|
|
3971
|
LOG( CACHE_ID => $self->cache->id ) if $self->[WARN_IDS] && $self->cache->id; |
160
|
500
|
0
|
|
|
|
1868
|
LOG( COMPILER => $self->[SAFE] ? 'Safe' : 'Normal' ) if DEBUG; |
|
|
50
|
|
|
|
|
|
161
|
500
|
|
|
|
|
767
|
my($CODE, $error); |
162
|
|
|
|
|
|
|
|
163
|
500
|
100
|
|
|
|
2073
|
my $compiler = $self->[SAFE] ? COMPILER_SAFE : COMPILER; |
164
|
|
|
|
|
|
|
|
165
|
500
|
|
|
|
|
47195
|
$CODE = $compiler->compile( $parsed ); |
166
|
|
|
|
|
|
|
|
167
|
500
|
50
|
|
|
|
6607
|
if( $error = $@ ) { |
168
|
0
|
|
|
|
|
0
|
my $error2; |
169
|
0
|
0
|
|
|
|
0
|
$error .= $error2 if $error2; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
500
|
|
|
|
|
3406
|
return $CODE, $error; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub _mini_compiler { |
176
|
|
|
|
|
|
|
# little dumb compiler for internal templates |
177
|
280
|
|
|
280
|
|
553
|
my $self = shift; |
178
|
280
|
|
33
|
|
|
1019
|
my $template = shift || fatal('tts.base.compiler._mini_compiler.notmp'); |
179
|
280
|
|
33
|
|
|
974
|
my $param = shift || fatal('tts.base.compiler._mini_compiler.noparam'); |
180
|
280
|
|
100
|
|
|
818
|
my $opt = shift || {}; |
181
|
|
|
|
|
|
|
|
182
|
280
|
50
|
|
|
|
1019
|
fatal('tts.base.compiler._mini_compiler.opt') if ! ishref($opt ); |
183
|
280
|
50
|
|
|
|
1236
|
fatal('tts.base.compiler._mini_compiler.param') if ! ishref($param); |
184
|
|
|
|
|
|
|
|
185
|
280
|
|
|
|
|
553
|
foreach my $var ( keys %{ $param } ) { |
|
280
|
|
|
|
|
2061
|
|
186
|
898
|
|
|
|
|
2159
|
my $str = $param->{$var}; |
187
|
898
|
|
|
|
|
15738
|
$template =~ s{<%\Q$var\E%>}{$str}xmsg; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
280
|
100
|
|
|
|
7254
|
$template =~ s{\s+}{ }xmsg if $opt->{flatten}; # remove extra spaces |
191
|
280
|
|
|
|
|
1530
|
return $template; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
1; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
__END__ |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=pod |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=head1 NAME |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
Text::Template::Simple::Base::Compiler - Base class for Text::Template::Simple |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=head1 SYNOPSIS |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
Private module. |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=head1 DESCRIPTION |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
This document describes version C<0.86> of C<Text::Template::Simple::Base::Compiler> |
211
|
|
|
|
|
|
|
released on C<5 March 2012>. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Private module. |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=head1 AUTHOR |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
Burak Gursoy <burak@cpan.org>. |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=head1 COPYRIGHT |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
Copyright 2004 - 2012 Burak Gursoy. All rights reserved. |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=head1 LICENSE |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
226
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.12.3 or, |
227
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=cut |