site/cgi-bin/modules/Squirrel/Template/Processor.pm

   1 package Squirrel::Template::Processor;
   2 use strict;
   3 use Squirrel::Template::Constants qw(:node);
   4 use Scalar::Util ();
   5
   6 our $VERSION = "1.025";
   7
   8 use constant ACTS => 0;
   9 use constant TMPLT => 1;
  10 use constant PARMS => 2;
  11 use constant WRAPPED => 3;
  12 use constant EVAL => 4;
  13
  14 sub new {
  15   my ($class, $acts, $tmplt, $wrapped) = @_;
  16
  17   return bless
  18     [
  19      $acts,
  20      $tmplt,
  21      {},
  22      $wrapped,
  23      Squirrel::Template::Expr::Eval->new($tmplt, $acts)
  24     ], $class;
  25 }
  26
  27 # return an error node matching the supplied node
  28 sub _error {
  29   my ($self, $node, $message) = @_;
  30
  31   my $error = [ error => "", $node->[NODE_LINE], $node->[NODE_FILENAME], $message ];
  32
  33   return $self->_process_error($error);
  34 }
  35
  36 sub process {
  37   my ($self, $node) = @_;
  38
  39   my $method = "_process_$node->[NODE_TYPE]";
  40   return $self->$method($node);
  41 }
  42
  43 sub _process_content {
  44   my ($self, $node) = @_;
  45
  46   return $node->[NODE_ORIG];
  47 }
  48
  49 sub _process_empty {
  50   my ($self, $node) = @_;
  51
  52   return;
  53 }
  54
  55 sub _process_stmt {
  56   my ($self, $node) = @_;
  57
  58   my @errors;
  59   my $value = "";
  60   unless (eval {
  61     for my $expr (@{$node->[NODE_EXPR_EXPR]}) {
  62       $self->[EVAL]->process($expr);
  63     }
  64     1;
  65   }) {
  66     my $msg = $@;
  67
  68     if ($msg =~ /\bENOIMPL\b/) {
  69       $self->[TMPLT]->trace_noimpl("stmt:$node->[NODE_FILENAME]:$node->[NODE_LINE]:$msg\n");
  70       return $node->[NODE_ORIG];
  71     }
  72
  73     push @errors, $self->_error($node, ref $msg ? $msg->[1] : $msg );
  74   }
  75
  76   return ( @errors );
  77 }
  78
  79 sub _process_expr {
  80   my ($self, $node) = @_;
  81
  82   my @errors;
  83   my $value = "";
  84   unless (eval { $value = $self->[EVAL]->process($node->[NODE_EXPR_EXPR]); 1 }) {
  85     my $msg = $@;
  86
  87     if ($msg =~ /\bENOIMPL\b/) {
  88       $self->[TMPLT]->trace_noimpl("expr:$node->[NODE_FILENAME]:$node->[NODE_LINE]:$msg\n");
  89       return $node->[NODE_ORIG];
  90     }
  91
  92     push @errors, $self->_error($node, ref $msg ? $msg->[1] : $msg );
  93   }
  94   defined $value
  95     or $value = '';
  96   if ($node->[NODE_EXPR_FORMAT]) {
  97     $value = $self->[TMPLT]->format($value, $node->[NODE_EXPR_FORMAT]);
  98   }
  99   return ( @errors, $value );
 100 }
 101
 102 sub _process_set {
 103   my ($self, $node) = @_;
 104
 105   my @errors;
 106   my $value = "";
 107   if (eval { $value = $self->[EVAL]->process($node->[NODE_SET_EXPR]); 1 }) {
 108     my @var = @{$node->[NODE_SET_VAR]};
 109     if (@var > 1) {
 110       my $top_name = shift @var;
 111       my $var = $self->[TMPLT]->get_var($top_name);
 112       unless ($var) {
 113         $var = {};
 114         $self->[TMPLT]->set_var($top_name, $var);
 115       }
 116       my @seen = $top_name;
 117       while (@var > 1) {
 118         my $subkey = shift @var;
 119         Scalar::Util::blessed($var)
 120             and die [ error => "Cannot set values in an object ".join(".", @seen) ];
 121         my $type = Scalar::Util::reftype($var);
 122         if ($type eq 'HASH') {
 123           exists $type->{$subkey}
 124             or die [ error => "$subkey not found in ".join(".", @seen) ];
 125           $var = $var->{$subkey};
 126           push @seen, $subkey;
 127         }
 128         else {
 129           die [ error => "Only hashes supported for now" ];
 130         }
 131       }
 132       Scalar::Util::blessed($var)
 133           and die [ error => "Cannot set values in an object ".join(".", @seen) ];
 134       ref $var
 135         or die [ error => join(".", @seen) . " isn't a reference" ];
 136       Scalar::Util::reftype($var) eq 'HASH'
 137         or die [ error => "Only hashes supported for now" ];
 138       $var->{$var[0]} = $value;
 139     }
 140     else {
 141       $self->[TMPLT]->set_var($var[0] => $value);
 142     }
 143   }
 144   else {
 145     my $msg = $@;
 146
 147     if ($msg =~ /\bENOIMPL\b/) {
 148       $self->[TMPLT]->trace_noimpl("set:$node->[NODE_FILENAME]:$node->[NODE_LINE]:$msg\n");
 149       return $node->[NODE_ORIG];
 150     }
 151
 152     push @errors, $self->_error($node, ref $msg ? $msg->[1] : $msg );
 153   }
 154
 155   return @errors;
 156 }
 157
 158 sub _process_define {
 159   my ($self, $define) = @_;
 160
 161   $self->[TMPLT]->define_macro($define->[NODE_DEFINE_NAME], $define->[NODE_DEFINE_CONTENT], $define->[NODE_DEFINE_DEFAULTS]);
 162
 163   return;
 164 }
 165
 166 sub _process_call {
 167   my ($self, $node) = @_;
 168
 169   my $parsed;
 170   my %args;
 171   my @result;
 172   my $defaults;
 173   my $name;
 174   if (eval {
 175     $name = $self->[EVAL]->process($node->[NODE_CALL_NAME]);
 176     for my $arg (@{$node->[NODE_CALL_LIST]}) {
 177       my $key = $self->[EVAL]->process($arg->[0]);
 178       my $value = $self->[EVAL]->process($arg->[1]);
 179       $args{$key} = $value;
 180     }
 181
 182     ($parsed, $defaults) = $self->[TMPLT]->get_macro($name);
 183     if (!$parsed) {
 184       ($parsed, my $message) = $self->[TMPLT]->parse_file($name);
 185       unless ($parsed) {
 186         $self->[TMPLT]->trace_noimpl("call:$node->[NODE_FILENAME]:$node->[NODE_LINE]:$message\n");
 187         die "ENOIMPL - $name not found\n";
 188       }
 189     }
 190     1;
 191   }) {
 192     my $ctx = ".call '$name' from $node->[NODE_FILENAME]:$node->[NODE_LINE]";
 193     if (eval { $self->[TMPLT]->start_scope($ctx, \%args), 1 }) {
 194       if ($defaults) {
 195         for my $entry (@$defaults) {
 196           my ($name_expr, $value_expr)= @$entry;
 197           my $name = $self->[EVAL]->process($name_expr);
 198           unless (exists $args{$name}) {
 199             my $value = $self->[EVAL]->process($value_expr);
 200             $self->[TMPLT]->set_var($name, $value);
 201           }
 202         }
 203       }
 204       @result = $self->process($parsed);
 205       $self->[TMPLT]->end_scope();
 206     }
 207     else {
 208       my $error = $@;
 209       chomp $error;
 210       push @result,
 211         "Error opening scope for call: $error\nBacktrace:\n",
 212           map {; "  ", $_, "\n" } ( reverse $self->[TMPLT]->backtrace );
 213     }
 214   }
 215   else {
 216     @result = $node->[NODE_ORIG];
 217   }
 218
 219   return @result;
 220 }
 221
 222 sub _process_for {
 223   my ($self, $node) = @_;
 224
 225   my $list;
 226   unless (eval {
 227     $list = $self->[EVAL]->process($node->[NODE_FOR_EXPR]); 1;
 228   }) {
 229     my $msg = $@;
 230     if ($msg =~ /\bENOIMPL\b/) {
 231       return
 232         (
 233          $node->[NODE_ORIG],
 234          $self->process($node->[NODE_FOR_CONTENT]),
 235          $node->[NODE_FOR_END][NODE_ORIG]
 236         );
 237     }
 238     else {
 239       return $self->_error($node, $@);
 240     }
 241   }
 242
 243   if (ref $list) {
 244     Scalar::Util::blessed($list)
 245         and return $self->_error($node, ".for expression cannot be a blessed object");
 246
 247     if (Scalar::Util::reftype($list) eq "ARRAY") {
 248       # nothing to do
 249     }
 250     elsif (Scalar::Util::reftype($list) eq "HASH") {
 251       my @work = map +{ key => $_, value => $list->{$_} }, keys %$list;
 252       $list = \@work;
 253     }
 254     else {
 255       return $self->_error($node, ".for expression cannot be a blessed object");
 256     }
 257   }
 258   else {
 259     $list = [ $list ];
 260   }
 261
 262   my $index = 0;
 263   my %loop =
 264     (
 265      first => @$list ? $list->[0] : undef,
 266      last => @$list ? $list->[-1] : undef,
 267      size => scalar @$list,
 268      is_last => sub { $index == $#$list },
 269      is_first => sub { $index == 0 },
 270      count => sub { $index + 1 },
 271      index => sub { $index },
 272
 273      # the parity/odd/even are based on counting from 1, $index counts
 274      # from zero
 275      parity => sub { $index % 2 ? "even" : "odd" },
 276      odd => sub { $index % 2 == 0 },
 277      even => sub { $index % 2 != 0 },
 278
 279      prev => sub { $index > 0 ? $list->[$index-1] : undef },
 280      next => sub { $index < $#$list ? $list->[$index+1] : undef },
 281      list => $list,
 282     );
 283   my $name = $node->[NODE_FOR_NAME];
 284
 285   my $scope = $self->[TMPLT]->top_scope;
 286   local $scope->{$name};
 287   local $scope->{loop} = \%loop;
 288
 289   my @result;
 290   for my $current (@$list) {
 291     $scope->{$name} = $current;
 292     $loop{current} = $current;
 293     push @result, $self->process($node->[NODE_FOR_CONTENT]);
 294     ++$index;
 295   }
 296
 297   return @result;
 298 }
 299
 300 sub _process_error {
 301   my ($self, $node) = @_;
 302
 303   return "* " . $node->[NODE_ERROR_MESSAGE] . " *";
 304 }
 305
 306 sub _process_cond {
 307   my ($self, $node) = @_;
 308
 309   local $SIG{__DIE__};
 310   my $acts = $self->[ACTS];
 311   my $cond;
 312   my $name = $node->[NODE_TAG_NAME];
 313   my @errors;
 314   my $result =
 315     eval {
 316       if (exists $acts->{"if$name"}) {
 317         #print STDERR " found cond if$name\n" if DEBUG > 1;
 318         $cond = !!$self->[TMPLT]->low_perform($acts, "if$name", $node->[NODE_TAG_ARGS], undef);
 319       }
 320       elsif (exists $acts->{lcfirst $name}) {
 321         #print STDERR " found cond $name\n" if DEBUG > 1;
 322         $cond = !!$self->[TMPLT]->low_perform($acts, lcfirst $name, $node->[NODE_TAG_ARGS], undef);
 323       }
 324     };
 325   if ($@) {
 326     my $msg = $@;
 327     if ($msg !~ /\bENOIMPL\b/) {
 328       @errors = $self->_error($node, $msg);
 329     }
 330   }
 331   if (defined $cond) {
 332     return (@errors, $self->process($cond ? $node->[NODE_COND_TRUE]
 333                                     : $node->[NODE_COND_FALSE]));
 334   }
 335   else {
 336     return (@errors, $node->[NODE_ORIG], $self->process($node->[NODE_COND_TRUE]), $node->[NODE_COND_OR][NODE_ORIG], $self->process($node->[NODE_COND_FALSE]), $node->[NODE_COND_EIF][NODE_ORIG]);
 337   }
 338 }
 339
 340 sub _process_condnot {
 341   my ($self, $node) = @_;
 342
 343   local $SIG{__DIE__};
 344   my $acts = $self->[ACTS];
 345   my $cond;
 346   my $name = $node->[NODE_TAG_NAME];
 347   my @errors;
 348   my $result =
 349     eval {
 350       if (exists $acts->{"if$name"}) {
 351         #print STDERR " found cond if$name\n" if DEBUG > 1;
 352         $cond = !!$self->[TMPLT]->low_perform($acts, "if$name", $node->[NODE_TAG_ARGS], undef);
 353       }
 354       elsif (exists $acts->{lcfirst $name}) {
 355         #print STDERR " found cond $name\n" if DEBUG > 1;
 356         $cond = !!$self->[TMPLT]->low_perform($acts, lcfirst $name, $node->[NODE_TAG_ARGS], undef);
 357       }
 358     };
 359   if ($@) {
 360     my $msg = $@;
 361     if ($msg !~ /\bENOIMPL\b/) {
 362       @errors = $self->_error($node, $msg);
 363     }
 364   }
 365   if (defined $cond) {
 366     return (@errors, $cond ? "" : $self->process($node->[NODE_COND_TRUE]));
 367   }
 368   else {
 369     return (@errors, $node->[NODE_ORIG], $self->process($node->[NODE_COND_TRUE]), $node->[NODE_COND_EIF][NODE_ORIG]);
 370   }
 371 }
 372
 373 sub _process_iterator {
 374   my ($self, $node) = @_;
 375
 376   my $name = $node->[NODE_TAG_NAME];
 377   my $args = $node->[NODE_TAG_ARGS];
 378
 379   my $entry = $self->[ACTS]{"iterate_$name"};
 380   if ($entry) {
 381     my $reset = $self->[ACTS]{"iterate_${name}_reset"};
 382     my ($resetf, @rargs);
 383     if ($reset) {
 384       if (ref $reset eq 'ARRAY') {
 385         ($resetf, @rargs) = @$reset;
 386       }
 387       else {
 388         $resetf = $reset;
 389       }
 390     }
 391
 392     my ($entryf, @eargs);
 393     if (ref $entry eq 'ARRAY') {
 394       ($entryf, @eargs) = @$entry;
 395     }
 396     else {
 397       $entryf = $entry;
 398     }
 399
 400     if ($resetf) {
 401       if (ref $resetf) {
 402         #print STDERR "  resetting (func)\n" if DEBUG > 1;
 403         $resetf->(@rargs, $args, $self->[ACTS], $name, $self->[TMPLT]);
 404       }
 405       else {
 406         my $obj = shift @rargs;
 407         #print STDERR "  resetting (method) $obj->$resetf\n" if DEBUG > 1;
 408         $obj->$resetf(@rargs, $args, $self->[ACTS], $name, $self->[TMPLT]);
 409       }
 410       #print STDERR "  reset done\n" if DEBUG > 1;
 411     }
 412     my $eobj;
 413     ref $entryf or $eobj = shift @eargs;
 414     my @result;
 415     my $index = 0;
 416     while ($eobj ? $eobj->$entryf(@eargs, $name, $args)
 417            : $entryf->(@eargs, $name, $args)) {
 418       push @result, $self->process($node->[NODE_ITERATOR_SEPARATOR])
 419         if $index;
 420       push @result, $self->process($node->[NODE_ITERATOR_LOOP]);
 421       ++$index;
 422     }
 423     return @result;
 424   }
 425   else {
 426     return
 427       (
 428        $node->[NODE_ORIG],
 429        $self->process($node->[NODE_ITERATOR_LOOP]),
 430        $node->[NODE_ITERATOR_SEPTOK][NODE_ORIG],
 431        $self->process($node->[NODE_ITERATOR_SEPARATOR]),
 432        $node->[NODE_ITERATOR_ENDTOK][NODE_ORIG]
 433       );
 434   }
 435 }
 436
 437 sub _process_with {
 438   my ($self, $node) = @_;
 439
 440   my $name = $node->[NODE_TAG_NAME];
 441   my $args = $node->[NODE_TAG_ARGS];
 442
 443   my $entry = $self->[ACTS]{"with_$name"};
 444   if ($entry) {
 445     my ($code, @args);
 446     if (ref $entry eq 'ARRAY') {
 447       ($code, @args) = @$entry;
 448     }
 449     else {
 450       $code = $entry;
 451     }
 452
 453     my $obj;
 454     ref $code or $obj = shift @args;
 455     my $work = join('', $self->process($node->[NODE_WITH_CONTENT]));
 456     return $obj
 457       ? $obj->$code(@args, $args, $work, "", $self->[ACTS], $name, $self->[TMPLT])
 458         : $code->(@args, $args, $work, "", $self->[ACTS], $name, $self->[TMPLT]);
 459   }
 460   else {
 461     return
 462       (
 463        $node->[NODE_ORIG],
 464        $self->process($node->[NODE_WITH_CONTENT]),
 465        $node->[NODE_WITH_END][NODE_ORIG]
 466       );
 467   }
 468 }
 469
 470 sub _process_wrap {
 471   my ($self, $node) = @_;
 472
 473   my ($filename, $args, $content) =
 474     @{$node}[NODE_WRAP_FILENAME, NODE_WRAP_ARGS, NODE_WRAP_CONTENT];
 475
 476   my %params;
 477   my $parms_re = $self->[TMPLT]->parms_re;
 478
 479   my @errors;
 480   while ($args =~ s/^\s*(\w+)\s*=>\s*\"([^\"]+)\"//
 481          || $args =~ s/^\s*(\w+)\s*=>\s*($parms_re)//
 482          || $args =~ s/^\s*(\w+)\s*=>\s*([^\s,]+)//) {
 483     my ($name, $value) = ($1, $2);
 484     $value =~ s/\A($parms_re)\z/ $self->[TMPLT]->perform($self->[ACTS], $2, $3, $1) /egs;
 485
 486     $params{$name} = $value;
 487     $args =~ s/\s*,\s*//;
 488   }
 489   $args =~ /^\s*$/
 490     or push @errors, $self->_error($node, "WARNING: Extra data after parameters '$args'");
 491
 492   my @result;
 493   if ($self->[TMPLT]->start_wrap(\%params)) {
 494     my ($wrap_node, $error) = $self->[TMPLT]->parse_file($node->[NODE_WRAP_FILENAME]);
 495
 496     if ($wrap_node) {
 497       my $proc = __PACKAGE__->new($self->[ACTS], $self->[TMPLT],
 498                                   sub { $self->process($content) });
 499
 500       push @result, $proc->process($wrap_node);
 501     }
 502     else {
 503       push @result, $self->_error($node, "Loading wrap: $error");
 504     }
 505     $self->[TMPLT]->end_wrap;
 506   }
 507   else {
 508     push @errors, $self->_error($node, "Error starting wrap: Too many levels of wrap for '$node->[NODE_WRAP_FILENAME]'");
 509     @result = $self->process($content);
 510   }
 511
 512   return ( @errors, @result );
 513 }
 514
 515 sub _process_ext_wrap {
 516   my ($self, $node) = @_;
 517
 518   my ($filename, $args, $content) =
 519     @{$node}[NODE_WRAP_FILENAME, NODE_WRAP_ARGS, NODE_WRAP_CONTENT];
 520
 521   my %args;
 522   my @result;
 523   my @errors;
 524   my $name;
 525   if (eval {
 526     $name = $self->[EVAL]->process($filename);
 527     for my $arg (@$args) {
 528       my $key = $self->[EVAL]->process($arg->[0]);
 529       my $value = $self->[EVAL]->process($arg->[1]);
 530       $args{$key} = $value;
 531     }
 532     1;
 533   }) {
 534     my $ctx = ".wrap '$name' from $node->[NODE_FILENAME]:$node->[NODE_LINE]";
 535     if ($self->[TMPLT]->start_wrap(\%args)) {
 536
 537       my $parsed = $self->[TMPLT]->get_macro($name);
 538       if (!$parsed) {
 539         ($parsed, my $message) = $self->[TMPLT]->parse_file($name);
 540         unless ($parsed) {
 541           $self->[TMPLT]->trace_noimpl("call:$node->[NODE_FILENAME]:$node->[NODE_LINE]:$message\n");
 542           push @result, $self->_error($node, "Loading wrap: $message");
 543         }
 544       }
 545
 546       if ($parsed) {
 547         my $proc = __PACKAGE__->new($self->[ACTS], $self->[TMPLT],
 548                                     sub { $self->process($content) });
 549         push @result, $proc->process($parsed);
 550       }
 551       $self->[TMPLT]->end_wrap;
 552     }
 553     else {
 554       push @result, $self->_error($node, "Starting wrap: too many levels?");
 555     }
 556   }
 557   else {
 558     @result =
 559       (
 560        $node->[NODE_ORIG],
 561        $self->process($node->[NODE_WRAP_CONTENT]),
 562        $node->[NODE_WRAP_END][NODE_ORIG],
 563       );
 564   }
 565
 566   return ( @errors, @result );
 567 }
 568
 569 sub _process_wraphere {
 570   my ($self, $node) = @_;
 571
 572   $self->[WRAPPED]
 573     or return $self->_error($node, "wrap here without being wrapped");
 574
 575   return $self->[WRAPPED]->();
 576 }
 577
 578 sub _process_switch {
 579   my ($self, $node) = @_;
 580
 581   my $cases = $node->[NODE_SWITCH_CASES];
 582   my @errors;
 583   for my $i (0 .. $#$cases) {
 584     my ($case, $content) = @{$cases->[$i]};
 585
 586     my ($type, $func, $args) =
 587       @{$case}[NODE_TYPE, NODE_TAG_NAME, NODE_TAG_ARGS];
 588
 589     if ($func eq "default") {
 590       return $self->process($content);
 591     }
 592
 593     my $result;
 594     my $good =
 595       eval {
 596         local $SIG{__DIE__};
 597
 598         if (exists $self->[ACTS]{"if$func"}) {
 599           $result = $self->[TMPLT]->low_perform($self->[ACTS], "if$func", $args, "");
 600         }
 601         elsif (exists $self->[ACTS]{lcfirst $func}) {
 602           $result = $self->[TMPLT]->low_perform($self->[ACTS], lcfirst $func, $args, '');
 603         }
 604         else {
 605           die "ENOIMPL $func not found for switch case\n";
 606         }
 607         1;
 608       };
 609     unless ($good) {
 610       my $msg = $@;
 611       if ($msg =~ /^ENOIMPL\b/) {
 612         return
 613           (
 614            @errors,
 615            $node->[NODE_ORIG],
 616            (
 617             map {
 618               $_->[0][NODE_ORIG], $self->process($_->[1])
 619             } @{$cases}[$i .. $#$cases ]
 620            ),
 621            $node->[NODE_SWITCH_END][NODE_ORIG],
 622           );
 623       }
 624       push @errors, $self->_error($case, $msg);
 625     }
 626     if ($type eq 'case' ? $result : !$result) {
 627       return (@errors, $self->process($content));
 628     }
 629   }
 630
 631   return @errors;
 632 }
 633
 634 sub _process_ext_if {
 635   my ($self, $node) = @_;
 636
 637   my @conds = @{$node->[NODE_EXTIF_CONDS]};
 638   while (my $cond = shift @conds) {
 639     my $result;
 640     if (eval { $result = $self->[EVAL]->process($cond->[2]); 1 }) {
 641       if ($result) {
 642         return $self->process($cond->[1]);
 643       }
 644     }
 645     else {
 646       my $msg = $@;
 647       if (!ref $msg && $msg =~ /\bENOIMPL\b/) {
 648         unshift @conds, $cond;
 649
 650         my $prefix = '';
 651         if (@conds < @{$node->[NODE_EXTIF_CONDS]}) {
 652           $prefix = "<:.if 0 :>";
 653         }
 654
 655         return
 656           (
 657            $prefix,
 658            (
 659             map { $_->[0][NODE_ORIG], $self->process($_->[1]) } @conds
 660            ),
 661            $node->[NODE_EXTIF_ELSE][0][NODE_ORIG],
 662            $self->process($node->[NODE_EXTIF_ELSE][1]),
 663            $node->[NODE_EXTIF_END][NODE_ORIG]
 664           );
 665       }
 666       else {
 667         return $self->_error($node, ref $msg ? $msg->[1] : $msg);
 668       }
 669     }
 670   }
 671
 672   return $self->process($node->[NODE_EXTIF_ELSE][1]);
 673 }
 674
 675 sub _process_comp {
 676   my ($self, $node) = @_;
 677
 678   return map $self->process($_), @{$node}[NODE_COMP_FIRST .. $#$node];
 679 }
 680
 681 sub _process_tag {
 682   my ($self, $node) = @_;
 683
 684   my $name = $node->[NODE_TAG_NAME];
 685   my $replaced = 0;
 686   my $tag_method = "tag_$name";
 687   if (exists $self->[ACTS]{$name} || $self->[TMPLT]->can($tag_method)) {
 688     my $value;
 689     if (eval { $value = $self->[TMPLT]->low_perform($self->[ACTS], $name, $node->[NODE_TAG_ARGS], $node->[NODE_ORIG]); 1 }) {
 690       return $value;
 691     }
 692     my $msg = $@;
 693     unless ($msg =~ /\bENOIMPL\b/) {
 694       return $self->_error($node, $msg);
 695     }
 696   }
 697
 698   return Squirrel::Template::Deparser->deparse($node);
 699 }
 700
 701 sub _process_iterateover {
 702   my ($self, $node) = @_;
 703
 704   my $call;
 705   my @args;
 706   unless (eval {
 707     $call = $self->[EVAL]->process($node->[NODE_ITERATEOVER_CALL]);
 708     @args = map $self->[EVAL]->process($_), @{$node->[NODE_ITERATEOVER_ARGS]};
 709     1;
 710   }) {
 711     my $msg = $@;
 712     if ($msg =~ /\bENOIMPL\b/) {
 713       return
 714         (
 715          $node->[NODE_ORIG],
 716          $self->process($node->[NODE_FOR_CONTENT]),
 717          $node->[NODE_FOR_END][NODE_ORIG]
 718         );
 719     }
 720     else {
 721       return $self->_error($node, $@);
 722     }
 723   }
 724
 725   unless (ref $call && !Scalar::Util::blessed($call)
 726           && Scalar::Util::reftype($call) eq 'CODE') {
 727     return $self->_error($node, ".iterateover expression must be a code reference");
 728   }
 729
 730   my @result;
 731   unless (eval {
 732     $call->
 733       (
 734        sub {
 735          push @result, $self->process($node->[NODE_ITERATEOVER_CONTENT]);
 736          1;
 737        },
 738        $self->[TMPLT],
 739        @args
 740       );
 741     1;
 742   }) {
 743     push @result, $self->_error($node, "exception in .iterateover callback ".$@);
 744   }
 745
 746   return @result;
 747 }
 748
 749 sub _process_while {
 750   my ($self, $node) = @_;
 751
 752   my $cond = $node->[NODE_WHILE_COND];
 753   my $result;
 754   unless (eval { $result = $self->[EVAL]->process($cond); 1 }) {
 755     my $msg = $@;
 756     if (!ref $msg && $msg =~ /\bENOIMPL\b/) {
 757       return
 758         (
 759          $node->[NODE_ORIG],
 760          $self->process($node->[NODE_WHILE_CONTENT]),
 761          $node->[NODE_WHILE_END][NODE_ORIG],
 762         );
 763     }
 764     else {
 765       return $self->_error($node, ref $msg ? $msg->[1] : $msg);
 766     }
 767   }
 768   my @output;
 769   while ($result) {
 770     push @output, $self->process($node->[NODE_WHILE_CONTENT]);
 771
 772     unless (eval { $result = $self->[EVAL]->process($cond); 1 }) {
 773       my $msg = $@;
 774       if (!ref $msg && $msg ==~ /\bENOIMPL\b/) {
 775         return
 776           (
 777            @output,
 778            $node->[NODE_ORIG],
 779            $self->process($node->[NODE_WHILE_CONTENT]),
 780            $node->[NODE_WHILE_END][NODE_ORIG],
 781           );
 782       }
 783       else {
 784         return
 785           (
 786            @output,
 787            $self->_error($node, ref $msg ? $msg->[1] : $msg),
 788           );
 789       }
 790     }
 791   }
 792
 793   return @output;
 794 }
 795
 796 1;
 797
 798 =head1 NAME
 799
 800 Squirrel::Template::Processor - process a parsed template
 801
 802 =head1 SYNOPSIS
 803
 804   use Squirrel::Template;
 805   my $tmpl = Squirrel::Template->new(...);
 806   my $proc = Squirrel::Template::Processor->new(\%acts, $tmpl);
 807   my @content = $proc->process($node);
 808
 809 =head1 DESCRIPTION
 810
 811 Processes a parsed template node producing text.
 812
 813 Calls back into the templater to find and parse wrapper files, to set
 814 wrap parameters and  to evaluate some tags.
 815
 816 =head1 METHODS
 817
 818 =over
 819
 820 =item new(\%acts, $tmpl)
 821
 822 Create a new processor.  A third C<$wrapped> parameter can be supplied
 823 when processing wrapped subtemplates.
 824
 825 =item process($node)
 826
 827 Process a parsed template node returning the results as a list.
 828
 829 =back
 830
 831 =head1 AUTHOR
 832
 833 Tony Cook <tony@develop-help.com>
 834
 835 =cut