avoid an internal error in .wrap if the arguments can't be evalled
[bse.git] / site / cgi-bin / modules / Squirrel / Template / Parser.pm
1 package Squirrel::Template::Parser;
2 use strict;
3 use Squirrel::Template::Constants qw(:token :node);
4
5 our $VERSION = "1.020";
6
7 use constant TOK => 0;
8 use constant TMPLT => 1;
9 use constant ERRORS => 2;
10
11 use constant TRACE => 0;
12
13 sub new {
14   my ($class, $tokenizer, $templater) = @_;
15
16   return bless [ $tokenizer, $templater, [] ], $class;
17 }
18
19 sub 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
41 sub _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     }
53     else {
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       }
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
76 sub _empty {
77   my ($self, $tok) = @_;
78
79   return [ empty => "", $tok->[TOKEN_LINE], $tok->[TOKEN_FILENAME] ];
80 }
81
82 sub _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
95 sub _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
104 sub _dummy {
105   my ($self, $base, $type, $orig) = @_;
106
107   return [ $type => $orig, $base->[TOKEN_LINE], $base->[TOKEN_FILENAME] ];
108 }
109
110 sub _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
127 sub _parse_expr {
128   my ($self, $expr) = @_;
129
130   my $parser = Squirrel::Template::Expr::Parser->new;
131   my $parsed;
132   local $SIG{__DIE__};
133   if (eval { $parsed = $parser->parse($expr->[TOKEN_EXPR_EXPR]); 1 }) {
134     $expr->[NODE_EXPR_EXPR] = $parsed;
135     $expr->[NODE_EXPR_FORMAT] ||= $self->[TMPLT]{def_format};
136     return $expr;
137   }
138   elsif (ref $@) {
139     return $self->_error($expr, $@->[1]);
140   }
141   else {
142     return $self->_error($expr, $@);
143   }
144 }
145
146 sub _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;
153   local $SIG{__DIE__};
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
176 sub _parse_set {
177   my ($self, $set) = @_;
178
179   my $parser = Squirrel::Template::Expr::Parser->new;
180   my $parsed;
181   local $SIG{__DIE__};
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
195 sub _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
245 sub _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
272 sub _parse_itbegin {
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
323 sub _parse_withbegin {
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
349 sub _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;
367   local $SIG{__DIE__};
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
382 sub _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) {
391     if ($tok->[TOKEN_TYPE] eq 'case' || $tok->[TOKEN_TYPE] eq 'casenot') {
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
416 sub _parse_wrap {
417   my ($self, $start) = @_;
418
419   my $content = $self->_parse_content;
420   my $end = $self->[TOK]->get;
421
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
443 sub _parse_ext_wrap {
444   my ($self, $wrap) = @_;
445
446   my $content = $self->_parse_content;
447   my $end = $self->[TOK]->get;
448
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
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   }
499   elsif ($end->[TOKEN_TYPE] ne 'eof') {
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
517 sub _parse_define {
518   my ($self, $define) = @_;
519
520   my $content = $self->_parse_content;
521   my $end = $self->[TOK]->get;
522   my @errors;
523   if ($end->[TOKEN_TYPE] eq 'end') {
524     if ($end->[TOKEN_END_TYPE] && $end->[TOKEN_END_TYPE] ne 'define') {
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]'");
526     }
527   }
528   else {
529     $self->[TOK]->unget($end);
530     push @errors, $self->_error($end, "Expected '.end' for .define started $define->[TOKEN_FILENAME]:$define->[TOKEN_LINE] but found $end->[TOKEN_TYPE]");
531     $end = $self->_empty($end);
532   }
533
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);
555   }
556   else {
557     return $define;
558   }
559 }
560
561 sub _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;
569   local $SIG{__DIE__};
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;
576   my $args = [];
577   if ($next->[0] eq 'op,') {
578     unless (eval {
579       $args = $parser->parse_pairs($tokens);
580
581       if ($tokens->peektype ne 'eof') {
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
593   @{$call}[NODE_CALL_NAME, NODE_CALL_LIST] = ( $name_expr, $args );
594
595   return $error ? $self->_comp($call, $error) : $call;
596 }
597
598 sub _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);
630     $end = $self->_empty($next);
631   }
632
633   my $parser = Squirrel::Template::Expr::Parser->new;
634   for my $cond (@conds) {
635     local $SIG{__DIE__};
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
648 sub _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;
667   local $SIG{__DIE__};
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
678 sub _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
708 sub _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;
715   local $SIG{__DIE__};
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
738 sub _parse_error {
739   my ($self, $error) = @_;
740
741   push @{$self->[ERRORS]}, $error;
742
743   return $error;
744 }
745
746 sub _parse_comment {
747   my ($self, $comment) = @_;
748
749   return;
750 }
751
752 sub errors {
753   my ($self) = @_;
754
755   return @{$self->[ERRORS]};
756 }
757
758 1;
759
760 =head1 NAME
761
762 Squirrel::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
776 Process the stream of tokens from a L<Squirrel::Template::Tokenizer>
777 object into a parse tree.
778
779 =head1 METHODS
780
781 =over
782
783 =item new($tokenizer, $templater)
784
785 Create a new parser.
786
787 =item parse()
788
789 Parse the stream of tokens and return a parse tree.
790
791 =item errors()
792
793 Returns any errors encountered parsing the tree as error tokens.
794
795 =back
796
797 =cut
798