| 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 |