File Coverage

blib/lib/Template/LiquidX/Tidy/impl.pm
Criterion Covered Total %
statement 177 229 77.2
branch 62 110 56.3
condition 47 125 37.6
subroutine 12 12 100.0
pod n/a
total 298 476 62.6


line stmt bran cond sub pod time code
1              
2             use strict;
3 3     3   19 use warnings;
  3         4  
  3         84  
4 3     3   12 use experimental 'signatures';
  3         12  
  3         65  
5 3     3   30  
  3         7  
  3         14  
6             our $VERSION = '0.03';
7              
8             use Exporter 'import';
9 3     3   323 our @EXPORT_OK = qw(_tidy_list _tidy_make_string);
  3         9  
  3         129  
10             use vars '%defaults';
11 3     3   21 *defaults = \%Template::LiquidX::Tidy::defaults;
  3         4  
  3         783  
12              
13             # parser regex
14             our $PI_START = qr/\{%-?/;
15             our $PI_END = qr/-?%\}/;
16             our $LV_START = qr/\{\{/;
17              
18             # pseudo html indenter
19             # $html - fragment of html to chunk into lines
20             # $args - indenter configuration
21             # $level - current level
22             # $clevel - current level for debugging
23             # $stack - additional storage for
24             # open_tags /
25             # closed_tags /
26             # level at return time
27             # returns a list of [ level, fragment ] pairs and modifies $stack
28             #print ((" " x $clevel ). "_tidy_html <<$html>> <<$level>>\n");
29 12     12   15 my $nl = $html =~ /\n/;
  12         16  
  12         12  
  12         16  
  12         15  
  12         14  
  12         14  
30             my @return;
31 12         23 my $last_line_start = 0;
32 12         14 my $start_level = $level;
33 12         17 my $level_change = '';
34 12         13 while ($html =~ m{(?: (?<cdata> <!\[CDATA\[(.*?)\]\]> )
35 12         14 | (?<nl> \n )
36 12         56 | (?<close2> />)
37             | <(?<close> /)? (?<tag> \w+ )
38             ) }gsx) {
39             #use Data::Dumper; warn Dumper \%+;
40             if ($+{cdata}) {
41             # ignore
42 3 50   3   1227 }
  3 100       1235  
  3         7595  
  15         105  
43             elsif (length $+{nl}) {
44             1 while $level_change =~ s/\(\)//;
45             push @return, [ $start_level - ($level_change =~ y/)//), (substr $html, $last_line_start, (pos $html) - $last_line_start),
46 6         21 +{ html => 1,
47             ($stack->{open_tags} ? (open => [$stack->{open_tags}->@*]) : ()),
48             ($stack->{closed_tags} ? (closed => [$stack->{closed_tags}->@*]) : ()), } ];
49             $last_line_start = pos($html);
50 6 100       39 $start_level = $level;
    50          
51 6         19 $level_change = '';
52 6         19 }
53 6         24 else {
54             my $tag = $+{tag} ? lc $+{tag} : '';
55             if ($tag =~ /^(?| area | base | br | col | embed | hr | img | input | link | meta | source | track | wbr )$/ix) {
56 9 50       60 push $stack->{waiting}->@*, $tag;
57 9 100       95 }
    50          
    100          
58 3         30 elsif ($+{close2}) {
59             if ($stack->{waiting} && $stack->{waiting}->@*) {
60             pop $stack->{waiting}->@*;
61 0 0 0     0 } else {
62 0         0 pop $stack->{open_tags}->@*;
63             $level_change .= ')';
64 0         0 $level--;
65 0         0 #print ((" " x $clevel ). " close2 <<$level_change>> <<$start_level>>\n");
66 0         0 }
67             }
68             elsif ($+{close}) {
69             if ($stack->{waiting} && $stack->{waiting}->@* && $stack->{waiting}[-1] eq $tag) {
70             pop $stack->{waiting}->@*;
71 3 50 33     19 }
      33        
72 0         0 else {
73             if ($stack->{open_tags} && $stack->{open_tags}[-1] eq $tag) {
74             pop $stack->{open_tags}->@*;
75 3 50 33     15 } else {
76 3         7 push $stack->{closed_tags}->@*, $tag;
77             }
78 0         0 $level_change .= ')';
79             $level--;
80 3         6 $stack->{waiting}->@* = ();
81 3         5 #print ((" " x $clevel ). " close<<$tag>> <<$level_change>> <<$start_level>>\n");
82 3         22 }
83             }
84             else {
85             push $stack->{open_tags}->@*, $tag;
86             $level_change .= '(';
87 3         21 $level++;
88 3         7 $stack->{waiting}->@* = ();
89 3         5 #print ((" " x $clevel ). " open<<$tag>> <<$level_change>> <<$start_level>>\n");
90 3         20 }
91             }
92             }
93             if ($last_line_start < length $html) {
94             1 while $level_change =~ s/\(\)//;
95 12 100       27 push @return, [ $start_level - ($level_change =~ y/)//), (substr $html, $last_line_start),
96 9         16 +{ html => 1,
97             ($stack->{open_tags} ? (open => [$stack->{open_tags}->@*]) : ()),
98             ($stack->{closed_tags} ? (closed => [$stack->{closed_tags}->@*]) : ()), } ];
99             }
100 9 50       49 $stack->{level} = $level;
    50          
101             @return
102 12         23 }
103              
104 12         24 # liquid indenter part
105             # $obj - an object, subclass of Template::Liquid::Document
106             # $args - indenter configuration
107             # $level - current level
108             # $clevel - current level for debugging
109             # $stack - additional storage for the html indenter in particular
110             # returns a list of [ level, fragment ] pairs and modifies $stack
111             my @return;
112             push @return, [ $level, $obj->{markup}, +{ markup => $obj } ]
113 42     42   51 if defined $obj->{markup};
  42         48  
  42         46  
  42         45  
  42         46  
  42         45  
  42         56  
114 42         44  
115             my $nlevel = $level + 1;
116 42 100       136 for my $node ($obj->{nodelist}->@*) {
117             my @result;
118 42         60 if (ref $node) {
119 42         70 @result = _tidy_list($node, $args, $nlevel, $clevel + 1, $stack)
120 36         40 } else {
121 36 100       56 if ($args->{html} // $defaults{html}) {
122 24         62 @result = _tidy_html($node, $args, $nlevel, $clevel + 1, $stack);
123             if ($stack->{level}) {
124 12 50 33     51 $nlevel = delete $stack->{level};
125 12         27 }
126 12 50       26 } else {
127 12         23 @result = [ $nlevel, $node, +{ text => 1 } ]
128             }
129             }
130 0         0 push @return, @result;
131             }
132              
133 36         75 for my $block ($obj->{blocks}->@*) {
134             my @result;
135             if (ref $block) {
136 42         76 @result = _tidy_list($block, $args, $level, $clevel + 1, $stack)
137 15         20 } else {
138 15 50       22 if ($args->{html} // $defaults{html}) {
139 15         38 @result = _tidy_html($block, $args, $level, $clevel + 1, $stack)
140             } else {
141 0 0 0     0 @result = [ $level, $block, +{ text => 1 } ]
142 0         0 }
143             }
144 0         0 push @return, @result;
145             }
146              
147 15         27 push @return, [ $level, $obj->{markup_2}, +{ markup_2 => $obj } ]
148             if defined $obj->{markup_2};
149              
150             @return
151 42 100       87 }
152              
153             # check if the tag should always be linebroken
154 42         83 # $args->{force_nl} - config option to enable linebreaks
155             # $args->{force_nl_tags} - whitespace separated string with tags that should be linebroken
156             my $force_nl = $args->{force_nl} // $defaults{force_nl};
157             my $force_nl_tags = $args->{force_nl_tags} // $defaults{force_nl_tags};
158             return unless $force_nl;
159 12     12   17 my @tags = split ' ', $force_nl_tags;
  12         14  
  12         14  
  12         21  
