1#!/usr/bin/perl -w
2
3=head1 NAME
4
5bench_optree.pl - Look at different ways of storing data that transform fast.
6
7=cut
8
9use strict;
10use Benchmark qw(cmpthese timethese);
11use CGI::Ex::Dump qw(debug);
12use constant skip_execute => 1;
13
14#my $obj = bless [1, 2], __PACKAGE__;
15#my $struct1 = \ [ '-', 1, 2 ];
16#my $struct2 = ['-', 1, 2];
17#
18#sub call { $_[0]->[0] - $_[0]->[1] }
19#
20#sub obj_meth {  $obj->call }
21#sub ref_type { if (ref($struct1) eq 'REF') { if (${$struct1}->[0] eq '-') { ${$struct1}->[1] - ${$struct1}->[2] } } }
22#
23#print "(".obj_meth().")\n";
24#print "(".ref_type().")\n";
25#cmpthese timethese(-2, {
26#    obj_meth => \&obj_meth,
27#    ref_type => \&ref_type,
28#}, 'auto');
29
30
31###----------------------------------------------------------------###
32### setup a new way of storing and executing the variable tree
33
34sub get_var2 { ref($_[1]) ? $_[1]->call($_[0]) : $_[1] }
35
36{
37    package Num;
38    sub new { my $c = shift; bless \@_, $c };
39    sub call { $_[0]->[0] }
40    package A::B;
41    sub new { my $c = shift; bless \@_, $c }
42#    sub new { my $c = shift; bless [map{ref$_?$_:Num->new($_)} @_], $c }
43    package A::B::Minus;
44    our @ISA = qw(A::B);
45    sub call { $_[1]->get_var2($_[0]->[0]) - $_[1]->get_var2($_[0]->[1]) }
46    package A::B::Plus;
47    our @ISA = qw(A::B);
48    sub call { $_[1]->get_var2($_[0]->[0]) + $_[1]->get_var2($_[0]->[1]) }
49    package A::B::Mult;
50    our @ISA = qw(A::B);
51    sub call { $_[1]->get_var2($_[0]->[0]) * $_[1]->get_var2($_[0]->[1]) }
52    package A::B::Div;
53    our @ISA = qw(A::B);
54    sub call { $_[1]->get_var2($_[0]->[0]) / $_[1]->get_var2($_[0]->[1]) }
55    package A::B::Var;
56    our @ISA = qw(A::B);
57
58our $HASH_OPS   = $CGI::Ex::Template::HASH_OPS;
59our $LIST_OPS   = $CGI::Ex::Template::LIST_OPS;
60our $SCALAR_OPS = $CGI::Ex::Template::SCALAR_OPS;
61our $FILTER_OPS = $CGI::Ex::Template::FILTER_OPS;
62our $OP_FUNC    = $CGI::Ex::Template::OP_FUNC;
63
64use constant trace => 0;
65sub call {
66    my $var  = shift;
67    my $self = shift;
68    my $ARGS = shift || {};
69    my $i    = 0;
70    my $generated_list;
71
72    ### determine the top level of this particular variable access
73    my $ref  = $var->[$i++];
74    my $args = $var->[$i++];
75    warn "get_variable: begin \"$ref\"\n" if trace;
76
77    if (defined $ref) {
78        if ($ARGS->{'is_namespace_during_compile'}) {
79            $ref = $self->{'NAMESPACE'}->{$ref};
80        } else {
81            return if $ref =~ /^[_.]/; # don't allow vars that begin with _
82            $ref = $self->{'_vars'}->{$ref};
83        }
84    }
85
86    my %seen_filters;
87    while (defined $ref) {
88
89        ### check at each point if the returned thing was a code
90        if (UNIVERSAL::isa($ref, 'CODE')) {
91            my @results = $ref->($args ? @{ $self->vivify_args($args) } : ());
92            if (defined $results[0]) {
93                $ref = ($#results > 0) ? \@results : $results[0];
94            } elsif (defined $results[1]) {
95                die $results[1]; # TT behavior - why not just throw ?
96            } else {
97                $ref = undef;
98                last;
99            }
100        }
101
102        ### descend one chained level
103        last if $i >= $#$var;
104        my $was_dot_call = $ARGS->{'no_dots'} ? 1 : $var->[$i++] eq '.';
105        my $name         = $var->[$i++];
106        my $args         = $var->[$i++];
107        warn "get_variable: nested \"$name\"\n" if trace;
108
109        ### allow for named portions of a variable name (foo.$name.bar)
110        if (ref $name) {
111            $name = $name->call($self);
112            if (! defined($name) || $name =~ /^[_.]/) {
113                $ref = undef;
114                last;
115            }
116        }
117
118        if ($name =~ /^_/) { # don't allow vars that begin with _
119            $ref = undef;
120            last;
121        }
122
123        ### allow for scalar and filter access (this happens for every non virtual method call)
124        if (! ref $ref) {
125            if ($SCALAR_OPS->{$name}) {                        # normal scalar op
126                $ref = $SCALAR_OPS->{$name}->($ref, $args ? @{ $self->vivify_args($args) } : ());
127
128            } elsif ($LIST_OPS->{$name}) {                     # auto-promote to list and use list op
129                $ref = $LIST_OPS->{$name}->([$ref], $args ? @{ $self->vivify_args($args) } : ());
130
131            } elsif (my $filter = $self->{'FILTERS'}->{$name}    # filter configured in Template args
132                     || $FILTER_OPS->{$name}                     # predefined filters in CET
133                     || (UNIVERSAL::isa($name, 'CODE') && $name) # looks like a filter sub passed in the stash
134                     || $self->list_filters->{$name}) {          # filter defined in Template::Filters
135
136                if (UNIVERSAL::isa($filter, 'CODE')) {
137                    $ref = eval { $filter->($ref) }; # non-dynamic filter - no args
138                    if (my $err = $@) {
139                        $self->throw('filter', $err) if ref($err) !~ /Template::Exception$/;
140                        die $err;
141                    }
142                } elsif (! UNIVERSAL::isa($filter, 'ARRAY')) {
143                    $self->throw('filter', "invalid FILTER entry for '$name' (not a CODE ref)");
144
145                } elsif (@$filter == 2 && UNIVERSAL::isa($filter->[0], 'CODE')) { # these are the TT style filters
146                    eval {
147                        my $sub = $filter->[0];
148                        if ($filter->[1]) { # it is a "dynamic filter" that will return a sub
149                            ($sub, my $err) = $sub->($self->context, $args ? @{ $self->vivify_args($args) } : ());
150                            if (! $sub && $err) {
151                                $self->throw('filter', $err) if ref($err) !~ /Template::Exception$/;
152                                die $err;
153                            } elsif (! UNIVERSAL::isa($sub, 'CODE')) {
154                                $self->throw('filter', "invalid FILTER for '$name' (not a CODE ref)")
155                                    if ref($sub) !~ /Template::Exception$/;
156                                die $sub;
157                            }
158                        }
159                        $ref = $sub->($ref);
160                    };
161                    if (my $err = $@) {
162                        $self->throw('filter', $err) if ref($err) !~ /Template::Exception$/;
163                        die $err;
164                    }
165                } else { # this looks like our vmethods turned into "filters" (a filter stored under a name)
166                    $self->throw('filter', 'Recursive filter alias \"$name\"') if $seen_filters{$name} ++;
167                    $var = [$name, 0, '|', @$filter, @{$var}[$i..$#$var]]; # splice the filter into our current tree
168                    $i = 2;
169                }
170                if (scalar keys %seen_filters
171                    && $seen_filters{$var->[$i - 5] || ''}) {
172                    $self->throw('filter', "invalid FILTER entry for '".$var->[$i - 5]."' (not a CODE ref)");
173                }
174            } else {
175                $ref = undef;
176            }
177
178        } else {
179
180            ### method calls on objects
181            if (UNIVERSAL::can($ref, 'can')) {
182                my @args = $args ? @{ $self->vivify_args($args) } : ();
183                my @results = eval { $ref->$name(@args) };
184                if ($@) {
185                    die $@ if ref $@ || $@ !~ /Can\'t locate object method/;
186                } elsif (defined $results[0]) {
187                    $ref = ($#results > 0) ? \@results : $results[0];
188                    next;
189                } elsif (defined $results[1]) {
190                    die $results[1]; # TT behavior - why not just throw ?
191                } else {
192                    $ref = undef;
193                    last;
194                }
195                # didn't find a method by that name - so fail down to hash and array access
196            }
197
198            ### hash member access
199            if (UNIVERSAL::isa($ref, 'HASH')) {
200                if ($was_dot_call && exists($ref->{$name}) ) {
201                    $ref = $ref->{$name};
202                } elsif ($HASH_OPS->{$name}) {
203                    $ref = $HASH_OPS->{$name}->($ref, $args ? @{ $self->vivify_args($args) } : ());
204                } elsif ($ARGS->{'is_namespace_during_compile'}) {
205                    return $var; # abort - can't fold namespace variable
206                } else {
207                    $ref = undef;
208                }
209
210            ### array access
211            } elsif (UNIVERSAL::isa($ref, 'ARRAY')) {
212                if ($name =~ /^\d+$/) {
213                    $ref = ($name > $#$ref) ? undef : $ref->[$name];
214                } else {
215                    $ref = (! $LIST_OPS->{$name}) ? undef : $LIST_OPS->{$name}->($ref, $args ? @{ $self->vivify_args($args) } : ());
216                }
217            }
218        }
219
220    } # end of while
221
222    ### allow for undefinedness
223    if (! defined $ref) {
224        if ($self->{'_debug_undef'}) {
225            my $chunk = $var->[$i - 2];
226            $chunk = $chunk->call($self) if ref $chunk;
227            die "$chunk is undefined\n";
228        } else {
229            $ref = $self->undefined_any($var);
230        }
231    }
232
233    ### allow for special behavior for the '..' operator
234    if ($generated_list && $ARGS->{'list_context'} && ref($ref) eq 'ARRAY') {
235        return @$ref;
236    }
237
238    return $ref;
239}
240};
241sub plus  ($$) { A::B::Plus->new( @_) }
242sub minus ($$) { A::B::Minus->new(@_) }
243sub mult  ($$) { A::B::Mult->new( @_) }
244sub div   ($$) { A::B::Div->new(  @_) }
245sub var        { A::B::Var->new(  @_) };
246$INC{'A/B.pm'} = 1;
247$INC{'A/B/Plus.pm'} = 1;
248$INC{'A/B/Minus.pm'} = 1;
249$INC{'A/B/Mult.pm'} = 1;
250$INC{'A/B/Div.pm'} = 1;
251$INC{'A/B/Var.pm'} = 1;
252
253###----------------------------------------------------------------###
254### now benchmark the different variable storage methods
255
256my $vars = {
257    foo  => {bar => {baz => [qw(a b c)]}},
258    bing => 'bang',
259};
260my $self = bless {'_vars' => $vars}, __PACKAGE__;
261
262#pauls@pslaptop:~/perl/CGI-Ex/lib$    perl -e 'my $a = "1 + 2 * (3 + (4 / 5) * 9) - 20";
263#       use CGI::Ex::Template;
264#       use Data::Dumper;
265#       print Dumper(CGI::Ex::Template->new->parse_variable(\$a));'
266
267###----------------------------------------------------------------###
268
269my $Y0 = '$self->{_vars}->{bing}';
270my $Y1 = [ 'bing', 0 ];
271my $Y2 = var('bing', 0);
272debug $Y2;
273
274### are they all the same
275print eval($Y0)."\n";
276print $self->get_variable($Y1)."\n";
277print $self->get_var2($Y2)."\n";
278
279if (! skip_execute) {
280    cmpthese timethese (-2, {
281        perl        => sub { eval $Y0 },
282        bare_data   => sub { $self->get_variable($Y1) },
283        method_call => sub { $self->get_var2($Y2) },
284    }, 'auto');
285}
286
287###----------------------------------------------------------------###
288
289my $Z0 = '$self->{_vars}->{foo}->{bar}->{baz}->[1]';
290my $Z1 = [ 'foo', 0, '.', 'bar', 0, '.', 'baz', 0, '.', 1, 0];
291my $Z2 = var('foo', 0, '.', 'bar', 0, '.', 'baz', 0, '.', 1, 0);
292debug $Z2;
293
294### are they all the same
295print eval($Z0)."\n";
296print $self->get_variable($Z1)."\n";
297print $self->get_var2($Z2)."\n";
298
299if (! skip_execute) {
300    cmpthese timethese (-2, {
301        perl        => sub { eval $Z0 },
302        bare_data   => sub { $self->get_variable($Z1) },
303        method_call => sub { $self->get_var2($Z2) },
304    }, 'auto');
305}
306
307###----------------------------------------------------------------###
308
309### $A0 = perl, $A1 = old optree, $A2 = new optree
310my $A0 = "1 + 2 * (3 + (4 / 5) * 9) - 20";
311my $A1 = [ \[ '-', [ \[ '+', '1', [ \[ '*', '2', [ \[ '+', '3', [ \[ '*', [ \[ '/', '4', '5' ], 0 ], '9' ], 0 ] ], 0 ] ], 0 ] ], 0 ], '20' ], 0 ];
312my $A2 = minus(plus(1, mult(2, plus(3, mult(div(4,5), 9)))), 20);
313debug $A2;
314
315### are they all the same
316print eval($A0)."\n";
317print $self->get_variable($A1)."\n";
318print $self->get_var2($A2)."\n";
319
320if (! skip_execute) {
321    cmpthese timethese (-2, {
322        perl        => sub { eval $A0 },
323        bare_data   => sub { $self->get_variable($A1) },
324        method_call => sub { $self->get_var2($A2) },
325    }, 'auto');
326}
327
328###----------------------------------------------------------------###
329
330my $B0 = "1 + 2";
331my $B1 = [ \[ '+', 1, 2] ];
332my $B2 = plus(1, 2);
333debug $B2;
334
335### are they all the same
336print eval($B0)."\n";
337print $self->get_variable($B1)."\n";
338print $self->get_var2($B2)."\n";
339
340if (! skip_execute) {
341    cmpthese timethese (-2, {
342        perl        => sub { eval $B0 },
343        bare_data   => sub { $self->get_variable($B1) },
344        method_call => sub { $self->get_var2($B2) },
345    }, 'auto');
346}
347
348###----------------------------------------------------------------###
349### Test (de)serialization speed
350
351use Storable;
352my $d1 = Storable::freeze($A1);
353my $d2 = Storable::freeze($A2);
354Storable::thaw($d1); # load lib
355print length($d1)."\n";
356print length($d2)."\n";
357
358cmpthese timethese (-2, {
359    freeze_bare => sub { Storable::freeze($A1) },
360    freeze_meth => sub { Storable::freeze($A2) },
361}, 'auto');
362
363cmpthese timethese (-2, {
364    thaw_bare => sub { Storable::thaw($d1) },
365    thaw_meth => sub { Storable::thaw($d2) },
366}, 'auto');
367
368###----------------------------------------------------------------###
369### create libraries similar to those from CGI::Ex::Template 1.201
370
371use CGI::Ex::Template;
372
373our $HASH_OPS   = $CGI::Ex::Template::HASH_OPS;
374our $LIST_OPS   = $CGI::Ex::Template::LIST_OPS;
375our $SCALAR_OPS = $CGI::Ex::Template::SCALAR_OPS;
376our $FILTER_OPS = $CGI::Ex::Template::FILTER_OPS;
377our $OP_FUNC    = $CGI::Ex::Template::OP_FUNC;
378
379use constant trace => 0;
380
381sub get_variable {
382    ### allow for the parse tree to store literals
383    return $_[1] if ! ref $_[1];
384
385    my $self = shift;
386    my $var  = shift;
387    my $ARGS = shift || {};
388    my $i    = 0;
389    my $generated_list;
390
391    ### determine the top level of this particular variable access
392    my $ref  = $var->[$i++];
393    my $args = $var->[$i++];
394    warn "get_variable: begin \"$ref\"\n" if trace;
395    if (ref $ref) {
396        if (ref($ref) eq 'SCALAR') { # a scalar literal
397            $ref = $$ref;
398        } elsif (ref($ref) eq 'REF') { # operator
399            return $self->play_operator($$ref) if ${ $ref }->[0] eq '\\'; # return the closure
400            $generated_list = 1 if ${ $ref }->[0] eq '..';
401            $ref = $self->play_operator($$ref);
402        } else { # a named variable access (ie via $name.foo)
403            $ref = $self->get_variable($ref);
404            if (defined $ref) {
405                return if $ref =~ /^[_.]/; # don't allow vars that begin with _
406                $ref = $self->{'_vars'}->{$ref};
407            }
408        }
409    } elsif (defined $ref) {
410        if ($ARGS->{'is_namespace_during_compile'}) {
411            $ref = $self->{'NAMESPACE'}->{$ref};
412        } else {
413            return if $ref =~ /^[_.]/; # don't allow vars that begin with _
414            $ref = $self->{'_vars'}->{$ref};
415        }
416    }
417
418
419    my %seen_filters;
420    while (defined $ref) {
421
422        ### check at each point if the returned thing was a code
423        if (UNIVERSAL::isa($ref, 'CODE')) {
424            my @results = $ref->($args ? @{ $self->vivify_args($args) } : ());
425            if (defined $results[0]) {
426                $ref = ($#results > 0) ? \@results : $results[0];
427            } elsif (defined $results[1]) {
428                die $results[1]; # TT behavior - why not just throw ?
429            } else {
430                $ref = undef;
431                last;
432            }
433        }
434
435        ### descend one chained level
436        last if $i >= $#$var;
437        my $was_dot_call = $ARGS->{'no_dots'} ? 1 : $var->[$i++] eq '.';
438        my $name         = $var->[$i++];
439        my $args         = $var->[$i++];
440        warn "get_variable: nested \"$name\"\n" if trace;
441
442        ### allow for named portions of a variable name (foo.$name.bar)
443        if (ref $name) {
444            if (ref($name) eq 'ARRAY') {
445                $name = $self->get_variable($name);
446                if (! defined($name) || $name =~ /^[_.]/) {
447                    $ref = undef;
448                    last;
449                }
450            } else {
451                die "Shouldn't get a ". ref($name) ." during a vivify on chain";
452            }
453        }
454        if ($name =~ /^_/) { # don't allow vars that begin with _
455            $ref = undef;
456            last;
457        }
458
459        ### allow for scalar and filter access (this happens for every non virtual method call)
460        if (! ref $ref) {
461            if ($SCALAR_OPS->{$name}) {                        # normal scalar op
462                $ref = $SCALAR_OPS->{$name}->($ref, $args ? @{ $self->vivify_args($args) } : ());
463
464            } elsif ($LIST_OPS->{$name}) {                     # auto-promote to list and use list op
465                $ref = $LIST_OPS->{$name}->([$ref], $args ? @{ $self->vivify_args($args) } : ());
466
467            } elsif (my $filter = $self->{'FILTERS'}->{$name}    # filter configured in Template args
468                     || $FILTER_OPS->{$name}                     # predefined filters in CET
469                     || (UNIVERSAL::isa($name, 'CODE') && $name) # looks like a filter sub passed in the stash
470                     || $self->list_filters->{$name}) {          # filter defined in Template::Filters
471
472                if (UNIVERSAL::isa($filter, 'CODE')) {
473                    $ref = eval { $filter->($ref) }; # non-dynamic filter - no args
474                    if (my $err = $@) {
475                        $self->throw('filter', $err) if ref($err) !~ /Template::Exception$/;
476                        die $err;
477                    }
478                } elsif (! UNIVERSAL::isa($filter, 'ARRAY')) {
479                    $self->throw('filter', "invalid FILTER entry for '$name' (not a CODE ref)");
480
481                } elsif (@$filter == 2 && UNIVERSAL::isa($filter->[0], 'CODE')) { # these are the TT style filters
482                    eval {
483                        my $sub = $filter->[0];
484                        if ($filter->[1]) { # it is a "dynamic filter" that will return a sub
485                            ($sub, my $err) = $sub->($self->context, $args ? @{ $self->vivify_args($args) } : ());
486                            if (! $sub && $err) {
487                                $self->throw('filter', $err) if ref($err) !~ /Template::Exception$/;
488                                die $err;
489                            } elsif (! UNIVERSAL::isa($sub, 'CODE')) {
490                                $self->throw('filter', "invalid FILTER for '$name' (not a CODE ref)")
491                                    if ref($sub) !~ /Template::Exception$/;
492                                die $sub;
493                            }
494                        }
495                        $ref = $sub->($ref);
496                    };
497                    if (my $err = $@) {
498                        $self->throw('filter', $err) if ref($err) !~ /Template::Exception$/;
499                        die $err;
500                    }
501                } else { # this looks like our vmethods turned into "filters" (a filter stored under a name)
502                    $self->throw('filter', 'Recursive filter alias \"$name\"') if $seen_filters{$name} ++;
503                    $var = [$name, 0, '|', @$filter, @{$var}[$i..$#$var]]; # splice the filter into our current tree
504                    $i = 2;
505                }
506                if (scalar keys %seen_filters
507                    && $seen_filters{$var->[$i - 5] || ''}) {
508                    $self->throw('filter', "invalid FILTER entry for '".$var->[$i - 5]."' (not a CODE ref)");
509                }
510            } else {
511                $ref = undef;
512            }
513
514        } else {
515
516            ### method calls on objects
517            if (UNIVERSAL::can($ref, 'can')) {
518                my @args = $args ? @{ $self->vivify_args($args) } : ();
519                my @results = eval { $ref->$name(@args) };
520                if ($@) {
521                    die $@ if ref $@ || $@ !~ /Can\'t locate object method/;
522                } elsif (defined $results[0]) {
523                    $ref = ($#results > 0) ? \@results : $results[0];
524                    next;
525                } elsif (defined $results[1]) {
526                    die $results[1]; # TT behavior - why not just throw ?
527                } else {
528                    $ref = undef;
529                    last;
530                }
531                # didn't find a method by that name - so fail down to hash and array access
532            }
533
534            ### hash member access
535            if (UNIVERSAL::isa($ref, 'HASH')) {
536                if ($was_dot_call && exists($ref->{$name}) ) {
537                    $ref = $ref->{$name};
538                } elsif ($HASH_OPS->{$name}) {
539                    $ref = $HASH_OPS->{$name}->($ref, $args ? @{ $self->vivify_args($args) } : ());
540                } elsif ($ARGS->{'is_namespace_during_compile'}) {
541                    return $var; # abort - can't fold namespace variable
542                } else {
543                    $ref = undef;
544                }
545
546            ### array access
547            } elsif (UNIVERSAL::isa($ref, 'ARRAY')) {
548                if ($name =~ /^\d+$/) {
549                    $ref = ($name > $#$ref) ? undef : $ref->[$name];
550                } else {
551                    $ref = (! $LIST_OPS->{$name}) ? undef : $LIST_OPS->{$name}->($ref, $args ? @{ $self->vivify_args($args) } : ());
552                }
553            }
554        }
555
556    } # end of while
557
558    ### allow for undefinedness
559    if (! defined $ref) {
560        if ($self->{'_debug_undef'}) {
561            my $chunk = $var->[$i - 2];
562            $chunk = $self->get_variable($chunk) if ref($chunk) eq 'ARRAY';
563            die "$chunk is undefined\n";
564        } else {
565            $ref = $self->undefined_any($var);
566        }
567    }
568
569    ### allow for special behavior for the '..' operator
570    if ($generated_list && $ARGS->{'list_context'} && ref($ref) eq 'ARRAY') {
571        return @$ref;
572    }
573
574    return $ref;
575}
576
577sub vivify_args {
578    my $self = shift;
579    my $vars = shift;
580    my $args = shift || {};
581    return [map {$self->get_variable($_, $args)} @$vars];
582}
583
584sub play_operator {
585    my $self = shift;
586    my $tree = shift;
587    my $ARGS = shift || {};
588    my $op = $tree->[0];
589    $tree = [@$tree[1..$#$tree]];
590
591    ### allow for operator function override
592    if (exists $OP_FUNC->{$op}) {
593        return $OP_FUNC->{$op}->($self, $op, $tree, $ARGS);
594    }
595
596    ### do constructors and short-circuitable operators
597    if ($op eq '~' || $op eq '_') {
598        return join "", grep {defined} @{ $self->vivify_args($tree) };
599    } elsif ($op eq 'arrayref') {
600        return $self->vivify_args($tree, {list_context => 1});
601    } elsif ($op eq 'hashref') {
602        my $args = $self->vivify_args($tree);
603        push @$args, undef if ! ($#$args % 2);
604        return {@$args};
605    } elsif ($op eq '?') {
606        if ($self->get_variable($tree->[0])) {
607            return defined($tree->[1]) ? $self->get_variable($tree->[1]) : undef;
608        } else {
609            return defined($tree->[2]) ? $self->get_variable($tree->[2]) : undef;
610        }
611    } elsif ($op eq '||' || $op eq 'or' || $op eq 'OR') {
612        for my $node (@$tree) {
613            my $var = $self->get_variable($node);
614            return $var if $var;
615        }
616        return '';
617    } elsif ($op eq '&&' || $op eq 'and' || $op eq 'AND') {
618        my $var;
619        for my $node (@$tree) {
620            $var = $self->get_variable($node);
621            return 0 if ! $var;
622        }
623        return $var;
624
625    } elsif ($op eq '!') {
626        my $var = ! $self->get_variable($tree->[0]);
627        return defined($var) ? $var : '';
628
629    }
630
631    ### equality operators
632    local $^W = 0;
633    my $n = $self->get_variable($tree->[0]);
634    $tree = [@$tree[1..$#$tree]];
635    if ($op eq '==')    { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n eq $_) }; return 1 }
636    elsif ($op eq '!=') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n ne $_) }; return 1 }
637    elsif ($op eq 'eq') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n eq $_) }; return 1 }
638    elsif ($op eq 'ne') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n ne $_) }; return 1 }
639    elsif ($op eq '<')  { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n <  $_); $n = $_ }; return 1 }
640    elsif ($op eq '>')  { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n >  $_); $n = $_ }; return 1 }
641    elsif ($op eq '<=') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n <= $_); $n = $_ }; return 1 }
642    elsif ($op eq '>=') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n >= $_); $n = $_ }; return 1 }
643    elsif ($op eq 'lt') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n lt $_); $n = $_ }; return 1 }
644    elsif ($op eq 'gt') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n gt $_); $n = $_ }; return 1 }
645    elsif ($op eq 'le') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n le $_); $n = $_ }; return 1 }
646    elsif ($op eq 'ge') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n ge $_); $n = $_ }; return 1 }
647
648    ### numeric operators
649    my $args = $self->vivify_args($tree);
650    if (! @$args) {
651        if ($op eq '-') { return - $n }
652        $self->throw('operator', "Not enough args for operator \"$op\"");
653    }
654    if ($op eq '..')        { return [($n || 0) .. ($args->[-1] || 0)] }
655    elsif ($op eq '+')      { $n +=  $_ for @$args; return $n }
656    elsif ($op eq '-')      { $n -=  $_ for @$args; return $n }
657    elsif ($op eq '*')      { $n *=  $_ for @$args; return $n }
658    elsif ($op eq '/')      { $n /=  $_ for @$args; return $n }
659    elsif ($op eq 'div'
660           || $op eq 'DIV') { $n = int($n / $_) for @$args; return $n }
661    elsif ($op eq '%'
662           || $op eq 'mod'
663           || $op eq 'MOD') { $n %=  $_ for @$args; return $n }
664    elsif ($op eq '**'
665           || $op eq 'pow') { $n **= $_ for @$args; return $n }
666
667    $self->throw('operator', "Un-implemented operation $op");
668}
669