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     $r->{document_encoding} ||= "utf-8";
  64     return OK;
  65 }
  66
  67 sub error {
  68     my ($self, $r) = @_;
  69     warn $r->{error};
  70     if ($r->{error} =~ /not found$/) {
  71         # This is a rough test to see whether or not we're a template or
  72         # a static page
  73         return -1 unless @{$r->{objects}||[]};
  74
  75         $r->{error} = <<EOF;
  76
  77 <H1> Template not found </H1>
  78
  79 This template was not found while processing the following request:
  80
  81 <B>@{[$r->{action}]}</B> on table <B>@{[ $r->{table} ]}</B> with objects:
  82
  83 <PRE>
  84 @{[join "\n", @{$r->{objects}}]}
  85 </PRE>
  86
  87 Looking for template <B>@{[$r->{template}]}</B> in paths:
  88
  89 <PRE>
  90 @{[ join "\n", $self->paths($r) ]}
  91 </PRE>
  92 EOF
  93         $r->{content_type} = "text/html";
  94         $r->{output} = $r->{error};
  95         return OK;
  96     }
  97     $r->{content_type} = "text/plain";
  98     $r->{output} = $r->{error};
  99     $r->send_output;
 100     return ERROR;
 101 }
 102
 103 sub template { die shift()." didn't define a decent template method!" }
 104
 105 1;