File Coverage

blib/lib/HTML/Template/Parser/NodeBuilder.pm
Criterion Covered Total %
statement 252 281 89.6
branch 47 62 75.8
condition 5 9 55.5
subroutine 69 74 93.2
pod 0 1 0.0
total 373 427 87.3


line stmt bran cond sub pod time code
1             package HTML::Template::Parser::NodeBuilder;
2              
3 10     10   59 use strict;
  10         19  
  10         352  
4 10     10   54 use warnings;
  10         17  
  10         16890  
5              
6             sub createNode {
7 207     207 0 307 my($attr) = @_;
8              
9 207         690 my @attr_list = @$attr;
10 207         329 my $type = shift @attr_list;
11 207         286 my($line, $column) = @{shift @attr_list}[0,1];
  207         424  
12              
13 207 100       1115 if($type eq 'string'){
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    100          
    50          
14 77         515 HTML::Template::Parser::Node::String->new({ line => $line, column => $column,
15             text => shift @attr_list });
16             }elsif($type eq 'var'){
17 59         999 HTML::Template::Parser::Node::Var->new({ line => $line, column => $column,
18             name_or_expr => shift @attr_list,
19             escape => shift @attr_list,
20             default => shift @attr_list,
21             });
22             }elsif($type eq 'include'){
23 9         112 HTML::Template::Parser::Node::Include->new({ line => $line, column => $column,
24             name_or_expr => shift @attr_list });
25             }elsif($type eq 'if'){
26 11         188 HTML::Template::Parser::Node::If->new({ line => $line, column => $column,
27             name_or_expr => shift @attr_list,
28             });
29             }elsif($type eq 'elsif'){
30 3         40 HTML::Template::Parser::Node::ElsIf->new({ line => $line, column => $column,
31             name_or_expr => shift @attr_list,
32             });
33             }elsif($type eq 'else'){
34 7         75 HTML::Template::Parser::Node::Else->new({ line => $line, column => $column });
35             }elsif($type eq 'if_end'){
36 11         123 HTML::Template::Parser::Node::IfEnd->new({ line => $line, column => $column });
37             }elsif($type eq 'unless'){
38 1         19 HTML::Template::Parser::Node::Unless->new({ line => $line, column => $column,
39             name_or_expr => shift @attr_list,
40             });
41             }elsif($type eq 'unless_end'){
42 0         0 HTML::Template::Parser::Node::UnlessEnd->new({ line => $line, column => $column });
43             }elsif($type eq 'loop'){
44 15         174 HTML::Template::Parser::Node::Loop->new({ line => $line, column => $column,
45             name_or_expr => shift @attr_list,
46             });
47             }elsif($type eq 'loop_end'){
48 14         124 HTML::Template::Parser::Node::LoopEnd->new({ line => $line, column => $column });
49             }else{
50 0         0 die "unknown type[$type]\n";
51             }
52             }
53              
54             package HTML::Template::Parser::Node;
55              
56 10     10   66 use strict;
  10         17  
  10         422  
57 10     10   54 use warnings;
  10         27  
  10         356  
58              
59 10     10   51 use base qw(Class::Accessor::Fast);
  10         16  
  10         1370  
60             __PACKAGE__->mk_accessors(qw( type can_have_child is_end_tag expected_begin_tag is_group_tag is_dont_add_me line column parent children raw_item ));
61              
62 10     10   57 use Scalar::Util;
  10         15  
  10         7990  
