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