File Coverage

lib/Rex/Template/NG.pm
Criterion Covered Total %
statement 133 183 72.6
branch 34 60 56.6
condition 49 88 55.6
subroutine 10 10 100.0
pod 0 2 0.0
total 226 343 65.8


line stmt bran cond sub pod time code
1             #
2             # (c) Jan Gehring
3             #
4              
5             package Rex::Template::NG;
6              
7 10     10   69939 use v5.12.5;
  10         59  
8 10     10   73 use warnings;
  10         30  
  10         5470  
9              
10             our $VERSION = '1.14.3'; # VERSION
11              
12             sub new {
13 1     1 0 98 my $that = shift;
14 1   33     7 my $proto = ref($that) || $that;
15 1         3 my $self = {@_};
16              
17 1         3 bless( $self, $proto );
18              
19 1         4 $self->_init();
20              
21 1         4 return $self;
22             }
23              
24             sub _init {
25 15     15   23 my ($self) = @_;
26              
27 15         33 $self->{__output__} = "";
28 15         26 $self->{__code__} = "";
29 15         21 $self->{__raw_data__} = "";
30             }
31              
32             sub parse {
33 14     14 0 34 my $self = shift;
34 14         28 my $c = shift;
35 14         19 my %in_vars;
36              
37 14         36 $self->_init();
38              
39 14 100       39 if ( ref $_[0] eq "HASH" ) {
40 11         15 %in_vars = %{ +shift };
  11         39  
41             }
42             else {
43 3         9 %in_vars = @_;
44             }
45              
46 14         22 my %vars;
47              
48 14         30 for my $key ( keys %in_vars ) {
49 12         19 my $new_key = $key;
50 12         39 $new_key =~ s/[^a-zA-Z0-9_]/_/gms;
51 12         30 $vars{$new_key} = $in_vars{$key};
52             }
53              
54             # some backward compat. to old template module.
55 14         70 $c =~ s/\$::([a-zA-Z0-9_]+)/_replace_var($1, \%vars)/egms;
  9         23  
56              
57 14         26 my $code = "";
58              
59 14         19 my $var_data = '
60            
61             return sub {
62             my (
63             $self,
64             ';
65              
66 14         22 my @code_values;
67 14         34 for my $var ( keys %vars ) {
68 12         21 $var_data .= '$' . $var . ", \n";
69 12         26 push( @code_values, $vars{$var} );
70             }
71              
72 14         25 $var_data .= '$this_is_really_nothing) = @_;';
73 14         20 $var_data .= "\n";
74              
75 14         18 $code = $var_data;
76              
77 14         31 $code .= $self->_parse($c);
78              
79 14         26 $code .= "\n}";
80              
81 14         19 my $idx_c = 1;
82 14         68 for my $l ( split( /\n/, $code ) ) {
83 232         257 $idx_c++;
84 232   100     423 $l ||= "";
85 232         462 Rex::Logger::debug("$idx_c. $l");
86             }
87              
88 14         36 $self->{__code__} = $code;
89 14         28 $self->{__raw_data__} = $c;
90              
91 10     10   116 no warnings;
  10         46  
  10         1066  
92 14         1588 my $tpl_code = eval($code);
93 10     10   90 use warnings;
  10         36  
  10         13868  
94              
95 14 50       44 if ($@) {
96              
97 0         0 my $error = $@;
98              
99 0         0 my ($error_line) = ( $error =~ m/line (\d+)[\.,]/ );
100 0         0 my @code_lines = split( /\n/, $code );
101 0         0 my @raw_lines = split( /\n/, $c );
102              
103 0         0 my $idx = $error_line - 5;
104 0         0 for my $l ( @code_lines[ $error_line - 5 .. $error_line + 5 ] ) {
105 0         0 $idx++;
106 0   0     0 $l ||= "";
107 0         0 Rex::Logger::debug("$idx. $l");
108             }
109              
110 0         0 my $template_line = 0;
111 0         0 my $add_to_error_line = -1;
112              
113             # search the error line
114 0         0 Rex::Logger::debug("Template-Error-Line: $error_line");
115 0         0 for ( my $bi = $error_line - 1 ; $bi >= 0 ; $bi-- ) {
116 0 0       0 if ( $code_lines[$bi] =~ m/^# LINE: (\d+)$/ ) {
117 0         0 $template_line = $1 + $add_to_error_line;
118 0         0 last;
119             }
120 0         0 $add_to_error_line++;
121             }
122              
123 0 0       0 if ( !$template_line ) {
124 0         0 die "Uncatchable error in template: $error ($error_line)";
125             }
126              
127 0         0 my $start_part = $template_line - 5;
128 0 0       0 $start_part = 0 if $start_part <= 0;
129 0         0 my $end_part = $template_line + 5;
130 0 0       0 $end_part = scalar @raw_lines if $end_part > scalar @raw_lines;
131              
132 0         0 my $idx_t = $start_part;
133              
134 0         0 for my $l ( @raw_lines[ $start_part .. $end_part ] ) {
135 0         0 $idx_t++;
136 0   0     0 $l ||= "";
137 0         0 Rex::Logger::info("$idx_t. $l");
138             }
139              
140 0         0 my $tpl_error = $error;
141 0         0 $tpl_error =~ s/at \(eval \d+\) line \d+/at template line $template_line/;
142              
143 0 0 0     0 if ( $error =~ m/Global symbol "([^"]+)" requires explicit package name/ ) {
    0          
144 0         0 $tpl_error =
145             "Unknown variable name $1 in code line: ,,$raw_lines[$template_line-1]'' line: $template_line.\nOriginal Error:\n$error\n";
146             }
147              
148             # internal parsing error, maybe runaway line without ";"
149             elsif ( $raw_lines[ $template_line - 2 ] =~ m/^%/
150             && $raw_lines[ $template_line - 2 ] !~ m/[;{("']/ )
151             {
152 0         0 Rex::Logger::debug(
153             "Template Error in compiled line: $code_lines[$error_line-1]");
154 0         0 Rex::Logger::info(
155             "Template Error somewhere around: $raw_lines[$template_line-2]",
156             "error" );
157              
158 0         0 my $template_line_ = $template_line - 1;
159 0         0 $tpl_error =
160             "Maybe missing <<;, {, (, \" or '>> in code line: ,,$raw_lines[$template_line-2]'' line $template_line_.\nOriginal Error:\n$error\n";
161             }
162             else {
163 0         0 $tpl_error =
164             "Failed parsing template. Unkown error near $template_line.\nOriginal Error:\n$error\n";
165             }
166              
167 0         0 die $tpl_error;
168             }
169              
170 14         295 $tpl_code->( $self, @code_values );
171              
172 14         230 return $self->{__output__};
173             }
174              
175             sub __out {
176 44     44   88 my ( $self, $str ) = @_;
177              
178 44 50       529 $self->{__output__} .= defined $str ? $str : "";
179             }
180              
181             sub _parse {
182 14     14   29 my ( $self, $c ) = @_;
183              
184 14         22 my $parsed = "";
185              
186 14         88 my @chars = split( //, $c );
187              
188 14         20 my $begin_line = 0;
189 14         19 my $code_line = 0;
190 14         24 my $code_block = 0;
191 14         15 my $code_block_output = 0;
192 14         17 my $current_char_idx = -1;
193 14         18 my $line_count = 1;
194 14         23 my $string_open = 0;
195 14         16 my $skip_next = 0;
196 14         20 my $skip_next_newline = 0;
197              
198 14         24 for my $curr_char (@chars) {
199 427         489 $current_char_idx++;
200              
201 427 100       659 if ($skip_next) {
202 10         12 $skip_next = 0;
203 10         17 next;
204             }
205              
206 417   100     735 my $prev_char = $chars[ $current_char_idx - 1 ] || "";
207 417   100     719 my $next_char = $chars[ $current_char_idx + 1 ] || "";
208              
209 417 50 33     663 if ( $skip_next_newline && $curr_char eq "\n" ) {
210 0         0 $skip_next_newline = 0;
211 0         0 $curr_char = "";
212             }
213              
214 417 100 66     722 if ( $curr_char eq "\n" && $prev_char ne "\n" ) { # count lines, for error messages
215 10         15 $line_count++;
216 10         13 $parsed .= $curr_char;
217              
218 10 50       16 if ($string_open) {
219 10         16 $parsed .= "});\n";
220             }
221              
222             # reset vars
223 10         11 $code_line = 0;
224 10         14 $string_open = 0;
225              
226 10         16 next;
227             }
228              
229 407 50 33     658 if ( $curr_char eq "\n" && $prev_char eq "\n" ) {
230 0         0 $parsed .= "\$self->__out(q{\n});\n";
231 0         0 $line_count++;
232 0         0 next;
233             }
234              
235 407 0 33     671 if ( $curr_char eq "-"
      0        
      33        
      0        
236             && $next_char eq "%"
237             && ( $prev_char eq " " || $prev_char eq "\n" )
238             && $chars[ $current_char_idx + 2 ] eq ">" )
239             {
240             # skip "-" of -%> sequence
241 0         0 $skip_next_newline = 1;
242 0         0 next;
243             }
244              
245             # catch code line
246             # % some code
247 407 50 100     1084 if (
      100        
      66        
      33        
248             !$code_block
249             && ( $prev_char eq "\n"
250             || $current_char_idx == 0 ) # first line or new line
251             && $curr_char eq "%"
252             && $next_char eq " " # code block, and no % char escape sequence
253             )
254             {
255 0         0 $code_line = 1;
256 0         0 $parsed .= "\n# LINE: $line_count\n";
257 0         0 next;
258             }
259              
260             # catch '<% ' ...
261 407 100 66     773 if ( $prev_char eq "<"
      66        
      66        
262             && $curr_char eq "%"
263             && ( $next_char eq " " || $next_char eq "\n" ) )
264             {
265 6         8 $code_block = 1;
266 6 50       13 if ($string_open) {
267 6         9 $parsed .= "});\n";
268 6         9 $string_open = 0;
269             }
270              
271 6         14 $parsed .= "\n# LINE: $line_count\n";
272              
273 6         8 next;
274             }
275              
276             # catch ' %>'
277 401 100 66     1100 if (
      100        
      100        
      66        
278             $code_block
279             && ( ( $code_block_output || $prev_char eq " " )
280             || $prev_char eq "\n"
281             || $prev_char eq "-" )
282             && $curr_char eq "%"
283             && $next_char eq ">"
284             )
285             {
286 16         29 $code_block = 0;
287              
288 16 100       29 if ($code_block_output) {
289 10         13 $parsed .= ");\n";
290 10         13 $code_block_output = 0;
291             }
292              
293 16         23 $string_open = 1;
294 16         20 $parsed .= "\n\$self->__out(q{";
295              
296 16         25 next;
297             }
298              
299             # catch '<%='
300 385 50 66     694 if ( $prev_char eq "<" && $curr_char eq "%" && $next_char eq "=" ) {
      66        
301 10         16 $code_block = 1;
302 10         14 $code_block_output = 1;
303              
304 10 50       19 if ($string_open) {
305 10         13 $parsed .= "});\n";
306             }
307              
308 10         20 $parsed .= "\n# LINE: $line_count\n";
309 10         16 $parsed .= "\$self->__out(";
310 10         15 $skip_next = 1;
311              
312 10         11 next;
313             }
314              
315 375 100 66     875 if ( $code_line || $code_block ) {
316 150         180 $parsed .= $curr_char;
317 150         196 next;
318             }
319              
320 225 100       341 if ( !$string_open ) {
321 24         33 $string_open = 1;
322 24         44 $parsed .= '$self->__out(q{';
323             }
324              
325             # don't catch opening <
326 225 100 66     386 if ( $curr_char eq "<" && $next_char eq "%" ) {
327 16         28 next;
328             }
329              
330             # don't catch closing >
331 209 100 66     365 if ( $curr_char eq ">" && $prev_char eq "%" ) {
332 16         28 next;
333             }
334              
335             # escaping of % sign
336 193 50 33     308 if ( $curr_char eq "%" && $prev_char eq "%" ) {
337 0         0 next;
338             }
339              
340 193 100       384 $parsed .= $curr_char =~ m/[{}]/ ? "\\$curr_char" : $curr_char;
341              
342             }
343              
344 14 50       25 if ($string_open) {
345 14         18 $parsed .= "});\n";
346             }
347              
348 14         69 return $parsed;
349              
350             }
351              
352             sub _replace_var {
353 9     9   29 my ( $var, $t_vars ) = @_;
354              
355 9 50       18 if ( exists $t_vars->{$var} ) {
356 9         43 return '$' . $var;
357             }
358             else {
359 0           return '$::' . $var;
360             }
361             }
362              
363             1;
364              
365             __END__