63              
64             sub new {
65 329     329   1149 my $class = shift;
66 329         1302 my $self = $class->SUPER::new(@_);
67 329         4280 $self->children([]);
68 329         2850 $self->_init();
69 329         2385 $self;
70             }
71              
72 0     0   0 sub _init {}
73              
74             sub add_chidren {
75 131     131   235 my($self, $node_list) = @_;
76              
77 131         515 while(@$node_list){
78 279         423 my $node = shift @$node_list;
79 279 100       983 return unless $node->list_to_tree($self, $node_list);
80             }
81 65 100       192 if($self->type eq 'group'){
82 3         25 my $tag = 'TMPL_' . uc($self->sub_type);
83 3         36 die sprintf("line %d. column %d. missing '' pared with <%s>\n",
84             $self->line, $self->column, $tag, $tag);
85             }
86             }
87              
88             sub list_to_tree {
89 279     279   581 my($self, $parent, $node_list) = @_;
90              
91 279 100       879 if($self->is_end_tag){
92 80 100       682 if(! $parent->is_group_tag){
93 33 100 66     224 if($parent->parent and $parent->parent->is_group_tag){
94             # REDO
95 29         416 unshift @{ $node_list }, $self;
  29         68  
96 29         100 return;
97             }else{
98             # tag mismatch
99 4         32 (my $tag = uc($self->type)) =~ s/_end$//i;
100 4         54 die sprintf("line %d. column %d. tag doesn't match \n",
101             $self->line, $self->column, $tag);
102             }
103             }else{
104 47 100 100     288 if($self->expected_begin_tag and $parent->sub_type !~ $self->expected_begin_tag){
105             # Ex) ...
106 2         73 die sprintf("line %d. column %d. tag doesn't match [%s]\n",
107             $self->line, $self->column, uc($self->expected_begin_tag), $parent->sub_type);
108             }
109 45 100       757 if(my $error = $parent->can_accept_this_node($self)){
110 2         37 die sprintf("line %d. column %d. %s\n",
111             $self->line, $self->column, $error);
112             }
113             }
114             }
115 242 100       1499 if($self->is_dont_add_me()){
116 18         163 return;
117             }
118              
119 224         1371 $parent->add_a_child($self);
120              
121 224 100       1591 if($self->can_have_child){
122 61         457 $self->add_chidren($node_list);
123             }
124 213         1421 1;
125             }
126              
127             sub add_a_child {
128 224     224   316 my($self, $child) = @_;
129              
130 224         263 push(@{$self->{children}}, $child);
  224         535  
131 224         762 $child->parent($self);
132             }
133              
134             sub can_accept_this_node {
135 24     24   171 '';
136             }
137              
138             sub remove_empty_block {
139 0     0   0 my $self = shift;
140              
141 0         0 my @children;
142 0         0 foreach my $child (@{ $self->{children} }){
  0         0  
143 0 0       0 if(not $child->is_empty){
144 0         0 push(@children, $child);
145             }
146             }
147 0         0 $self->{children} = \@children;
148             }
149              
150             sub is_empty {
151 0     0   0 my $self = shift;
152              
153 0         0 $self->remove_empty_block();
154 0 0 0     0 if($self->can_have_child and @{$self->{children}} == 0){
  0         0  
155 0         0 return 1;
156             }
157 0         0 return 0;
158             }
159              
160             package HTML::Template::Parser::Node::Root;
161              
162 10     10   141 use strict;
  10         17  
  10         368  
163 10     10   66 use warnings;
  10         22  
  10         638  
164              
165             sub _init {
166 70     70   112 my $self = shift;
167 70         235 $self->type('root');
168 70         499 $self->can_have_child(1);
169             }
170              
171 10     10   53 use base qw(HTML::Template::Parser::Node);
  10         27  
  10         12484  
172              
173             package HTML::Template::Parser::Node::String;
174              
175 10     10   59 use strict;
  10         22  
  10         385  
176 10     10   51 use warnings;
  10         17  
  10         290  
177              
178 10     10   60 use base qw(HTML::Template::Parser::Node);
  10         21  
  10         5989  
179             __PACKAGE__->mk_accessors(qw( text ));
180              
181             sub _init {
182 77     77   108 my $self = shift;
183 77         212 $self->type('string');
184             }
185              
186             package HTML::Template::Parser::Node::Var;
187              
188 10     10   60 use strict;
  10         24  
  10         421  
189 10     10   83 use warnings;
  10         21  
  10         456  
