Commit | Line | Data |
7adfd53f |
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 | |
7adfd53f |
9 | has 'iter_class' => ( |
10 | is => 'ro', required => 1, |
11 | default => sub { 'Reaction::UI::Renderer::TT::Iter'; }, |
12 | ); |
13 | |
14 | implements 'render' => as { |
d8c7a86e |
15 | my ($self, $lset, $fname, $args) = @_; |
7adfd53f |
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 | } |
d8c7a86e |
44 | $lset->tt_view->include($fname, $tt_args); |
7adfd53f |
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; |