.wrap now allows barewords for parameter names
[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.021";
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   # it's not really the filename (yet)
455   my $tokens = Squirrel::Template::Expr::Tokenizer->new($wrap->[NODE_WRAP_FILENAME]);
456
457   my @errors;
458   my $parser = Squirrel::Template::Expr::Parser->new;
459   my $name_expr;
460   unless (eval { $name_expr = $parser->parse_tokens($tokens); 1 }) {
461     return $self->_error($wrap, "Could not parse expression: ".$@->[1]);
462   }
463
464   my @result;
465   my $next = $tokens->get;
466   my $args = [];
467   if ($next->[0] eq 'op,') {
468     unless (eval {
469       $args = $parser->parse_pairs($tokens);
470
471       if ($tokens->peektype ne 'eof') {
472         die [ error => "Expected , or eof but found $next->[0]" ];
473       }
474       1;
475     }) {
476       return $self->_error($wrap, ref $@ ? $@->[0] : $@);
477     }
478   }
479   elsif ($next->[0] ne 'eof') {
480     push @errors, $self->_error($wrap, "Expected , or end of expression but found $next->[0]");
481   }
482
483   if ($end->[TOKEN_TYPE] eq 'end') {
484     if ($end->[TOKEN_END_TYPE] && $end->[TOKEN_END_TYPE] ne 'wrap') {
485       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]'");
486     }
487   }
488   elsif ($end->[TOKEN_TYPE] ne 'eof') {
489     $self->[TOK]->unget($end);
490     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]");
491     $end = $self->_dummy($end, end => "");
492   }
493   $wrap->[NODE_WRAP_CONTENT] = $content;
494   $wrap->[NODE_WRAP_FILENAME] = $name_expr;
495   $wrap->[NODE_WRAP_ARGS] = $args;
496   $wrap->[NODE_WRAP_END] = $end;
497
498   if (@errors) {
499     return $self->_comp($wrap, @errors);
500   }
501   else {
502     return $wrap;
503   }
504 }
505
506 sub _parse_define {
507   my ($self, $define) = @_;
508
509   my $content = $self->_parse_content;
510   my $end = $self->[TOK]->get;
511   my @errors;
512   if ($end->[TOKEN_TYPE] eq 'end') {
513     if ($end->[TOKEN_END_TYPE] && $end->[TOKEN_END_TYPE] ne 'define') {
514       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]'");
515     }
516   }
517   else {
518     $self->[TOK]->unget($end);
519     push @errors, $self->_error($end, "Expected '.end' for .define started $define->[TOKEN_FILENAME]:$define->[TOKEN_LINE] but found $end->[TOKEN_TYPE]");
520     $end = $self->_empty($end);
521   }
522
523   my $text = $define->[NODE_DEFINE_NAME];
524   my $name;
525   if ($text =~ s(^([^;\s]+))()) {
526     $name = $1;
527   }
528   my $defaults;
529   my %seen_args;
530   if ($text =~ s/^\s*;\s*// && $text ne "") {
531     my $tokens = Squirrel::Template::Expr::Tokenizer->new($text);
532     my $parser = Squirrel::Template::Expr::Parser->new;
533     $defaults = $parser->parse_pairs($tokens);
534     $tokens->peektype eq 'eof'
535       or push @errors, $self->_error($end, "Defaults list for .define started $define->[TOKEN_FILENAME]:$define->[TOKEN_LINE] has extra junk");
536   }
537   $define->[NODE_DEFINE_NAME] = $name;
538
539   @{$define}[NODE_DEFINE_END, NODE_DEFINE_CONTENT, NODE_DEFINE_DEFAULTS] =
540     ( $end, $content, $defaults );
541
542   if (@errors) {
543     return $self->_comp($define, @errors);
544   }
545   else {
546     return $define;
547   }
548 }
549
550 sub _parse_call {
551   my ($self, $call) = @_;
552
553   my $tokens = Squirrel::Template::Expr::Tokenizer->new($call->[TOKEN_EXPR_EXPR]);
554
555   my $error;
556   my $parser = Squirrel::Template::Expr::Parser->new;
557   my $name_expr;
558   local $SIG{__DIE__};
559   unless (eval { $name_expr = $parser->parse_tokens($tokens); 1 }) {
560     return $self->_error($call, "Could not parse expression: ".$@->[1]);
561   }
562
563   my @result;
564   my $next = $tokens->get;
565   my $args = [];
566   if ($next->[0] eq 'op,') {
567     unless (eval {
568       $args = $parser->parse_pairs($tokens);
569
570       if ($tokens->peektype ne 'eof') {
571         die [ error => "Expected , or eof but found $next->[0]" ];
572       }
573       1;
574     }) {
575       return $self->_error($call, ref $@ ? $@->[0] : $@);
576     }
577   }
578   elsif ($next->[0] ne 'eof') {
579     $error = $self->_error($call, "Expected , or end of expression but found $next->[0]");
580   }
581
582   @{$call}[NODE_CALL_NAME, NODE_CALL_LIST] = ( $name_expr, $args );
583
584   return $error ? $self->_comp($call, $error) : $call;
585 }
586
587 sub _parse_ext_if {
588   my ($self, $if) = @_;
589
590   my @conds;
591   my @errors;
592   my $content = $self->_parse_content;
593   push @conds, [ $if, $content];
594   my $next = $self->[TOK]->get;
595   while ($next->[TOKEN_TYPE] eq 'ext_elsif') {
596     my $content = $self->_parse_content;
597     push @conds, [ $next, $content ];
598     $next = $self->[TOK]->get;
599   }
600   my $else;
601   my $else_content;
602   my $end;
603   if ($next->[TOKEN_TYPE] eq 'ext_else') {
604     $else = $next;
605     $else_content = $self->_parse_content;
606     $next = $self->[TOK]->get;
607   }
608   else {
609     $else = $else_content = $self->_empty($next);
610   }
611   if ($next->[TOKEN_TYPE] eq 'end') {
612     if ($next->[TOKEN_END_TYPE] ne "" && $next->[TOKEN_END_TYPE] ne 'if') {
613       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]'");
614     }
615     $end = $next;
616   }
617   else {
618     $self->[TOK]->unget($next);
619     $end = $self->_empty($next);
620   }
621
622   my $parser = Squirrel::Template::Expr::Parser->new;
623   for my $cond (@conds) {
624     local $SIG{__DIE__};
625     unless (eval { $cond->[2] = $parser->parse($cond->[0][TOKEN_EXT_EXPR]); 1 }) {
626       $cond->[2] = [ const => "", "" ];
627       push @errors, $self->_error($cond->[0], ref $@ ? $@->[1] : $@);
628     }
629   }
630
631   @{$if}[NODE_EXTIF_CONDS, NODE_EXTIF_ELSE, NODE_EXTIF_END] =
632     ( \@conds, [ $else, $else_content ], $end );
633
634   return @errors ? $self->_comp($if, @errors) : $if;
635 }
636
637 sub _parse_ext_while {
638   my ($self, $while) = @_;
639
640   my @errors;
641   my $content = $self->_parse_content;
642   my $end = $self->[TOK]->get;
643   if ($end->[TOKEN_TYPE] eq 'end') {
644     if ($end->[TOKEN_END_TYPE] ne "" && $end->[TOKEN_END_TYPE] ne 'while') {
645       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]'");
646     }
647   }
648   else {
649     push @errors, $self->_error($end, "Expected '.end' for .while started $while->[TOKEN_FILENAME]:$while->[TOKEN_LINE] but found $end->[TOKEN_TYPE]");
650     $self->[TOK]->unget($end);
651     $end = $self->_empty($end);
652   }
653
654   my $parser = Squirrel::Template::Expr::Parser->new;
655   my $cond_expr;
656   local $SIG{__DIE__};
657   unless (eval { $cond_expr = $parser->parse($while->[TOKEN_EXT_EXPR]); 1 }) {
658     return $self->_error($while, "Could not parse condition for .while: " . ref $@ ? $@->[0] : $@);
659   }
660
661   @{$while}[NODE_TYPE, NODE_WHILE_COND, NODE_WHILE_CONTENT, NODE_WHILE_END] =
662     ( "while", $cond_expr, $content, $end );
663
664   return @errors ? $self->_comp($while, @errors) : $while;
665 }
666
667 sub _parse_iterateover {
668   my ($self, $token) = @_;
669
670   my $content = $self->_parse_content;
671   my $end = $self->[TOK]->get;
672   my $error;
673   if ($end->[TOKEN_TYPE] eq 'end') {
674     if ($end->[TOKEN_END_TYPE] && $end->[TOKEN_END_TYPE] ne 'iterateover') {
675       $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]'");
676     }
677   }
678   else {
679     $self->[TOK]->unget($end);
680     $error = $self->_error($end, "Expected '.end' for .iterateover started $token->[TOKEN_FILENAME]:$token->[TOKEN_LINE] but found $end->[TOKEN_TYPE]");
681     $end = $self->_empty($end);
682   }
683
684   my @exprs;
685   {
686     my $error;
687     @exprs = $self->_parse_expr_list($token, $token->[TOKEN_ITERATEOVER_EXPR], \$error)
688       or return $error;
689   }
690
691   my $callto = shift @exprs;
692   @{$token}[NODE_ITERATEOVER_CALL, NODE_ITERATEOVER_CONTENT, NODE_ITERATEOVER_ARGS] = ( $callto, $content, \@exprs );
693
694   return $error ? $self->_comp($token, $error) : $token;
695 }
696
697 sub _parse_expr_list {
698   my ($self, $token, $text, $rerror) = @_;
699
700   my $tokens = Squirrel::Template::Expr::Tokenizer->new($text);
701   my $parser = Squirrel::Template::Expr::Parser->new;
702   my @result;
703   my $expr;
704   local $SIG{__DIE__};
705   unless (eval { $expr = $parser->parse_tokens($tokens); 1 }) {
706     $$rerror = $self->_error($token, "Could not parse expression list: ".$@->[1]);
707     return;
708   }
709   push @result, $expr;
710   my $next = $tokens->get;
711   while ($next->[0] eq 'op,') {
712     unless (eval { $expr = $parser->parse_tokens($tokens); 1 }) {
713       $$rerror = $self->_error($token, "Could not parse expression list: ".$@->[1]);
714       return;
715     }
716     push @result, $expr;
717     $next = $tokens->get;
718   }
719   if ($next->[0] ne 'eof') {
720     $$rerror = $self->_error($token, "Expected , or end of expression list but found $next->[0]");
721     return;
722   }
723
724   return @result;
725 }
726
727 sub _parse_error {
728   my ($self, $error) = @_;
729
730   push @{$self->[ERRORS]}, $error;
731
732   return $error;
733 }
734
735 sub _parse_comment {
736   my ($self, $comment) = @_;
737
738   return;
739 }
740
741 sub errors {
742   my ($self) = @_;
743
744   return @{$self->[ERRORS]};
745 }
746
747 1;
748
749 =head1 NAME
750
751 Squirrel::Template::Parser - parse a stream of tokens from a template
752
753 =head1 SYNOPSIS
754
755   use Squirrel::Template;
756   my $t = Squirrel::Template::Tokenizer->new($text, $filename, $templater);
757   my $p = Squirrel::Template::Parser->new($t, $templater);
758
759   my $parse_tree = $p->parse;
760
761   my @errors = $p->errors;
762
763 =head1 DESCRIPTION
764
765 Process the stream of tokens from a L<Squirrel::Template::Tokenizer>
766 object into a parse tree.
767
768 =head1 METHODS
769
770 =over
771
772 =item new($tokenizer, $templater)
773
774 Create a new parser.
775
776 =item parse()
777
778 Parse the stream of tokens and return a parse tree.
779
780 =item errors()
781
782 Returns any errors encountered parsing the tree as error tokens.
783
784 =back
785
786 =cut
787