160 12   66     31 return 1 unless @tags;
161 12   33     36 my $re = join '|', map { "\Q$_" } @tags;
162 12 100       27 return $content =~ /$PI_START\s*($re)/;
163 8         34 }
164 8 50       16  
165 8         16 # there is only whitespace before $list[$i] and a linebreak
  104         162  
166 8         198 while ($i > 0) {
167             $i--;
168             # found newline, exit search
169             if ($list[$i]->[1] =~ /\n\z/) {
170 19     19   25 return 1;
  19         23  
  19         60  
  19         20  
171 19         43 }
172 19         26 # found non whitespace
173             if ($list[$i]->[1] =~ /\S/) {
174 19 50       38 return;
175 0         0 }
176             }
177             return 1;
178 19 50       48 }
179 19         55  
180             # there is only whitespace after $list[$i] and a processing instruction
181             while ($i < $#list) {
182 0         0 $i++;
183             # found processing instruction, exit search
184             if ($list[$i]->[1] =~ /\{%-?/) {
185             return 1;
186 30     30   35 }
  30         35  
  30         62  
  30         31  
187 30         58 # found non whitespace
188 27         33 if ($list[$i]->[1] =~ /\S/) {
189             return;
190 27 100       75 }
191 21         64 }
192             return;
193             }
194 6 50       21  
195 6         21 # liquid indenter main routine
196             # $obj - the root element object, subclass of Template::Liquid::Document
197             # $args - indenter configuration
198 3         12 # @list - a list of [ level, string fragment ] pairs as produced by _tidy_html / _tidy_list
199             # returns the indented document string
200             my $level_correct = -1;
201             #my $level_correct = 0;
202             #use Data::Dumper;
203             #print Dumper \@list;
204              
205             my $result = '';
206 3     3   5  
  3         6  
  3         5  
  3         12  
  3         6  
