It is starting to look like this may actually work after all. Listview is the only...
[catagits/Reaction.git] / lib / Reaction / UI / LayoutSet / TT.pm
1 package Reaction::UI::LayoutSet::TT;
2
3 use Reaction::Class;
4 use aliased 'Reaction::UI::LayoutSet';
5 use aliased 'Template::View';
6
7 class TT is LayoutSet, which {
8
9   has 'tt_view' => (is => 'rw', isa => View, lazy_fail => 1);
10
11   implements 'BUILD' => as {
12     my ($self, $args) = @_;
13
14     # Do this at build time rather than on demand so any exception if it
15     # goes wrong gets thrown sometime sensible
16
17     $self->tt_view($self->_build_tt_view($args));
18   };
19
20   implements '_build_tt_view' => as {
21     my ($self, $args) = @_;
22     my $tt_object = $args->{tt_object}
23       || confess "tt_object not provided to new()";
24     my $tt_args = { data => {} };
25     my $name = $self->name;
26     $name =~ s/\//__/g; #slashes are not happy here...
27     my $fragments = $self->fragments;
28     my $tt_source = qq{[% VIEW ${name};\n\n}.
29                     join("\n\n",
30                       map {
31                         qq{BLOCK $_; -%]\n}.$fragments->{$_}.qq{\n[% END;};
32                       } keys %$fragments
33                    ).qq{\nEND; # End view\ndata.view = ${name};\n %]};
34     $tt_object->process(\$tt_source, $tt_args)
35       || confess "Template processing error: ".$tt_object->error
36                 ." processing:\n${tt_source}";
37     confess "View template processed but no view object found"
38            ." after processing:\n${tt_source}"
39       unless $tt_args->{data}{view};
40     return $tt_args->{data}{view};
41   };
42
43 };
44
45 1;