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   404841 use 5.006;
  55         435  
  55         2493  
2 48     48   359 use warnings;
  48         94  
  48         1673  
3 48     48   245 use strict;
  48         91  
  48         3875  
4             #use Smart::Comments;
5             #use Smart::Comments '####';
6              
7             package Template::Declare::Tags;
8              
9             our $VERSION = '0.43';
10              
11 48     48   7623 use Template::Declare;
  48         118  
  48         1683  
12 48     48   285 use base 'Exporter';
  48         113  
  48         5836  
13 48     48   274 use Carp qw(carp croak);
  48         92  
  48         3803  
14 48     48   66416 use Symbol 'qualify_to_ref';
  48         69708  
  48         27417  
15              
16             our $self;
17              
18             our @EXPORT = qw(
19             template private current_template current_base_path
20             show show_page
21             attr with get_current_attr
22             outs outs_raw
23             xml_decl
24             under setting
25             smart_tag_wrapper create_wrapper
26             $self
27             );
28              
29             our @TAG_SUB_LIST;
30             our @TagSubs;
31             *TagSubs = \@TAG_SUB_LIST; # For backward compatibility only
32              
33             our %ATTRIBUTES = ();
34             our %ELEMENT_ID_CACHE = ();
35             our $TAG_NEST_DEPTH = 0;
36             our $TAG_INDENTATION = 1;
37             our $EOL = "\n";
38             our @TEMPLATE_STACK = ();
39              
40             our $SKIP_XML_ESCAPING = 0;
41              
42             sub import {
43 105     105   195976 my $self = shift;
44 105         221 my @set_modules;
45 105 100       473 if (!@_) {
46 90         272 push @_, 'HTML';
47             }
48             ### @_
49             ### caller: caller()
50              
51             # XXX We can't reset @TAG_SUB_LIST here since
52             # use statements always run at BEGIN time.
53             # A better approach may be install such lists
54             # directly into the caller's namespace...
55             #undef @TAG_SUB_LIST;
56              
57 105         343 while (@_) {
58 112         217 my $lang = shift;
59 112         185 my $opts;
60 112 100 66     580 if (ref $_[0] and ref $_[0] eq 'HASH') {
61 7         12 $opts = shift;
62 7   100     46 $opts->{package} ||= $opts->{namespace};
63             # XXX TODO: carp if the derived package already exists?
64             }
65 112   100     1102 $opts->{package} ||= scalar(caller);
66 112   66     578 my $module = $opts->{from} ||
67             "Template::Declare::TagSet::$lang";
68              
69             ### Loading tag set: $module
70 112 100       2018 if (! $module->can('get_tag_list') ) {
71 47     47   36214 eval "use $module";
  47         189  
  47         759  
  54         5780  
72 54 50       1340 if ($@) {
73 0         0 warn $@;
74 0         0 croak "Failed to load tagset module $module";
75             }
76             }
77             ### TagSet options: $opts
78 112         846 my $tagset = $module->new($opts);
79 112         2297 my $tag_list = $tagset->get_tag_list;
80             Template::Declare::Tags::install_tag($_, $tagset)
81 112         561 for @$tag_list;
82             }
83 105         89833 __PACKAGE__->export_to_level(1, $self);
84             }
85              
86             sub _install {
87 16562     16562   104615 my ($override, $package, $subname, $coderef) = @_;
88              
89 16562         31257 my $name = $package . '::' . $subname;
90 16562         40376 my $slot = qualify_to_ref($name);
91 16562 100 100     267436 return if !$override and *$slot{CODE};
92              
93 48     48   373 no warnings 'redefine';
  48         517  
  48         6986  
94 16187         68420 *$slot = $coderef;
95             }
96              
97             =head1 NAME
98              
99             Template::Declare::Tags - Build and install XML Tag subroutines for Template::Declare
100              
101             =head1 SYNOPSIS
102              
103             package MyApp::Templates;
104              
105             use base 'Template::Declare';
106             use Template::Declare::Tags 'HTML';
107              
108             template main => sub {
109             link {}
110             table {
111             row {
112             cell { "Hello, world!" }
113             }
114             }
115             img { attr { src => 'cat.gif' } }
116             img { src is 'dog.gif' }
117             };
118              
119             Produces:
120              
121            
122            
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 16989 my $template_name = shift;
289 160         268 my $coderef = shift;
290 160         1228 my $template_class = ( caller(0) )[0];
291              
292 48     48   300 no warnings qw( uninitialized redefine );
  48         87  
  48         33257  