207 3         3 # config
208             my $indent = $args->{indent} // $defaults{indent};
209             my $short_if = $args->{short_if} // $defaults{short_if} // 0;
210             my $indent_html = $args->{html} // $defaults{html};
211              
212 3         7 # state
213             my $next_nl = 0; # next PI needs to have a newline because we just deleted one
214              
215 3   33     14 for my $i (0..$#list) {
216 3   33     16 # poke = previous line
      50        
217 3   33     19 my $poke_content = $i > 0 ? $list[$i - 1]->[1] : '';
218              
219             my $it = $list[$i];
220 3         7 my $content = $it->[1];
221              
222 3         10 # peek = next line
223             my $peek_content = $i < $#list ? $list[$i + 1]->[1] : '';
224 54 100       115  
225             my $level = $it->[0] + $level_correct;
226 54         75 my $peek_level = $i < $#list ? $list[$i + 1]->[0] + $level_correct : $level;
227 54         64  
228             if ($content =~ /$PI_START/) {
229             # $result .= "\e[34mPI;$level\e[0m";
230 54 100       99 if (($content !~ /\n/ && !_force_nl_tags($args, $content))
231             || $content =~ /$PI_START\s*post_url\s/) {
232 54         74 # $result .= "\e[35mA\e[0m";
233 54 100       89 # we stripped a newline, put it back
234             if ($next_nl) {
235 54 100       187 $result .= "\n";
236             $next_nl = 0;
237 24 100 100     110 }
      66        
238              
239             # there was only whitespace before this tag (which we deleted)
240             # -> add indentation
241 4 50       10 if (_ws_only_before($i, @list)) {
242 0         0 my $m1 = $content;
243 0         0 $m1 =~ s/^\s*+/' ' x ($indent * $level)/e
244             if $indent_html;
245             #$m1 =~ s/\n\K/' ' x ($indent * ($level + 1))/ge;
246              
247             $result .= $m1;
248 4 50       6 next;
249 0         0 }
250 0 0       0  
  0         0  
251             $result .= $content;
252             next;
253             }
254 0         0  
255 0         0 if ($short_if > 0 && !$next_nl && $content !~ /\n/) {
256             if ($content =~ /$PI_START\s*(if|unless)\s/ && (length $peek_content) <= $short_if
257             && ($i + 2 <= $#list) && $list[$i + 2]->[1] =~ /$PI_START/) {
258 4         7 $result .= $content;
259 4         7 next;
260             }
261             if ($content =~ /$PI_START\s*end(if|unless)\s/ && (length $poke_content) <= $short_if
262 20 100 33     97 && ($i - 2 >= 0) && $list[$i - 2]->[1] =~ /$PI_START\s*(\Q$1\E\s|elsif\s|else)/) {
      66        
263 8 0 66     71 $result .= $content;
      33        
      33        
264             next;
265 0         0 }
266 0         0 }
267              
268 8 0 33     55 my $m1 = $content;
      33        
      0        
269             # normalise
270 0         0 $m1 =~ s/\s*($PI_END)/ $1/;
271 0         0 $m1 =~ s/($PI_START)\s*/$1 /;
272             # $result .= "[\e[33m$m1\e[0m]";
273             # $result .= "{\e[32m$poke_content\e[0m}";
274             my $line = 0;
275 20         26  
276             # previous line not empty
277 20         162 # -> we assume the {% goes to previous line
278 20         100 if ( ($poke_content =~ /^(.*)\z/m && length $1)
279             || ($indent_html && $poke_content =~ />\s*\n\z/) ) {
280             $m1 =~ s/$PI_START\K\s*/\n/;
281 20         34 }
282             # there was only whitespace before this tag (which we deleted)
283             # -> add indentation
284             elsif (_ws_only_before($i, @list) || $next_nl) {
285 20 50 33     122 # $result .= "[\e[33mwsonly before $i; next_nl:$next_nl\e[0m]";
    0 0        
      33        
      0        
286             # if ($indent_html && !$next_nl) {
287 20         104 # # we can indent the whole tag
288             # $m1 =~ s/^\s*+/' ' x ($indent * $level)/e;
289             # $line++;
290             # } else {
291             my $local_indent = $poke_content =~ /^(.*)\z/m ? length $1 : 0;
292             my $required_indent = $indent * $level;
293             $required_indent -= $local_indent;
294             $required_indent -= length '{% ';
295             if ($required_indent >= 0 && !$next_nl) {
296             $m1 =~ s/$PI_START\K\s*/' ' x ($required_indent + 1)/e;
297             } else {
298 0 0       0 # force newline after {%
299 0         0 $m1 =~ s/$PI_START\K\s*/\n/;
300 0         0 }
301 0         0 # }
302 0 0 0     0 }
303 0         0 $next_nl = 0;
  0         0  
304             $m1 =~ s/\n\K(?!["'])[ \t]*/' ' x ($indent * ($level + ($line++ ? 1 : 0)))/ge;
305             # $result .= "[\e[33m$m1\e[0m]";
306 0         0  
307             # next line is no processing instruction
308             # -> the %} should go to the next line, indented
309             if ($peek_content !~ /$PI_START/ && $peek_content !~ /^\n/) {
310 20         40 $m1 =~ s/ ($PI_END)/"\n" . (' ' x ($indent * $peek_level)) . $1/e;
311 20 50       61 }
  20         67  
312              
313             # clean "blank" lines
314             $m1 =~ s/^[ \t]+(?=\n)//gm;
315              
316 20 50 66     83 # special case for the last command in file:
317 17         77 # the %} goes on its own line
  17         50  
318             if ($i == $#list || ($peek_content eq "\n"
319             && !grep { $_->[1] ne "\n" } @list[ ($i + 1) .. $#list ]) ) {
320             $m1 =~ s/ ($PI_END)/\n$1/;
321 20         94 }
322              
323             # $result .= "\e[35mB\e[0m";
324             $result .= $m1;
325 20 50 33     63 next;
      33        
326 0         0 }
327 0         0  
328             # indent content that starts with {{ (liquid variables)
329             if ($content =~ /^\s*$LV_START/ && (_ws_only_before($i, @list)) ) {
330             my $m1 = $content;
331 20         44 if ($indent_html) {
332 20         47 $m1 =~ s/^\s*+/' ' x ($indent * $level)/e;
333             }
334             $m1 =~ s/\n\K/' ' x ($indent * ($level + 1))/ge;
335              
336 30 50 66     165 $result .= $m1;
337 0         0 next;
338 0 0       0 }
339 0         0  
  0         0  
340             # indent content that start with < (html tag)
341 0         0 if ($indent_html && $content =~ /^\s*<[^!]/ && ($poke_content =~ /\n\z/) ) {
  0         0  
342             my $m1 = $content;
343 0         0 $m1 =~ s/^\s*+/' ' x ($indent * $level)/e;
344 0         0  
345             # next line is a processing instruction
346             # -> delete the last newline if the line ends with > (html tag end)
347             if (_ws_only_after_beforepi($i, @list)) {
348 30 100 66     134 $next_nl = $m1 =~ s/>\K\s*\n\z//;
      100        
349 3         5 }
350 3         12  
  3         12  
351             $result .= $m1;
352             next;
353             }
354 3 50       9  
355 3         9 # next line is a processing instruction
356             # -> delete the last newline if the line ends with > (html tag end)
357             if ($indent_html && _ws_only_after_beforepi($i, @list)) {
358 3         13 my $m1 = $content;
359 3         7 if ($m1 =~ s/(?<!-)>\K\s*\n\z//) {
360             $result .= $m1;
361             $next_nl = 1;
362             next;
363             }
364 27 100 66     59  
365 18         26 # ignore plain newline if it follows a processing instruction
366 18 50       35 if ($m1 eq "\n" && $poke_content =~ /$PI_START/ && $poke_content !~ /$PI_START\s*capture/) {
367 0         0 $next_nl = 1;
368 0         0 next;
369 0         0 }
370             }
371              
372             # ignore white space in front of liquid variables and liquid processing instructions
373 18 0 33     36 if ($indent_html
      33        
374 0         0 && $content =~ /^[ \t]+$/
375 0         0 && ($peek_content =~ /$LV_START/ || $peek_content =~ /$PI_START/)
376             && $poke_content =~ /\n\z/) {
377              
378             # skip this indentation, will be corrected when the next token is processed
379             next;
380 27 0 33     93 }
      0        
      33        
      0        
381              
382             # indent html text
383             if ($indent_html
384             && !($it->[2] && $it->[2]{open} && $it->[2]{open}->@* && $it->[2]{open}[-1] eq 'script')) {
385             my $m1 = $content;
386 0         0 if ($poke_content =~ /\n\z/) {
387             $m1 =~ s/^[ \t]++/' ' x ($indent * $level)/e;
388             }
389             # clean "blank" lines
390 27 50 66     158 $m1 =~ s/^[ \t]+(?=\n)//gm;
      33        
391              
392 27         42 $result .= $m1;
393 27 50       46 next;
394 0         0 }
  0         0  
395              
396             # fallback: don't touch the content, add as is
397 27         47 $result .= $content;
398             next;
399 27         49 }
400 27         53 $result
401             }
402              
403             1;
404 0         0  
405 0         0 =head1 NAME
406              
407             Template::LiquidX::Tidy::impl - The implementation of Template::LiquidX::Tidy
408 3         34  
409             =head1 SYNOPSIS
410              
411             For internal usage.
412              
413             =head1 METHODS
414              
415             =head2 _tidy_list($obj, $args, $level, $clevel, $stack = {})
416              
417             The Liquid indenter part
418              
419             =over 4
420              
421             =item B<$obj>
422              
423             an object, subclass of Template::Liquid::Document
424              
425             =item B<$args>
426              
427             The indenter configuration
428              
429             =back
430              
431             returns a list of [ level, fragment ] pairs and modifies C<$stack>
432              
433             =head2 _tidy_make_string($obj, $args, @list)
434              
435             Liquid indenter main routine. This does the grunt work of joining
436             together all the tuples returned by the calls to _tidy_list
437              
438             =over 4
439              
440             =item B<$obj>
441              
442             an object, subclass of Template::Liquid::Document
443              
444             =item B<$args>
445              
446             The indenter configuration
447              
448             =back
449              
450             returns the indented document string
451              
452             =cut
453