File Coverage

blib/lib/Text/Xslate/Syntax/TTerse.pm
Criterion Covered Total %
statement 296 301 98.3
branch 48 54 88.8
condition 11 14 78.5
subroutine 32 32 100.0
pod 0 24 0.0
total 387 425 91.0


line stmt bran cond sub pod time code
1             package Text::Xslate::Syntax::TTerse;
2 50     50   75196 use Mouse;
  50         659093  
  50         317  
3 50     50   17951 use Text::Xslate::Util qw(p any_in);
  50         118  
  50         3299  
4 50     50   265 use Scalar::Util ();
  50         108  
  50         174215  
5              
6             extends qw(Text::Xslate::Parser);
7              
8             sub _build_identity_pattern {
9 59     59   9391 return qr/(?: [A-Za-z_] [A-Za-z0-9_]* )/xms;
10             }
11              
12             # [% ... %] and %% ...
13 59     59   548 sub _build_line_start { '%%' }
14 57     57   412 sub _build_tag_start { '[%' }
15 57     57   644 sub _build_tag_end { '%]' }
16              
17             around trim_code => sub {
18             my($super, $self, $code) = @_;
19              
20             if($code =~ /^\#/) { # multiline comments
21             return '';
22             }
23              
24             return $super->($self, $code);
25             };
26              
27             sub init_symbols {
28 59     59 0 121 my($parser) = @_;
29 59         122 my $s;
30              
31 59         465 $parser->init_basic_operators();
32              
33 59         257 $parser->symbol('$')->set_nud(\&nud_dollar);
34 59         392 $parser->make_alias('~' => '_');
35 59         286 $parser->make_alias('|' => 'FILTER');
36 59         278 $parser->symbol('.')->set_led(\&led_dot); # redefine
37              
38 59         211 $parser->symbol('END') ->is_block_end(1);
39 59         207 $parser->symbol('ELSE') ->is_block_end(1);
40 59         200 $parser->symbol('ELSIF')->is_block_end(1);
41 59         201 $parser->symbol('CASE') ->is_block_end(1);
42              
43 59         207 $parser->symbol('IN');
44              
45 59         212 $s = $parser->symbol('IF');
46 59         233 $s->set_std(\&std_if);
47 59         285 $s->can_be_modifier(1);
48 59         213 $s = $parser->symbol('UNLESS');
49 59         238 $s->set_std(\&std_if);
50 59         186 $s->can_be_modifier(1);
51              
52 59         201 $parser->symbol('FOREACH') ->set_std(\&std_for);
53 59         203 $parser->symbol('FOR') ->set_std(\&std_for);
54 59         210 $parser->symbol('WHILE') ->set_std(\&std_while);
55 59         218 $parser->symbol('SWITCH') ->set_std(\&std_switch);
56 59         219 $parser->symbol('CASE') ->set_std(\&std_case);
57              
58 59         207 $parser->symbol('INCLUDE') ->set_std(\&std_include);
59 59         213 $parser->symbol('WITH');
60              
61 59         219 $parser->symbol('GET') ->set_std(\&std_get);
62 59         212 $parser->symbol('SET') ->set_std(\&std_set);
63 59         212 $parser->symbol('DEFAULT') ->set_std(\&std_set);
64 59         215 $parser->symbol('CALL') ->set_std(\&std_call);
65              
66 59         197 $parser->symbol('NEXT') ->set_std( $parser->can('std_next') );
67 59         211 $parser->symbol('LAST') ->set_std( $parser->can('std_last') );
68              
69 59         203 $parser->symbol('MACRO') ->set_std(\&std_macro);
70 59         217 $parser->symbol('BLOCK');
71 59         196 $parser->symbol('WRAPPER')->set_std(\&std_wrapper);
72 59         251 $parser->symbol('INTO');
73              
74 59         202 $parser->symbol('FILTER')->set_std(\&std_filter);
75              
76             # unsupported directives
77 59         342 my $nos = $parser->can('not_supported');
78 59         194 foreach my $keyword (qw(
79             INSERT PROCESS PERL RAWPERL TRY THROW RETURN
80             STOP CLEAR META TAGS DEBUG VIEW)) {
81 767         2074 $parser->symbol($keyword)->set_std($nos);
82             }
83              
84             # not supported, but ignored (synonym to CALL)
85 59         250 $parser->symbol('USE')->set_std(\&std_call);
86              
87 59         107 foreach my $id(keys %{$parser->symbol_table}) {
  59         1320  
88 6195 100       18055 if($id =~ /\A [A-Z]+ \z/xms) { # upper-cased keywords
89 2242         7649 $parser->make_alias($id => lc $id)->set_nud(\&aliased_nud);
90             }
91             }
92              
93 59         571 $parser->make_alias('not' => 'NOT');
94 59         277 $parser->make_alias('and' => 'AND');
95 59         266 $parser->make_alias('or' => 'OR');
96              
97 59         336 return;
98             }
99              
100             around _build_iterator_element => sub {
101             my($super, $parser) = @_;
102              
103             my $table = $super->($parser);
104              
105             # make aliases
106             $table->{first} = $table->{is_first};
107             $table->{last} = $table->{is_last};
108             $table->{next} = $table->{peek_next};
109             $table->{prev} = $table->{peek_prev};
110             $table->{max} = $table->{max_index};
111              
112             return $table;
113             };
114              
115             sub default_nud {
116 85     85 0 152 my($parser, $symbol) = @_;
117 85         241 return $symbol->clone(
118             arity => 'variable',
119             );
120             }
121              
122             # same as default_nud, except for aliased symbols
123             sub aliased_nud {
124 2     2 0 5 my($parser, $symbol) = @_;
125 2         16 return $symbol->clone(
126             arity => 'name',
127             id => lc( $symbol->id ),
128             value => $symbol->id,
129             );
130             }
131              
132             sub nud_dollar {
133 28     28 0 47 my($parser, $symbol) = @_;
134 28         40 my $expr;
135 28         87 my $t = $parser->token;
136 28 100       103 if($t->id eq "{") {
137 6         19 $parser->advance("{");
138 6         21 $expr = $parser->expression(0);
139 6         19 $parser->advance("}");
140             }
141             else {
142 22 100       109 if(!any_in($t->arity, qw(name variable))) {
143 1         8 $parser->_unexpected("a name", $t);
144             }
145 21         76 $parser->advance();
146 21         70 $expr = $t->clone( arity => 'variable' );
147             }
148 27         489 return $expr;
149             }
150              
151             sub undefined_name {
152 464     464 0 749 my($parser, $name) = @_;
153             # undefined names are always variables
154 464         1882 return $parser->symbol_table->{'(variable)'}->clone(
155             id => $name,
156             );
157             }
158              
159             sub is_valid_field {
160 50     50 0 69 my($parser, $token) = @_;
161 50   66     174 return $parser->SUPER::is_valid_field($token)
162             || $token->arity eq "variable";
163             }
164              
165             sub led_dot {
166 55     55 0 90 my($parser, $symbol, $left) = @_;
167              
168             # special case: foo.$field, foo.${expr}
169 55 100       247 if($parser->token->id eq '$') {
170 5         23 return $symbol->clone(
171             arity => "field",
172             first => $left,
173             second => $parser->expression( $symbol->lbp ),
174             );
175             }
176              
177 50         209 return $parser->SUPER::led_dot($symbol, $left);
178             }
179              
180             sub led_assignment {
181 26     26 0 182 my($parser, $symbol, $left) = @_;
182              
183 26         122 my $assign = $parser->led_infixr($symbol, $left);
184 26         578 $assign->arity('assign');
185 26         121 $assign->is_statement(1);
186              
187 26         72 my $name = $assign->first;
188 26 100       107 if(not $parser->find_or_create($name->id)->is_defined) {
189 15         322 $parser->define($name);
190 15         46 $assign->third('declare');
191             }
192              
193 26         471 return $assign;
194             }
195              
196             sub assignment {
197 590     590 0 1012 my($parser, $id, $bp) = @_;
198              
199 590         1495 $parser->symbol($id, $bp)->set_led(\&led_assignment);
200 590         1327 return;
201             }
202              
203             sub std_if {
204 69     69 0 119 my($parser, $symbol, $expr) = @_;
205 69         194 my $if = $symbol->clone(arity => "if");
206              
207 69         1464 my $is_modifier = defined $expr;
208              
209 69 100       323 $parser->new_scope() unless $is_modifier; # whole if block
210              
211 69         217 my $cond = $parser->expression(0);
212              
213 69 100       278 if($symbol->id eq 'UNLESS') {
214 7         23 $cond = $parser->symbol('!')->clone(
215             arity => 'unary',
216             first => $cond,
217             );
218             }
219 69         357 $if->first($cond);
220              
221 69 100       177 if($is_modifier) {
222 17         62 $if->second([ $expr ]);
223 17         55 return $if;
224             }
225              
226             # then block
227             {
228 52         63 $parser->new_scope();
  52         160  
229 52         215 $if->second( $parser->statements() );
230 52         197 $parser->pop_scope();
231             }
232              
233 52         148 my $t = $parser->token;
234              
235 52         81 my $top_if = $if;
236              
237 52         218 while($t->id eq "ELSIF") {
238 10         32 $parser->reserve($t);
239 10         64 $parser->advance(); # "ELSIF"
240              
241 10         35 my $elsif = $t->clone(arity => "if");
242 10         208 $elsif->first( $parser->expression(0) );
243              
244             {
245 10         18 $parser->new_scope();
  10         33  
246 10         29 $elsif->second( $parser->statements() );
247 10         32 $parser->pop_scope();
248             }
249              
250 10         41 $if->third([$elsif]);
251 10         16 $if = $elsif;
252 10         49 $t = $parser->token;
253             }
254              
255 52 100       193 if($t->id eq "ELSE") {
256 16         40 my $else_line = $t->line;
257 16         50 $parser->reserve($t);
258 16         68 $t = $parser->advance(); # "ELSE"
259              
260 16 50 33     116 if($t->id eq "IF" and $t->line != $else_line) {
261 0         0 Carp::carp(sprintf "%s: Parsing ELSE-IF sequense as ELSIF, but it is likely to be a misuse of ELSE-IF. Please insert semicolon as ELSE; IF, or write it in the same line (around input line %d)", ref $parser, $t->line);
262             }
263              
264             {
265 16         19 $parser->new_scope();
  16         46  
266 16 50       78 $if->third( $t->id eq "IF"
267             ? [$parser->statement()]
268             : $parser->statements());
269 16         50 $parser->pop_scope();
270             }
271             }
272              
273 52         153 $parser->advance("END");
274 51         150 $parser->pop_scope();
275 51         401 return $top_if;
276             }
277              
278             sub std_switch {
279 10     10 0 14 my($parser, $symbol) = @_;
280              
281 10         35 $parser->new_scope();
282              
283 10         29 my $topic = $parser->symbol('$_')->clone(arity => 'variable' );
284 10         206 my $switch = $symbol->clone(
285             arity => 'given',
286             first => $parser->expression(0),
287             second => [ $topic ],
288             );
289              
290 10         228 local $parser->{in_given} = 1;
291              
292 10         16 my @cases;
293 10   100     96 while(!($parser->token->id eq "END" or $parser->token->id eq '(end)')) {
294 39         123 push @cases, $parser->statement();
295             }
296 10         34 $switch->third( \@cases );
297              
298 10         41 $parser->build_given_body($switch, "case");
299              
300 9         25 $parser->advance("END");
301 9         32 $parser->pop_scope();
302 9         125 return $switch;
303             }
304              
305             sub std_case {
306 19     19 0 25 my($parser, $symbol) = @_;
307 19 50       60 if(!$parser->in_given) {
308 0         0 $parser->_error("You cannot use $symbol statements outside switch statements");
309             }
310 19         51 my $case = $symbol->clone(arity => "case");
311              
312 19 100       478 if($parser->token->id ne "DEFAULT") {
313 12         35 $case->first( $parser->expression(0) );
314             }
315             else {
316 7         17 $parser->advance();
317             }
318 19         57 $case->second( $parser->statements() );
319 19         149 return $case;
320             }
321              
322             sub iterator_name {
323 35     35 0 121 return 'loop'; # always 'loop'
324             }
325              
326             # FOR ... IN ...; ...; END
327             sub std_for {
328 35     35 0 60 my($parser, $symbol) = @_;
329              
330 35         129 my $proc = $symbol->clone(arity => "for");
331              
332 35         763 my $var = $parser->token;
333 35 50       178 if(!any_in($var->arity, qw(variable name))) {
334 0         0 $parser->_unexpected("a variable name", $var);
335             }
336 35         114 $parser->advance();
337 35         108 $parser->advance("IN");
338 35         147 $proc->first( $parser->expression(0) );
339 35         157 $proc->second([$var]);
340              
341 35         215 $parser->new_scope();
342 35         139 $parser->define_iterator($var);
343              
344 35         129 $proc->third( $parser->statements() );
345              
346             # for-else
347 35 100       202 if($parser->token->id eq 'ELSE') {
348 3         14 $parser->reserve($parser->token);
349 3         9 $parser->advance();
350 3         10 my $else = $parser->statements();
351 3         12 $proc = $symbol->clone( arity => 'for_else',
352             first => $proc,
353             second => $else,
354             );
355             }
356 35         183 $parser->advance("END");
357 35         175 $parser->pop_scope();
358 35         313 return $proc;
359             }
360              
361             sub std_while {
362 10     10 0 15 my($parser, $symbol) = @_;
363              
364 10         31 my $while = $symbol->clone(arity => "while");
365              
366 10         210 $while->first( $parser->expression(0) );
367 10         33 $while->second([]); # no vars
368 10         38 $parser->new_scope();
369 10         32 $while->third( $parser->statements() );
370 10         33 $parser->advance("END");
371 10         42 $parser->pop_scope();
372 10         64 return $while;
373             }
374              
375             around std_include => sub {
376             my($super, $self, $symbol) = @_;
377             $symbol->id( lc $symbol->id );
378             return $self->$super( $symbol );
379             };
380              
381             sub localize_vars {
382 28     28 0 54 my($parser, $symbol) = @_;
383              
384             # should make 'WITH' optional?
385             # my $t = $parser->token;
386             # if($t->id eq "WITH" or $t->arity eq "variable") {
387             # $parser->advance() if $t->id eq "WITH";
388 28 100       139 if($parser->token->id eq "WITH") {
389 9         26 $parser->advance();
390 9         187 $parser->new_scope();
391 9         29 my $vars = $parser->set_list();
392 9         84 $parser->pop_scope();
393 9         22 return $vars;
394             }
395 19         73 return undef;
396             }
397              
398             sub set_list {
399 39     39 0 65 my($parser) = @_;
400 39         58 my @args;
401 39         57 while(1) {
402 84         201 my $key = $parser->token;
403              
404 84 100 100     387 if(!(any_in($key->arity, qw(variable name))
405             && $parser->next_token_is("="))) {
406 39         75 last;
407             }
408 45         154 $parser->advance();
409 45         143 $parser->advance("=");
410              
411 45         158 my $value = $parser->expression(0);
412              
413 45         106 push @args, $key => $value;
414              
415 45 100       236 if($parser->token->id eq ",") { # , is optional
416 3         10 $parser->advance();
417             }
418             }
419              
420 39         91 return \@args;
421             }
422              
423             sub std_get {
424 5     5 0 8 my($parser, $symbol) = @_;
425              
426 5         18 my $stmt = $parser->print( $parser->expression(0) );
427 5         125 return $parser->finish_statement($stmt);
428             }
429              
430             sub std_set {
431 30     30 0 48 my($parser, $symbol) = @_;
432              
433 30         90 my $is_default = ($symbol->id eq 'DEFAULT');
434              
435 30         86 my $set_list = $parser->set_list();
436 30         53 my @assigns;
437 30         75 for(my $i = 0; $i < @{$set_list}; $i += 2) {
  63         215  
438 33         62 my($name, $value) = @{$set_list}[$i, $i+1];
  33         81  
439              
440 33 100       92 if($is_default) { # DEFAULT a = b -> a = a || b
441 7         22 my $var = $parser->symbol('(variable)')->clone(
442             id => $name->id,
443             );
444              
445 7         162 $value = $parser->binary('||', $var, $value);
446             }
447 33         397 my $assign = $symbol->clone(
448             id => '=',
449             arity => 'assign',
450             first => $name,
451             second => $value,
452             );
453              
454 33 100       838 if(not $parser->find_or_create($name->id)->is_defined) {
455 32         723 $parser->define($name);
456 32         99 $assign->third('declare');
457             }
458 33         225 push @assigns, $assign;
459             }
460 30         248 return @assigns;
461             }
462              
463             sub std_call {
464 7     7 0 12 my($parser, $symbol) = @_;
465 7         23 my $stmt = $parser->expression(0);
466 7         26 return $parser->finish_statement($stmt);
467             }
468              
469             sub std_macro {
470 18     18 0 36 my($parser, $symbol) = @_;
471 18         63 my $proc = $symbol->clone(
472             arity => 'proc',
473             id => 'macro',
474             );
475              
476 18         403 my $name = $parser->token;
477 18 50       81 if($name->arity ne "variable") {
478 0         0 $parser->_error("a name", $name);
479             }
480              
481 18         87 $parser->define_function($name->id);
482              
483 18         58 $proc->first($name);
484 18         50 $parser->advance();
485              
486 18         92 $parser->new_scope();
487              
488 18         73 my $paren = ($parser->token->id eq "(");
489              
490 18 100       77 $parser->advance("(") if $paren;
491              
492 18         47 my $t = $parser->token;
493 18         23 my @vars;
494 18         94 while($t->arity eq "variable") {
495 9         18 push @vars, $t;
496 9         35 $parser->define($t);
497              
498 9         27 $t = $parser->advance();
499              
500 9 100       34 if($t->id eq ",") {
501 1         4 $t = $parser->advance(); # ","
502             }
503             else {
504 8         16 last;
505             }
506             }
507 18 100       66 $parser->advance(")") if $paren;
508              
509 18         75 $proc->second(\@vars);
510              
511 18         58 $parser->advance("BLOCK");
512 18         82 $proc->third( $parser->statements() );
513 18         57 $parser->advance("END");
514 18         83 $parser->pop_scope();
515 18         184 return $proc;
516             }
517              
518              
519             # WRAPPER "foo.tt" ... END
520             # is
521             # cascade "foo.tt" { content => lambda@xxx() }
522             # macro content@xxx -> { ... }
523             sub std_wrapper {
524 10     10 0 15 my($parser, $symbol) = @_;
525              
526 10         51 my $base = $parser->barename();
527 10         17 my $into;
528 10 100       47 if($parser->token->id eq "INTO") {
529 1         4 my $t = $parser->advance();
530 1 50       8 if(!any_in($t->arity, qw(name variable))) {
531 0         0 $parser->_unexpected("a variable name", $t);
532             }
533 1         4 $parser->advance();
534 1         4 $into = $t->id;
535             }
536             else {
537 9         16 $into = 'content';
538             }
539 10   100     35 my $vars = $parser->localize_vars() || [];
540 10         41 my $body = $parser->statements();
541 10         33 $parser->advance("END");
542              
543 10         31 return $parser->wrap(
544             $symbol,
545             $base,
546             $into,
547             $vars,
548             $body,
549             );
550             }
551              
552             sub wrap {
553 10     10 0 24 my($parser, $proto, $base, $into, $vars, $body) = @_;
554 10         33 my $cascade = $proto->clone(
555             arity => 'cascade',
556             first => $base,
557             );
558              
559 10         229 my $content = $parser->lambda($proto);
560 10         264 $content->second([]); # args
561 10         32 $content->third($body);
562              
563 10         69 my $call_content = $parser->call($content->first);
564              
565 10         231 my $into_name = $proto->clone(
566             arity => 'literal',
567             id => $into,
568             );
569              
570 10         199 push @{$vars}, $into_name => $call_content;
  10         27  
571 10         37 $cascade->third($vars);
572 10         91 return( $cascade, $content );
573             }
574              
575             # [% FILTER html %]
576             # ...
577             # [% END %]
578             # is
579             # : block filter_xxx | html -> {
580             # ...
581             # : }
582             # in Kolon
583              
584             sub std_filter {
585 7     7 0 10 my($parser, $symbol) = @_;
586              
587 7         20 my $filter = $parser->expression(0);
588              
589 7         25 my $proc = $parser->lambda($symbol);
590              
591 7         158 $proc->second([]);
592 7         23 $proc->third( $parser->statements() );
593 7         22 $parser->advance("END");
594              
595 7         34 my $callmacro = $parser->call($proc->first);
596              
597 7 100       160 if($filter->id eq 'html') {
598             # for compatibility with TT2
599 4         6 $filter = 'unmark_raw';
600             }
601 7         32 my $callfilter = $parser->call($filter, $callmacro);
602 7         163 return( $proc, $parser->print($callfilter) );
603             }
604              
605 50     50   365 no Mouse;
  50         125  
  50         370  
606             __PACKAGE__->meta->make_immutable();
607             __END__