293              
294             # template "foo" ==> CallerPkg::_jifty_template_foo;
295             # template "foo/bar" ==> CallerPkg::_jifty_template_foo/bar;
296             my $codesub = sub {
297 214   33 214   1286 local $self = shift || $self || $template_class;
298 214         799 unshift @_, $self, $coderef;
299 214         1986 goto $self->can('_dispatch_template');
300 160         1006 };
301              
302 160 100       522 if (wantarray) {
303             # We're being called by something like private that doesn't want us to register ourselves
304 11         57 return ( $template_class, $template_name, $codesub );
305             } else {
306             # We've been called in a void context and should register this template
307 149         599 Template::Declare::register_template(
308             $template_class,
309             $template_name,
310             $codesub,
311             );
312             }
313             }
314              
315             =head3 private template TEMPLATENAME => sub { 'Implementation' };
316              
317             private template select_list => sub {
318             my $self = shift;
319             select {
320             option { $_ } for @_;
321             }
322             };
323              
324             Declares that a template isn't available to be called directly from client
325             code. The resulting template can instead only be called from the package in
326             which it's created.
327              
328             =cut
329              
330             sub private (@) {
331 11     11 1 19 my $class = shift;
332 11         17 my $subname = shift;
333 11         20 my $code = shift;
334 11         40 Template::Declare::register_private_template( $class, $subname, $code );
335             }
336              
337             =head2 Showing templates
338              
339             =head3 show [$template_name or $template_coderef], args
340              
341             show( main => { user => 'Bob' } );
342              
343             Displays templates. The first argument is the name of the template to be
344             displayed. Any additional arguments will be passed directly to the template.
345              
346             C can either be called with a template name or a package/object and a
347             template. (It's both functional and OO.)
348              
349             If called from within a Template::Declare subclass, then private templates are
350             accessible and visible. If called from something that isn't a
351             Template::Declare, only public templates will be visible.
352              
353             From the outside world, users can either call C<< Template::Declare->show() >>,
354             C<< show() >> exported from Template::Declare::Tags or
355             C directly to render a publicly visible template.
356              
357             Private templates may only be called from within the C
358             package.
359              
360             =cut
361              
362             sub show {
363 119     119 1 100919 my $template = shift;
364              
365             # if we're inside a template, we should show private templates
366 119 100       1156 if ( caller->isa('Template::Declare') ) {
367 66         383 _show_template( $template, 1, \@_ );
368 66         222 return Template::Declare->buffer->data;
369             } else {
370 53         202 show_page( $template, @_);
371             }
372              
373             }
374              
375             =head3 show_page
376              
377             show_page( main => { user => 'Bob' } );
378              
379             Like C, but does not dispatch to private templates. It's used
380             internally by C when when that method is called from outside a
381             template class.
382              
383             =cut
384              
385             sub show_page {
386 167     167 1 36146 my $template = shift;
387 167         354 my $args = \@_;
388              
389 167         803 Template::Declare->buffer->push(
390             private => defined wantarray,
391             from => "T::D path $template",
392             );
393 167         6302 _show_template( $template, 0, $args );
394 165         339 %ELEMENT_ID_CACHE = ();
395 165         691 return Template::Declare->buffer->pop;
396             }
397              
398             =head2 Attributes
399              
400             =head3 attr HASH
401              
402             attr { src => 'logo.png' };
403              
404             Specifies attributes for the element tag in which it appears. For example, to
405             add a class and ID to an HTML paragraph:
406              
407             p {
408             attr {
409             class => 'greeting text',
410             id => 'welcome',
411             };
412             'This is a welcoming paragraph';
413             }
414              
415             =cut
416              
417             sub attr (&;@) {
418 52     52 1 718 my $code = shift;
419 52         152 my @rv = $code->();
420 52         449 while ( my ( $field, $val ) = splice( @rv, 0, 2 ) ) {
421              
422             # only defined whle in a tag context
423 68         144 append_attr( $field, $val );
424             }
425 51         267 return @_;
426             }
427              
428             =head3 ATTR is VALUE
429              
430             Attributes can also be specified by using C, as in
431              
432             p {
433             class is 'greeting text';
434             id is 'welcome';
435             'This is a welcoming paragraph';
436             }
437              
438             A few tricks work for 'is':
439              
440             http_equiv is 'foo'; # => http-equiv="foo"
441             xml__lang is 'foo'; # => xml:lang="foo"
442              
443             So double underscore replaced with colon and single underscore with dash.
444              
445             =cut
446              
447             # 'is' is declared later, when needed, using 'local *is::AUTOLOAD = sub {};'
448              
449             =head3 with
450              
451             with ( id => 'greeting', class => 'foo' ),
452             p { 'Hello, World wide web' };
453              
454             An alternative way to specify attributes for a tag, just for variation. The
455             standard way to do the same as this example using C is:
456              
457             p { attr { id => 'greeting', class => 'foo' }
458             'Hello, World wide web' };
459              
460             =cut
461              
462             sub with (@) {
463 37     37 1 303 %ATTRIBUTES = ();
464 37         164 while ( my ( $key, $val ) = splice( @_, 0, 2 ) ) {
465 48     48   345 no warnings 'uninitialized';
  48         122  
  48         22078  
466 44         98 $ATTRIBUTES{$key} = $val;
467              
468 44 100       162 if ( lc($key) eq 'id' ) {
469 34 100       164 if ( $ELEMENT_ID_CACHE{$val}++ ) {
470 11         32 my $msg = "HTML appears to contain illegal duplicate element id: $val";
471 11 100       37 die $msg if Template::Declare->strict;
472 10         211 warn $msg;
473             }
474             }
475              
476             }
477 36 100       820 wantarray ? () : '';
478             }
479              
480             =head2 Displaying text and raw data
481              
482             =head3 outs STUFF
483              
484             p { outs 'Grettings & welcome pyoonie hyoomon.' }
485              
486             HTML-encodes its arguments and appends them to C's output
487             buffer. This is similar to simply returning a string from a tag function call,
488             but is occasionally useful when you need to output a mix of things, as in:
489              
490             p { outs 'hello'; em { 'world' } }
491              
492             =head3 outs_raw STUFF
493              
494             p { outs_raw "That's what I'm talking about!' }
495              
496             Appends its arguments to C's output buffer without HTML
497             escaping.
498              
499             =cut
500              
501 82     82 1 822 sub outs { _outs( 0, @_ ); }
502 31     31 1 252 sub outs_raw { _outs( 1, @_ ); }
503              
504             =head2 Installing tags and wrapping stuff
505              
506             =head3 install_tag TAGNAME, TAGSET
507              
508             install_tag video => 'Template::Declare::TagSet::HTML';
509              
510             Sets up TAGNAME as a tag that can be used in user templates. TAGSET is an
511             instance of a subclass for L.
512              
513             =cut
514              
515             sub install_tag {
516 15967     15967 1 29334 my $tag = $_[0]; # we should not do lc($tag) here :)
517 15967         21181 my $name = $tag;
518 15967         25629 my $tagset = $_[1];
519              
520 15967         47214 my $alternative = $tagset->get_alternate_spelling($tag);
521 15967 100       38348 if ( defined $alternative ) {
522             _install(
523             0, # do not override
524             scalar(caller), $tag,
525             sub (&) {
526 1     1   163 die "$tag {...} is invalid; use $alternative {...} instead.\n";
527             }
528 595         4081 );
529             ### Exporting place-holder sub: $name
530             # XXX TODO: more checking here
531 595 100       4434 if ($name !~ /^(?:base|tr|time)$/) {
532 203         490 push @EXPORT, $name;
533 203         375 push @TAG_SUB_LIST, $name;
534             }
535 595 50       1499 $name = $alternative or return;
536             }
537              
538             # We don't need this since we directly install
539             # subs into the target package.
540             #push @EXPORT, $name;
541 15967         27961 push @TAG_SUB_LIST, $name;
542              
543 48     48   301 no strict 'refs';
  48         104  
  48         4759  
544 48     48   269 no warnings 'redefine';
  48         110  
  48         28498  
545             #### Installing tag: $name
546             # XXX TODO: use sub _install to insert subs into the caller's package so as to support XML packages
547             my $code = sub (&;$) {
548 422     422   3408 local *__ANON__ = $tag;
549 422 100 100     1694 if ( defined wantarray and not wantarray ) {
550              
551             # Scalar context - return a coderef that represents ourselves.
552 85         173 my @__ = @_;
553 85         117 my $_self = $self;
554             my $sub = sub {
555 85     85   137 local $self = $_self;
556 85         8631 local *__ANON__ = $tag;
557 85         458 _tag($tagset, $tag, @__);
558 85         338 };
559 85         217 bless $sub, 'Template::Declare::Tag';
560 85         437 return $sub;
561             } else {
562 337         1410 _tag($tagset, $tag, @_);
563             }
564 15967         101348 };
565 15967         72960 _install(
566             1, # do override the existing sub with the same name
567             $tagset->package => $name => $code
568             );
569             }
570              
571             =head3 smart_tag_wrapper
572              
573             # create a tag that has access to the arguments set with L.
574             sub sample_smart_tag (&) {
575             my $code = shift;
576              
577             smart_tag_wrapper {
578             my %args = @_; # set using 'with'
579             outs( 'keys: ' . join( ', ', sort keys %args) . "\n" );
580             $code->();
581             };
582             }
583              
584             # use it
585             with ( foo => 'bar', baz => 'bundy' ), sample_smart_tag {
586             outs( "Hello, World!\n" );
587             };
588              
589             The output would be
590              
591             keys: baz, foo
592             Hello, World!
593              
594             The smart tag wrapper allows you to create code that has access to the
595             attribute arguments specified via C. It passes those arguments in to the
596             wrapped code in C<@_>. It also takes care of putting the output in the right
597             place and tidying up after itself. This might be useful to change the behavior
598             of a template based on attributes passed to C.
599              
600             =cut
601              
602             sub smart_tag_wrapper (&) {
603 5     5 1 49 my $coderef = shift;
604              
605 5         16 Template::Declare->buffer->append($EOL);
606 5         105 Template::Declare->buffer->push( from => "T::D tag wrapper", private => 1 );
607              
608 5         122 my %attr = %ATTRIBUTES;
609 5         11 %ATTRIBUTES = (); # prevent leakage
610              
611 5 50       91 my $last = join '',
612 5         16 map { ref($_) ? $_ : _postprocess($_) }
613             $coderef->(%attr);
614              
615 5         24 my $content = Template::Declare->buffer->pop;
616 5 50 33     150 $content .= "$last" if not length $content and length $last;
617 5         15 Template::Declare->buffer->append( $content );
618              
619 5         97 return '';
620             }
621              
622             =head3 create_wrapper WRAPPERNAME => sub { 'Implementation' };
623              
624             create_wrapper basics => sub {
625             my $code = shift;
626             html {
627             head { title { 'Welcome' } };
628             body { $code->() }
629             }
630             };
631              
632             C declares a wrapper subroutine that can be called like a tag
633             sub, but can optionally take arguments to be passed to the wrapper sub. For
634             example, if you wanted to wrap all of the output of a template in the usual
635             HTML headers and footers, you can do something like this:
636              
637             package MyApp::Templates;
638             use Template::Declare::Tags;
639             use base 'Template::Declare';
640              
641             BEGIN {
642             create_wrapper wrap => sub {
643             my $code = shift;
644             my %params = @_;
645             html {
646             head { title { outs "Hello, $params{user}!"} };
647             body {
648             $code->();
649             div { outs 'This is the end, my friend' };
650             };
651             }
652             };
653             }
654              
655             template inner => sub {
656             wrap {
657             h1 { outs "Hello, Jesse, s'up?" };
658             } user => 'Jesse';
659             };
660              
661             Note how the C wrapper function is available for calling after it has
662             been declared in a C block. Also note how you can pass arguments to the
663             function after the closing brace (you don't need a comma there!).
664              
665             The output from the "inner" template will look something like this:
666              
667            
668            
669             Hello, Jesse!
670            
671            
672            

Hello, Jesse, s'up?

673            
This is the end, my friend
674            
675            
676              
677             =cut
678              
679             sub create_wrapper ($$) {
680 1     1 1 469 my $wrapper_name = shift;
681 1         2 my $coderef = shift;
682 1         3 my $template_class = caller;
683              
684             # Shove the code ref into the calling class.
685 48     48   365 no strict 'refs';
  48         90  
  48         43623  
686 1     1   5 *{"$template_class\::$wrapper_name"} = sub (&;@) { goto $coderef };
  1         100  
  1         16  
687             }
688              
689             =head2 Helpers
690              
691             =head3 xml_decl HASH
692              
693             xml_decl { 'xml', version => '1.0' };
694              
695             Emits an XML declaration. For example:
696              
697             xml_decl { 'xml', version => '1.0' };
698             xml_decl { 'xml-stylesheet', href => "chrome://global/skin/", type => "text/css" };
699              
700             Produces:
701              
702            
703            
704              
705             =cut
706              
707             sub xml_decl (&;$) {
708 4     4 1 35 my $code = shift;
709 4         10 my @rv = $code->();
710 4         25 my $name = shift @rv;
711 4         16 outs_raw("
712 4         143 while ( my ( $field, $val ) = splice( @rv, 0, 2 ) ) {
713 6         81 outs_raw(qq/ $field="$val"/);
714             }
715 4         125 outs_raw("?>$EOL");
716 4         143 return @_;
717             }
718              
719             =head3 current_template
720              
721             my $path = current_template();
722              
723             Returns the absolute path of the current template
724              
725             =cut
726              
727             sub current_template {
728 217   100 217 1 1861 return $TEMPLATE_STACK[-1] || '';
729             }
730              
731             =head3 current_base_path
732              
733             my $path = current_base_path();
734              
735             Returns the absolute base path of the current template
736              
737             =cut
738              
739             sub current_base_path {
740             # Rip it apart
741 0     0 1 0 my @parts = split('/', current_template());
742              
743             # Remove the last element
744 0         0 pop @parts;
745              
746             # Put it back together again
747 0         0 my $path = join('/', @parts);
748              
749             # And serve
750 0         0 return $path;
751             }
752              
753             =head3 under
754              
755             C is a helper function providing semantic sugar for the C method
756             of L.
757              
758             =cut
759              
760 37     37 1 2554 sub under ($) { return shift }
761              
762             =head3 setting
763              
764             C is a helper function providing semantic sugar for the C method
765             of L.
766              
767             =cut
768              
769 2     2 1 20 sub setting ($) { return shift }
770              
771             =begin comment
772              
773             =head2 get_current_attr
774              
775             Deprecated.
776              
777             =end comment
778              
779             =cut
780              
781             sub get_current_attr ($) {
782 0     0 1 0 $ATTRIBUTES{ $_[0] };
783             }
784              
785             sub _tag {
786 422     422   600 my $tagset = shift;
787 422         599 my $tag = shift;
788 422         521 my $code = shift;
789 422         587 my $more_code = shift;
790 422 100       2638 $tag = $tagset->namespace . ":$tag" if defined $tagset->namespace;
791              
792 35   50     539 Template::Declare->buffer->append(
793             $EOL
794             . ( " " x $TAG_NEST_DEPTH )
795             . "<$tag"
796             . join( '',
797 422         3911 map { qq{ $_="} . ( $ATTRIBUTES{$_} || '' ) . qq{"} }
798             sort keys %ATTRIBUTES )
799             );
800              
801 422         9835 my $attrs = "";
802 422         580 my $last;
803             {
804 48     48   1612 no warnings qw( uninitialized redefine once );
  48         117  
  48         70363  
  422         884  
805              
806             local *is::AUTOLOAD = sub {
807 26     26   239 shift;
808              
809 26         43 my $field = our $AUTOLOAD;
810 26         135 $field =~ s/.*:://;
811              
812 26         47 $field =~ s/__/:/g; # xml__lang is 'foo' ====> xml:lang="foo"
813 26         46 $field =~ s/_/-/g; # http_equiv is 'bar' ====> http-equiv="bar"
814              
815             # Squash empty values, but not '0' values
816 26 50       44 my $val = join ' ', grep { defined $_ && $_ ne '' } @_;
  26         227  
817              
818 26         426 append_attr( $field, $val );
819 422         1927 };
820              
821             local *append_attr = sub {
822 93     93   144 my $field = shift;
823 93         129 my $val = shift;
824              
825 93         276 $attrs .= ' ' . $field . q{="} . _postprocess($val, 1) . q{"};
826 93 100       505 wantarray ? () : '';
827 422         1988 };
828              
829 422         813 local $TAG_NEST_DEPTH = $TAG_NEST_DEPTH + $TAG_INDENTATION;
830 422         911 %ATTRIBUTES = ();
831 422         1295 Template::Declare->buffer->push( private => 1, from => "T::D tag $tag" );
832 422 100 100     23807 $last = join '', map { ref($_) && $_->isa('Template::Declare::Tag') ? $_ : _postprocess($_) } $code->();
  357         9157  
833             }
834 422         4451 my $content = Template::Declare->buffer->pop;
835 422 100 100     14744 $content .= "$last" if not length $content and length $last;
836 422 100       1146 Template::Declare->buffer->append($attrs) if length $attrs;
837              
838 422 100       2344 if (length $content) {
    100          
839 345         1124 Template::Declare->buffer->append(">$content");
840 345 100       7899 Template::Declare->buffer->append( $EOL . ( " " x $TAG_NEST_DEPTH )) if $content =~ /\
841 345         3509 Template::Declare->buffer->append("");
842             } elsif ( $tagset->can_combine_empty_tags($tag) ) {
843 37         115 Template::Declare->buffer->append(" />");
844             } else {
845             # Otherwise we supply a closing tag.
846 40         151 Template::Declare->buffer->append(">");
847             }
848              
849 422 100 66     10744 return ( ref($more_code) && $more_code->isa('CODE') )
850             ? $more_code->()
851             : '';
852             }
853              
854             sub _resolve_template_path {
855 233     233   427 my $template = shift;
856              
857 233         414 my @parts;
858 233 100       1028 if ( substr($template, 0, 1) ne '/' ) {
859             # relative
860 217         634 @parts = split '/', current_template();
861             # Get rid of the parent's template name
862 217         417 pop @parts;
863             }
864              
865 233         900 foreach ( split '/', $template ) {
866 310 100 100     3024 if ( $_ eq '..' ) {
    100          
867 3         5 pop @parts;
868             }
869             # Get rid of "." and empty entries by the way
870             elsif ( $_ ne '.' && $_ ne '' ) {
871 288         1003 push @parts, $_;
872             }
873             }
874              
875 233         822 return join '/', @parts;
876             }
877              
878             sub _show_template {
879 233     233   542 my $template = shift;
880 233         329 my $inside_template = shift;
881 233         339 my $args = shift;
882 233         600 $template = _resolve_template_path($template);
883 233         709 local @TEMPLATE_STACK = (@TEMPLATE_STACK, $template);
884              
885 233 50 33     1538 my $callable =
886             ( ref($template) && $template->isa('Template::Declare::Tag') )
887             ? $template
888             : Template::Declare->resolve_template( $template, $inside_template );
889              
890             # If the template was not found let the user know.
891 233 100       881 unless ($callable) {
892 19         57 my $msg = "The template '$template' could not be found";
893 19 100       67 $msg .= " (it might be private)" if !$inside_template;
894 19 100       84 croak $msg if Template::Declare->strict;
895 18         625 carp $msg;
896 18         15371 return '';
897             }
898              
899 214 100       788 if (my $instrumentation = Template::Declare->around_template) {
900             $instrumentation->(
901 6     6   43 sub { &$callable($self, @$args) },
902 6         88 $template,
903             $args,
904             $callable,
905             );
906             }
907             else {
908 208         1907 &$callable($self, @$args);
909             }
910              
911 213         1764 return;
912             }
913              
914             sub _outs {
915 113     113   183 my $raw = shift;
916 113         229 my @phrases = (@_);
917              
918 113   66     381 Template::Declare->buffer->push(
919             private => (defined wantarray and not wantarray), from => "T::D outs"
920             );
921              
922 113         3082 foreach my $item ( grep {defined} @phrases ) {
  113         387  
923 112 100       522 my $returned = ref($item) eq 'CODE'
    50          
924             ? $item->()
925             : $raw
926             ? $item
927             : _postprocess($item);
928 112         365 Template::Declare->buffer->append( $returned );
929             }
930 113         2352 return Template::Declare->buffer->pop;
931             }
932              
933             sub _postprocess {
934 534     534   750 my $val = shift;
935 534         679 my $skip_postprocess = shift;
936              
937 534 100       1464 return $val unless defined $val;
938              
939             # stringify in case $val is object with overloaded ""
940 526         827 $val = "$val";
941 526 50       1234 if ( ! $SKIP_XML_ESCAPING ) {
942 48     48   362 no warnings 'uninitialized';
  48         89  
  48         17666  
943 526         906 $val =~ s/&/&/g;
944 526         986 $val =~ s/
945 526         682 $val =~ s/>/>/g;
946 526         760 $val =~ s/\(/(/g;
947 526         677 $val =~ s/\)/)/g;
948 526         646 $val =~ s/"/"/g;
949 526         806 $val =~ s/'/'/g;
950             }
951 526 100       2067 $val = Template::Declare->postprocessor->($val)
952             unless $skip_postprocess;
953              
954 526         9991 return $val;
955             }
956              
957             =begin comment
958              
959             =head2 append_attr
960              
961             C is a helper function providing an interface for setting
962             attributes from within tags. But it's better to use C or C to set
963             your attributes. Nohting to see here, really. Move along.
964              
965             =end comment
966              
967             =cut
968              
969             sub append_attr {
970 1     1 1 18 die "Subroutine attr failed: $_[0] => '$_[1]'\n\t".
971             "(Perhaps you're using an unknown tag in the outer container?)";
972             }
973              
974             =head1 VARIABLES
975              
976             =over 4
977              
978             =item C<@Template::Declare::Tags::EXPORT>
979              
980             Holds the names of the static subroutines exported by this class. Tag
981             subroutines generated by tag sets, however, are not included here.
982              
983             =item C<@Template::Declare::Tags::TAG_SUB_LIST>
984              
985             Contains the names of the tag subroutines generated from a tag set.
986              
987             Note that this array won't get cleared automatically before another
988             C<< use Template::Decalre::Tags >> statement.
989              
990             C<@Template::Declare::Tags::TagSubs> is aliased to this variable for
991             backward-compatibility.
992              
993             =item C<$Template::Declare::Tags::TAG_NEST_DEPTH>
994              
995             Controls the indentation of the XML tags in the final outputs. For example,
996             you can temporarily disable a tag's indentation by the following lines of
997             code:
998              
999             body {
1000             pre {
1001             local $Template::Declare::Tags::TAG_NEST_DEPTH = 0;
1002             script { attr { src => 'foo.js' } }
1003             }
1004             }
1005              
1006             It generates
1007              
1008            
1009            
 
1010            
1011            
1012            
1013              
1014             Note that now the C