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