File Coverage

blib/lib/HTML/Template/Ex/Filter.pm
Criterion Covered Total %
statement 6 31 19.3
branch 0 34 0.0
condition n/a
subroutine 2 5 40.0
pod 1 1 100.0
total 9 71 12.6


line stmt bran cond sub pod time code
1             package HTML::Template::Ex::Filter;
2             #
3             # Copyright (C) 2007 Bee Flag, Corp, All Rights Reserved.
4             # Masatoshi Mizuno E<lt>mizunoE<64>bomcity.comE<gt>
5             #
6             # $Id: Filter.pm 297 2007-03-25 14:34:59Z lushe $
7             #
8 2     2   8343 use strict;
  2         6  
  2         73  
9 2     2   11 use warnings;
  2         3  
  2         1522  
10              
11             our $VERSION = '0.02';
12              
13             sub set {
14             {
15             format=> 'scalar',
16             sub=> sub {
17 0     0     my $text= shift;
18 0           $$text=~s{\[\%\s*([^\%]+)\s*\%\]} [ &__filter($1) ]sge;
  0            
19             },
20 0     0 1   };
21             }
22             sub __filter {
23 0     0     local($_)= @_;
24             return
25             /^(?:var|\=)\s*(\S+)/i ? do {
26 0           my $v= $1;
27 0 0         $v=~/^(url|html)\s*\:(.+)/i
28             ? qq{<tmpl_var escape="$1" name="$2">}
29             : qq{<tmpl_var name=$v>};
30             }:
31             /^ex(?:\s+(.+))?/i ? do {
32 0           my($str, $option)= ($1, "");
33 0 0         if ($str) {
34 0 0         my($name, $escape)=
    0          
    0          
35             $str=~/^([^\:\"\']+)\s*\:\s*([^\s\"\']+)/ ? ($2, $1):
36             $str=~/^([^\:\"\']+)\:\s*$/ ? ("", $1):
37             $str=~/([^\s\"\']+)/ ? ($1, ""): ("", "");
38 0 0         $option = qq{ escape="$escape} if $escape;
39 0 0         $option.= qq{ name="$name"} if $name;
40             }
41 0           qq{<tmpl_ex$option>};
42             }:
43             /^set\s+([^\s\=]+)\s*\=\s*(.+)/i ? do {
44 0           my($name, $value)= ($1, $2);
45 0           $value=~s/(?:^[\"\']|[\"\']\s*$)//g;
46 0           qq{<tmpl_set name="$name" value="$value">};
47             }:
48 0           /^(if|unless)\s+(\S+)/i ? do { qq{<tmpl_$1 name=$2>} }:
49 0           /^else/i ? do { qq{<tmpl_else>} }:
50 0           /^loop\s+(\S+)/i ? do { qq{<tmpl_loop name=$1>} }:
51 0           /^(?:end_loop|\/\s*loop)/ ? do { qq{</tmpl_loop>} }:
52 0           /^(?:include|\.\.\.?)\s*(\S+)/i ? do { qq{<tmpl_include name=$1>} }:
53 0           /^(?:end_|\/\s*)(if|unless|ex)/i ? do { qq{</tmpl_$1>} }:
54 0           /^(?:\!|comment)/ ? do { "" }:
55 0 0         do { qq{[% $_ %]} };
  0 0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
56             }
57              
58             1;
59              
60             __END__
61              
62             =head1 NAME
63              
64             HTML::Template::Ex::Filter - tmpl_tag filter for HTML::Template::Ex.
65              
66             =head1 SYNOPSIS
67              
68             use HTML::Template::Ex;
69             use HTML::Template::Ex::Filter;
70            
71             my $tmpl= HTML::Template::Ex->new(
72             ...
73             filter=> HTML::Template::Ex::Filter->set,
74             );
75              
76             [%... include_template.tmpl %]
77            
78             [% ex %]
79             my($self, $param)= @_;
80             ...
81             ..... ban, bo, bon.
82             "";
83             [% end_ex %]
84            
85             [% =param_name %]
86            
87             [% loop loop_param_name %]
88             ...
89             [% end_loop %]
90              
91             =head1 DESCRIPTION
92              
93             This module offers the filter to make the format of HTML::Template easy a little.
94              
95             =head1 TAGS
96              
97             =head2 [% ex %] ... [% end_ex %]
98              
99             It corresponds to '<TMPL_EX> ... </TMPL_EX>'.
100              
101             To specify the NAME attribute, as follows is done.
102              
103             [% ex param_name %] ...
104              
105             In addition, delimit by the ESCAPE attribute and to the following
106              
107             [% ex html:param_name %]
108              
109             NAME attribute a unspecified ESCAPE attribute must make the head and to the
110             following
111              
112             [% ex html: %]
113              
114             =head2 [% set PARAM_NAME="PARAM_VALUE" %]
115              
116             It corresponds to '<TMPL_SET NAME="PARAM_NAME" VALUE="PARAM_VALUE">'.
117              
118             =head2 [% =VAR_NAME %]
119              
120             It corresponds to '<TMPL_VAR NAME="VAR_NAME">'.
121              
122             The ESCAPE attribute does as follows.
123              
124             [% =html:VAR_NAME %]
125              
126             =head2 [% if VAR_NAME %] ... [% else %] ... [% end_if %]
127              
128             It corresponds to '<TMPL_IF NAME="VAR_NAME"> ... <TMPL_ELSE> ... </TMPL_IF>'.
129              
130             =head2 [% unless VAR_NAME %] ... [% else %] ... [% end_unless %]
131              
132             It corresponds to '<TMPL_UNLESS NAME="VAR_NAME"> ... <TMPL_ELSE> ... </TMPL_UNLESS>'.
133              
134             =head2 [% loop ARRAY_NAME %] ... [% end_loop %]
135              
136             It corresponds to '<TMPL_LOOP NAME="ARRAY_NAME"> ... </TMPL_LOOP>'.
137              
138             =head2 [%... INCLUDE_TEMPLATE %] or [% include INCLUDE_TEMPLATE %]
139              
140             It corresponds to '<TMPL_INCLUDE NAME="...">'.
141              
142             =head2 [% ! COMMENT_STRING %] or [% comment COMMENT_STRING %]
143              
144             It is a comment. It is not reflected in the template.
145              
146             =head1 SEE ALSO
147              
148             L<Egg::Release>,
149              
150             =head1 AUTHOR
151              
152             Masatoshi Mizuno E<lt>mizunoE<64>bomcity.comE<gt>
153              
154             =head1 COPYRIGHT
155              
156             Copyright (C) 2007 by Bee Flag, Corp. E<lt>L<http://egg.bomcity.com/>E<gt>, All Rights Reserved.
157              
158             This library is free software; you can redistribute it and/or modify
159             it under the same terms as Perl itself, either Perl version 5.8.6 or,
160             at your option, any later version of Perl 5 you may have available.
161              
162             =cut