lib/Maypole/View/Base.pm

   1 package Maypole::View::Base;
   2 use File::Spec;
   3 use UNIVERSAL::moniker;
   4 use strict;
   5 use Maypole::Constants;
   6
   7 sub new { bless {}, shift } # By default, do nothing.
   8
   9 sub paths {
  10     my ($self, $r) = @_;
  11     my $root = $r->{config}{template_root} || $r->get_template_root;
  12     return (
  13         $root,
  14         ($r->model_class &&
  15             File::Spec->catdir($root, $r->model_class->moniker)),
  16         File::Spec->catdir($root, "custom"),
  17         File::Spec->catdir($root, "factory")
  18     );
  19 }
  20
  21 sub vars {
  22     my ($self, $r) = @_;
  23     my $class = $r->model_class;
  24     my $base = $r->{config}->{uri_base};
  25     $base =~ s/\/+$//;
  26     my %args = (
  27         request => $r,
  28         objects => $r->objects,
  29         base    => $base,
  30         config  => $r->config
  31         # ...
  32     ) ;
  33     if ($class) {
  34         $args{classmetadata} = {
  35             name => $class,
  36             table => $class->table,
  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         };
  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 $status = $self->template($r);
  61     return $self->error($r) if $status != OK;
  62     $r->{content_type} ||= "text/html";
  63     return OK;
  64 }
  65
  66 sub error {
  67     my ($self, $r) = @_;
  68     warn $r->{error};
  69     if ($r->{error} =~ /not found$/) {
  70         # This is a rough test to see whether or not we're a template or
  71         # a static page
  72         return -1 unless @{$r->{objects}||[]};
  73
  74         $r->{error} = <<EOF;
  75
  76 <H1> Template not found </H1>
  77
  78 This template was not found while processing the following request:
  79
  80 <B>@{[$r->{action}]}</B> on table <B>@{[ $r->{table} ]}</B> with objects:
  81
  82 <PRE>
  83 @{[join "\n", @{$r->{objects}}]}
  84 </PRE>
  85
  86 Looking for template <B>@{[$r->{template}]}</B> in paths:
  87
  88 <PRE>
  89 @{[ join "\n", $self->paths($r) ]}
  90 </PRE>
  91 EOF
  92         $r->{content_type} = "text/html";
  93         $r->{output} = $r->{error};
  94         return OK;
  95     }
  96     $r->{content_type} = "text/plain";
  97     $r->{output} = $r->{error};
  98     $r->send_output;
  99     return ERROR;
 100 }
 101
 102 sub template { die shift()." didn't define a decent template method!" }
 103
 104 1;