190              
191 10     10   51 use base qw(HTML::Template::Parser::Node);
  10         17  
  10         5794  
192             __PACKAGE__->mk_accessors(qw( name_or_expr escape default ));
193              
194             sub _init {
195 59     59   119 my $self = shift;
196 59         223 $self->type('var');
197             }
198              
199             package HTML::Template::Parser::Node::Include;
200              
201 10     10   67 use strict;
  10         26  
  10         350  
202 10     10   52 use warnings;
  10         28  
  10         267  
203              
204 10     10   70 use base qw(HTML::Template::Parser::Node);
  10         16  
  10         6143  
205             __PACKAGE__->mk_accessors(qw( name_or_expr ));
206              
207             sub _init {
208 9     9   19 my $self = shift;
209 9         46 $self->type('include');
210             }
211              
212             package HTML::Template::Parser::Node::If;
213              
214 10     10   61 use strict;
  10         18  
  10         289  
215 10     10   57 use warnings;
  10         23  
  10         562  
216              
217 10     10   56 use base qw(HTML::Template::Parser::Node);
  10         86  
  10         7103  
218             __PACKAGE__->mk_accessors(qw( name_or_expr else_seen ));
219              
220             sub _init {
221 11     11   23 my $self = shift;
222 11         61 $self->type('if');
223 11         111 $self->can_have_child(1);
224             }
225              
226             sub can_accept_this_node {
227 21     21   115 my($self, $node) = @_;
228              
229 21 100       54 return if($node->type eq 'group_end');
230              
231 15 100       132 if($self->else_seen){
232             # accept 'if_end' only
233 4 100       27 if($node->type ne 'if_end'){
234 2         19 return sprintf("can't accept , since already seen . accept only.",
235             uc($node->type));
236             }
237             }
238 13 100       101 if($node->type eq 'else'){
239 5         40 $self->else_seen(1);
240             }
241 13         119 return;
242             }
243              
244             package HTML::Template::Parser::Node::ElsIf;
245             __PACKAGE__->mk_accessors(qw( name_or_expr ));
246              
247 10     10   65 use strict;
  10         18  
  10         320  
248 10     10   49 use warnings;
  10         16  
  10         10953  
249              
250 10     10   58 use base qw(HTML::Template::Parser::Node);
  10         28  
  10         11294  
251              
252             sub _init {
253 3     3   7 my $self = shift;
254 3         22 $self->type('elsif');
255 3         39 $self->can_have_child(1);
256 3         38 $self->is_end_tag(1);
257 3         59 $self->expected_begin_tag(qr/if|unless/);
258             }
259              
260             package HTML::Template::Parser::Node::Else;
261              
262 10     10   1555 use strict;
  10         17  
  10         279  
263 10     10   46 use warnings;
  10         14  
  10         295  
264              
265 10     10   45 use base qw(HTML::Template::Parser::Node);
  10         16  
  10         6880  
266              
267             sub _init {
268 7     7   13 my $self = shift;
269 7         34 $self->type('else');
270 7         58 $self->can_have_child(1);
271 7         76 $self->is_end_tag(1);
272 7         74 $self->expected_begin_tag(qr/if|unless/);
273             }
274              
275             package HTML::Template::Parser::Node::IfEnd;
276              
277 10     10   1299 use strict;
  10         14  
  10         1671  
278 10     10   44 use warnings;
  10         15  
  10         337  
279              
280 10     10   43 use base qw(HTML::Template::Parser::Node);
  10         28  
  10         5495  
281              
282             sub _init {
283 11     11   22 my $self = shift;
284 11         51 $self->type('if_end');
285 11         96 $self->is_end_tag(1);
286 11         106 $self->expected_begin_tag('if');
287             }
288              
289             package HTML::Template::Parser::Node::Unless;
290              
291 10     10   50 use strict;
  10         21  
  10         236  
292 10     10   40 use warnings;
  10         12  
  10         261  
293              
294 10     10   43 use base qw(HTML::Template::Parser::Node);
  10         30  
  10         19288  
