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 'tt_view' => ( is => 'ro', required => 1, isa => View);
  10
  11   has 'iter_class' => (
  12     is => 'ro', required => 1,
  13     default => sub { 'Reaction::UI::Renderer::TT::Iter'; },
  14   );
  15
  16   implements 'render' => as {
  17     my ($self, $fname, $args) = @_;
  18
  19     # foreach non-_ prefixed key in the args
  20     # build a subref for this key that passes self so the generator has a
  21     # rendering context when [% key %] is evaluated by TT as $val->()
  22     # (assuming it's a subref - if not just pass through)
  23
  24     my $tt_args = {
  25       map {
  26         my $arg = $args->{$_};
  27         ($_ => (ref $arg eq 'CODE' ? sub { $arg->($self) } : $arg))
  28       } grep { !/^_/ } keys %$args
  29     };
  30
  31     # if there's an _ key that's our current topic (decalarative syntax
  32     # sees $_ as $_{_}) so build an iterator around it.
  33
  34     # There's possibly a case for making everything an iterator but I think
  35     # any fragment should only have a single multiple arg
  36
  37     # we also create a 'pos' shortcut to content.pos for brevity
  38
  39     if (my $topic = $args->{_}) {
  40       my $iter = $self->iter_class->new(
  41         $topic, $self
  42       );
  43       $tt_args->{content} = $iter;
  44       $tt_args->{pos} = sub { $iter->pos };
  45     }
  46     $self->tt_view->include($fname, $tt_args);
  47   };
  48
  49 };
  50
  51 package Reaction::UI::Renderer::TT::Iter;
  52
  53 use overload (
  54   q{""} => 'stringify',
  55   fallback => 1
  56 );
  57
  58 sub pos { shift->{pos} }
  59
  60 sub new {
  61   my ($class, $cr, $rctx) = @_;
  62   bless({ rctx => $rctx, cr => $cr, pos => 0 }, $class);
  63 }
  64
  65 sub next {
  66   my $self = shift;
  67   $self->{pos}++;
  68   my $next = $self->{cr}->();
  69   return unless $next;
  70   return sub { $next->($self->{rctx}) };
  71 }
  72
  73 sub all {
  74   my $self = shift;
  75   my @all;
  76   while (my $e = $self->next) {
  77     push(@all, $e);
  78   }
  79   \@all;
  80 }
  81
  82 sub stringify {
  83   my $self = shift;
  84   my $res = '';
  85   foreach my $e (@{$self->all}) {
  86     $res .= $e->();
  87   }
  88   $res;
  89 }
  90
  91 1;