File Coverage

blib/lib/Template/Declare/Tags.pm
Criterion Covered Total %
statement 263 271 97.0
branch 73 82 89.0
condition 33 44 75.0
subroutine 49 51 96.0
pod 18 18 100.0
total 436 466 93.5


line stmt bran cond sub pod time code
1 55     55   69794 use 5.006;
  55         511  
  55         1934  
2 48     48   224 use warnings;
  48         67  
  48         1367  
3 48     48   200 use strict;
  48         63  
  48         2641  
4             #use Smart::Comments;
5             #use Smart::Comments '####';
6              
7             package Template::Declare::Tags;
8              
9             our $VERSION = '0.43';
10              
11 48     48   4857 use Template::Declare;
  48         112  
  48         1553  
12 48     48   241 use base 'Exporter';
  48         63  
  48         4028  
13 48     48   249 use Carp qw(carp croak);
  48         67  
  48         3473  
14 48     48   26856 use Symbol 'qualify_to_ref';
  48         39186  
  48         21394  
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   144232 my $self = shift;
44 105         192 my @set_modules;
45 105 100       454 if (!@_) {
46 90         253 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         317 while (@_) {
58 112         208 my $lang = shift;
59 112         182 my $opts;
60 112 100 66     536 if (ref $_[0] and ref $_[0] eq 'HASH') {
61 7         12 $opts = shift;
62 7   100     55 $opts->{package} ||= $opts->{namespace};
63             # XXX TODO: carp if the derived package already exists?
64             }
65 112   100     916 $opts->{package} ||= scalar(caller);
66 112   66     600 my $module = $opts->{from} ||
67             "Template::Declare::TagSet::$lang";
68              
69             ### Loading tag set: $module
70 112 100       1422 if (! $module->can('get_tag_list') ) {
71 47     47   23043 eval "use $module";
  47         146  
  47         595  
  54         5125  
72 54 50       1227 if ($@) {
73 0         0 warn $@;
74 0         0 croak "Failed to load tagset module $module";
75             }
76             }
77             ### TagSet options: $opts
78 112         748 my $tagset = $module->new($opts);
79 112         1532 my $tag_list = $tagset->get_tag_list;
80             Template::Declare::Tags::install_tag($_, $tagset)
81 112         492 for @$tag_list;
82             }
83 105         53905 __PACKAGE__->export_to_level(1, $self);
84             }
85              
86             sub _install {
87 16562     16562   59984 my ($override, $package, $subname, $coderef) = @_;
88              
89 16562         21751 my $name = $package . '::' . $subname;
90 16562         25314 my $slot = qualify_to_ref($name);
91 16562 100 100     184929 return if !$override and *$slot{CODE};
92              
93 48     48   318 no warnings 'redefine';
  48         76  
  48         6199  
94 16187         49428 *$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            
123            
124             Hello, world!
125            
126            
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 statement:
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 13707 my $template_name = shift;
289 160         220 my $coderef = shift;
290 160         933 my $template_class = ( caller(0) )[0];
291              
292 48     48   296 no warnings qw( uninitialized redefine );
  48         66  
  48         23361  
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   1159 local $self = shift || $self || $template_class;
298 214         526 unshift @_, $self, $coderef;
299 214         1531 goto $self->can('_dispatch_template');
300 160         698 };
301              
302 160 100       398 if (wantarray) {
303             # We're being called by something like private that doesn't want us to register ourselves
304 11         48 return ( $template_class, $template_name, $codesub );
305             } else {
306             # We've been called in a void context and should register this template
307 149         468 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         14 my $subname = shift;
333 11         16 my $code = shift;
334 11         35 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 70827 my $template = shift;
364              
365             # if we're inside a template, we should show private templates
366 119 100       1119 if ( caller->isa('Template::Declare') ) {
367 66         273 _show_template( $template, 1, \@_ );
368 66         182 return Template::Declare->buffer->data;
369             } else {
370 53         175 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 15288 my $template = shift;
387 167         338 my $args = \@_;
388              
389 167         640 Template::Declare->buffer->push(
390             private => defined wantarray,
391             from => "T::D path $template",
392             );
393 167         5196 _show_template( $template, 0, $args );
394 165         444 %ELEMENT_ID_CACHE = ();
395 165         616 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 560 my $code = shift;
419 52         152 my @rv = $code->();
420 52         407 while ( my ( $field, $val ) = splice( @rv, 0, 2 ) ) {
421              
422             # only defined whle in a tag context
423 68         149 append_attr( $field, $val );
424             }
425 51         240 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 209 %ATTRIBUTES = ();
464 37         153 while ( my ( $key, $val ) = splice( @_, 0, 2 ) ) {
465 48     48   280 no warnings 'uninitialized';
  48         88  
  48         16652  
466 44         84 $ATTRIBUTES{$key} = $val;
467              
468 44 100       138 if ( lc($key) eq 'id' ) {
469 34 100       153 if ( $ELEMENT_ID_CACHE{$val}++ ) {
470 11         25 my $msg = "HTML appears to contain illegal duplicate element id: $val";
471 11 100       38 die $msg if Template::Declare->strict;
472 10         155 warn $msg;
473             }
474             }
475              
476             }
477 36 100       835 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 607 sub outs { _outs( 0, @_ ); }
502 31     31 1 172 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 15924 my $tag = $_[0]; # we should not do lc($tag) here :)
517 15967         12660 my $name = $tag;
518 15967         13340 my $tagset = $_[1];
519              
520 15967         31686 my $alternative = $tagset->get_alternate_spelling($tag);
521 15967 100       25852 if ( defined $alternative ) {
522             _install(
523             0, # do not override
524             scalar(caller), $tag,
525             sub (&) {
526 1     1   115 die "$tag {...} is invalid; use $alternative {...} instead.\n";
527             }
528 595         3785 );
529             ### Exporting place-holder sub: $name
530             # XXX TODO: more checking here
531 595 100       4024 if ($name !~ /^(?:base|tr|time)$/) {
532 203         526 push @EXPORT, $name;
533 203         336 push @TAG_SUB_LIST, $name;
534             }
535 595 50       1349 $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         26366 push @TAG_SUB_LIST, $name;
542              
543 48     48   275 no strict 'refs';
  48         79  
  48         2088  
544 48     48   231 no warnings 'redefine';
  48         74  
  48         20877  
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   3155 local *__ANON__ = $tag;
549 422 100 100     1524 if ( defined wantarray and not wantarray ) {
550              
551             # Scalar context - return a coderef that represents ourselves.
552 85         140 my @__ = @_;
553 85         93 my $_self = $self;
554             my $sub = sub {
555 85     85   121 local $self = $_self;
556 85         186 local *__ANON__ = $tag;
557 85         392 _tag($tagset, $tag, @__);
558 85         271 };
559 85         184 bless $sub, 'Template::Declare::Tag';
560 85         379 return $sub;
561             } else {
562 337         1215 _tag($tagset, $tag, @_);
563             }
564 15967         60051 };
565 15967         37590 _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 47 my $coderef = shift;
604              
605 5         16 Template::Declare->buffer->append($EOL);
606 5         102 Template::Declare->buffer->push( from => "T::D tag wrapper", private => 1 );
607              
608 5         110 my %attr = %ATTRIBUTES;
609 5         29 %ATTRIBUTES = (); # prevent leakage
610              
611 5 50       70 my $last = join '',
612 5         16 map { ref($_) ? $_ : _postprocess($_) }
613             $coderef->(%attr);
614              
615 5         21 my $content = Template::Declare->buffer->pop;
616 5 50 33     103 $content .= "$last" if not length $content and length $last;
617 5         13 Template::Declare->buffer->append( $content );
618              
619 5         77 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 238 my $wrapper_name = shift;
681 1         2 my $coderef = shift;
682 1         2 my $template_class = caller;
683              
684             # Shove the code ref into the calling class.
685 48     48   281 no strict 'refs';
  48         80  
  48         23775  
686 1     1   3 *{"$template_class\::$wrapper_name"} = sub (&;@) { goto $coderef };
  1         103  
  1         10  
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 23 my $code = shift;
709 4         8 my @rv = $code->();
710 4         19 my $name = shift @rv;
711 4         10 outs_raw("
712 4         117 while ( my ( $field, $val ) = splice( @rv, 0, 2 ) ) {
713 6         53 outs_raw(qq/ $field="$val"/);
714             }
715 4         83 outs_raw("?>$EOL");
716 4         75 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 1462 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 2123 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 24 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   493 my $tagset = shift;
787 422         445 my $tag = shift;
788 422         400 my $code = shift;
789 422         439 my $more_code = shift;
790 422 100       2094 $tag = $tagset->namespace . ":$tag" if defined $tagset->namespace;
791              
792 35   50     497 Template::Declare->buffer->append(
793             $EOL
794             . ( " " x $TAG_NEST_DEPTH )
795             . "<$tag"
796             . join( '',
797 422         3268 map { qq{ $_="} . ( $ATTRIBUTES{$_} || '' ) . qq{"} }
798             sort keys %ATTRIBUTES )
799             );
800              
801 422         8054 my $attrs = "";
802 422         450 my $last;
803             {
804 48     48   1255 no warnings qw( uninitialized redefine once );
  48         81  
  48         51451  
  422         458  
805              
806             local *is::AUTOLOAD = sub {
807 26     26   206 shift;
808              
809 26         27 my $field = our $AUTOLOAD;
810 26         124 $field =~ s/.*:://;
811              
812 26         42 $field =~ s/__/:/g; # xml__lang is 'foo' ====> xml:lang="foo"
813 26         31 $field =~ s/_/-/g; # http_equiv is 'bar' ====> http-equiv="bar"
814              
815             # Squash empty values, but not '0' values
816 26 50       35 my $val = join ' ', grep { defined $_ && $_ ne '' } @_;
  26         145  
817              
818 26         49 append_attr( $field, $val );
819 422         1890 };
820              
821             local *append_attr = sub {
822 93     93   100 my $field = shift;
823 93         95 my $val = shift;
824              
825 93         234 $attrs .= ' ' . $field . q{="} . _postprocess($val, 1) . q{"};
826 93 100       396 wantarray ? () : '';
827 422         1517 };
828              
829 422         657 local $TAG_NEST_DEPTH = $TAG_NEST_DEPTH + $TAG_INDENTATION;
830 422         719 %ATTRIBUTES = ();
831 422         1191 Template::Declare->buffer->push( private => 1, from => "T::D tag $tag" );
832 422 100 100     9527 $last = join '', map { ref($_) && $_->isa('Template::Declare::Tag') ? $_ : _postprocess($_) } $code->();
  357         3320  
833             }
834 422         2006 my $content = Template::Declare->buffer->pop;
835 422 100 100     21946 $content .= "$last" if not length $content and length $last;
836 422 100       1007 Template::Declare->buffer->append($attrs) if length $attrs;
837              
838 422 100       2153 if (length $content) {
    100          
839 345         909 Template::Declare->buffer->append(">$content");
840 345 100       6846 Template::Declare->buffer->append( $EOL . ( " " x $TAG_NEST_DEPTH )) if $content =~ /\
841 345         2813 Template::Declare->buffer->append("");
842             } elsif ( $tagset->can_combine_empty_tags($tag) ) {
843 37         90 Template::Declare->buffer->append(" />");
844             } else {
845             # Otherwise we supply a closing tag.
846 40         135 Template::Declare->buffer->append(">");
847             }
848              
849 422 100 66     8439 return ( ref($more_code) && $more_code->isa('CODE') )
850             ? $more_code->()
851             : '';
852             }
853              
854             sub _resolve_template_path {
855 233     233   318 my $template = shift;
856              
857 233         261 my @parts;
858 233 100       908 if ( substr($template, 0, 1) ne '/' ) {
859             # relative
860 217         556 @parts = split '/', current_template();
861             # Get rid of the parent's template name
862 217         325 pop @parts;
863             }
864              
865 233         639 foreach ( split '/', $template ) {
866 310 100 100     1630 if ( $_ eq '..' ) {
    100          
867 3         6 pop @parts;
868             }
869             # Get rid of "." and empty entries by the way
870             elsif ( $_ ne '.' && $_ ne '' ) {
871 288         592 push @parts, $_;
872             }
873             }
874              
875 233         693 return join '/', @parts;
876             }
877              
878             sub _show_template {
879 233     233   320 my $template = shift;
880 233         272 my $inside_template = shift;
881 233         259 my $args = shift;
882 233         483 $template = _resolve_template_path($template);
883 233         584 local @TEMPLATE_STACK = (@TEMPLATE_STACK, $template);
884              
885 233 50 33     1379 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       603 unless ($callable) {
892 19         53 my $msg = "The template '$template' could not be found";
893 19 100       55 $msg .= " (it might be private)" if !$inside_template;
894 19 100       69 croak $msg if Template::Declare->strict;
895 18         435 carp $msg;
896 18         10154 return '';
897             }
898              
899 214 100       646 if (my $instrumentation = Template::Declare->around_template) {
900             $instrumentation->(
901 6     6   41 sub { &$callable($self, @$args) },
902 6         87 $template,
903             $args,
904             $callable,
905             );
906             }
907             else {
908 208         1740 &$callable($self, @$args);
909             }
910              
911 213         1996 return;
912             }
913              
914             sub _outs {
915 113     113   161 my $raw = shift;
916 113         211 my @phrases = (@_);
917              
918 113   66     288 Template::Declare->buffer->push(
919             private => (defined wantarray and not wantarray), from => "T::D outs"
920             );
921              
922 113         2418 foreach my $item ( grep {defined} @phrases ) {
  113         395  
923 112 100       460 my $returned = ref($item) eq 'CODE'
    50          
924             ? $item->()
925             : $raw
926             ? $item
927             : _postprocess($item);
928 112         266 Template::Declare->buffer->append( $returned );
929             }
930 113         1920 return Template::Declare->buffer->pop;
931             }
932              
933             sub _postprocess {
934 534     534   681 my $val = shift;
935 534         494 my $skip_postprocess = shift;
936              
937 534 100       1026 return $val unless defined $val;
938              
939             # stringify in case $val is object with overloaded ""
940 526         751 $val = "$val";
941 526 50       983 if ( ! $SKIP_XML_ESCAPING ) {
942 48     48   306 no warnings 'uninitialized';
  48         72  
  48         12492  
943 526         803 $val =~ s/&/&/g;
944 526         585 $val =~ s/
945 526         595 $val =~ s/>/>/g;
946 526         513 $val =~ s/\(/(/g;
947 526         569 $val =~ s/\)/)/g;
948 526         550 $val =~ s/"/"/g;
949 526         617 $val =~ s/'/'/g;
950             }
951 526 100       1648 $val = Template::Declare->postprocessor->($val)
952             unless $skip_postprocess;
953              
954 526         3327 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 15 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