295             __PACKAGE__->mk_accessors(qw( name_or_expr else_seen ));
296              
297             sub _init {
298 1     1   3 my $self = shift;
299 1         8 $self->type('unless');
300 1         13 $self->can_have_child(1);
301             }
302              
303             sub can_accept_this_node {
304 0     0   0 my($self, $node) = @_;
305              
306 0 0       0 return if($node->type eq 'group_end');
307              
308 0 0       0 if($self->else_seen){
309             # accept 'if_end' only
310 0 0       0 if($node->type ne 'unless_end'){
311 0         0 return sprintf("can't accept , since already seen . accept only.",
312             uc($node->type));
313             }
314             }
315 0 0       0 if($node->type eq 'else'){
316 0         0 $self->else_seen(1);
317             }
318 0         0 return;
319             }
320              
321             package HTML::Template::Parser::Node::UnlessEnd;
322              
323 10     10   68 use strict;
  10         16  
  10         463  
324 10     10   43 use warnings;
  10         17  
  10         295  
325              
326 10     10   73 use base qw(HTML::Template::Parser::Node);
  10         26  
  10         5946  
327              
328             sub _init {
329 0     0   0 my $self = shift;
330 0         0 $self->type('unless_end');
331 0         0 $self->is_end_tag(1);
332 0         0 $self->expected_begin_tag('unless');
333             }
334              
335             package HTML::Template::Parser::Node::Loop;
336              
337 10     10   53 use strict;
  10         36  
  10         631  
338 10     10   42 use warnings;
  10         16  
  10         262  
339              
340 10     10   42 use base qw(HTML::Template::Parser::Node);
  10         16  
  10         5419  
341             __PACKAGE__->mk_accessors(qw( name_or_expr ));
342              
343             sub _init {
344 15     15   27 my $self = shift;
345 15         69 $self->type('loop');
346 15         124 $self->can_have_child(1);
347             }
348              
349             package HTML::Template::Parser::Node::LoopEnd;
350              
351 10     10   53 use strict;
  10         22  
  10         417  
352 10     10   48 use warnings;
  10         14  
  10         319  
353              
354 10     10   45 use base qw(HTML::Template::Parser::Node);
  10         22  
  10         5432  
355              
356             sub _init {
357 14     14   21 my $self = shift;
358 14         50 $self->type('loop_end');
359 14         108 $self->is_end_tag(1);
360 14         100 $self->expected_begin_tag('loop');
361             }
362              
363             package HTML::Template::Parser::Node::Group;
364              
365 10     10   57 use strict;
  10         16  
  10         269  
366 10     10   52 use warnings;
  10         17  
  10         305  
367              
368 10     10   59 use base qw(HTML::Template::Parser::Node);
  10         13  
  10         20209  
369             __PACKAGE__->mk_accessors(qw( sub_type ));
370              
371             sub _init {
372 27     27   55 my $self = shift;
373 27         96 $self->type('group');
374 27         183 $self->can_have_child(1);
375 27         181 $self->is_group_tag(1);
376             }
377              
378             sub can_accept_this_node {
379 45     45   74 my($self, $node) = @_;
380              
381 45 50       58 if(0 < @{$self->children}){
  45         105  
382 45         314 return $self->children->[0]->can_accept_this_node($node);
383             }
384 0         0 return '';
385             }
386              
387             package HTML::Template::Parser::Node::GroupEnd;
388             __PACKAGE__->mk_accessors(qw( sub_type ));
389              
390 10     10   65 use strict;
  10         15  
  10         280  
391 10     10   57 use warnings;
  10         27  
  10         320  
392              
393 10     10   46 use base qw(HTML::Template::Parser::Node);
  10         21  
  10         47359  
394              
395             sub _init {
396 25     25   46 my $self = shift;
397 25         190 $self->type('group_end');
398 25         177 $self->is_end_tag(1);
399 25         182 $self->is_dont_add_me(1);
400             }
401              
402             1;