line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Tenjin::Template; |
2
|
|
|
|
|
|
|
|
3
|
7
|
|
|
7
|
|
125
|
use strict; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
291
|
|
4
|
7
|
|
|
7
|
|
43
|
use warnings; |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
318
|
|
5
|
7
|
|
|
7
|
|
38
|
use Fcntl qw/:flock/; |
|
7
|
|
|
|
|
13
|
|
|
7
|
|
|
|
|
1215
|
|
6
|
7
|
|
|
7
|
|
44
|
use Carp; |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
23765
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = "0.070001"; |
9
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 NAME |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
Tenjin::Template - A Tenjin template object, either built from a file or from memory. |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 VERSION |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
version 0.070001 |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 SYNOPSIS |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# mostly used internally, but you can manipulate |
22
|
|
|
|
|
|
|
# templates like so |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
my $template = Tenjin::Template->new('/path/to/templates/template.html'); |
25
|
|
|
|
|
|
|
my $context = { scalar => 'scalar', arrayref => ['one', 2, "3"] }; |
26
|
|
|
|
|
|
|
$template->render($context); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 DESCRIPTION |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
This module is in charge of the task of compiling Tenjin templates. |
31
|
|
|
|
|
|
|
Templates in Tenjin are compiled into standard Perl code (combined with |
32
|
|
|
|
|
|
|
any Perl code used inside the templates themselves). Rendering a template |
33
|
|
|
|
|
|
|
means Cuating that Perl code and returning its output. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
The Tenjin engine reads a template file or a template string, and creates |
36
|
|
|
|
|
|
|
a Template object from it. Then the object compiles itself by traversing |
37
|
|
|
|
|
|
|
the template, parsing Tenjin macros like 'include' and 'start_capture', |
38
|
|
|
|
|
|
|
replaces Tenjin expressions (i.e. C<[== $expr =]> or C<[= $expr =]>) with the |
39
|
|
|
|
|
|
|
appropriate Perl code, etc. This module ties a template object with |
40
|
|
|
|
|
|
|
a context object, but all context manipulation (and the actual Cuation |
41
|
|
|
|
|
|
|
of the Perl code) is done by L. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
If you're planning on using this module by itself (i.e. without the L |
44
|
|
|
|
|
|
|
engine), keep in mind that template caching and layout templates are not |
45
|
|
|
|
|
|
|
handled by this module. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=cut |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
our $MACRO_HANDLER_TABLE = { |
50
|
|
|
|
|
|
|
'include' => sub { my $arg = shift; |
51
|
|
|
|
|
|
|
" \$_buf .= \$_context->{'_engine'}->render($arg, \$_context, 0);"; |
52
|
|
|
|
|
|
|
}, |
53
|
|
|
|
|
|
|
'start_capture' => sub { my $arg = shift; |
54
|
|
|
|
|
|
|
" my \$_buf_bkup=\$_buf; \$_buf=''; my \$_capture_varname=$arg;"; |
55
|
|
|
|
|
|
|
}, |
56
|
|
|
|
|
|
|
'stop_capture' => sub { my $arg = shift; |
57
|
|
|
|
|
|
|
" \$_context->{\$_capture_varname}=\$_buf; \$_buf=\$_buf_bkup;"; |
58
|
|
|
|
|
|
|
}, |
59
|
|
|
|
|
|
|
'start_placeholder' => sub { my $arg = shift; |
60
|
|
|
|
|
|
|
" if (\$_context->{$arg}) { \$_buf .= \$_context->{$arg}; } else {"; |
61
|
|
|
|
|
|
|
}, |
62
|
|
|
|
|
|
|
'stop_placeholder' => sub { my $arg = shift; |
63
|
|
|
|
|
|
|
" }"; |
64
|
|
|
|
|
|
|
}, |
65
|
|
|
|
|
|
|
'echo' => sub { my $arg = shift; |
66
|
|
|
|
|
|
|
" \$_buf .= $arg;"; |
67
|
|
|
|
|
|
|
}, |
68
|
|
|
|
|
|
|
}; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=head1 METHODS |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head2 new( [$filename, \%opts] ) |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Creates a new Tenjin::Template object, possibly from a file on the file |
75
|
|
|
|
|
|
|
system (in which case C<$filename> must be provided and be an absolute |
76
|
|
|
|
|
|
|
path to a template file). Optionally, a hash-ref of options can be |
77
|
|
|
|
|
|
|
passed to set some customizations. Available options are 'escapefunc', |
78
|
|
|
|
|
|
|
which will be in charge of escaping expressions (from C<[= $expr =]>) instead |
79
|
|
|
|
|
|
|
of the internal method (which uses L); and 'rawclass', |
80
|
|
|
|
|
|
|
which can be used to prevent variables and objects of a certain class |
81
|
|
|
|
|
|
|
from being escaped, in which case the variable must be a hash-ref |
82
|
|
|
|
|
|
|
that has a key named 'str', which will be used instead. So, for example, |
83
|
|
|
|
|
|
|
if you have a variable named C<$var> which is a hash-ref, and 'rawclass' |
84
|
|
|
|
|
|
|
is set as 'HASH', then writing C<[= $var =]> on your templates will replace |
85
|
|
|
|
|
|
|
C<$var> with C<< $var->{str} >>. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=cut |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub new { |
90
|
16
|
|
|
16
|
1
|
126
|
my ($class, $filename, $template_name, $opts) = @_; |
91
|
|
|
|
|
|
|
|
92
|
16
|
50
|
33
|
|
|
157
|
my $escapefunc = defined($opts) && exists($opts->{escapefunc}) ? $opts->{escapefunc} : undef; |
93
|
16
|
50
|
33
|
|
|
117
|
my $rawclass = defined($opts) && exists($opts->{rawclass}) ? $opts->{rawclass} : undef; |
94
|
|
|
|
|
|
|
|
95
|
16
|
|
|
|
|
144
|
my $self = bless { |
96
|
|
|
|
|
|
|
'filename' => $filename, |
97
|
|
|
|
|
|
|
'name' => $template_name, |
98
|
|
|
|
|
|
|
'script' => undef, |
99
|
|
|
|
|
|
|
'escapefunc' => $escapefunc, |
100
|
|
|
|
|
|
|
'rawclass' => $rawclass, |
101
|
|
|
|
|
|
|
'timestamp' => undef, |
102
|
|
|
|
|
|
|
'args' => undef, |
103
|
|
|
|
|
|
|
}, $class; |
104
|
|
|
|
|
|
|
|
105
|
16
|
50
|
|
|
|
59
|
$self->convert_file($filename) if $filename; |
106
|
|
|
|
|
|
|
|
107
|
16
|
|
|
|
|
65
|
return $self; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head2 render( [$_context] ) |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
Renders the template, possibly with a context hash-ref, and returns the |
113
|
|
|
|
|
|
|
rendered output. If errors have occured when rendering the template (which |
114
|
|
|
|
|
|
|
might happen since templates have and are Perl code), then this method |
115
|
|
|
|
|
|
|
will croak. |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=cut |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub render { |
120
|
21
|
|
|
21
|
1
|
38
|
my ($self, $_context) = @_; |
121
|
|
|
|
|
|
|
|
122
|
21
|
|
50
|
|
|
146
|
$_context ||= {}; |
123
|
|
|
|
|
|
|
|
124
|
21
|
50
|
|
|
|
106
|
if ($self->{func}) { |
125
|
0
|
|
|
|
|
0
|
return $self->{func}->($_context); |
126
|
|
|
|
|
|
|
} else { |
127
|
21
|
100
|
|
|
|
207
|
$_context = $Tenjin::CONTEXT_CLASS->new($_context) if ref $_context eq 'HASH'; |
128
|
|
|
|
|
|
|
|
129
|
21
|
|
|
|
|
72
|
my $script = $self->{script}; |
130
|
21
|
50
|
|
|
|
157
|
$script = $_context->_build_decl() . $script unless $self->{args}; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
# rendering is actually done inside the context object |
133
|
|
|
|
|
|
|
# with the evaluate method. We pass either the name of |
134
|
|
|
|
|
|
|
# the template or the filename of the template for debug |
135
|
|
|
|
|
|
|
# purposes |
136
|
|
|
|
|
|
|
|
137
|
21
|
|
33
|
|
|
183
|
return $_context->evaluate($script, $self->{filename} || $self->{name}); |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=head1 INTERNAL METHODS |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=head2 convert_file( $filename ) |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
Receives an absolute path to a template file, converts that file |
146
|
|
|
|
|
|
|
to Perl code by calling L and |
147
|
|
|
|
|
|
|
returns that code. |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=cut |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub convert_file { |
152
|
0
|
|
|
0
|
1
|
0
|
my ($self, $filename) = @_; |
153
|
|
|
|
|
|
|
|
154
|
0
|
|
|
|
|
0
|
return $self->convert($self->_read_file($filename, 1), $filename); |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head2 convert( $input, [$filename] ) |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
Receives a text of a template (i.e. the template itself) and possibly |
160
|
|
|
|
|
|
|
an absolute path to the template file (if the template comes from a file), |
161
|
|
|
|
|
|
|
and converts the template into Perl code, which is later Cuated |
162
|
|
|
|
|
|
|
for rendering. Conversion is done by parsing the statements in the |
163
|
|
|
|
|
|
|
template (see L). |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=cut |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub convert { |
168
|
0
|
|
|
0
|
1
|
0
|
my ($self, $input, $filename) = @_; |
169
|
|
|
|
|
|
|
|
170
|
0
|
|
|
|
|
0
|
$self->{filename} = $filename; |
171
|
0
|
|
|
|
|
0
|
my @buf = ('my $_buf = ""; my $_V; ', ); |
172
|
0
|
|
|
|
|
0
|
$self->parse_stmt(\@buf, $input); |
173
|
|
|
|
|
|
|
|
174
|
0
|
|
|
|
|
0
|
return $self->{script} = $buf[0] . " \$_buf;\n"; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=head2 compile_stmt_pattern( $pl ) |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
Receives a string which denotes the Perl code delimiter which is used |
180
|
|
|
|
|
|
|
inside templates. Tenjin uses 'C<< >>' and 'C<< >>' |
181
|
|
|
|
|
|
|
(the latter for preprocessing), so C<$pl> will be 'pl'. This method |
182
|
|
|
|
|
|
|
returns a tranlsation regular expression which will be used for reading |
183
|
|
|
|
|
|
|
embedded Perl code. |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=cut |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub compile_stmt_pattern { |
188
|
0
|
|
|
0
|
1
|
0
|
my $pl = shift; |
189
|
|
|
|
|
|
|
|
190
|
0
|
|
|
|
|
0
|
my $pat = '((^[ \t]*)?<\?'.$pl.'( |\t|\r?\n)(.*?) ?\?>([ \t]*\r?\n)?)'; |
191
|
0
|
|
|
|
|
0
|
return qr/$pat/sm; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=head2 stmt_pattern |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
Returns the default pattern (which uses 'pl') with the |
197
|
|
|
|
|
|
|
L. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=cut |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub stmt_pattern { |
202
|
0
|
|
|
0
|
1
|
0
|
return compile_stmt_pattern('pl'); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head2 expr_pattern() |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Defines how expressions are written in Tenjin templates (C<[== $expr =]> |
208
|
|
|
|
|
|
|
and C<[= $expr =]>). |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=cut |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub expr_pattern { |
213
|
0
|
|
|
0
|
1
|
0
|
return qr/\[=(=?)(.*?)(=?)=\]/s; |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=head2 parse_stmt( $bufref, $input ) |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Receives a buffer which is used for saving a template's expressions |
219
|
|
|
|
|
|
|
and the template's text, parses all expressions in the templates and |
220
|
|
|
|
|
|
|
pushes them to the buffer. |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=cut |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sub parse_stmt { |
225
|
0
|
|
|
0
|
1
|
0
|
my ($self, $bufref, $input) = @_; |
226
|
|
|
|
|
|
|
|
227
|
0
|
|
|
|
|
0
|
my $pos = 0; |
228
|
0
|
|
|
|
|
0
|
my $pat = $self->stmt_pattern(); |
229
|
0
|
|
|
|
|
0
|
while ($input =~ /$pat/g) { |
230
|
0
|
|
|
|
|
0
|
my ($pi, $lspace, $mspace, $stmt, $rspace) = ($1, $2, $3, $4, $5); |
231
|
0
|
|
|
|
|
0
|
my $start = $-[0]; |
232
|
0
|
|
|
|
|
0
|
my $text = substr($input, $pos, $start - $pos); |
233
|
0
|
|
|
|
|
0
|
$pos = $start + length($pi); |
234
|
0
|
0
|
|
|
|
0
|
$self->parse_expr($bufref, $text) if $text; |
235
|
0
|
0
|
|
|
|
0
|
$mspace = '' if $mspace eq ' '; |
236
|
0
|
|
|
|
|
0
|
$stmt = $self->hook_stmt($stmt); |
237
|
0
|
0
|
|
|
|
0
|
$stmt .= $rspace if $rspace; |
238
|
0
|
0
|
|
|
|
0
|
$stmt = $mspace . $stmt if $mspace; |
239
|
0
|
0
|
|
|
|
0
|
$stmt = $lspace . $stmt if $lspace; |
240
|
0
|
|
|
|
|
0
|
$self->add_stmt($bufref, $stmt); |
241
|
|
|
|
|
|
|
} |
242
|
0
|
0
|
|
|
|
0
|
my $rest = $pos == 0 ? $input : substr($input, $pos); |
243
|
0
|
0
|
|
|
|
0
|
$self->parse_expr($bufref, $rest) if $rest; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=head2 hook_stmt( $stmt ) |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=cut |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub hook_stmt { |
251
|
0
|
|
|
0
|
1
|
0
|
my ($self, $stmt) = @_; |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
## macro expantion |
254
|
0
|
0
|
|
|
|
0
|
if ($stmt =~ /\A(\s*)(\w+)\((.*?)\);?(\s*)\Z/) { |
255
|
0
|
|
|
|
|
0
|
my ($lspace, $funcname, $arg, $rspace) = ($1, $2, $3, $4); |
256
|
0
|
|
|
|
|
0
|
my $s = $self->expand_macro($funcname, $arg); |
257
|
0
|
0
|
|
|
|
0
|
return $lspace . $s . $rspace if defined($s); |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
## template arguments |
261
|
0
|
0
|
|
|
|
0
|
unless ($self->{args}) { |
262
|
0
|
0
|
|
|
|
0
|
if ($stmt =~ m/\A(\s*)\#\@ARGS\s+(.*)(\s*)\Z/) { |
263
|
0
|
|
|
|
|
0
|
my ($lspace, $argstr, $rspace) = ($1, $2, $3); |
264
|
0
|
|
|
|
|
0
|
my @args = (); |
265
|
0
|
|
|
|
|
0
|
my @declares = (); |
266
|
0
|
|
|
|
|
0
|
foreach my $arg (split(/,/, $argstr)) { |
267
|
0
|
|
|
|
|
0
|
$arg =~ s/(^\s+|\s+$)//g; |
268
|
0
|
0
|
|
|
|
0
|
next unless $arg; |
269
|
0
|
0
|
|
|
|
0
|
$arg =~ m/\A([\$\@\%])?([a-zA-Z_]\w*)\Z/ or croak "[Tenjin] $arg: invalid template argument."; |
270
|
0
|
0
|
0
|
|
|
0
|
croak "[Tenjin] $arg: only '\$var' is available for template argument." unless (!$1 || $1 eq '$'); |
271
|
0
|
|
|
|
|
0
|
my $name = $2; |
272
|
0
|
|
|
|
|
0
|
push(@args, $name); |
273
|
0
|
|
|
|
|
0
|
push(@declares, "my \$$name = \$_context->{$name}; "); |
274
|
|
|
|
|
|
|
} |
275
|
0
|
|
|
|
|
0
|
$self->{args} = \@args; |
276
|
0
|
|
|
|
|
0
|
return $lspace . join('', @declares) . $rspace; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
0
|
|
|
|
|
0
|
return $stmt; |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=head2 expand_macro( $funcname, $arg ) |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
This method is in charge of invoking macro functions which might be used |
286
|
|
|
|
|
|
|
inside templates. The following macros are available: |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=over |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=item * C |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
Includes another template, whose name is C<$filename>, inside the current |
293
|
|
|
|
|
|
|
template. The included template will be placed inside the template as if |
294
|
|
|
|
|
|
|
they were one unit, so the context variable applies to both. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=item * C and C |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
Tells Tenjin to capture the output of the rendered template from the point |
299
|
|
|
|
|
|
|
where C was called to the point where C |
300
|
|
|
|
|
|
|
was called. You must provide a name for the captured portion, which will be |
301
|
|
|
|
|
|
|
made available in the context as C<< $_context->{$name} >> for immediate |
302
|
|
|
|
|
|
|
usage. Note that the captured portion will not be printed unless you do |
303
|
|
|
|
|
|
|
so explicilty with C<< $_context->{$name} >>. |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=item * C and C |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
This is a special method which can be used for making your templates a bit |
308
|
|
|
|
|
|
|
cleaner. Suppose your context might have a variable whose name is defined |
309
|
|
|
|
|
|
|
in C<$var>. If that variable exists in the context, you simply want to print |
310
|
|
|
|
|
|
|
it, but if it's not, you want to print and/or perform other things. In that |
311
|
|
|
|
|
|
|
case you can call C with the name of the context |
312
|
|
|
|
|
|
|
variable you want printed, and if it's not, anything you do between |
313
|
|
|
|
|
|
|
C and C will be printed instead. |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
=item * echo( $exr ) |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
Just prints the provided expression. You might want to use it if you're |
318
|
|
|
|
|
|
|
a little too comfortable with PHP. |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
=back |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=cut |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
sub expand_macro { |
325
|
0
|
|
|
0
|
1
|
0
|
my ($self, $funcname, $arg) = @_; |
326
|
|
|
|
|
|
|
|
327
|
0
|
|
|
|
|
0
|
my $handler = $MACRO_HANDLER_TABLE->{$funcname}; |
328
|
0
|
0
|
|
|
|
0
|
return $handler ? $handler->($arg) : undef; |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
=head2 get_expr_and_escapeflag( $not_escape, $expr, $delete_newline ) |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=cut |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
## ex. get_expr_and_escapeflag('=', '$item->{name}', '') => 1, '$item->{name}', 0 |
336
|
|
|
|
|
|
|
sub get_expr_and_escapeflag { |
337
|
0
|
|
|
0
|
1
|
0
|
my ($self, $not_escape, $expr, $delete_newline) = @_; |
338
|
|
|
|
|
|
|
|
339
|
0
|
|
|
|
|
0
|
return $expr, $not_escape eq '', $delete_newline eq '='; |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=head2 parse_expr( $bufref, $input ) |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=cut |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
sub parse_expr { |
347
|
0
|
|
|
0
|
1
|
0
|
my ($self, $bufref, $input) = @_; |
348
|
|
|
|
|
|
|
|
349
|
0
|
|
|
|
|
0
|
my $pos = 0; |
350
|
0
|
|
|
|
|
0
|
$self->start_text_part($bufref); |
351
|
0
|
|
|
|
|
0
|
my $pat = $self->expr_pattern(); |
352
|
0
|
|
|
|
|
0
|
while ($input =~ /$pat/g) { |
353
|
0
|
|
|
|
|
0
|
my $start = $-[0]; |
354
|
0
|
|
|
|
|
0
|
my $text = substr($input, $pos, $start - $pos); |
355
|
0
|
|
|
|
|
0
|
my ($expr, $flag_escape, $delete_newline) = $self->get_expr_and_escapeflag($1, $2, $3); |
356
|
0
|
|
|
|
|
0
|
$pos = $start + length($&); |
357
|
0
|
0
|
|
|
|
0
|
$self->add_text($bufref, $text) if $text; |
358
|
0
|
0
|
|
|
|
0
|
$self->add_expr($bufref, $expr, $flag_escape) if $expr; |
359
|
0
|
0
|
|
|
|
0
|
if ($delete_newline) { |
360
|
0
|
|
|
|
|
0
|
my $end = $+[0]; |
361
|
0
|
0
|
|
|
|
0
|
if (substr($input, $end + 1, 1) eq "\n") { |
362
|
0
|
|
|
|
|
0
|
$bufref->[0] .= "\n"; |
363
|
0
|
|
|
|
|
0
|
$pos++; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
} |
367
|
0
|
0
|
|
|
|
0
|
my $rest = $pos == 0 ? $input : substr($input, $pos); |
368
|
0
|
|
|
|
|
0
|
$self->add_text($bufref, $rest); |
369
|
0
|
|
|
|
|
0
|
$self->stop_text_part($bufref); |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=head2 start_text_part( $bufref ) |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=cut |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub start_text_part { |
377
|
0
|
|
|
0
|
1
|
0
|
my ($self, $bufref) = @_; |
378
|
|
|
|
|
|
|
|
379
|
0
|
|
|
|
|
0
|
$bufref->[0] .= ' $_buf .= '; |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
=head2 stop_text_part( $bufref ) |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=cut |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
sub stop_text_part { |
387
|
0
|
|
|
0
|
1
|
0
|
my ($self, $bufref) = @_; |
388
|
|
|
|
|
|
|
|
389
|
0
|
|
|
|
|
0
|
$bufref->[0] .= '; '; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=head2 add_text( $bufref, $text ) |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=cut |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
sub add_text { |
397
|
0
|
|
|
0
|
1
|
0
|
my ($self, $bufref, $text) = @_; |
398
|
|
|
|
|
|
|
|
399
|
0
|
0
|
|
|
|
0
|
return unless $text; |
400
|
0
|
|
|
|
|
0
|
$text =~ s/[`\\]/\\$&/g; |
401
|
0
|
|
|
|
|
0
|
my $is_start = $bufref->[0] =~ / \$_buf \.= \Z/; |
402
|
0
|
0
|
|
|
|
0
|
$bufref->[0] .= $is_start ? "q`$text`" : " . q`$text`"; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=head2 add_stmt( $bufref, $stmt ) |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
=cut |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
sub add_stmt { |
410
|
0
|
|
|
0
|
1
|
0
|
my ($self, $bufref, $stmt) = @_; |
411
|
|
|
|
|
|
|
|
412
|
0
|
|
|
|
|
0
|
$bufref->[0] .= $stmt; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=head2 add_expr( $bufref, $expr, $flag_escape ) |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
=cut |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub add_expr { |
420
|
0
|
|
|
0
|
1
|
0
|
my ($self, $bufref, $expr, $flag_escape) = @_; |
421
|
|
|
|
|
|
|
|
422
|
0
|
0
|
|
|
|
0
|
my $dot = $bufref->[0] =~ / \$_buf \.= \Z/ ? '' : ' . '; |
423
|
0
|
0
|
|
|
|
0
|
$bufref->[0] .= $dot . ($flag_escape ? $self->escaped_expr($expr) : "($expr)"); |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=head2 defun( $funcname, @args ) |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
=cut |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
sub defun { ## (experimental) |
431
|
0
|
|
|
0
|
1
|
0
|
my ($self, $funcname, @args) = @_; |
432
|
|
|
|
|
|
|
|
433
|
0
|
0
|
|
|
|
0
|
unless ($funcname) { |
434
|
0
|
|
|
|
|
0
|
my $funcname = $self->{filename}; |
435
|
0
|
0
|
|
|
|
0
|
if ($funcname) { |
436
|
0
|
|
|
|
|
0
|
$funcname =~ s/\.\w+$//; |
437
|
0
|
|
|
|
|
0
|
$funcname =~ s/[^\w]/_/g; |
438
|
|
|
|
|
|
|
} |
439
|
0
|
|
|
|
|
0
|
$funcname = 'render_' . $funcname; |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
0
|
|
|
|
|
0
|
my $str = "sub $funcname { my (\$_context) = \@_; "; |
443
|
0
|
|
|
|
|
0
|
foreach (@args) { |
444
|
0
|
|
|
|
|
0
|
$str .= "my \$$_ = \$_context->{'$_'}; "; |
445
|
|
|
|
|
|
|
} |
446
|
0
|
|
|
|
|
0
|
$str .= $self->{script}; |
447
|
0
|
|
|
|
|
0
|
$str .= "}\n"; |
448
|
|
|
|
|
|
|
|
449
|
0
|
|
|
|
|
0
|
return $str; |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=head2 compile() |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=cut |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
## compile $self->{script} into closure. |
457
|
|
|
|
|
|
|
sub compile { |
458
|
16
|
|
|
16
|
1
|
45
|
my $self = shift; |
459
|
|
|
|
|
|
|
|
460
|
16
|
50
|
|
|
|
79
|
if ($self->{args}) { |
461
|
0
|
|
|
|
|
0
|
$self->{func} = $Tenjin::CONTEXT_CLASS->to_func($self->{script}, $self->{name}); |
462
|
0
|
|
|
|
|
0
|
return $self->{func}; |
463
|
|
|
|
|
|
|
} |
464
|
16
|
|
|
|
|
66
|
return; |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
=head2 escaped_expr( $expr ) |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
Receives a Perl expression (from C<[= $expr =]>) and escapes it. This will |
470
|
|
|
|
|
|
|
happen in one of three ways: with the escape function defined in |
471
|
|
|
|
|
|
|
C<< $opts->{escapefunc} >> (if defined), with a scalar string (if |
472
|
|
|
|
|
|
|
C<< $opts->{rawclass} >> is defined), or with C from |
473
|
|
|
|
|
|
|
L, which uses L. |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
=cut |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
sub escaped_expr { |
478
|
0
|
|
|
0
|
1
|
0
|
my ($self, $expr) = @_; |
479
|
|
|
|
|
|
|
|
480
|
0
|
0
|
|
|
|
0
|
return "$self->{escapefunc}($expr)" if $self->{escapefunc}; |
481
|
|
|
|
|
|
|
|
482
|
0
|
0
|
|
|
|
0
|
return "(ref(\$_V = ($expr)) eq '$self->{rawclass}' ? \$_V->{str} : escape_xml($expr)" if $self->{rawclass}; |
483
|
|
|
|
|
|
|
|
484
|
0
|
|
|
|
|
0
|
return "escape_xml($expr)"; |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=head2 _read_file( $filename, [$lock_required] ) |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
Receives an absolute path to a template file, reads its content and |
490
|
|
|
|
|
|
|
returns it. If C<$lock_required> is passed (and has a true value), the |
491
|
|
|
|
|
|
|
file will be locked for reading. |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
=cut |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
sub _read_file { |
496
|
16
|
|
|
16
|
|
36
|
my ($self, $filename, $lock_required) = @_; |
497
|
|
|
|
|
|
|
|
498
|
16
|
50
|
|
6
|
|
787
|
open(IN, "<:encoding($Tenjin::ENCODING)", $filename) |
|
6
|
|
|
|
|
66
|
|
|
6
|
|
|
|
|
19
|
|
|
6
|
|
|
|
|
67
|
|
499
|
|
|
|
|
|
|
or croak "[Tenjin] Can't open $filename for reading: $!"; |
500
|
16
|
50
|
|
|
|
137649
|
flock(IN, LOCK_SH) if $lock_required; |
501
|
|
|
|
|
|
|
|
502
|
16
|
|
|
|
|
452893
|
read(IN, my $content, -s $filename); |
503
|
|
|
|
|
|
|
|
504
|
16
|
|
|
|
|
1029
|
close(IN); |
505
|
|
|
|
|
|
|
|
506
|
16
|
|
|
|
|
216
|
return $content; |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=head2 _write_file( $filename, $content, [$lock_required] ) |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
Receives an absolute path to a template file and the templates contents, |
512
|
|
|
|
|
|
|
and creates the file (or truncates it, if existing) with that contents. |
513
|
|
|
|
|
|
|
If C<$lock_required> is passed (and has a true value), the file will be |
514
|
|
|
|
|
|
|
locked exclusively when writing. |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
=cut |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
sub _write_file { |
519
|
0
|
|
|
0
|
|
0
|
my ($self, $filename, $content, $lock_required) = @_; |
520
|
|
|
|
|
|
|
|
521
|
0
|
0
|
|
|
|
0
|
my $enc = $Tenjin::ENCODING eq 'UTF-8' ? '>:utf8' : ">:encoding($Tenjin::ENCODING)"; |
522
|
|
|
|
|
|
|
|
523
|
0
|
0
|
|
|
|
0
|
open(OUT, $enc, $filename) |
524
|
|
|
|
|
|
|
or croak "[Tenjin] Can't open $filename for writing: $!"; |
525
|
0
|
0
|
|
|
|
0
|
flock(OUT, LOCK_EX) if $lock_required; |
526
|
0
|
|
|
|
|
0
|
print OUT $content; |
527
|
0
|
|
|
|
|
0
|
close(OUT); |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
1; |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
=head1 SEE ALSO |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
L. |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
=head1 AUTHOR |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
The CPAN version of Tenjin was forked by Ido Perlmuter Eido at ido50.netE |
539
|
|
|
|
|
|
|
from version 0.0.2 of the original plTenjin, which is developed by Makoto Kuwata |
540
|
|
|
|
|
|
|
at L. |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
Development of Tenjin is done with github at L. |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
Tenjin is licensed under the MIT license. |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
Copyright (c) 2007-2010 the aforementioned authors. |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
Permission is hereby granted, free of charge, to any person obtaining |
551
|
|
|
|
|
|
|
a copy of this software and associated documentation files (the |
552
|
|
|
|
|
|
|
"Software"), to deal in the Software without restriction, including |
553
|
|
|
|
|
|
|
without limitation the rights to use, copy, modify, merge, publish, |
554
|
|
|
|
|
|
|
distribute, sublicense, and/or sell copies of the Software, and to |
555
|
|
|
|
|
|
|
permit persons to whom the Software is furnished to do so, subject to |
556
|
|
|
|
|
|
|
the following conditions: |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
The above copyright notice and this permission notice shall be |
559
|
|
|
|
|
|
|
included in all copies or substantial portions of the Software. |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, |
562
|
|
|
|
|
|
|
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF |
563
|
|
|
|
|
|
|
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND |
564
|
|
|
|
|
|
|
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE |
565
|
|
|
|
|
|
|
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION |
566
|
|
|
|
|
|
|
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION |
567
|
|
|
|
|
|
|
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
=cut |