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     # if there's an _ key that's our current topic (decalarative syntax
  66     # sees $_ as $_{_}) so build an iterator around it.
  67
  68     # There's possibly a case for making everything an iterator but I think
  69     # any fragment should only have a single multiple arg
  70
  71     # we also create a 'pos' shortcut to content.pos for brevity
  72
  73     if (my $topic = $args->{_}) {
  74       my $iter = $self->iter_class->new(
  75         $topic, $self
  76       );
  77       $tt_args->{content} = $iter;
  78       $tt_args->{pos} = sub { $iter->pos };
  79     }
  80     $body .= $lset->tt_view->include($fname, $tt_args);
  81 #warn "rendered ${fname}, body length now ".length($body)."\n";
  82   };
  83
  84 };
  85
  86 package Reaction::UI::Renderer::TT::Iter;
  87
  88 use overload (
  89   q{""} => 'stringify',
  90   fallback => 1
  91 );
  92
  93 sub pos { shift->{pos} }
  94
  95 sub new {
  96   my ($class, $cr, $rctx) = @_;
  97   bless({ rctx => $rctx, cr => $cr, pos => 0 }, $class);
  98 }
  99
 100 sub next {
 101   my $self = shift;
 102   $self->{pos}++;
 103   my $next = $self->{cr}->();
 104   return unless $next;
 105   return sub { $next->($self->{rctx}) };
 106 }
 107
 108 sub all {
 109   my $self = shift;
 110   my @all;
 111   while (my $e = $self->next) {
 112     push(@all, $e);
 113   }
 114   \@all;
 115 }
 116
 117 sub stringify {
 118   my $self = shift;
 119   my $res = '';
 120   foreach my $e (@{$self->all}) {
 121     $res .= $e->();
 122   }
 123   $res;
 124 }
 125
 126 1;