avoid an internal error in .wrap if the arguments can't be evalled
[bse.git] / site / cgi-bin / modules / Squirrel / Template / Parser.pm
CommitLineData
58f0ca94
TC
1package Squirrel::Template::Parser;
2use strict;
3use Squirrel::Template::Constants qw(:token :node);
4
75ecc5ce 5our $VERSION = "1.020";
58f0ca94
TC
6
7use constant TOK => 0;
8use constant TMPLT => 1;
9use constant ERRORS => 2;
10
11use constant TRACE => 0;
12
13sub new {
14 my ($class, $tokenizer, $templater) = @_;
15
16 return bless [ $tokenizer, $templater, [] ], $class;
17}
18
19sub parse {
20 my ($self) = @_;
21
22 my @results;
23
24 while (1) {
25 push @results, $self->_parse_content;
26
27 my $tok = $self->[TOK]->get;
28
29 if (!$tok) {
30 die "Internal error: Unexpected end of tokens\n";
31 }
32
33 last if $tok->[TOKEN_TYPE] eq 'eof';
34
35 push @results, $self->_error_mod($tok, "Expected eof but found $tok->[TOKEN_TYPE]");
36 }
37
38 return @results > 1 ? $self->_comp(@results) : $results[0];
39}
40
41sub _parse_content {
42 my ($self) = @_;
43
44 my @result;
45 my $token;
46 TOKEN:
47 while (my $token = $self->[TOK]->get) {
48 my $type = $token->[TOKEN_TYPE];
49 print STDERR "NEXT: $type\n" if TRACE;
50 if ($type eq 'content' || $type eq 'tag' || $type eq 'wraphere') {
51 push @result, $token;
52 }
58f0ca94 53 else {
5b527c11
TC
54 my $method = "_parse_$type";
55 if ($self->can($method)) {
56 push @result, $self->$method($token);
57 }
58 else {
59 $self->[TOK]->unget($token);
60 last TOKEN;
61 }
58f0ca94
TC
62 }
63 }
64
65 if (@result > 1) {
66 return $self->_comp(@result);
67 }
68 elsif (@result) {
69 return $result[0];
70 }
71 else {
72 return $self->_empty($self->[TOK]->peek);
73 }
74}
75
76sub _empty {
77 my ($self, $tok) = @_;
78
79 return [ empty => "", $tok->[TOKEN_LINE], $tok->[TOKEN_FILENAME] ];
80}
81
82sub _error {
83 my ($self, $tok, $message) = @_;
84
85 print STDERR "ERROR: $message\n" if TRACE;
86
87 my $error = [ error => "", $tok->[TOKEN_LINE], $tok->[TOKEN_FILENAME], $message ];
88 push @{$self->[ERRORS]}, $error;
89
90 return $error;
91}
92
93# returns the token transformed into an error message, ie the token is being replaced
94
95sub _error_mod {
96 my ($self, $tok, $message) = @_;
97
98 my $error = [ error => $tok->[TOKEN_ORIG], $tok->[TOKEN_LINE], $tok->[TOKEN_FILENAME], $message ];
99 push @{$self->[ERRORS]}, $error;
100
101 return $error;
102}
103
104sub _dummy {
105 my ($self, $base, $type, $orig) = @_;
106
107 return [ $type => $orig, $base->[TOKEN_LINE], $base->[TOKEN_FILENAME] ];
108}
109
110sub _comp {
111 my ($self, @parts) = @_;
112
113 my @result = ( comp => "", $parts[0][TOKEN_LINE], $parts[0][TOKEN_FILENAME] );
114
115 for my $part (@parts) {
116 if ($part->[0] eq "comp") {
117 push @result, @{$part}[4 .. $#$part];
118 }
119 else {
120 push @result, $part;
121 }
122 }
123
124 return \@result;
125}
126
ac507437
TC
127sub _parse_expr {
128 my ($self, $expr) = @_;
129
130 my $parser = Squirrel::Template::Expr::Parser->new;
131 my $parsed;
46296d79 132 local $SIG{__DIE__};
ac507437
TC
133 if (eval { $parsed = $parser->parse($expr->[TOKEN_EXPR_EXPR]); 1 }) {
134 $expr->[NODE_EXPR_EXPR] = $parsed;
6f186c3b 135 $expr->[NODE_EXPR_FORMAT] ||= $self->[TMPLT]{def_format};
ac507437
TC
136 return $expr;
137 }
138 elsif (ref $@) {
139 return $self->_error($expr, $@->[1]);
140 }
141 else {
142 return $self->_error($expr, $@);
143 }
144}
145
231cecfb
TC
146sub _parse_stmt {
147 my ($self, $stmt) = @_;
148
149 my $parser = Squirrel::Template::Expr::Parser->new;
150 my $tokens = Squirrel::Template::Expr::Tokenizer->new($stmt->[TOKEN_EXPR_EXPR]);
151 my @list;
152 my $parsed;
46296d79 153 local $SIG{__DIE__};
231cecfb
TC
154 my $good = eval {
155 push @list, $parser->parse_tokens($tokens);
156 while ($tokens->peektype eq "op;") {
157 $tokens->get;
158 push @list, $parser->parse_tokens($tokens);
159 }
160 $tokens->peektype eq "eof"
161 or die [ error => "Expected ; or end, but found ".$tokens->peektype ];
162 1;
163 };
164 if ($good) {
165 $stmt->[NODE_EXPR_EXPR] = \@list;
166 return $stmt;
167 }
168 elsif (ref $@) {
169 return $self->_error($stmt, $@->[1]);
170 }
171 else {
172 return $self->_error($stmt, $@);
173 }
174}
175
ac507437
TC
176sub _parse_set {
177 my ($self, $set) = @_;
178
179 my $parser = Squirrel::Template::Expr::Parser->new;
180 my $parsed;
46296d79 181 local $SIG{__DIE__};
ac507437
TC
182 if (eval { $parsed = $parser->parse($set->[TOKEN_SET_EXPR]); 1 }) {
183 $set->[NODE_SET_VAR] = [ split /\./, $set->[TOKEN_SET_VAR] ];
184 $set->[NODE_SET_EXPR] = $parsed;
185 return $set;
186 }
187 elsif (ref $@) {
188 return $self->_error($set, $@->[1]);
189 }
190 else {
191 return $self->_error($set, $@);
192 }
193}
194
58f0ca94
TC
195sub _parse_if {
196 my ($self, $if) = @_;
197
198 my $true = $self->_parse_content;
199 my $or = $self->[TOK]->get;
200 my $eif;
201 my $false;
202 my @errors;
203 if ($or->[TOKEN_TYPE] eq 'or') {
204 if ($or->[TOKEN_TAG_NAME] ne "" && $or->[TOKEN_TAG_NAME] ne $if->[TOKEN_TAG_NAME]) {
205 push @errors, $self->_error($or, "'or' or 'eif' for 'if $if->[TOKEN_TAG_NAME]' starting $if->[TOKEN_FILENAME]:$if->[TOKEN_LINE] expected but found 'or $or->[TOKEN_TAG_NAME]'");
206 }
207 $false = $self->_parse_content;
208
209 $eif = $self->[TOK]->get;
210 if ($eif->[TOKEN_TYPE] eq 'eif') {
211 if ($eif->[TOKEN_TAG_NAME] ne "" && $eif->[TOKEN_TAG_NAME] ne $if->[TOKEN_TAG_NAME]) {
212 push @errors, $self->_error($or, "'eif' for 'if $if->[TOKEN_TAG_NAME]' starting $if->[TOKEN_FILENAME]:$if->[TOKEN_LINE] expected but found 'eif $eif->[TOKEN_TAG_NAME]'");
213 }
214 # fall through
215 }
216 else {
217 push @errors, $self->_error($eif, "Expected 'eif' tag for if starting $if->[TOKEN_FILENAME]:$if->[TOKEN_LINE] but found $eif->[TOKEN_TYPE]");
218 $self->[TOK]->unget($eif);
219 $eif = $self->_dummy($eif, eif => "<:eif:>");
220 }
221 }
222 elsif ($or->[TOKEN_TYPE] eq 'eif') {
223 if ($or->[TOKEN_TAG_NAME] ne "" && $or->[TOKEN_TAG_NAME] ne $if->[TOKEN_TAG_NAME]) {
224 push @errors, $self->_error($or, "'or' or 'eif' for 'if $if->[TOKEN_TAG_NAME]' starting $if->[TOKEN_FILENAME]:$if->[TOKEN_LINE] expected but found 'eif $or->[TOKEN_TAG_NAME]'");
225 }
226
227 $eif = $or;
228 $or = $false = $self->_empty($or);
229 }
230 else {
231 push @errors, $self->_error($or, "Expected 'or' or 'eif' tag for if starting $if->[TOKEN_FILENAME]:$if->[TOKEN_LINE] but found $or->[TOKEN_TYPE]");
232 $self->[TOK]->unget($or);
233 $or = $false = $self->_empty($or);
234 $eif = $self->_dummy($or, eif => "");
235 }
236 @{$if}[NODE_TYPE, NODE_COND_TRUE, NODE_COND_FALSE, NODE_COND_OR, NODE_COND_EIF] = ( "cond", $true, $false, $or, $eif );
237 if (@errors) {
238 return $self->_comp($if, @errors);
239 }
240 else {
241 return $if;
242 }
243}
244
33e0317f
TC
245sub _parse_ifnot {
246 my ($self, $ifnot) = @_;
247
248 my $true = $self->_parse_content;
249 my $eif = $self->[TOK]->get;
250 my @errors;
251 if ($eif->[TOKEN_TYPE] eq 'eif') {
252 if ($eif->[TOKEN_TAG_NAME] ne "" && $eif->[TOKEN_TAG_NAME] ne $ifnot->[TOKEN_TAG_NAME]) {
253 push @errors, $self->_error($eif, "'eif' for 'if !$ifnot->[TOKEN_TAG_NAME]' starting $ifnot->[TOKEN_FILENAME]:$ifnot->[TOKEN_LINE] expected but found 'eif $eif->[TOKEN_TAG_NAME]'");
254 }
255 # fall through
256 }
257 else {
258 push @errors, $self->_error($eif, "Expected 'eif' tag for if ! starting $ifnot->[TOKEN_FILENAME]:$ifnot->[TOKEN_LINE] but found $eif->[TOKEN_TYPE]");
259 $self->[TOK]->unget($eif);
260 $eif = $self->_dummy($eif, eif => "<:eif:>");
261 }
262
263 @{$ifnot}[NODE_TYPE, NODE_COND_TRUE, NODE_COND_EIF] = ( "condnot", $true, $eif );
264 if (@errors) {
265 return $self->_comp($ifnot, @errors);
266 }
267 else {
268 return $ifnot;
269 }
270}
271
5b527c11 272sub _parse_itbegin {
58f0ca94
TC
273 my ($self, $start) = @_;
274
275 my $name = $start->[TOKEN_TAG_NAME];
276 my $loop = $self->_parse_content;
277 my $septok = $self->[TOK]->get;
278 my $endtok;
279 my $sep;
280 my @errors;
281 if ($septok->[TOKEN_TYPE] eq 'itsep') {
282 if ($septok->[TOKEN_TAG_NAME] ne $name) {
283 push @errors, $self->_error($septok, "Expected 'iterator separator $name' for 'iterator begin $name' at $start->[TOKEN_FILENAME]:$start->[TOKEN_LINE] but found 'iterator separator $septok->[TOKEN_TAG_NAME]'");
284 }
285 $sep = $self->_parse_content;
286 $endtok = $self->[TOK]->get;
287 if ($endtok->[TOKEN_TYPE] eq 'itend') {
288 if ($endtok->[TOKEN_TAG_NAME] ne $name) {
289 push @errors, $self->_error($endtok, "Expected 'iterator end $name' for 'iterator begin $name' at $start->[TOKEN_FILENAME]:$start->[TOKEN_LINE] but found 'iterator end $endtok->[TOKEN_TAG_NAME]'");
290 }
291 }
292 else {
293 push @errors, $self->_error($endtok, "Expected 'iterator end $name' for 'iterator begin $name' at $start->[TOKEN_FILENAME]:$start->[TOKEN_LINE] but found $endtok->[TOKEN_TYPE]");
294 $self->[TOK]->unget($endtok);
295 $endtok = $self->_dummy($endtok, "itend", "<:iterator end $name:>");
296 }
297 }
298 elsif ($septok->[TOKEN_TYPE] eq 'itend') {
299 $sep = $self->_empty($septok);
300 if ($septok->[TOKEN_TAG_NAME] ne $name) {
301 push @errors, $self->_error($septok, "Expected 'iterator end $name' for 'iterator begin $start->[TOKEN_TAG_NAME]' at $start->[TOKEN_FILENAME]:$start->[TOKEN_LINE] but found 'iterator end $septok->[TOKEN_TAG_NAME]'");
302 }
303 $endtok = $septok;
304 $septok = $self->_empty($endtok);
305 }
306 else {
307 push @errors, $self->_error($septok, "Expected 'iterator separator $name' or 'iterator end $name' for 'iterator begin $name' at $start->[TOKEN_FILENAME]:$start->[TOKEN_LINE] but found $septok->[TOKEN_TYPE]");
308 $self->[TOK]->unget($septok);
309 $sep = $self->_empty($septok);
310 $septok = $self->_empty($septok);
311 $endtok = $self->_dummy($septok, itend => "<:iterator end $name:>");
312 }
313 @{$start}[NODE_TYPE, NODE_ITERATOR_LOOP, NODE_ITERATOR_SEPARATOR, NODE_ITERATOR_SEPTOK, NODE_ITERATOR_ENDTOK] =
314 ( iterator => $loop, $sep, $septok, $endtok );
315 if (@errors) {
316 return $self->_comp($start, @errors);
317 }
318 else {
319 return $start;
320 }
321}
322
5b527c11 323sub _parse_withbegin {
58f0ca94
TC
324 my ($self, $start) = @_;
325
326 my $name = $start->[TOKEN_TAG_NAME];
327 my $loop = $self->_parse_content;
328 my $end = $self->[TOK]->get;
329 my @errors;
330 if ($end->[TOKEN_TYPE] eq 'withend') {
331 if ($end->[TOKEN_TAG_NAME] ne $name) {
332 push @errors, $self->_error($end, "Expected 'with end $name' for 'with begin $name' at $start->[TOKEN_FILENAME]:$start->[TOKEN_LINE] but found 'with end $end->[TOKEN_TAG_NAME]'");
333 }
334 }
335 else {
336 push @errors, $self->_error($end, "Expected 'with end $name' for 'with begin $name' at $start->[TOKEN_FILENAME]:$start->[TOKEN_LINE] but found $end->[TOKEN_TYPE]");
337 $self->[TOK]->unget($end);
338 $end = $self->_dummy($end, withend => "<:with end $start->[TOKEN_TAG_NAME]:>");
339 }
340 @{$start}[NODE_TYPE, NODE_WITH_CONTENT, NODE_WITH_END] = ( "with", $loop, $end );
341 if (@errors) {
342 return $self->_comp($start, @errors);
343 }
344 else {
345 return $start;
346 }
347}
348
f75af510
TC
349sub _parse_for {
350 my ($self, $for) = @_;
351
352 my $content = $self->_parse_content;
353 my $end = $self->[TOK]->get;
354 my $error;
355 if ($end->[TOKEN_TYPE] eq 'end') {
356 if ($end->[TOKEN_END_TYPE] && $end->[TOKEN_END_TYPE] ne 'for') {
357 $error = $self->_error($end, "Expected '.end' or '.end for' for .for started $for->[TOKEN_FILENAME]:$for->[TOKEN_LINE] but found '.end $end->[TOKEN_END_TYPE]'");
358 }
359 }
360 else {
361 $self->[TOK]->unget($end);
362 $error = $self->_error($end, "Expected '.end' for .for started $for->[TOKEN_FILENAME]:$for->[TOKEN_LINE] but found $end->[TOKEN_TYPE]");
363 $end = $self->_empty($end);
364 }
365 my $list_expr;
366 my $parser = Squirrel::Template::Expr::Parser->new;
46296d79 367 local $SIG{__DIE__};
f75af510
TC
368 unless (eval { $list_expr = $parser->parse($for->[TOKEN_FOR_EXPR]); 1 }) {
369 return $self->_error($for, "Could not parse list for .for: " . (ref $@ ? $@->[0] : $@));
370 }
371 @{$for}[NODE_FOR_EXPR, NODE_FOR_END, NODE_FOR_CONTENT] =
372 ( $list_expr, $end, $content );
373
374 if ($error) {
375 return $self->_comp($for, $error);
376 }
377 else {
378 return $for;
379 }
380}
381
58f0ca94
TC
382sub _parse_switch {
383 my ($self, $start) = @_;
384
385 my $ignored = $self->_parse_content;
386 my $error;
387 my @cases;
388 my $tok;
389 CASE:
390 while ($tok = $self->[TOK]->get) {
c11c1f71 391 if ($tok->[TOKEN_TYPE] eq 'case' || $tok->[TOKEN_TYPE] eq 'casenot') {
58f0ca94
TC
392 my $case = $self->_parse_content;
393 push @cases, [ $tok, $case ];
394 }
395 elsif ($tok->[TOKEN_TYPE] eq 'endswitch') {
396 last CASE;
397 }
398 else {
399 $self->[TOK]->unget($tok);
400 $error = $self->_error($tok, "Expected case or endswitch for switch starting $start->[TOKEN_FILENAME]:$start->[TOKEN_LINE] but found $tok->[TOKEN_TYPE]");
401 $tok = $self->_dummy($tok, endswitch => "<:endswitch:>");
402 last CASE;
403 }
404 }
405
406 @{$start}[NODE_SWITCH_CASES, NODE_SWITCH_END] = ( \@cases, $tok );
407
408 if ($error) {
409 return $self->_comp($start, $error);
410 }
411 else {
412 return $start;
413 }
414}
415
416sub _parse_wrap {
417 my ($self, $start) = @_;
418
419 my $content = $self->_parse_content;
420 my $end = $self->[TOK]->get;
c507244d 421
58f0ca94
TC
422 my $error;
423 if ($end->[TOKEN_TYPE] eq 'endwrap') {
424 # nothing to do
425 }
426 elsif ($end->[TOKEN_TYPE] eq 'eof') {
427 $self->[TOK]->unget($end);
428 }
429 else {
430 $self->[TOK]->unget($end);
431 $error = $self->_error($end, "Expected 'endwrap' or eof for wrap started $start->[TOKEN_FILENAME]:$start->[TOKEN_LINE] but found $end->[TOKEN_TYPE]");
432 }
433 $start->[NODE_WRAP_CONTENT] = $content;
434
435 if ($error) {
436 return $self->_comp($start, $error);
437 }
438 else {
439 return $start;
440 }
441}
442
8ca0c874
TC
443sub _parse_ext_wrap {
444 my ($self, $wrap) = @_;
445
446 my $content = $self->_parse_content;
447 my $end = $self->[TOK]->get;
448
75ecc5ce
TC
449 # put it back before we fail parsing wrap params
450 if ($end->[TOKEN_TYPE] eq 'eof') {
451 $self->[TOK]->unget($end);
452 }
453
454
8ca0c874
TC
455 # it's not really the filename (yet)
456 my $tokens = Squirrel::Template::Expr::Tokenizer->new($wrap->[NODE_WRAP_FILENAME]);
457
458 my @errors;
459 my $parser = Squirrel::Template::Expr::Parser->new;
460 my $name_expr;
461 unless (eval { $name_expr = $parser->parse_tokens($tokens); 1 }) {
462 return $self->_error($wrap, "Could not parse expression: ".$@->[1]);
463 }
464
465 my @result;
466 my $next = $tokens->get;
467 my @args;
468 if ($next->[0] eq 'op,') {
469 unless (eval {
470 while ($next->[0] eq 'op,') {
471 my $key;
472 my $value;
473 $key = $parser->parse_tokens($tokens);
474 my $colon = $tokens->get;
475 $colon->[0] eq 'op:'
476 or die [ error => "Expected : but found $colon->[0]" ];
477 $value = $parser->parse_tokens($tokens);
478 push @args, [ $key, $value ];
479 $next = $tokens->get;
480 }
481
482 if ($next->[0] ne 'eof') {
483 die [ error => "Expected , or eof but found $next->[0]" ];
484 }
485 1;
486 }) {
487 return $self->_error($wrap, ref $@ ? $@->[0] : $@);
488 }
489 }
490 elsif ($next->[0] ne 'eof') {
491 push @errors, $self->_error($wrap, "Expected , or end of expression but found $next->[0]");
492 }
493
494 if ($end->[TOKEN_TYPE] eq 'end') {
495 if ($end->[TOKEN_END_TYPE] && $end->[TOKEN_END_TYPE] ne 'wrap') {
496 push @errors, $self->_error($end, "Expected '.end' or '.end wrap' for .wrap started $wrap->[TOKEN_FILENAME]:$wrap->[TOKEN_LINE] but found '.end $end->[TOKEN_END_TYPE]'");
497 }
498 }
75ecc5ce 499 elsif ($end->[TOKEN_TYPE] ne 'eof') {
8ca0c874
TC
500 $self->[TOK]->unget($end);
501 push @errors, $self->_error($end, "Expected '.end', '.end wrap' or eof for .wrap started $wrap->[TOKEN_FILENAME]:$wrap->[TOKEN_LINE] but found $end->[TOKEN_TYPE]");
502 $end = $self->_dummy($end, end => "");
503 }
504 $wrap->[NODE_WRAP_CONTENT] = $content;
505 $wrap->[NODE_WRAP_FILENAME] = $name_expr;
506 $wrap->[NODE_WRAP_ARGS] = \@args;
507 $wrap->[NODE_WRAP_END] = $end;
508
509 if (@errors) {
510 return $self->_comp($wrap, @errors);
511 }
512 else {
513 return $wrap;
514 }
515}
516
c507244d
TC
517sub _parse_define {
518 my ($self, $define) = @_;
519
520 my $content = $self->_parse_content;
521 my $end = $self->[TOK]->get;
53c28223 522 my @errors;
c507244d
TC
523 if ($end->[TOKEN_TYPE] eq 'end') {
524 if ($end->[TOKEN_END_TYPE] && $end->[TOKEN_END_TYPE] ne 'define') {
53c28223 525 push @errors, $self->_error($end, "Expected '.end' or '.end define' for .define started $define->[TOKEN_FILENAME]:$define->[TOKEN_LINE] but found '.end $end->[TOKEN_END_TYPE]'");
c507244d
TC
526 }
527 }
528 else {
529 $self->[TOK]->unget($end);
53c28223 530 push @errors, $self->_error($end, "Expected '.end' for .define started $define->[TOKEN_FILENAME]:$define->[TOKEN_LINE] but found $end->[TOKEN_TYPE]");
c507244d
TC
531 $end = $self->_empty($end);
532 }
c507244d 533
53c28223
TC
534 my $text = $define->[NODE_DEFINE_NAME];
535 my $name;
536 if ($text =~ s(^([^;\s]+))()) {
537 $name = $1;
538 }
539 my $defaults;
540 my %seen_args;
541 if ($text =~ s/^\s*;\s*// && $text ne "") {
542 my $tokens = Squirrel::Template::Expr::Tokenizer->new($text);
543 my $parser = Squirrel::Template::Expr::Parser->new;
544 $defaults = $parser->parse_pairs($tokens);
545 $tokens->peektype eq 'eof'
546 or push @errors, $self->_error($end, "Defaults list for .define started $define->[TOKEN_FILENAME]:$define->[TOKEN_LINE] has extra junk");
547 }
548 $define->[NODE_DEFINE_NAME] = $name;
549
550 @{$define}[NODE_DEFINE_END, NODE_DEFINE_CONTENT, NODE_DEFINE_DEFAULTS] =
551 ( $end, $content, $defaults );
552
553 if (@errors) {
554 return $self->_comp($define, @errors);
c507244d
TC
555 }
556 else {
557 return $define;
558 }
559}
560
561sub _parse_call {
562 my ($self, $call) = @_;
563
564 my $tokens = Squirrel::Template::Expr::Tokenizer->new($call->[TOKEN_EXPR_EXPR]);
565
566 my $error;
567 my $parser = Squirrel::Template::Expr::Parser->new;
568 my $name_expr;
46296d79 569 local $SIG{__DIE__};
c507244d
TC
570 unless (eval { $name_expr = $parser->parse_tokens($tokens); 1 }) {
571 return $self->_error($call, "Could not parse expression: ".$@->[1]);
572 }
573
574 my @result;
575 my $next = $tokens->get;
53c28223 576 my $args = [];
c507244d
TC
577 if ($next->[0] eq 'op,') {
578 unless (eval {
53c28223 579 $args = $parser->parse_pairs($tokens);
c507244d 580
53c28223 581 if ($tokens->peektype ne 'eof') {
c507244d
TC
582 die [ error => "Expected , or eof but found $next->[0]" ];
583 }
584 1;
585 }) {
586 return $self->_error($call, ref $@ ? $@->[0] : $@);
587 }
588 }
589 elsif ($next->[0] ne 'eof') {
590 $error = $self->_error($call, "Expected , or end of expression but found $next->[0]");
591 }
592
53c28223 593 @{$call}[NODE_CALL_NAME, NODE_CALL_LIST] = ( $name_expr, $args );
c507244d
TC
594
595 return $error ? $self->_comp($call, $error) : $call;
596}
597
2421be86
TC
598sub _parse_ext_if {
599 my ($self, $if) = @_;
600
601 my @conds;
602 my @errors;
603 my $content = $self->_parse_content;
604 push @conds, [ $if, $content];
605 my $next = $self->[TOK]->get;
606 while ($next->[TOKEN_TYPE] eq 'ext_elsif') {
607 my $content = $self->_parse_content;
608 push @conds, [ $next, $content ];
609 $next = $self->[TOK]->get;
610 }
611 my $else;
612 my $else_content;
613 my $end;
614 if ($next->[TOKEN_TYPE] eq 'ext_else') {
615 $else = $next;
616 $else_content = $self->_parse_content;
617 $next = $self->[TOK]->get;
618 }
619 else {
620 $else = $else_content = $self->_empty($next);
621 }
622 if ($next->[TOKEN_TYPE] eq 'end') {
623 if ($next->[TOKEN_END_TYPE] ne "" && $next->[TOKEN_END_TYPE] ne 'if') {
624 push @errors, $self->_error($next, "Expected '.end' or '.end if' for .if started $if->[TOKEN_FILENAME]:$if->[TOKEN_LINE] but found '.end $next->[TOKEN_END_TYPE]'");
625 }
626 $end = $next;
627 }
628 else {
629 $self->[TOK]->unget($next);
be843d7f 630 $end = $self->_empty($next);
2421be86
TC
631 }
632
633 my $parser = Squirrel::Template::Expr::Parser->new;
634 for my $cond (@conds) {
46296d79 635 local $SIG{__DIE__};
2421be86
TC
636 unless (eval { $cond->[2] = $parser->parse($cond->[0][TOKEN_EXT_EXPR]); 1 }) {
637 $cond->[2] = [ const => "", "" ];
638 push @errors, $self->_error($cond->[0], ref $@ ? $@->[1] : $@);
639 }
640 }
641
642 @{$if}[NODE_EXTIF_CONDS, NODE_EXTIF_ELSE, NODE_EXTIF_END] =
643 ( \@conds, [ $else, $else_content ], $end );
644
645 return @errors ? $self->_comp($if, @errors) : $if;
646}
647
394018ef
TC
648sub _parse_ext_while {
649 my ($self, $while) = @_;
650
651 my @errors;
652 my $content = $self->_parse_content;
653 my $end = $self->[TOK]->get;
654 if ($end->[TOKEN_TYPE] eq 'end') {
655 if ($end->[TOKEN_END_TYPE] ne "" && $end->[TOKEN_END_TYPE] ne 'while') {
656 push @errors, $self->_error($end, "Expected '.end' or '.end while' for .while started $while->[TOKEN_FILENAME]:$while->[TOKEN_LINE] but found '.end $end->[TOKEN_END_TYPE]'");
657 }
658 }
659 else {
660 push @errors, $self->_error($end, "Expected '.end' for .while started $while->[TOKEN_FILENAME]:$while->[TOKEN_LINE] but found $end->[TOKEN_TYPE]");
661 $self->[TOK]->unget($end);
662 $end = $self->_empty($end);
663 }
664
665 my $parser = Squirrel::Template::Expr::Parser->new;
666 my $cond_expr;
46296d79 667 local $SIG{__DIE__};
394018ef
TC
668 unless (eval { $cond_expr = $parser->parse($while->[TOKEN_EXT_EXPR]); 1 }) {
669 return $self->_error($while, "Could not parse condition for .while: " . ref $@ ? $@->[0] : $@);
670 }
671
672 @{$while}[NODE_TYPE, NODE_WHILE_COND, NODE_WHILE_CONTENT, NODE_WHILE_END] =
673 ( "while", $cond_expr, $content, $end );
674
675 return @errors ? $self->_comp($while, @errors) : $while;
676}
677
5dde4b09
TC
678sub _parse_iterateover {
679 my ($self, $token) = @_;
680
681 my $content = $self->_parse_content;
682 my $end = $self->[TOK]->get;
683 my $error;
684 if ($end->[TOKEN_TYPE] eq 'end') {
685 if ($end->[TOKEN_END_TYPE] && $end->[TOKEN_END_TYPE] ne 'iterateover') {
686 $error = $self->_error($end, "Expected '.end' or '.end iterateover' for .iterateover started $token->[TOKEN_FILENAME]:$token->[TOKEN_LINE] but found '.end $end->[TOKEN_END_TYPE]'");
687 }
688 }
689 else {
690 $self->[TOK]->unget($end);
691 $error = $self->_error($end, "Expected '.end' for .iterateover started $token->[TOKEN_FILENAME]:$token->[TOKEN_LINE] but found $end->[TOKEN_TYPE]");
692 $end = $self->_empty($end);
693 }
694
695 my @exprs;
696 {
697 my $error;
698 @exprs = $self->_parse_expr_list($token, $token->[TOKEN_ITERATEOVER_EXPR], \$error)
699 or return $error;
700 }
701
702 my $callto = shift @exprs;
703 @{$token}[NODE_ITERATEOVER_CALL, NODE_ITERATEOVER_CONTENT, NODE_ITERATEOVER_ARGS] = ( $callto, $content, \@exprs );
704
705 return $error ? $self->_comp($token, $error) : $token;
706}
707
708sub _parse_expr_list {
709 my ($self, $token, $text, $rerror) = @_;
710
711 my $tokens = Squirrel::Template::Expr::Tokenizer->new($text);
712 my $parser = Squirrel::Template::Expr::Parser->new;
713 my @result;
714 my $expr;
46296d79 715 local $SIG{__DIE__};
5dde4b09
TC
716 unless (eval { $expr = $parser->parse_tokens($tokens); 1 }) {
717 $$rerror = $self->_error($token, "Could not parse expression list: ".$@->[1]);
718 return;
719 }
720 push @result, $expr;
721 my $next = $tokens->get;
722 while ($next->[0] eq 'op,') {
723 unless (eval { $expr = $parser->parse_tokens($tokens); 1 }) {
724 $$rerror = $self->_error($token, "Could not parse expression list: ".$@->[1]);
725 return;
726 }
727 push @result, $expr;
728 $next = $tokens->get;
729 }
730 if ($next->[0] ne 'eof') {
731 $$rerror = $self->_error($token, "Expected , or end of expression list but found $next->[0]");
732 return;
733 }
734
735 return @result;
736}
737
58f0ca94
TC
738sub _parse_error {
739 my ($self, $error) = @_;
740
741 push @{$self->[ERRORS]}, $error;
742
743 return $error;
744}
745
5b527c11
TC
746sub _parse_comment {
747 my ($self, $comment) = @_;
748
749 return;
750}
751
58f0ca94
TC
752sub errors {
753 my ($self) = @_;
754
755 return @{$self->[ERRORS]};
756}
757
7581;
759
760=head1 NAME
761
762Squirrel::Template::Parser - parse a stream of tokens from a template
763
764=head1 SYNOPSIS
765
766 use Squirrel::Template;
767 my $t = Squirrel::Template::Tokenizer->new($text, $filename, $templater);
768 my $p = Squirrel::Template::Parser->new($t, $templater);
769
770 my $parse_tree = $p->parse;
771
772 my @errors = $p->errors;
773
774=head1 DESCRIPTION
775
776Process the stream of tokens from a L<Squirrel::Template::Tokenizer>
777object into a parse tree.
778
779=head1 METHODS
780
781=over
782
783=item new($tokenizer, $templater)
784
785Create a new parser.
786
787=item parse()
788
789Parse the stream of tokens and return a parse tree.
790
791=item errors()
792
793Returns any errors encountered parsing the tree as error tokens.
794
795=back
796
797=cut
798