line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
55
|
|
|
55
|
|
404841
|
use 5.006; |
|
55
|
|
|
|
|
435
|
|
|
55
|
|
|
|
|
2493
|
|
2
|
48
|
|
|
48
|
|
359
|
use warnings; |
|
48
|
|
|
|
|
94
|
|
|
48
|
|
|
|
|
1673
|
|
3
|
48
|
|
|
48
|
|
245
|
use strict; |
|
48
|
|
|
|
|
91
|
|
|
48
|
|
|
|
|
3875
|
|
4
|
|
|
|
|
|
|
#use Smart::Comments; |
5
|
|
|
|
|
|
|
#use Smart::Comments '####'; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
package Template::Declare::Tags; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.43'; |
10
|
|
|
|
|
|
|
|
11
|
48
|
|
|
48
|
|
7623
|
use Template::Declare; |
|
48
|
|
|
|
|
118
|
|
|
48
|
|
|
|
|
1683
|
|
12
|
48
|
|
|
48
|
|
285
|
use base 'Exporter'; |
|
48
|
|
|
|
|
113
|
|
|
48
|
|
|
|
|
5836
|
|
13
|
48
|
|
|
48
|
|
274
|
use Carp qw(carp croak); |
|
48
|
|
|
|
|
92
|
|
|
48
|
|
|
|
|
3803
|
|
14
|
48
|
|
|
48
|
|
66416
|
use Symbol 'qualify_to_ref'; |
|
48
|
|
|
|
|
69708
|
|
|
48
|
|
|
|
|
27417
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $self; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our @EXPORT = qw( |
19
|
|
|
|
|
|
|
template private current_template current_base_path |
20
|
|
|
|
|
|
|
show show_page |
21
|
|
|
|
|
|
|
attr with get_current_attr |
22
|
|
|
|
|
|
|
outs outs_raw |
23
|
|
|
|
|
|
|
xml_decl |
24
|
|
|
|
|
|
|
under setting |
25
|
|
|
|
|
|
|
smart_tag_wrapper create_wrapper |
26
|
|
|
|
|
|
|
$self |
27
|
|
|
|
|
|
|
); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
our @TAG_SUB_LIST; |
30
|
|
|
|
|
|
|
our @TagSubs; |
31
|
|
|
|
|
|
|
*TagSubs = \@TAG_SUB_LIST; # For backward compatibility only |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
our %ATTRIBUTES = (); |
34
|
|
|
|
|
|
|
our %ELEMENT_ID_CACHE = (); |
35
|
|
|
|
|
|
|
our $TAG_NEST_DEPTH = 0; |
36
|
|
|
|
|
|
|
our $TAG_INDENTATION = 1; |
37
|
|
|
|
|
|
|
our $EOL = "\n"; |
38
|
|
|
|
|
|
|
our @TEMPLATE_STACK = (); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
our $SKIP_XML_ESCAPING = 0; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub import { |
43
|
105
|
|
|
105
|
|
195976
|
my $self = shift; |
44
|
105
|
|
|
|
|
221
|
my @set_modules; |
45
|
105
|
100
|
|
|
|
473
|
if (!@_) { |
46
|
90
|
|
|
|
|
272
|
push @_, 'HTML'; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
### @_ |
49
|
|
|
|
|
|
|
### caller: caller() |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# XXX We can't reset @TAG_SUB_LIST here since |
52
|
|
|
|
|
|
|
# use statements always run at BEGIN time. |
53
|
|
|
|
|
|
|
# A better approach may be install such lists |
54
|
|
|
|
|
|
|
# directly into the caller's namespace... |
55
|
|
|
|
|
|
|
#undef @TAG_SUB_LIST; |
56
|
|
|
|
|
|
|
|
57
|
105
|
|
|
|
|
343
|
while (@_) { |
58
|
112
|
|
|
|
|
217
|
my $lang = shift; |
59
|
112
|
|
|
|
|
185
|
my $opts; |
60
|
112
|
100
|
66
|
|
|
580
|
if (ref $_[0] and ref $_[0] eq 'HASH') { |
61
|
7
|
|
|
|
|
12
|
$opts = shift; |
62
|
7
|
|
100
|
|
|
46
|
$opts->{package} ||= $opts->{namespace}; |
63
|
|
|
|
|
|
|
# XXX TODO: carp if the derived package already exists? |
64
|
|
|
|
|
|
|
} |
65
|
112
|
|
100
|
|
|
1102
|
$opts->{package} ||= scalar(caller); |
66
|
112
|
|
66
|
|
|
578
|
my $module = $opts->{from} || |
67
|
|
|
|
|
|
|
"Template::Declare::TagSet::$lang"; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
### Loading tag set: $module |
70
|
112
|
100
|
|
|
|
2018
|
if (! $module->can('get_tag_list') ) { |
71
|
47
|
|
|
47
|
|
36214
|
eval "use $module"; |
|
47
|
|
|
|
|
189
|
|
|
47
|
|
|
|
|
759
|
|
|
54
|
|
|
|
|
5780
|
|
72
|
54
|
50
|
|
|
|
1340
|
if ($@) { |
73
|
0
|
|
|
|
|
0
|
warn $@; |
74
|
0
|
|
|
|
|
0
|
croak "Failed to load tagset module $module"; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
### TagSet options: $opts |
78
|
112
|
|
|
|
|
846
|
my $tagset = $module->new($opts); |
79
|
112
|
|
|
|
|
2297
|
my $tag_list = $tagset->get_tag_list; |
80
|
|
|
|
|
|
|
Template::Declare::Tags::install_tag($_, $tagset) |
81
|
112
|
|
|
|
|
561
|
for @$tag_list; |
82
|
|
|
|
|
|
|
} |
83
|
105
|
|
|
|
|
89833
|
__PACKAGE__->export_to_level(1, $self); |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub _install { |
87
|
16562
|
|
|
16562
|
|
104615
|
my ($override, $package, $subname, $coderef) = @_; |
88
|
|
|
|
|
|
|
|
89
|
16562
|
|
|
|
|
31257
|
my $name = $package . '::' . $subname; |
90
|
16562
|
|
|
|
|
40376
|
my $slot = qualify_to_ref($name); |
91
|
16562
|
100
|
100
|
|
|
267436
|
return if !$override and *$slot{CODE}; |
92
|
|
|
|
|
|
|
|
93
|
48
|
|
|
48
|
|
373
|
no warnings 'redefine'; |
|
48
|
|
|
|
|
517
|
|
|
48
|
|
|
|
|
6986
|
|
94
|
16187
|
|
|
|
|
68420
|
*$slot = $coderef; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=head1 NAME |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
Template::Declare::Tags - Build and install XML Tag subroutines for Template::Declare |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head1 SYNOPSIS |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
package MyApp::Templates; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
use base 'Template::Declare'; |
106
|
|
|
|
|
|
|
use Template::Declare::Tags 'HTML'; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
template main => sub { |
109
|
|
|
|
|
|
|
link {} |
110
|
|
|
|
|
|
|
table { |
111
|
|
|
|
|
|
|
row { |
112
|
|
|
|
|
|
|
cell { "Hello, world!" } |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
img { attr { src => 'cat.gif' } } |
116
|
|
|
|
|
|
|
img { src is 'dog.gif' } |
117
|
|
|
|
|
|
|
}; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
Produces: |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Using XUL templates with a namespace: |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
package MyApp::Templates; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
use base 'Template::Declare'; |
135
|
|
|
|
|
|
|
use Template::Declare::Tags |
136
|
|
|
|
|
|
|
'XUL', HTML => { namespace => 'html' }; |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
template main => sub { |
139
|
|
|
|
|
|
|
groupbox { |
140
|
|
|
|
|
|
|
caption { attr { label => 'Colors' } } |
141
|
|
|
|
|
|
|
html::div { html::p { 'howdy!' } } |
142
|
|
|
|
|
|
|
html::br {} |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
}; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
Produces: |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
howdy! |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head1 DESCRIPTION |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
C is used to generate templates and install |
159
|
|
|
|
|
|
|
subroutines for tag sets into the calling namespace. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
You can specify the tag sets to install by providing a list of tag modules in |
162
|
|
|
|
|
|
|
the C |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
use Template::Declare::Tags qw/ HTML XUL /; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
By default, Template::Declare::Tags uses the tag set provided by |
167
|
|
|
|
|
|
|
L. So |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
use Template::Declare::Tags; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
is equivalent to |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
use Template::Declare::Tags 'HTML'; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
Currently L bundles the following tag sets: |
176
|
|
|
|
|
|
|
L, L, |
177
|
|
|
|
|
|
|
L, and L. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
You can specify your own tag set classes, as long as they subclass |
180
|
|
|
|
|
|
|
L and implement the corresponding methods (e.g. |
181
|
|
|
|
|
|
|
C). |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
If you implement a custom tag set module named |
184
|
|
|
|
|
|
|
C, you can load it into a template module like |
185
|
|
|
|
|
|
|
so: |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
use Template::Declare::Tags 'Foo'; |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
If your tag set module is not under the |
190
|
|
|
|
|
|
|
L namespace, use the |
191
|
|
|
|
|
|
|
C option to load it. Fore example, if you created a tag set named |
192
|
|
|
|
|
|
|
C, then you could load it like so: |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
use Template::Declare::Tags Foo => { from => 'MyTag::Foo' }; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
XML namespaces are emulated by Perl packages. For example, to embed HTML tags |
197
|
|
|
|
|
|
|
within XUL using the C namespace: |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
package MyApp::Templates; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
use base 'Template::Declare'; |
202
|
|
|
|
|
|
|
use Template::Declare::Tags 'XUL', HTML => { namespace => 'html' }; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
template main => sub { |
205
|
|
|
|
|
|
|
groupbox { |
206
|
|
|
|
|
|
|
caption { attr { label => 'Colors' } } |
207
|
|
|
|
|
|
|
html::div { html::p { 'howdy!' } } |
208
|
|
|
|
|
|
|
html::br {} |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
}; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
This will output: |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
howdy! |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
Behind the scenes, C generates a Perl package named |
223
|
|
|
|
|
|
|
C and installs the HTML tag subroutines into that package. On the other |
224
|
|
|
|
|
|
|
hand, XUL tag subroutines are installed into the current package, namely, |
225
|
|
|
|
|
|
|
C in the previous example. |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
There may be cases when you want to specify a different Perl package for a |
228
|
|
|
|
|
|
|
particular XML namespace. For instance, if the C Perl package has |
229
|
|
|
|
|
|
|
already been used for other purposes in your application and you don't want to |
230
|
|
|
|
|
|
|
install subs there and mess things up, use the C option to install |
231
|
|
|
|
|
|
|
them elsewhere: |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
package MyApp::Templates; |
234
|
|
|
|
|
|
|
use base 'Template::Declare'; |
235
|
|
|
|
|
|
|
use Template::Declare::Tags 'XUL', HTML => { |
236
|
|
|
|
|
|
|
namespace => 'htm', |
237
|
|
|
|
|
|
|
package => 'MyHtml' |
238
|
|
|
|
|
|
|
}; |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
template main => sub { |
241
|
|
|
|
|
|
|
groupbox { |
242
|
|
|
|
|
|
|
caption { attr { label => 'Colors' } } |
243
|
|
|
|
|
|
|
MyHtml::div { MyHtml::p { 'howdy!' } } |
244
|
|
|
|
|
|
|
MyHtml::br {} |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
}; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
This code will generate something like the following: |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
howdy! |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=head1 METHODS AND SUBROUTINES |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=head2 Declaring templates |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=head3 template TEMPLATENAME => sub { 'Implementation' }; |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
template select_list => sub { |
265
|
|
|
|
|
|
|
my $self = shift; |
266
|
|
|
|
|
|
|
select { |
267
|
|
|
|
|
|
|
option { $_ } for @_; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
}; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Declares a template in the current package. The first argument to the template |
272
|
|
|
|
|
|
|
subroutine will always be a C object. Subsequent arguments |
273
|
|
|
|
|
|
|
will be all those passed to C. For example, to use the above example |
274
|
|
|
|
|
|
|
to output a select list of colors, you'd call it like so: |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
Template::Declare->show('select_list', qw(red yellow green purple)); |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
You can use any URL-legal characters in the template name; |
279
|
|
|
|
|
|
|
C will encode the template as a Perl subroutine and stash |
280
|
|
|
|
|
|
|
it where C can find it. |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
(Did you know that you can have characters like ":" and "/" in your Perl |
283
|
|
|
|
|
|
|
subroutine names? The easy way to get at them is with C). |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=cut |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
sub template ($$) { |
288
|
160
|
|
|
160
|
1
|
16989
|
my $template_name = shift; |
289
|
160
|
|
|
|
|
268
|
my $coderef = shift; |
290
|
160
|
|
|
|
|
1228
|
my $template_class = ( caller(0) )[0]; |
291
|
|
|
|
|
|
|
|
292
|
48
|
|
|
48
|
|
300
|
no warnings qw( uninitialized redefine ); |
|
48
|
|
|
|
|
87
|
|
|
48
|
|
|
|
|
33257
|
|
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
# template "foo" ==> CallerPkg::_jifty_template_foo; |
295
|
|
|
|
|
|
|
# template "foo/bar" ==> CallerPkg::_jifty_template_foo/bar; |
296
|
|
|
|
|
|
|
my $codesub = sub { |
297
|
214
|
|
33
|
214
|
|
1286
|
local $self = shift || $self || $template_class; |
298
|
214
|
|
|
|
|
799
|
unshift @_, $self, $coderef; |
299
|
214
|
|
|
|
|
1986
|
goto $self->can('_dispatch_template'); |
300
|
160
|
|
|
|
|
1006
|
}; |
301
|
|
|
|
|
|
|
|
302
|
160
|
100
|
|
|
|
522
|
if (wantarray) { |
303
|
|
|
|
|
|
|
# We're being called by something like private that doesn't want us to register ourselves |
304
|
11
|
|
|
|
|
57
|
return ( $template_class, $template_name, $codesub ); |
305
|
|
|
|
|
|
|
} else { |
306
|
|
|
|
|
|
|
# We've been called in a void context and should register this template |
307
|
149
|
|
|
|
|
599
|
Template::Declare::register_template( |
308
|
|
|
|
|
|
|
$template_class, |
309
|
|
|
|
|
|
|
$template_name, |
310
|
|
|
|
|
|
|
$codesub, |
311
|
|
|
|
|
|
|
); |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
=head3 private template TEMPLATENAME => sub { 'Implementation' }; |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
private template select_list => sub { |
318
|
|
|
|
|
|
|
my $self = shift; |
319
|
|
|
|
|
|
|
select { |
320
|
|
|
|
|
|
|
option { $_ } for @_; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
}; |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
Declares that a template isn't available to be called directly from client |
325
|
|
|
|
|
|
|
code. The resulting template can instead only be called from the package in |
326
|
|
|
|
|
|
|
which it's created. |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=cut |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub private (@) { |
331
|
11
|
|
|
11
|
1
|
19
|
my $class = shift; |
332
|
11
|
|
|
|
|
17
|
my $subname = shift; |
333
|
11
|
|
|
|
|
20
|
my $code = shift; |
334
|
11
|
|
|
|
|
40
|
Template::Declare::register_private_template( $class, $subname, $code ); |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=head2 Showing templates |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=head3 show [$template_name or $template_coderef], args |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
show( main => { user => 'Bob' } ); |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
Displays templates. The first argument is the name of the template to be |
344
|
|
|
|
|
|
|
displayed. Any additional arguments will be passed directly to the template. |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
C can either be called with a template name or a package/object and a |
347
|
|
|
|
|
|
|
template. (It's both functional and OO.) |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
If called from within a Template::Declare subclass, then private templates are |
350
|
|
|
|
|
|
|
accessible and visible. If called from something that isn't a |
351
|
|
|
|
|
|
|
Template::Declare, only public templates will be visible. |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
From the outside world, users can either call C<< Template::Declare->show() >>, |
354
|
|
|
|
|
|
|
C<< show() >> exported from Template::Declare::Tags or |
355
|
|
|
|
|
|
|
C directly to render a publicly visible template. |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
Private templates may only be called from within the C |
358
|
|
|
|
|
|
|
package. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=cut |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub show { |
363
|
119
|
|
|
119
|
1
|
100919
|
my $template = shift; |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
# if we're inside a template, we should show private templates |
366
|
119
|
100
|
|
|
|
1156
|
if ( caller->isa('Template::Declare') ) { |
367
|
66
|
|
|
|
|
383
|
_show_template( $template, 1, \@_ ); |
368
|
66
|
|
|
|
|
222
|
return Template::Declare->buffer->data; |
369
|
|
|
|
|
|
|
} else { |
370
|
53
|
|
|
|
|
202
|
show_page( $template, @_); |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=head3 show_page |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
show_page( main => { user => 'Bob' } ); |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
Like C, but does not dispatch to private templates. It's used |
380
|
|
|
|
|
|
|
internally by C when when that method is called from outside a |
381
|
|
|
|
|
|
|
template class. |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
=cut |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
sub show_page { |
386
|
167
|
|
|
167
|
1
|
36146
|
my $template = shift; |
387
|
167
|
|
|
|
|
354
|
my $args = \@_; |
388
|
|
|
|
|
|
|
|
389
|
167
|
|
|
|
|
803
|
Template::Declare->buffer->push( |
390
|
|
|
|
|
|
|
private => defined wantarray, |
391
|
|
|
|
|
|
|
from => "T::D path $template", |
392
|
|
|
|
|
|
|
); |
393
|
167
|
|
|
|
|
6302
|
_show_template( $template, 0, $args ); |
394
|
165
|
|
|
|
|
339
|
%ELEMENT_ID_CACHE = (); |
395
|
165
|
|
|
|
|
691
|
return Template::Declare->buffer->pop; |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=head2 Attributes |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=head3 attr HASH |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
attr { src => 'logo.png' }; |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
Specifies attributes for the element tag in which it appears. For example, to |
405
|
|
|
|
|
|
|
add a class and ID to an HTML paragraph: |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
p { |
408
|
|
|
|
|
|
|
attr { |
409
|
|
|
|
|
|
|
class => 'greeting text', |
410
|
|
|
|
|
|
|
id => 'welcome', |
411
|
|
|
|
|
|
|
}; |
412
|
|
|
|
|
|
|
'This is a welcoming paragraph'; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=cut |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
sub attr (&;@) { |
418
|
52
|
|
|
52
|
1
|
718
|
my $code = shift; |
419
|
52
|
|
|
|
|
152
|
my @rv = $code->(); |
420
|
52
|
|
|
|
|
449
|
while ( my ( $field, $val ) = splice( @rv, 0, 2 ) ) { |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
# only defined whle in a tag context |
423
|
68
|
|
|
|
|
144
|
append_attr( $field, $val ); |
424
|
|
|
|
|
|
|
} |
425
|
51
|
|
|
|
|
267
|
return @_; |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
=head3 ATTR is VALUE |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
Attributes can also be specified by using C, as in |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
p { |
433
|
|
|
|
|
|
|
class is 'greeting text'; |
434
|
|
|
|
|
|
|
id is 'welcome'; |
435
|
|
|
|
|
|
|
'This is a welcoming paragraph'; |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
A few tricks work for 'is': |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
http_equiv is 'foo'; # => http-equiv="foo" |
441
|
|
|
|
|
|
|
xml__lang is 'foo'; # => xml:lang="foo" |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
So double underscore replaced with colon and single underscore with dash. |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
=cut |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
# 'is' is declared later, when needed, using 'local *is::AUTOLOAD = sub {};' |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=head3 with |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
with ( id => 'greeting', class => 'foo' ), |
452
|
|
|
|
|
|
|
p { 'Hello, World wide web' }; |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
An alternative way to specify attributes for a tag, just for variation. The |
455
|
|
|
|
|
|
|
standard way to do the same as this example using C is: |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
p { attr { id => 'greeting', class => 'foo' } |
458
|
|
|
|
|
|
|
'Hello, World wide web' }; |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=cut |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
sub with (@) { |
463
|
37
|
|
|
37
|
1
|
303
|
%ATTRIBUTES = (); |
464
|
37
|
|
|
|
|
164
|
while ( my ( $key, $val ) = splice( @_, 0, 2 ) ) { |
465
|
48
|
|
|
48
|
|
345
|
no warnings 'uninitialized'; |
|
48
|
|
|
|
|
122
|
|
|
48
|
|
|
|
|
22078
|
|
466
|
44
|
|
|
|
|
98
|
$ATTRIBUTES{$key} = $val; |
467
|
|
|
|
|
|
|
|
468
|
44
|
100
|
|
|
|
162
|
if ( lc($key) eq 'id' ) { |
469
|
34
|
100
|
|
|
|
164
|
if ( $ELEMENT_ID_CACHE{$val}++ ) { |
470
|
11
|
|
|
|
|
32
|
my $msg = "HTML appears to contain illegal duplicate element id: $val"; |
471
|
11
|
100
|
|
|
|
37
|
die $msg if Template::Declare->strict; |
472
|
10
|
|
|
|
|
211
|
warn $msg; |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
} |
477
|
36
|
100
|
|
|
|
820
|
wantarray ? () : ''; |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
=head2 Displaying text and raw data |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
=head3 outs STUFF |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
p { outs 'Grettings & welcome pyoonie hyoomon.' } |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
HTML-encodes its arguments and appends them to C's output |
487
|
|
|
|
|
|
|
buffer. This is similar to simply returning a string from a tag function call, |
488
|
|
|
|
|
|
|
but is occasionally useful when you need to output a mix of things, as in: |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
p { outs 'hello'; em { 'world' } } |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
=head3 outs_raw STUFF |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
p { outs_raw "That's what I'm talking about!' } |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
Appends its arguments to C's output buffer without HTML |
497
|
|
|
|
|
|
|
escaping. |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
=cut |
500
|
|
|
|
|
|
|
|
501
|
82
|
|
|
82
|
1
|
822
|
sub outs { _outs( 0, @_ ); } |
502
|
31
|
|
|
31
|
1
|
252
|
sub outs_raw { _outs( 1, @_ ); } |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
=head2 Installing tags and wrapping stuff |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=head3 install_tag TAGNAME, TAGSET |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
install_tag video => 'Template::Declare::TagSet::HTML'; |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
Sets up TAGNAME as a tag that can be used in user templates. TAGSET is an |
511
|
|
|
|
|
|
|
instance of a subclass for L. |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=cut |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
sub install_tag { |
516
|
15967
|
|
|
15967
|
1
|
29334
|
my $tag = $_[0]; # we should not do lc($tag) here :) |
517
|
15967
|
|
|
|
|
21181
|
my $name = $tag; |
518
|
15967
|
|
|
|
|
25629
|
my $tagset = $_[1]; |
519
|
|
|
|
|
|
|
|
520
|
15967
|
|
|
|
|
47214
|
my $alternative = $tagset->get_alternate_spelling($tag); |
521
|
15967
|
100
|
|
|
|
38348
|
if ( defined $alternative ) { |
522
|
|
|
|
|
|
|
_install( |
523
|
|
|
|
|
|
|
0, # do not override |
524
|
|
|
|
|
|
|
scalar(caller), $tag, |
525
|
|
|
|
|
|
|
sub (&) { |
526
|
1
|
|
|
1
|
|
163
|
die "$tag {...} is invalid; use $alternative {...} instead.\n"; |
527
|
|
|
|
|
|
|
} |
528
|
595
|
|
|
|
|
4081
|
); |
529
|
|
|
|
|
|
|
### Exporting place-holder sub: $name |
530
|
|
|
|
|
|
|
# XXX TODO: more checking here |
531
|
595
|
100
|
|
|
|
4434
|
if ($name !~ /^(?:base|tr|time)$/) { |
532
|
203
|
|
|
|
|
490
|
push @EXPORT, $name; |
533
|
203
|
|
|
|
|
375
|
push @TAG_SUB_LIST, $name; |
534
|
|
|
|
|
|
|
} |
535
|
595
|
50
|
|
|
|
1499
|
$name = $alternative or return; |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
# We don't need this since we directly install |
539
|
|
|
|
|
|
|
# subs into the target package. |
540
|
|
|
|
|
|
|
#push @EXPORT, $name; |
541
|
15967
|
|
|
|
|
27961
|
push @TAG_SUB_LIST, $name; |
542
|
|
|
|
|
|
|
|
543
|
48
|
|
|
48
|
|
301
|
no strict 'refs'; |
|
48
|
|
|
|
|
104
|
|
|
48
|
|
|
|
|
4759
|
|
544
|
48
|
|
|
48
|
|
269
|
no warnings 'redefine'; |
|
48
|
|
|
|
|
110
|
|
|
48
|
|
|
|
|
28498
|
|
545
|
|
|
|
|
|
|
#### Installing tag: $name |
546
|
|
|
|
|
|
|
# XXX TODO: use sub _install to insert subs into the caller's package so as to support XML packages |
547
|
|
|
|
|
|
|
my $code = sub (&;$) { |
548
|
422
|
|
|
422
|
|
3408
|
local *__ANON__ = $tag; |
549
|
422
|
100
|
100
|
|
|
1694
|
if ( defined wantarray and not wantarray ) { |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
# Scalar context - return a coderef that represents ourselves. |
552
|
85
|
|
|
|
|
173
|
my @__ = @_; |
553
|
85
|
|
|
|
|
117
|
my $_self = $self; |
554
|
|
|
|
|
|
|
my $sub = sub { |
555
|
85
|
|
|
85
|
|
137
|
local $self = $_self; |
556
|
85
|
|
|
|
|
8631
|
local *__ANON__ = $tag; |
557
|
85
|
|
|
|
|
458
|
_tag($tagset, $tag, @__); |
558
|
85
|
|
|
|
|
338
|
}; |
559
|
85
|
|
|
|
|
217
|
bless $sub, 'Template::Declare::Tag'; |
560
|
85
|
|
|
|
|
437
|
return $sub; |
561
|
|
|
|
|
|
|
} else { |
562
|
337
|
|
|
|
|
1410
|
_tag($tagset, $tag, @_); |
563
|
|
|
|
|
|
|
} |
564
|
15967
|
|
|
|
|
101348
|
}; |
565
|
15967
|
|
|
|
|
72960
|
_install( |
566
|
|
|
|
|
|
|
1, # do override the existing sub with the same name |
567
|
|
|
|
|
|
|
$tagset->package => $name => $code |
568
|
|
|
|
|
|
|
); |
569
|
|
|
|
|
|
|
} |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
=head3 smart_tag_wrapper |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
# create a tag that has access to the arguments set with L. |
574
|
|
|
|
|
|
|
sub sample_smart_tag (&) { |
575
|
|
|
|
|
|
|
my $code = shift; |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
smart_tag_wrapper { |
578
|
|
|
|
|
|
|
my %args = @_; # set using 'with' |
579
|
|
|
|
|
|
|
outs( 'keys: ' . join( ', ', sort keys %args) . "\n" ); |
580
|
|
|
|
|
|
|
$code->(); |
581
|
|
|
|
|
|
|
}; |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
# use it |
585
|
|
|
|
|
|
|
with ( foo => 'bar', baz => 'bundy' ), sample_smart_tag { |
586
|
|
|
|
|
|
|
outs( "Hello, World!\n" ); |
587
|
|
|
|
|
|
|
}; |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
The output would be |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
keys: baz, foo |
592
|
|
|
|
|
|
|
Hello, World! |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
The smart tag wrapper allows you to create code that has access to the |
595
|
|
|
|
|
|
|
attribute arguments specified via C. It passes those arguments in to the |
596
|
|
|
|
|
|
|
wrapped code in C<@_>. It also takes care of putting the output in the right |
597
|
|
|
|
|
|
|
place and tidying up after itself. This might be useful to change the behavior |
598
|
|
|
|
|
|
|
of a template based on attributes passed to C. |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
=cut |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
sub smart_tag_wrapper (&) { |
603
|
5
|
|
|
5
|
1
|
49
|
my $coderef = shift; |
604
|
|
|
|
|
|
|
|
605
|
5
|
|
|
|
|
16
|
Template::Declare->buffer->append($EOL); |
606
|
5
|
|
|
|
|
105
|
Template::Declare->buffer->push( from => "T::D tag wrapper", private => 1 ); |
607
|
|
|
|
|
|
|
|
608
|
5
|
|
|
|
|
122
|
my %attr = %ATTRIBUTES; |
609
|
5
|
|
|
|
|
11
|
%ATTRIBUTES = (); # prevent leakage |
610
|
|
|
|
|
|
|
|
611
|
5
|
50
|
|
|
|
91
|
my $last = join '', |
612
|
5
|
|
|
|
|
16
|
map { ref($_) ? $_ : _postprocess($_) } |
613
|
|
|
|
|
|
|
$coderef->(%attr); |
614
|
|
|
|
|
|
|
|
615
|
5
|
|
|
|
|
24
|
my $content = Template::Declare->buffer->pop; |
616
|
5
|
50
|
33
|
|
|
150
|
$content .= "$last" if not length $content and length $last; |
617
|
5
|
|
|
|
|
15
|
Template::Declare->buffer->append( $content ); |
618
|
|
|
|
|
|
|
|
619
|
5
|
|
|
|
|
97
|
return ''; |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
=head3 create_wrapper WRAPPERNAME => sub { 'Implementation' }; |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
create_wrapper basics => sub { |
625
|
|
|
|
|
|
|
my $code = shift; |
626
|
|
|
|
|
|
|
html { |
627
|
|
|
|
|
|
|
head { title { 'Welcome' } }; |
628
|
|
|
|
|
|
|
body { $code->() } |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
}; |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
C declares a wrapper subroutine that can be called like a tag |
633
|
|
|
|
|
|
|
sub, but can optionally take arguments to be passed to the wrapper sub. For |
634
|
|
|
|
|
|
|
example, if you wanted to wrap all of the output of a template in the usual |
635
|
|
|
|
|
|
|
HTML headers and footers, you can do something like this: |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
package MyApp::Templates; |
638
|
|
|
|
|
|
|
use Template::Declare::Tags; |
639
|
|
|
|
|
|
|
use base 'Template::Declare'; |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
BEGIN { |
642
|
|
|
|
|
|
|
create_wrapper wrap => sub { |
643
|
|
|
|
|
|
|
my $code = shift; |
644
|
|
|
|
|
|
|
my %params = @_; |
645
|
|
|
|
|
|
|
html { |
646
|
|
|
|
|
|
|
head { title { outs "Hello, $params{user}!"} }; |
647
|
|
|
|
|
|
|
body { |
648
|
|
|
|
|
|
|
$code->(); |
649
|
|
|
|
|
|
|
div { outs 'This is the end, my friend' }; |
650
|
|
|
|
|
|
|
}; |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
}; |
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
template inner => sub { |
656
|
|
|
|
|
|
|
wrap { |
657
|
|
|
|
|
|
|
h1 { outs "Hello, Jesse, s'up?" }; |
658
|
|
|
|
|
|
|
} user => 'Jesse'; |
659
|
|
|
|
|
|
|
}; |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
Note how the C wrapper function is available for calling after it has |
662
|
|
|
|
|
|
|
been declared in a C block. Also note how you can pass arguments to the |
663
|
|
|
|
|
|
|
function after the closing brace (you don't need a comma there!). |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
The output from the "inner" template will look something like this: |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
Hello, Jesse! |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
Hello, Jesse, s'up? |
673
|
|
|
|
|
|
|
This is the end, my friend |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=cut |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
sub create_wrapper ($$) { |
680
|
1
|
|
|
1
|
1
|
469
|
my $wrapper_name = shift; |
681
|
1
|
|
|
|
|
2
|
my $coderef = shift; |
682
|
1
|
|
|
|
|
3
|
my $template_class = caller; |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
# Shove the code ref into the calling class. |
685
|
48
|
|
|
48
|
|
365
|
no strict 'refs'; |
|
48
|
|
|
|
|
90
|
|
|
48
|
|
|
|
|
43623
|
|
686
|
1
|
|
|
1
|
|
5
|
*{"$template_class\::$wrapper_name"} = sub (&;@) { goto $coderef }; |
|
1
|
|
|
|
|
100
|
|
|
1
|
|
|
|
|
16
|
|
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
=head2 Helpers |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
=head3 xml_decl HASH |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
xml_decl { 'xml', version => '1.0' }; |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
Emits an XML declaration. For example: |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
xml_decl { 'xml', version => '1.0' }; |
698
|
|
|
|
|
|
|
xml_decl { 'xml-stylesheet', href => "chrome://global/skin/", type => "text/css" }; |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
Produces: |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=cut |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
sub xml_decl (&;$) { |
708
|
4
|
|
|
4
|
1
|
35
|
my $code = shift; |
709
|
4
|
|
|
|
|
10
|
my @rv = $code->(); |
710
|
4
|
|
|
|
|
25
|
my $name = shift @rv; |
711
|
4
|
|
|
|
|
16
|
outs_raw("$name"); |
712
|
4
|
|
|
|
|
143
|
while ( my ( $field, $val ) = splice( @rv, 0, 2 ) ) { |
713
|
6
|
|
|
|
|
81
|
outs_raw(qq/ $field="$val"/); |
714
|
|
|
|
|
|
|
} |
715
|
4
|
|
|
|
|
125
|
outs_raw("?>$EOL"); |
716
|
4
|
|
|
|
|
143
|
return @_; |
717
|
|
|
|
|
|
|
} |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
=head3 current_template |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
my $path = current_template(); |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
Returns the absolute path of the current template |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
=cut |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
sub current_template { |
728
|
217
|
|
100
|
217
|
1
|
1861
|
return $TEMPLATE_STACK[-1] || ''; |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
=head3 current_base_path |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
my $path = current_base_path(); |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
Returns the absolute base path of the current template |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
=cut |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
sub current_base_path { |
740
|
|
|
|
|
|
|
# Rip it apart |
741
|
0
|
|
|
0
|
1
|
0
|
my @parts = split('/', current_template()); |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
# Remove the last element |
744
|
0
|
|
|
|
|
0
|
pop @parts; |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
# Put it back together again |
747
|
0
|
|
|
|
|
0
|
my $path = join('/', @parts); |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
# And serve |
750
|
0
|
|
|
|
|
0
|
return $path; |
751
|
|
|
|
|
|
|
} |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
=head3 under |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
C is a helper function providing semantic sugar for the C method |
756
|
|
|
|
|
|
|
of L. |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=cut |
759
|
|
|
|
|
|
|
|
760
|
37
|
|
|
37
|
1
|
2554
|
sub under ($) { return shift } |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
=head3 setting |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
C is a helper function providing semantic sugar for the C method |
765
|
|
|
|
|
|
|
of L. |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=cut |
768
|
|
|
|
|
|
|
|
769
|
2
|
|
|
2
|
1
|
20
|
sub setting ($) { return shift } |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
=begin comment |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
=head2 get_current_attr |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
Deprecated. |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
=end comment |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
=cut |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
sub get_current_attr ($) { |
782
|
0
|
|
|
0
|
1
|
0
|
$ATTRIBUTES{ $_[0] }; |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
sub _tag { |
786
|
422
|
|
|
422
|
|
600
|
my $tagset = shift; |
787
|
422
|
|
|
|
|
599
|
my $tag = shift; |
788
|
422
|
|
|
|
|
521
|
my $code = shift; |
789
|
422
|
|
|
|
|
587
|
my $more_code = shift; |
790
|
422
|
100
|
|
|
|
2638
|
$tag = $tagset->namespace . ":$tag" if defined $tagset->namespace; |
791
|
|
|
|
|
|
|
|
792
|
35
|
|
50
|
|
|
539
|
Template::Declare->buffer->append( |
793
|
|
|
|
|
|
|
$EOL |
794
|
|
|
|
|
|
|
. ( " " x $TAG_NEST_DEPTH ) |
795
|
|
|
|
|
|
|
. "<$tag" |
796
|
|
|
|
|
|
|
. join( '', |
797
|
422
|
|
|
|
|
3911
|
map { qq{ $_="} . ( $ATTRIBUTES{$_} || '' ) . qq{"} } |
798
|
|
|
|
|
|
|
sort keys %ATTRIBUTES ) |
799
|
|
|
|
|
|
|
); |
800
|
|
|
|
|
|
|
|
801
|
422
|
|
|
|
|
9835
|
my $attrs = ""; |
802
|
422
|
|
|
|
|
580
|
my $last; |
803
|
|
|
|
|
|
|
{ |
804
|
48
|
|
|
48
|
|
1612
|
no warnings qw( uninitialized redefine once ); |
|
48
|
|
|
|
|
117
|
|
|
48
|
|
|
|
|
70363
|
|
|
422
|
|
|
|
|
884
|
|
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
local *is::AUTOLOAD = sub { |
807
|
26
|
|
|
26
|
|
239
|
shift; |
808
|
|
|
|
|
|
|
|
809
|
26
|
|
|
|
|
43
|
my $field = our $AUTOLOAD; |
810
|
26
|
|
|
|
|
135
|
$field =~ s/.*:://; |
811
|
|
|
|
|
|
|
|
812
|
26
|
|
|
|
|
47
|
$field =~ s/__/:/g; # xml__lang is 'foo' ====> xml:lang="foo" |
813
|
26
|
|
|
|
|
46
|
$field =~ s/_/-/g; # http_equiv is 'bar' ====> http-equiv="bar" |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
# Squash empty values, but not '0' values |
816
|
26
|
50
|
|
|
|
44
|
my $val = join ' ', grep { defined $_ && $_ ne '' } @_; |
|
26
|
|
|
|
|
227
|
|
817
|
|
|
|
|
|
|
|
818
|
26
|
|
|
|
|
426
|
append_attr( $field, $val ); |
819
|
422
|
|
|
|
|
1927
|
}; |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
local *append_attr = sub { |
822
|
93
|
|
|
93
|
|
144
|
my $field = shift; |
823
|
93
|
|
|
|
|
129
|
my $val = shift; |
824
|
|
|
|
|
|
|
|
825
|
93
|
|
|
|
|
276
|
$attrs .= ' ' . $field . q{="} . _postprocess($val, 1) . q{"}; |
826
|
93
|
100
|
|
|
|
505
|
wantarray ? () : ''; |
827
|
422
|
|
|
|
|
1988
|
}; |
828
|
|
|
|
|
|
|
|
829
|
422
|
|
|
|
|
813
|
local $TAG_NEST_DEPTH = $TAG_NEST_DEPTH + $TAG_INDENTATION; |
830
|
422
|
|
|
|
|
911
|
%ATTRIBUTES = (); |
831
|
422
|
|
|
|
|
1295
|
Template::Declare->buffer->push( private => 1, from => "T::D tag $tag" ); |
832
|
422
|
100
|
100
|
|
|
23807
|
$last = join '', map { ref($_) && $_->isa('Template::Declare::Tag') ? $_ : _postprocess($_) } $code->(); |
|
357
|
|
|
|
|
9157
|
|
833
|
|
|
|
|
|
|
} |
834
|
422
|
|
|
|
|
4451
|
my $content = Template::Declare->buffer->pop; |
835
|
422
|
100
|
100
|
|
|
14744
|
$content .= "$last" if not length $content and length $last; |
836
|
422
|
100
|
|
|
|
1146
|
Template::Declare->buffer->append($attrs) if length $attrs; |
837
|
|
|
|
|
|
|
|
838
|
422
|
100
|
|
|
|
2344
|
if (length $content) { |
|
|
100
|
|
|
|
|
|
839
|
345
|
|
|
|
|
1124
|
Template::Declare->buffer->append(">$content"); |
840
|
345
|
100
|
|
|
|
7899
|
Template::Declare->buffer->append( $EOL . ( " " x $TAG_NEST_DEPTH )) if $content =~ /\; |
841
|
345
|
|
|
|
|
3509
|
Template::Declare->buffer->append("$tag>"); |
842
|
|
|
|
|
|
|
} elsif ( $tagset->can_combine_empty_tags($tag) ) { |
843
|
37
|
|
|
|
|
115
|
Template::Declare->buffer->append(" />"); |
844
|
|
|
|
|
|
|
} else { |
845
|
|
|
|
|
|
|
# Otherwise we supply a closing tag. |
846
|
40
|
|
|
|
|
151
|
Template::Declare->buffer->append(">$tag>"); |
847
|
|
|
|
|
|
|
} |
848
|
|
|
|
|
|
|
|
849
|
422
|
100
|
66
|
|
|
10744
|
return ( ref($more_code) && $more_code->isa('CODE') ) |
850
|
|
|
|
|
|
|
? $more_code->() |
851
|
|
|
|
|
|
|
: ''; |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
sub _resolve_template_path { |
855
|
233
|
|
|
233
|
|
427
|
my $template = shift; |
856
|
|
|
|
|
|
|
|
857
|
233
|
|
|
|
|
414
|
my @parts; |
858
|
233
|
100
|
|
|
|
1028
|
if ( substr($template, 0, 1) ne '/' ) { |
859
|
|
|
|
|
|
|
# relative |
860
|
217
|
|
|
|
|
634
|
@parts = split '/', current_template(); |
861
|
|
|
|
|
|
|
# Get rid of the parent's template name |
862
|
217
|
|
|
|
|
417
|
pop @parts; |
863
|
|
|
|
|
|
|
} |
864
|
|
|
|
|
|
|
|
865
|
233
|
|
|
|
|
900
|
foreach ( split '/', $template ) { |
866
|
310
|
100
|
100
|
|
|
3024
|
if ( $_ eq '..' ) { |
|
|
100
|
|
|
|
|
|
867
|
3
|
|
|
|
|
5
|
pop @parts; |
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
# Get rid of "." and empty entries by the way |
870
|
|
|
|
|
|
|
elsif ( $_ ne '.' && $_ ne '' ) { |
871
|
288
|
|
|
|
|
1003
|
push @parts, $_; |
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
} |
874
|
|
|
|
|
|
|
|
875
|
233
|
|
|
|
|
822
|
return join '/', @parts; |
876
|
|
|
|
|
|
|
} |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
sub _show_template { |
879
|
233
|
|
|
233
|
|
542
|
my $template = shift; |
880
|
233
|
|
|
|
|
329
|
my $inside_template = shift; |
881
|
233
|
|
|
|
|
339
|
my $args = shift; |
882
|
233
|
|
|
|
|
600
|
$template = _resolve_template_path($template); |
883
|
233
|
|
|
|
|
709
|
local @TEMPLATE_STACK = (@TEMPLATE_STACK, $template); |
884
|
|
|
|
|
|
|
|
885
|
233
|
50
|
33
|
|
|
1538
|
my $callable = |
886
|
|
|
|
|
|
|
( ref($template) && $template->isa('Template::Declare::Tag') ) |
887
|
|
|
|
|
|
|
? $template |
888
|
|
|
|
|
|
|
: Template::Declare->resolve_template( $template, $inside_template ); |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
# If the template was not found let the user know. |
891
|
233
|
100
|
|
|
|
881
|
unless ($callable) { |
892
|
19
|
|
|
|
|
57
|
my $msg = "The template '$template' could not be found"; |
893
|
19
|
100
|
|
|
|
67
|
$msg .= " (it might be private)" if !$inside_template; |
894
|
19
|
100
|
|
|
|
84
|
croak $msg if Template::Declare->strict; |
895
|
18
|
|
|
|
|
625
|
carp $msg; |
896
|
18
|
|
|
|
|
15371
|
return ''; |
897
|
|
|
|
|
|
|
} |
898
|
|
|
|
|
|
|
|
899
|
214
|
100
|
|
|
|
788
|
if (my $instrumentation = Template::Declare->around_template) { |
900
|
|
|
|
|
|
|
$instrumentation->( |
901
|
6
|
|
|
6
|
|
43
|
sub { &$callable($self, @$args) }, |
902
|
6
|
|
|
|
|
88
|
$template, |
903
|
|
|
|
|
|
|
$args, |
904
|
|
|
|
|
|
|
$callable, |
905
|
|
|
|
|
|
|
); |
906
|
|
|
|
|
|
|
} |
907
|
|
|
|
|
|
|
else { |
908
|
208
|
|
|
|
|
1907
|
&$callable($self, @$args); |
909
|
|
|
|
|
|
|
} |
910
|
|
|
|
|
|
|
|
911
|
213
|
|
|
|
|
1764
|
return; |
912
|
|
|
|
|
|
|
} |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
sub _outs { |
915
|
113
|
|
|
113
|
|
183
|
my $raw = shift; |
916
|
113
|
|
|
|
|
229
|
my @phrases = (@_); |
917
|
|
|
|
|
|
|
|
918
|
113
|
|
66
|
|
|
381
|
Template::Declare->buffer->push( |
919
|
|
|
|
|
|
|
private => (defined wantarray and not wantarray), from => "T::D outs" |
920
|
|
|
|
|
|
|
); |
921
|
|
|
|
|
|
|
|
922
|
113
|
|
|
|
|
3082
|
foreach my $item ( grep {defined} @phrases ) { |
|
113
|
|
|
|
|
387
|
|
923
|
112
|
100
|
|
|
|
522
|
my $returned = ref($item) eq 'CODE' |
|
|
50
|
|
|
|
|
|
924
|
|
|
|
|
|
|
? $item->() |
925
|
|
|
|
|
|
|
: $raw |
926
|
|
|
|
|
|
|
? $item |
927
|
|
|
|
|
|
|
: _postprocess($item); |
928
|
112
|
|
|
|
|
365
|
Template::Declare->buffer->append( $returned ); |
929
|
|
|
|
|
|
|
} |
930
|
113
|
|
|
|
|
2352
|
return Template::Declare->buffer->pop; |
931
|
|
|
|
|
|
|
} |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
sub _postprocess { |
934
|
534
|
|
|
534
|
|
750
|
my $val = shift; |
935
|
534
|
|
|
|
|
679
|
my $skip_postprocess = shift; |
936
|
|
|
|
|
|
|
|
937
|
534
|
100
|
|
|
|
1464
|
return $val unless defined $val; |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
# stringify in case $val is object with overloaded "" |
940
|
526
|
|
|
|
|
827
|
$val = "$val"; |
941
|
526
|
50
|
|
|
|
1234
|
if ( ! $SKIP_XML_ESCAPING ) { |
942
|
48
|
|
|
48
|
|
362
|
no warnings 'uninitialized'; |
|
48
|
|
|
|
|
89
|
|
|
48
|
|
|
|
|
17666
|
|
943
|
526
|
|
|
|
|
906
|
$val =~ s/&/&/g; |
944
|
526
|
|
|
|
|
986
|
$val =~ s/</g; |
945
|
526
|
|
|
|
|
682
|
$val =~ s/>/>/g; |
946
|
526
|
|
|
|
|
760
|
$val =~ s/\(/(/g; |
947
|
526
|
|
|
|
|
677
|
$val =~ s/\)/)/g; |
948
|
526
|
|
|
|
|
646
|
$val =~ s/"/"/g; |
949
|
526
|
|
|
|
|
806
|
$val =~ s/'/'/g; |
950
|
|
|
|
|
|
|
} |
951
|
526
|
100
|
|
|
|
2067
|
$val = Template::Declare->postprocessor->($val) |
952
|
|
|
|
|
|
|
unless $skip_postprocess; |
953
|
|
|
|
|
|
|
|
954
|
526
|
|
|
|
|
9991
|
return $val; |
955
|
|
|
|
|
|
|
} |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=begin comment |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
=head2 append_attr |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
C is a helper function providing an interface for setting |
962
|
|
|
|
|
|
|
attributes from within tags. But it's better to use C or C to set |
963
|
|
|
|
|
|
|
your attributes. Nohting to see here, really. Move along. |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
=end comment |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
=cut |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
sub append_attr { |
970
|
1
|
|
|
1
|
1
|
18
|
die "Subroutine attr failed: $_[0] => '$_[1]'\n\t". |
971
|
|
|
|
|
|
|
"(Perhaps you're using an unknown tag in the outer container?)"; |
972
|
|
|
|
|
|
|
} |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
=head1 VARIABLES |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=over 4 |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
=item C<@Template::Declare::Tags::EXPORT> |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
Holds the names of the static subroutines exported by this class. Tag |
981
|
|
|
|
|
|
|
subroutines generated by tag sets, however, are not included here. |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
=item C<@Template::Declare::Tags::TAG_SUB_LIST> |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
Contains the names of the tag subroutines generated from a tag set. |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
Note that this array won't get cleared automatically before another |
988
|
|
|
|
|
|
|
C<< use Template::Decalre::Tags >> statement. |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
C<@Template::Declare::Tags::TagSubs> is aliased to this variable for |
991
|
|
|
|
|
|
|
backward-compatibility. |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
=item C<$Template::Declare::Tags::TAG_NEST_DEPTH> |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
Controls the indentation of the XML tags in the final outputs. For example, |
996
|
|
|
|
|
|
|
you can temporarily disable a tag's indentation by the following lines of |
997
|
|
|
|
|
|
|
code: |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
body { |
1000
|
|
|
|
|
|
|
pre { |
1001
|
|
|
|
|
|
|
local $Template::Declare::Tags::TAG_NEST_DEPTH = 0; |
1002
|
|
|
|
|
|
|
script { attr { src => 'foo.js' } } |
1003
|
|
|
|
|
|
|
} |
1004
|
|
|
|
|
|
|
} |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
It generates |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
Note that now the C |