.wrap now allows barewords for parameter names
[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
d0f4820b 5our $VERSION = "1.021";
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
8ca0c874
TC
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;
d0f4820b 466 my $args = [];
8ca0c874
TC
467 if ($next->[0] eq 'op,') {
468 unless (eval {
d0f4820b 469 $args = $parser->parse_pairs($tokens);
8ca0c874 470
d0f4820b 471 if ($tokens->peektype ne 'eof') {
8ca0c874
TC
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 }
75ecc5ce 488 elsif ($end->[TOKEN_TYPE] ne 'eof') {
8ca0c874
TC
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;
d0f4820b 495 $wrap->[NODE_WRAP_ARGS] = $args;
8ca0c874
TC
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
c507244d
TC
506sub _parse_define {
507 my ($self, $define) = @_;
508
509 my $content = $self->_parse_content;
510 my $end = $self->[TOK]->get;
53c28223 511 my @errors;
c507244d
TC
512 if ($end->[TOKEN_TYPE] eq 'end') {
513 if ($end->[TOKEN_END_TYPE] && $end->[TOKEN_END_TYPE] ne 'define') {
53c28223 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]'");
c507244d
TC
515 }
516 }
517 else {
518 $self->[TOK]->unget($end);
53c28223 519 push @errors, $self->_error($end, "Expected '.end' for .define started $define->[TOKEN_FILENAME]:$define->[TOKEN_LINE] but found $end->[TOKEN_TYPE]");
c507244d
TC
520 $end = $self->_empty($end);
521 }
c507244d 522
53c28223
TC
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);
c507244d
TC
544 }
545 else {
546 return $define;
547 }
548}
549
550sub _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;
46296d79 558 local $SIG{__DIE__};
c507244d
TC
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;
53c28223 565 my $args = [];
c507244d
TC
566 if ($next->[0] eq 'op,') {
567 unless (eval {
53c28223 568 $args = $parser->parse_pairs($tokens);
c507244d 569
53c28223 570 if ($tokens->peektype ne 'eof') {
c507244d
TC
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
53c28223 582 @{$call}[NODE_CALL_NAME, NODE_CALL_LIST] = ( $name_expr, $args );
c507244d
TC
583
584 return $error ? $self->_comp($call, $error) : $call;
585}
586
2421be86
TC
587sub _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);
be843d7f 619 $end = $self->_empty($next);
2421be86
TC
620 }
621
622 my $parser = Squirrel::Template::Expr::Parser->new;
623 for my $cond (@conds) {
46296d79 624 local $SIG{__DIE__};
2421be86
TC
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
394018ef
TC
637sub _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;
46296d79 656 local $SIG{__DIE__};
394018ef
TC
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
5dde4b09
TC
667sub _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
697sub _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;
46296d79 704 local $SIG{__DIE__};
5dde4b09
TC
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
58f0ca94
TC
727sub _parse_error {
728 my ($self, $error) = @_;
729
730 push @{$self->[ERRORS]}, $error;
731
732 return $error;
733}
734
5b527c11
TC
735sub _parse_comment {
736 my ($self, $comment) = @_;
737
738 return;
739}
740
58f0ca94
TC
741sub errors {
742 my ($self) = @_;
743
744 return @{$self->[ERRORS]};
745}
746
7471;
748
749=head1 NAME
750
751Squirrel::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
765Process the stream of tokens from a L<Squirrel::Template::Tokenizer>
766object into a parse tree.
767
768=head1 METHODS
769
770=over
771
772=item new($tokenizer, $templater)
773
774Create a new parser.
775
776=item parse()
777
778Parse the stream of tokens and return a parse tree.
779
780=item errors()
781
782Returns any errors encountered parsing the tree as error tokens.
783
784=back
785
786=cut
787