fixed word-wrapping for audit-log emails
[bse.git] / site / cgi-bin / modules / Squirrel / Template / Expr.pm
CommitLineData
4697e5c3
TC
1package Squirrel::Template::Expr;
2use strict;
3
53c28223 4our $VERSION = "1.013";
ac507437
TC
5
6package Squirrel::Template::Expr::Eval;
7use Scalar::Util ();
f17f9f79
TC
8use Squirrel::Template::Expr::WrapScalar;
9use Squirrel::Template::Expr::WrapHash;
10use Squirrel::Template::Expr::WrapArray;
11use Squirrel::Template::Expr::WrapCode;
12use Squirrel::Template::Expr::WrapClass;
13
ac507437 14use constant TMPL => 0;
a96f9b25 15use constant ACTS => 1;
ac507437
TC
16
17sub new {
a96f9b25 18 my ($class, $templater, $acts) = @_;
ac507437 19
a96f9b25 20 return bless [ $templater, $acts ], $class;
ac507437
TC
21}
22
23sub _wrapped {
24 my ($self, $val) = @_;
25
26 if (ref($val)) {
27 if (Scalar::Util::blessed($val)) {
28 return $val;
29 }
30 else {
31 my $type = Scalar::Util::reftype($val);
32 if ($type eq "ARRAY") {
a96f9b25 33 return Squirrel::Template::Expr::WrapArray->new($val, $self->[TMPL]);
ac507437
TC
34 }
35 elsif ($type eq "HASH") {
a96f9b25 36 return Squirrel::Template::Expr::WrapHash->new($val, $self->[TMPL]);
ac507437
TC
37 }
38 elsif ($type eq "CODE") {
a96f9b25 39 return Squirrel::Template::Expr::WrapCode->new($val, $self->[TMPL]);
ac507437
TC
40 }
41 }
42 }
43 else {
a96f9b25 44 return Squirrel::Template::Expr::WrapScalar->new($val, $self->[TMPL], $self->[ACTS]);
ac507437
TC
45 }
46}
47
48sub _process_var {
49 return $_[0][TMPL]->get_var($_[1][1]);
50}
51
52sub _process_add {
53 return $_[0]->process($_[1][1]) + $_[0]->process($_[1][2]);
54}
55
56sub _process_subtract {
57 return $_[0]->process($_[1][1]) - $_[0]->process($_[1][2]);
58}
59
60sub _process_mult {
61 return $_[0]->process($_[1][1]) * $_[0]->process($_[1][2]);
62}
63
64sub _process_fdiv {
65 return $_[0]->process($_[1][1]) / $_[0]->process($_[1][2]);
66}
67
68sub _process_div {
69 return int($_[0]->process($_[1][1]) / $_[0]->process($_[1][2]));
70}
71
72sub _process_mod {
73 return $_[0]->process($_[1][1]) % $_[0]->process($_[1][2]);
74}
75
76# string relops
77sub _process_eq {
78 return $_[0]->process($_[1][1]) eq $_[0]->process($_[1][2]);
79}
80
81sub _process_ne {
82 return $_[0]->process($_[1][1]) ne $_[0]->process($_[1][2]);
83}
84
85sub _process_gt {
86 return $_[0]->process($_[1][1]) gt $_[0]->process($_[1][2]);
87}
88
89sub _process_lt {
90 return $_[0]->process($_[1][1]) lt $_[0]->process($_[1][2]);
91}
92
93sub _process_ge {
94 return $_[0]->process($_[1][1]) ge $_[0]->process($_[1][2]);
95}
96
97sub _process_le {
98 return $_[0]->process($_[1][1]) le $_[0]->process($_[1][2]);
99}
100
101# number relops
102sub _process_neq {
103 return $_[0]->process($_[1][1]) == $_[0]->process($_[1][2]);
104}
105
106sub _process_nne {
107 return $_[0]->process($_[1][1]) != $_[0]->process($_[1][2]);
108}
109
110sub _process_ngt {
111 return $_[0]->process($_[1][1]) > $_[0]->process($_[1][2]);
112}
113
114sub _process_nlt {
115 return $_[0]->process($_[1][1]) < $_[0]->process($_[1][2]);
116}
117
118sub _process_nge {
119 return $_[0]->process($_[1][1]) >= $_[0]->process($_[1][2]);
120}
121
122sub _process_nle {
123 return $_[0]->process($_[1][1]) <= $_[0]->process($_[1][2]);
124}
125
126sub _process_match {
127 return $_[0]->process($_[1][1]) =~ $_[0]->process($_[1][2]);
128}
129
130sub _process_notmatch {
131 return $_[0]->process($_[1][1]) !~ $_[0]->process($_[1][2]);
132}
133
134sub _process_cond {
135 return $_[0]->process($_[1][1]) ? $_[0]->process($_[1][2]) : $_[0]->process($_[1][3]);
136}
137
138sub _process_uminus {
139 return - ($_[0]->process($_[1][1]));
140}
141
142sub _process_concat {
143 return $_[0]->process($_[1][1]) . $_[0]->process($_[1][2]);
144}
145
146sub _process_const {
147 return $_[1][1];
148}
149
dd94dd8e
TC
150sub _do_call {
151 my ($self, $val, $args, $method, $ctx) = @_;
b12ea476 152
b12ea476
TC
153 if (Scalar::Util::blessed($val)
154 && !$val->isa("Squirrel::Template::Expr::WrapBase")) {
ac507437
TC
155 $val->can($method)
156 or die [ error => "No such method $method" ];
157 if ($val->can("restricted_method")) {
158 $val->restricted_method($method)
159 and die [ error => "method $method is restricted" ];
160 }
161 return $ctx && $ctx eq 'LIST' ? $val->$method(@$args)
162 : scalar($val->$method(@$args));
163 }
164 else {
165 my $wrapped = $self->_wrapped($val);
166 return $wrapped->call($method, $args, $ctx);
167 }
168}
169
dd94dd8e
TC
170sub _process_call {
171 my ($self, $node, $ctx) = @_;
172
173 $ctx ||= "";
174
175 my $val = $self->process($node->[2]);
176 my $args = $self->process_list($node->[3]);
177 my $method = $node->[1];
178
179 return $self->_do_call($val, $args, $method, $ctx);
180}
181
182sub _process_callvar {
183 my ($self, $node, $ctx) = @_;
184
185 $ctx ||= "";
186
187 my $val = $self->process($node->[2]);
188 my $args = $self->process_list($node->[3]);
189 my $method = $self->[TMPL]->get_var($node->[1]);
190
191 return $self->_do_call($val, $args, $method, $ctx);
192}
193
194sub _process_funccall {
195 my ($self, $node, $ctx) = @_;
196
197 $ctx ||= "";
198 my $code = $self->process($node->[1]);
199 my $args = $self->process_list($node->[2]);
200
201 if (Scalar::Util::reftype($code) eq "CODE") {
202 return $ctx eq "LIST" ? $code->(@$args) : scalar($code->(@$args));
203 }
204 else {
205 die [ error => "can't call non code as a function" ];
206 }
207}
208
ac507437
TC
209sub _process_list {
210 my ($self, $node) = @_;
211
212 return $self->process_list($node->[1], 'LIST');
213}
214
215sub _process_range {
216 my ($self, $node, $ctx) = @_;
217
218 my $start = $self->process($node->[1]);
219 my $end = $self->process($node->[2]);
220
221 return $ctx eq 'LIST' ? ( $start .. $end ) : [ $start .. $end ];
222}
223
f17f9f79
TC
224sub _process_hash {
225 my ($self, $node) = @_;
226
227 my %result;
228 for my $pair (@{$node->[1]}) {
229 my $key = $self->process($pair->[0]);
230 my $value = $self->process($pair->[1]);
231 $result{$key} = $value;
232 }
233
234 return \%result;
235}
236
ac507437
TC
237sub _process_subscript {
238 my ($self, $node) = @_;
239
240 my $list = $self->process($node->[1]);
241 my $index = $self->process($node->[2]);
242 Scalar::Util::blessed($list)
243 and die [ error => "Cannot subscript an object" ];
244 my $type = Scalar::Util::reftype($list);
245 if ($type eq "HASH") {
246 return $list->{$index};
247 }
248 elsif ($type eq "ARRAY") {
249 return $list->[$index];
250 }
251 else {
252 die [ error => "Cannot subscript a $type" ];
253 }
254}
255
256sub _process_not {
257 return !$_[0]->process($_[1][1]);
258}
259
260sub _process_or {
261 return $_[0]->process($_[1][1]) || $_[0]->process($_[1][2]);
262}
263
264sub _process_and {
265 return $_[0]->process($_[1][1]) && $_[0]->process($_[1][2]);
266}
267
268sub process {
269 my ($self, $node, $ctx) = @_;
270
271 my $method = "_process_$node->[0]";
272 $self->can($method) or die "No handler for $node->[0]";
273 return $self->$method($node, $ctx);
274}
275
276sub process_list {
277 my ($self, $list) = @_;
278
279 return [ map $self->process($_, 'LIST'), @$list ];
280}
4697e5c3
TC
281
282package Squirrel::Template::Expr::Parser;
283
284sub new {
285 my ($class) = @_;
286
287 return bless {}, $class;
288}
289
290sub parse {
291 my ($self, $text) = @_;
292
293 my $tokenizer = Squirrel::Template::Expr::Tokenizer->new($text);
c507244d
TC
294 my $result = $self->_parse_expr($tokenizer);
295
296 my $last = $tokenizer->get;
297 unless ($last->[0] eq 'eof') {
298 die [ error => "Expected eof but found $last->[0]" ];
299 }
300
301 return $result;
4697e5c3
TC
302}
303
231cecfb
TC
304sub parse_tokens {
305 my ($self, $tokenizer) = @_;
306
307 return $self->_parse_expr($tokenizer);
308}
309
4697e5c3
TC
310sub _parse_expr {
311 my ($self, $tok) = @_;
312
ac507437 313 return $self->_parse_cond($tok);
4697e5c3
TC
314}
315
316my %ops =
317 (
ac507437
TC
318 "op+" => "add",
319 "op-" => "subtract",
320 "op*" => "mult",
321 "op/" => "fdiv",
4697e5c3
TC
322 "div" => "div",
323 "mod" => "mod",
324 "op_" => "concat",
ac507437
TC
325
326 "opeq" => "eq",
327 "opne" => "ne",
328 "oplt" => "lt",
329 "opgt" => "gt",
330 "ople" => "le",
331 "opge" => "ge",
332
333 "op==" => "neq",
334 "op!=" => "nne",
335 "op<" => "nlt",
336 "op>" => "ngt",
337 "op<=" => "nle",
338 "op>=" => "nge",
339 'op=~' => "match",
340 'op!~' => "notmatch",
4697e5c3
TC
341 );
342
ac507437
TC
343sub _parse_cond {
344 my ($self, $tok) = @_;
345
346 my $result = $self->_parse_or($tok);
347 if ($tok->peektype eq 'op?') {
348 $tok->get;
349 my $true = $self->_parse_or($tok);
350 my $colon = $tok->get;
351 $colon->[0] eq 'op:'
46296d79 352 or die [ error => "Expected : for ? : operator but found $colon->[0]" ];
4742ac21 353 my $false = $self->_parse_cond($tok);
ac507437
TC
354
355 $result = [ cond => $result, $true, $false ];
356 }
357
358 return $result;
359}
360
4697e5c3
TC
361sub _parse_or {
362 my ($self, $tok) = @_;
363
364 my $result = $self->_parse_and($tok);
365 while ($tok->peektype eq 'or') {
366 my $op = $tok->get;
367 my $other = $self->_parse_and($tok);
368 $result = [ or => $result, $other ];
369 }
370
371 return $result;
372}
373
374sub _parse_and {
375 my ($self, $tok) = @_;
376
377 my $result = $self->_parse_rel($tok);
378 while ($tok->peektype eq 'and') {
379 my $op = $tok->get;
380 my $other = $self->_parse_rel($tok);
381 $result = [ and => $result, $other ];
382 }
383
384 return $result;
385}
386
387my %relops = map {; "op$_" => 1 } qw(eq ne gt lt ge le == != < > >= <= =~ !~);
388
389sub _parse_rel {
390 my ($self, $tok) = @_;
391
392 my $result = $self->_parse_additive($tok);
393 my $nexttype = $tok->peektype;
394 while ($relops{$nexttype}) {
395 my $op = $tok->get;
396 my $other = $self->_parse_additive($tok);
ac507437 397 $result = [ $ops{$nexttype}, $result, $other ];
4697e5c3
TC
398 $nexttype = $tok->peektype;
399 }
400 return $result;
401}
402
403sub _parse_additive {
404 my ($self, $tok) = @_;
405
406 my $result = $self->_parse_mult($tok);
407 my $nexttype = $tok->peektype;
408 while ($nexttype eq 'op+' || $nexttype eq 'op-' || $nexttype eq 'op_') {
409 my $op = $tok->get;
410 my $other = $self->_parse_mult($tok);
411 $result = [ $ops{$nexttype}, $result, $other ];
412 $nexttype = $tok->peektype;
413 }
414 return $result;
415}
416
417sub _parse_mult {
418 my ($self, $tok) = @_;
419
420 my $result = $self->_parse_prefix($tok);
421 my $nexttype = $tok->peektype;
422 while ($nexttype eq 'op*' || $nexttype eq 'op/'
423 || $nexttype eq 'div' || $nexttype eq 'mod') {
424 my $op = $tok->get;
425 my $other = $self->_parse_prefix($tok);
426 $result = [ $ops{$op->[0]}, $result, $other ];
427 $nexttype = $tok->peektype;
428 }
429 return $result;
430}
431
432sub _parse_prefix {
433 my ($self, $tok) = @_;
434
435 my $nexttype = $tok->peektype('TERM');
961939b5 436 if ($nexttype eq 'op-') {
4697e5c3
TC
437 $tok->get;
438 return [ uminus => $self->_parse_prefix($tok) ];
439 }
440 elsif ($nexttype eq 'op+') {
441 $tok->get;
442 return $self->_parse_prefix($tok);
443 }
444 elsif ($nexttype eq 'op!' || $nexttype eq 'opnot') {
445 $tok->get;
446 return [ not => $self->_parse_prefix($tok) ];
447 }
448 else {
449 return $self->_parse_call($tok);
450 }
451}
452
453sub _parse_list {
454 my ($self, $tok) = @_;
455
4742ac21 456 $tok->peektype("TERM") eq 'op)'
4697e5c3
TC
457 and return [];
458
459 my @list;
460 push @list, $self->_parse_expr($tok);
461 my $peek = $tok->peektype;
462 while ($peek eq 'op,' || $peek eq '..') {
463 $tok->get;
464 if ($peek eq '..') {
465 my $start = pop @list;
466 $start->[0] ne 'range'
467 or die [ error => "Can't use a range as the start of a range" ];
468 my $end = $self->_parse_expr($tok);
469 push @list, [ range => $start, $end ];
470 }
471 else {
472 push @list, $self->_parse_expr($tok);
473 }
474 $peek = $tok->peektype;
475 }
476
477 return \@list;
478}
479
480sub _parse_paren_list {
481 my ($self, $tok, $what) = @_;
482
483 my $open = $tok->get;
484 $open->[0] eq 'op('
485 or die [ error => "Expected '(' for $what but found $open->[0]" ];
486 my $list = $self->_parse_list($tok);
487 my $close = $tok->get;
488 $close->[0] eq 'op)'
489 or die [ error => "Expected ')' for $what but found $close->[0]" ];
490
491 return $list;
492}
493
494sub _parse_call {
495 my ($self, $tok) = @_;
496
497 my $result = $self->_parse_postfix($tok);
498 my $next = $tok->peektype;
dd94dd8e 499 while ($next eq 'op.' || $next eq 'op[' || $next eq 'op(') {
4697e5c3
TC
500 if ($next eq 'op.') {
501 $tok->get;
502 my $name = $tok->get;
dd94dd8e
TC
503 if ($name->[0] eq "id") {
504 my $list = [];
505 if ($tok->peektype eq 'op(') {
506 $list = $self->_parse_paren_list($tok, "method");
507 }
508 $result = [ call => $name->[2], $result, $list ];
509 }
510 elsif ($name->[0] eq 'op$') {
511 # get the real name
512 $name = $tok->get;
513 $name->[0] eq 'id'
46296d79 514 or die [ error => "Expected an identifier after .\$ but found $name->[1]" ];
dd94dd8e
TC
515 my $list = [];
516 if ($tok->peektype eq 'op(') {
517 $list = $self->_parse_paren_list($tok, "method");
518 }
519 $result = [ callvar => $name->[2], $result, $list ];
520 }
521 else {
46296d79 522 die [ error => "Expected a method name or \$var after '.' but found $name->[1]" ];
4697e5c3 523 }
4697e5c3
TC
524 }
525 elsif ($next eq 'op[') {
526 $tok->get;
527 my $index = $self->_parse_expr($tok);
528 my $close = $tok->get;
529 $close->[0] eq 'op]'
46296d79 530 or die [ error => "Expected closing ']' but got $close->[0]" ];
4697e5c3
TC
531 $result = [ subscript => $result, $index ];
532 }
dd94dd8e
TC
533 elsif ($next eq 'op(') {
534 my $args = $self->_parse_paren_list($tok, "call");
535 $result = [ funccall => $result, $args ];
536 }
4697e5c3
TC
537 $next = $tok->peektype;
538 }
539
540 return $result;
541}
542
543sub _parse_postfix {
544 my ($self, $tok) = @_;
545
546 return $self->_parse_primary($tok);
547}
548
549sub _parse_primary {
550 my ($self, $tok) = @_;
551
552 my $t = $tok->get('TERM');
961939b5
TC
553 if ($t->[0] eq 'op(') {
554 my $r = $self->_parse_expr($tok);
555 my $close = $tok->get;
556 unless ($close->[0] eq 'op)') {
557 die [ error => "Expected ')' but found $close->[0]" ];
558 }
559 return $r;
560 }
561 elsif ($t->[0] eq 'str' || $t->[0] eq 'num') {
4697e5c3
TC
562 return [ const => $t->[2] ];
563 }
ac507437
TC
564 elsif ($t->[0] eq 're') {
565 my $str = $t->[2];
566 my $opts = $t->[3];
567 my $sub = eval "sub { my \$str = shift; qr/\$str/$opts; }";
568 my $re;
569 $sub and $re = eval { $sub->($str) };
570 $re
571 or die [ error => "Cannot compile /$t->[2]/$opts: $@" ];
572 return [ const => $re ];
573 }
4697e5c3
TC
574 elsif ($t->[0] eq 'id') {
575 return [ var => $t->[2] ];
576 }
577 elsif ($t->[0] eq 'op[') {
39fbca4a
TC
578 my $list = [];
579 if ($tok->peektype ne 'op]') {
580 $list = $self->_parse_list($tok);
581 }
4697e5c3
TC
582 my $close = $tok->get;
583 $close->[0] eq 'op]'
46296d79 584 or die [ error => "Expected list end ']' but got $close->[0]" ];
4697e5c3
TC
585 return [ list => $list ];
586 }
f17f9f79 587 elsif ($t->[0] eq 'op{') {
53c28223
TC
588 my $pairs = $self->parse_pairs($tok);
589 my $next = $tok->get;
590 $next->[0] eq 'op}'
591 or die [ error => "Expected , or } but found $next->[1]" ];
f17f9f79 592
53c28223 593 return [ hash => $pairs ];
f17f9f79 594 }
4697e5c3
TC
595 elsif ($t->[0] eq 're') {
596 return [ re => $t->[2], $t->[3] ];
597 }
598 else {
599 die [ error => "Expected term but got $t->[0]" ];
600 }
601}
602
53c28223
TC
603sub parse_pairs {
604 my ($self, $tok) = @_;
605
606 my $nexttype = $tok->peektype;
607 if ($nexttype eq 'op}' || $nexttype eq 'eof') {
608 return [];
609 }
610 else {
611 my $next;
612 my @pairs;
613 do {
614 my $key;
615 if ($tok->peektype eq 'id') {
616 my $id = $tok->get;
617 if ($tok->peektype eq 'op:') {
618 $key = [ const => $id->[2] ];
619 }
620 else {
621 $tok->unget($id);
622 }
623 }
624 $key ||= $self->_parse_additive($tok);
625 my $colon = $tok->get;
626 $colon->[0] eq 'op:'
627 or die [ error => "Expected : in hash but found $colon->[1]" ];
628 my $value = $self->_parse_expr($tok);
629 push @pairs, [ $key, $value ];
630 } while ($next = $tok->get and $next->[0] eq 'op,');
631 $tok->unget($next);
632
633 return \@pairs;
634 }
635}
636
4697e5c3
TC
637package Squirrel::Template::Expr::Tokenizer;
638
639use constant TEXT => 0;
640use constant QUEUE => 1;
641
642sub new {
643 my ($class, $text) = @_;
644
645 return bless [ $text, [] ], $class;
646}
647
648my %escapes =
649 (
650 n => "\n",
651 "\\" => "\\",
652 t => "\t",
653 '"' => '"',
654 );
655
656sub get {
657 my ($self, $want) = @_;
658
659 my $queue = $self->[QUEUE];
660 @$queue
661 and return shift @$queue;
662 length $self->[TEXT]
663 or return;
664
665 $want ||= '';
666
667 if ($want ne 'TERM' &&
a97045d4 668 $self->[TEXT] =~ s/\A(\s*(div\b|mod\b|\.\.|and\b|or\b)\s*)//) {
4697e5c3
TC
669 push @$queue, [ $2 => $1 ];
670 }
671 elsif ($self->[TEXT] =~ s/\A(\s*(0x[0-9A-Fa-f]+)\s*)//) {
672 push @$queue, [ num => $1, oct $2 ];
673 }
674 elsif ($self->[TEXT] =~ s/\A(\s*(0b[01]+)\s*)//) {
675 push @$queue, [ num => $1, oct $2 ];
676 }
677 elsif ($self->[TEXT] =~ s/\A(\s*0o([0-7]+)\s*)//) {
678 push @$queue, [ num => $1, oct $2 ];
679 }
680 elsif ($self->[TEXT] =~ s/\A(\s*((?:\.[0-9]+|[0-9]+(?:\.[0-9]*)?)(?:[Ee][+-]?[0-9]+)?)\s*)//) {
681 push @$queue, [ num => $1, $2 ];
682 }
683 elsif ($want eq 'TERM' &&
684 $self->[TEXT] =~ s!\A(\s*/((?:[^/\\]|\\.)+)/([ismx]*\s)?\s*)!!) {
685 push @$queue, [ re => $1, $2, $3 || "" ];
686 }
66a07e7c 687 elsif ($self->[TEXT] =~ s/\A(\s*(not\b|eq\b|ne\b|le\b|lt\b|ge\b|gt\b|<=|>=|[!=]\=|\=\~|!~|[_\?:,\[\]\(\)<>=!.*\/+\{\};\$-])\s*)//) {
4697e5c3
TC
688 push @$queue, [ "op$2" => $1 ];
689 }
690 elsif ($self->[TEXT] =~ s/\A(\s*([A-Za-z_][a-zA-Z_0-9]*)\s*)//) {
691 push @$queue, [ id => $1, $2 ];
692 }
693 elsif ($self->[TEXT] =~ s/\A(\s*\"((?:[^"\\]|\\["\\nt]|\\x[0-9a-fA-F]{2}|\\x\{[0-9a-fA-F]+\}|\\N\{[A-Za-z0-9 ]+\})*)\"\s*)//) {
694 my $orig = $1;
695 my $str = _process_escapes($2);
696 push @$queue, [ str => $1, $str ];
697 }
698 elsif ($self->[TEXT] =~ s/\A(\s*\'([^\']*)\'\s*)//) {
699 push @$queue, [ str => $1, $2 ];
700 }
701 else {
702 die [ error => "Unknown token '$self->[TEXT]'" ];
703 }
704
705 unless (length $self->[TEXT]) {
706 push @$queue, [ eof => "" ];
707 }
708
709 return shift @$queue;
710}
711
712sub unget {
713 my ($self, $tok) = @_;
714
715 unshift @{$self->[QUEUE]}, $tok;
716}
717
718sub peek {
719 my ($self, $what) = @_;
720
721 unless (@{$self->[QUEUE]}) {
722 my $t = $self->get($what)
723 or return;
724 unshift @{$self->[QUEUE]}, $t;
725 }
726
727 return $self->[QUEUE][0];
728}
729
730sub peektype {
731 my ($self, $what) = @_;
732
733 return $self->peek($what)->[0];
734}
735
736sub _process_escapes {
737 my ($str) = @_;
738
739 $str =~
740 s(
741 \\([nt\\\"])
742 |
743 \\x\{([0-9A-Fa-f]+)\}
744 |
745 \\x([0-9A-Fa-f]{2})
746 |
747 \\N\{([A-Za-z0-9\ ]+)\}
748 )(
749 $1 ? $escapes{$1} :
750 $2 ? chr(hex($2)) :
751 $3 ? chr(hex($3)) :
752 _vianame($4)
753 )gex;
754
755 return $str;
756}
757
758my $charnames_loaded;
759sub _vianame {
760 my ($name, $errors) = @_;
761
762 require charnames;
763 my $code = charnames::vianame($name);
764 unless (defined $code) {
765 die [ error => "Unknown \\N name '$name'" ];
766 }
767 return chr($code);
768}
769
7701;
6c291231
TC
771
772__END__
773
774=head1 NAME
775
776Squirrel::Template::Expr - expression handling for Squirrel::Template
777
778=head1 SYNOPSIS
779
780 # code that uses it
781 my $parser = Squirrel::Template::Expr::Parser->new;
782
783 my $expr = $parser->parse($expr_text);
784
785 my $tokens = Squirrel::Template::Expr::Tokenizer->new($expr_text);
786
787 my $expr = $parser->parse_tokens($tokenizer);
788 # and possibly process more tokens here
789
790 my $eval = Squirrel::Template::Expr::Parser->new($templater);
791
792 my $value = $eval->process($expr);
793 my $value = $eval->process($expr, "LIST");
794
795 my $arrayref = $eval->process(\@exprs);
796
797 # Expressions
798
799 <:= somevalue + 10 :>
800 <:.if somevalue == 10 :>
801
802=head1 DESCRIPTION
803
804Squirrel::Template::Expr provides expression parsing and evaluation
805for newer style tags for L<Squirrel::Template>.
806
807=head1 EXPRESSION SYNTAX
808
809=head2 Operators
810
811Listed highest precedence first.
812
813=over
814
815=item *
816
817C<<[ I<list> ]>>, C<<{ I<key>:I<value>, ... }>>, literals
818
819C<<[ I<list> ]>> allows you to build lists objects. Within C<[ ... ]>
820you can use the C<..> operator to produce a list of numerically or
821alphabetically ascending values per Perl's magic increment.
822
823eg.
824
825 [ "a", "c" .. "z" ]
826 [ 1 .. 10 ]
827
828Method calls within C<<[ ... ]>> are done in perl's list context.
829
830C<<{ ... }>> allows you to build hash objects.
831
832eg.
833
834 { "somekey":somevariable, somekeyinvar:"somevalue" }
835
836See L</Literals> for literals
837
838=item *
839
840method calls - methods are called as:
841
842 object.method;
843
844or
845
846 object.method(arguments)
847
848and may be chained.
849
850Virtual methods are defined for hashes, arrays and scalars, see
851L<Squirrel::Template::Expr::WrapHash>,
852L<Squirrel::Template::Expr::WrapArray>,
853L<Squirrel::Template::Expr::WrapScalar>,
854L<Squirrel::Template::Expr::WrapCode> and
855L<Squirrel::Template::Expr::WrapClass>.
856
857=item *
858
dd94dd8e
TC
859function calls - functions are called as:
860
861 somevar();
862
863or
864
865 somevar(arguments);
866
867or any other expression that doesn't look like a method call:
868
869 somehash.get["foo"]();
870
871=item *
872
6c291231
TC
873unary -, unary +, unary !, unary not
874
875=item *
876
877* / div mod - simple arithmetic operators. C<div> returns the integer
878portion of dividing the first operand by the second. C<mod> returns
879the remainder of integer division.
880
881=item *
882
883+ - _ - arithmetic addition and subtraction. C<_> does string
884concatenation.
885
886=item *
887
888eq ne le lt ge gt == != > < >= <= =~ !~ - relational operators as per
889Perl.
890
891=item *
892
893and - boolean and, with shortcut.
894
895=item *
896
897or - boolean or, with shortcut.
898
899=item *
900
901Conditional (C<< I<cond> ? I<true> : I<false> >>) - return the value
902of I<true> or I<false> depending on I<cond>.
903
904=back
905
906=head2 Literals
907
908Numbers can be represented in several formats:
909
910=over
911
912=item *
913
914simple decimal - C<100>, C<3.14159>, C<1e10>.
915
916=item *
917
918hex - C<0x64>
919
920=item *
921
922octal - C<0o144>
923
924=item *
925
926binary - C<0b1100100>
927
928=back
929
930Strings can be either " or ' delimited.
931
932Simple quote delimited strings allow no escaping, and may not contain
933single quotes. The contents are treated literally.
934
935Double quoted strings allow escaping as follows:
936
937=over
938
939=item *
940
941Any of C<\">, C<\n>, C<\\>, C<\t> are treated as in C or perl,
942replaced with double quote, newline, backslash or tab respectively.
943
944=item *
945
946C<<\x{I<hex-digits>}>> is replaced with the unicode code-point
947indicated by the hex number.
948
949=item *
950
951C<< \xI<hex-digit>I<hex-digit> >> is replaced by the unicode
952code-point indicated by the 2-digit hex number.
953
954=item *
955
956C<< \N{ I<unicode-character-name> } >> is replaced by the unicode
957character named.
958
959=back
960
961=head1 Squirrel::Template::Expr::Parser
962
963Squirrel::Template::Expr::Parser provides parsing for expressions.
964
965=head1 Methods
966
967=over
968
969=item new()
970
971Create a new parser object.
972
973=item parse($text)
974
975Parse C<$text> as an expression. Parsing must reach the end of the
976text or an exception will be thrown.
977
978=item parse_tokens($tokenizer)
979
980Process tokens from C<$tokenizer>, a
981L</Squirrel::Template::Expr::Tokenizer> object. The caller can call
982these method several times with the same C<$tokenizer> to parse
983components of a statement, and should ensure the eof token is visible
984after the final component.
985
986=back
987
988=head1 Squirrel::Template::Expr::Tokenizer
989
990Split text into tokens. Token parsing is occasionally context
991sensitive.
992
993=head2 Methods
994
995=over
996
997=item new($text)
998
999Create a new tokenizer for parsing C<$text>.
1000
1001=item get()
1002
1003=item get($context)
1004
1005Retrieve a token from the stream, consuming it. If a term is expected
1006$context should be set to C<'TERM'>.
1007
1008=item unget()
1009
1010Push a token back into the stream.
1011
1012=item peek()
1013
1014=item peek($context)
1015
1016Retrieve the next token from the stream without consuming it.
1017
1018=item peektype()
1019
1020=item peektype($context)
1021
1022Retrieve the type of the next token from the stream without consuming
1023it.
1024
1025=back
1026
1027=head1 Squirrel::Template::Expr::Eval
1028
1029Used to evaluate an expression returned by
1030Squirrel::Template::Expr::parse().
1031
1032=head2 Methods
1033
1034=over
1035
1036=item new($templater)
1037
1038Create a new evaluator. C<$templater> should be a
1039L<Squirrel::Template> object.
1040
1041=back
1042
1043=head1 SEE ALSO
1044
1045L<Squirrel::Template>
1046
1047=head1 AUTHOR
1048
1049Tony Cook <tony@develop-help.com>
1050
1051=cut