File Coverage

blib/lib/Template/Declare/Tags.pm
Criterion Covered Total %
statement 260 264 98.4
branch 69 78 88.4
condition 33 44 75.0
subroutine 49 50 98.0
pod 17 17 100.0
total 428 453 94.4


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            
121            
122             Hello, world!
123            
124            
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 statement:
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("
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("");
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(">");
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/
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