lib/Maypole/View/TT.pm

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