lib/Maypole/View/TT.pm

   1 package Maypole::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     # This bit sucks.
  14     my $root = $r->{config}{template_root} || $r->get_template_root;
  15     Template->new({ INCLUDE_PATH => [
  16         $root,
  17         ($r->model_class && File::Spec->catdir($root, $r->model_class->moniker)),
  18         File::Spec->catdir($root, "custom"),
  19         File::Spec->catdir($root, "factory")
  20     ]});
  21 }
  22
  23 sub _args {
  24     my ($self, $r) = @_;
  25     my $class = $r->model_class;
  26     my %args = (
  27         request => $r,
  28         objects => $r->objects,
  29         base    => $r->config->{uri_base},
  30         config  => $r->config
  31         # ...
  32     ) ;
  33     if ($class) {
  34         $args{classmetadata} = {
  35             name => $class,
  36             columns => [ $class->display_columns ],
  37             colnames => { $class->column_names },
  38             related_accessors => [ $class->related($r) ],
  39             moniker => $class->moniker,
  40             plural  => $class->plural_moniker,
  41             cgi => { $class->to_cgi },
  42             description => $class->description
  43         };
  44
  45         # User-friendliness facility for custom template writers.
  46         if (@{$r->objects || []} > 1) {
  47             $args{$r->model_class->plural_moniker} = $r->objects;
  48         } else {
  49             ($args{$r->model_class->moniker}) = @{$r->objects ||[]};
  50         }
  51     }
  52
  53     # Overrides
  54     %args = (%args, %{$r->{template_args}||{}});
  55     %args;
  56 }
  57
  58 sub process {
  59     my ($self, $r) = @_;
  60     my $template = $self->_tt($r);
  61     my $output;
  62     $template->process($r->template, { $self->_args($r) }, \$output)
  63     || return $self->error($r, $template->error);
  64
  65     $r->{content_type} ||= "text/html";
  66     $r->{output} = $output;
  67     return 200;
  68 }
  69
  70 sub error {
  71     my ($self, $r, $error) = @_;
  72     warn $error;
  73     if ($error =~ /not found$/) { return -1 }
  74     $r->{content_type} = "text/plain";
  75     $r->{output} = $error;
  76     $r->send_output;
  77     exit;
  78 }
  79
  80 1;