lib/Apache/MVC/View/TT.pm

   1 package Apache::MVC::View::TT;
   2 use Lingua::EN::Inflect;
   3 use Template;
   4 use File::Spec;
   5 use UNIVERSAL::moniker;
   6 use strict;
   7
   8
   9 sub new { bless {}, shift } # Not worth having
  10
  11 sub _tt {
  12     my ($self, $r) = @_;
  13     my $root = $r->config->{template_root};
  14     Template->new({ INCLUDE_PATH => [
  15         $root,
  16         File::Spec->catdir($root, $r->model_class->moniker),
  17         File::Spec->catdir($root, "custom"),
  18         File::Spec->catdir($root, "factory")
  19     ]});
  20 }
  21
  22 sub _args {
  23     my ($self, $r) = @_;
  24     my $class = $r->model_class;
  25     my %args = (
  26         request => $r,
  27         class   => $class,
  28         objects => $r->objects,
  29         base    => $r->config->{uri_base},
  30         config  => $r->config
  31         # ...
  32     );
  33     $args{classmetadata} = {
  34         name => $class,
  35         columns => [ $class->columns ],
  36         colnames => { $class->column_names },
  37         related_accessors => [ $class->related($r) ],
  38         moniker => $class->moniker,
  39         plural  => $class->plural_moniker,
  40         cgi => { $class->to_cgi },
  41         description => $class->description
  42     };
  43
  44     # User-friendliness facility for custom template writers.
  45     if (@{$r->objects} > 1){
  46         $args{$r->model_class->plural_moniker} = $r->objects;
  47     } else {
  48         ($args{$r->model_class->moniker}) = @{$r->objects};
  49     }
  50
  51     # Overrides
  52     %args = (%args, %{$r->{template_args}||{}});
  53     %args;
  54 }
  55
  56 sub process {
  57     my ($self, $r) = @_;
  58     my $template = $self->_tt($r);
  59     my $output;
  60     $template->process($r->template, { $self->_args($r) }, \$output)
  61     || $self->error($r, $template->error);
  62     $r->{ar}->content_type("text/html");
  63     $r->{ar}->headers_out->set("Content-Length" => length $output);
  64     $r->{ar}->send_http_header;
  65     $r->{ar}->print($output);
  66     return 200;
  67 }
  68
  69 sub error {
  70     my ($self, $r, $error) = @_;
  71     $r->{ar}->send_http_header("text/plain");
  72     $r->{ar}->print($error);
  73     exit;
  74 }