lib/Reaction/UI/RenderingContext/TT.pm

   1 package Reaction::UI::RenderingContext::TT;
   2
   3 use Reaction::Class;
   4 use aliased 'Reaction::UI::RenderingContext';
   5 use aliased 'Template::View';
   6
   7 class TT is RenderingContext, which {
   8
   9   has 'iter_class' => (
  10     is => 'ro', required => 1,
  11     default => sub { 'Reaction::UI::Renderer::TT::Iter'; },
  12   );
  13
  14   our $body;
  15
  16   implements 'dispatch' => as {
  17     my ($self, $render_tree, $args) = @_;
  18 #warn "-- dispatch start\n";
  19     local $body = '';
  20     my %args_copy = %$args;
  21     foreach my $to_render (@$render_tree) {
  22       my ($type, @to) = @$to_render;
  23       if ($type eq '-layout') {
  24         my ($lset, $fname, $next) = @to;
  25         local $args_copy{call_next} =
  26           (@$next
  27             ? sub { $self->dispatch($next, $args); }
  28             : '' # no point running internal dispatch if nothing -to- dispatch
  29           );
  30         $self->render($lset, $fname, \%args_copy);
  31       } elsif ($type eq '-render') {
  32         my ($widget, $fname, $over) = @to;
  33         #warn "@to";
  34         if (defined $over) {
  35           $over->each(sub {
  36             local $args_copy{_} = $_[0];
  37             $body .= $widget->render($fname, $self, \%args_copy);
  38           });
  39         } else {
  40           $body .= $widget->render($fname, $self, \%args_copy);
  41         }
  42       }
  43     }
  44 #warn "-- dispatch end, body: ${body}\n-- end body\nbacktrace: ".Carp::longmess()."\n-- end trace\n";
  45     return $body;
  46   };
  47
  48   implements 'render' => as {
  49     my ($self, $lset, $fname, $args) = @_;
  50
  51     confess "\$body not in scope" unless defined($body);
  52
  53     # foreach non-_ prefixed key in the args
  54     # build a subref for this key that passes self so the generator has a
  55     # rendering context when [% key %] is evaluated by TT as $val->()
  56     # (assuming it's a subref - if not just pass through)
  57
  58     my $tt_args = {
  59       map {
  60         my $arg = $args->{$_};
  61         ($_ => (ref $arg eq 'CODE' ? sub { $arg->($self, $args) } : $arg))
  62       } grep { !/^_/ } keys %$args
  63     };
  64
  65     $body .= $lset->tt_view->include($fname, $tt_args);
  66 #warn "rendered ${fname}, body length now ".length($body)."\n";
  67   };
  68
  69 };
  70
  71 package Reaction::UI::Renderer::TT::Iter;
  72
  73 use overload (
  74   q{""} => 'stringify',
  75   fallback => 1
  76 );
  77
  78 sub pos { shift->{pos} }
  79
  80 sub new {
  81   my ($class, $cr, $rctx) = @_;
  82   bless({ rctx => $rctx, cr => $cr, pos => 0 }, $class);
  83 }
  84
  85 sub next {
  86   my $self = shift;
  87   $self->{pos}++;
  88   my $next = $self->{cr}->();
  89   return unless $next;
  90   return sub { $next->($self->{rctx}) };
  91 }
  92
  93 sub all {
  94   my $self = shift;
  95   my @all;
  96   while (my $e = $self->next) {
  97     push(@all, $e);
  98   }
  99   \@all;
 100 }
 101
 102 sub stringify {
 103   my $self = shift;
 104   my $res = '';
 105   foreach my $e (@{$self->all}) {
 106     $res .= $e->();
 107   }
 108   $res;
 109 }
 110
 111 1;