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         # ...
  31     );
  32     $args{classmetadata} = {
  33         name => $class,
  34         columns => [ $class->columns ],
  35         colnames => { $class->column_names },
  36         moniker => $class->moniker,
  37         plural  => $class->plural_moniker,
  38         cgi => { $class->to_cgi },
  39         description => $class->description
  40     };
  41
  42     # User-friendliness facility for custom template writers.
  43     if (@{$r->objects} > 1){
  44         $args{$r->model_class->plural_moniker} = $r->objects;
  45     } else {
  46         ($args{$r->model_class->moniker}) = @{$r->objects};
  47     }
  48
  49     # Overrides
  50     %args = (%args, %{$r->{template_args}||{}});
  51     %args;
  52 }
  53
  54 sub process {
  55     my ($self, $r) = @_;
  56     my $template = $self->_tt($r);
  57     my $output;
  58     $template->process($r->template, { $self->_args($r) }, \$output)
  59     || $self->error($r, $template->error);
  60     $r->{ar}->content_type("text/html");
  61     $r->{ar}->headers_out->set("Content-Length" => length $output);
  62     $r->{ar}->send_http_header;
  63     $r->{ar}->print($output);
  64     return 200;
  65 }
  66
  67 sub error {
  68     my ($self, $r, $error) = @_;
  69     $r->{ar}->send_http_header("text/plain");
  70     $r->{ar}->print($error);
  71     exit;
  72 }