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         (
  15             $r->model_class
  16               && File::Spec->catdir( $root, $r->model_class->moniker )
  17         ),
  18         File::Spec->catdir( $root, "custom" ),
  19         File::Spec->catdir( $root, "factory" )
  20     );
  21 }
  22
  23 sub vars {
  24     my ( $self, $r ) = @_;
  25     my $class = $r->model_class;
  26     my $base  = $r->config->uri_base;
  27     $base =~ s/\/+$//;
  28     my %args = (
  29         request => $r,
  30         objects => $r->objects,
  31         base    => $base,
  32         config  => $r->config
  33
  34           # ...
  35     );
  36     if ($class) {
  37         $args{classmetadata} = {
  38             name              => $class,
  39             table             => $class->table,
  40             columns           => [ $class->display_columns ],
  41             list_columns      => [ $class->list_columns ],
  42             colnames          => { $class->column_names },
  43             related_accessors => [ $class->related($r) ],
  44             moniker           => $class->moniker,
  45             plural            => $class->plural_moniker,
  46             cgi               => { $class->to_cgi },
  47         };
  48
  49         # User-friendliness facility for custom template writers.
  50         if ( @{ $r->objects || [] } > 1 ) {
  51             $args{ $r->model_class->plural_moniker } = $r->objects;
  52         }
  53         else {
  54             ( $args{ $r->model_class->moniker } ) = @{ $r->objects || [] };
  55         }
  56     }
  57
  58     # Overrides
  59     %args = ( %args, %{ $r->{template_args} || {} } );
  60     %args;
  61 }
  62
  63 sub process {
  64     my ( $self, $r ) = @_;
  65     $r->{content_type}      ||= "text/html";
  66     $r->{document_encoding} ||= "utf-8";
  67     my $status = $self->template($r);
  68     return $self->error($r) if $status != OK;
  69     return OK;
  70 }
  71
  72 sub error {
  73     my ( $self, $r ) = @_;
  74     warn $r->{error};
  75     if ( $r->{error} =~ /not found$/ ) {
  76
  77         # This is a rough test to see whether or not we're a template or
  78         # a static page
  79         return -1 unless @{ $r->{objects} || [] };
  80
  81         $r->{error} = <<EOF;
  82
  83 <H1> Template not found </H1>
  84
  85 This template was not found while processing the following request:
  86
  87 <B>@{[$r->{action}]}</B> on table <B>@{[ $r->{table} ]}</B> with objects:
  88
  89 <PRE>
  90 @{[join "\n", @{$r->{objects}}]}
  91 </PRE>
  92
  93 Looking for template <B>@{[$r->{template}]}</B> in paths:
  94
  95 <PRE>
  96 @{[ join "\n", $self->paths($r) ]}
  97 </PRE>
  98 EOF
  99         $r->{content_type} = "text/html";
 100         $r->{output}       = $r->{error};
 101         return OK;
 102     }
 103     $r->{content_type} = "text/plain";
 104     $r->{output}       = $r->{error};
 105     $r->send_output;
 106     return ERROR;
 107 }
 108
 109 sub template { die shift() . " didn't define a decent template method!" }
 110
 111 1;
 112
 113
 114 =head1 NAME
 115
 116 Maypole::View::Base - Base cl
 117
 118 =head1 DESCRIPTION
 119
 120 This is the base class for Maypole view classes. This is an abstract class
 121 meant to define the interface, and can't be used directly.
 122
 123 =head2 process
 124
 125 This is the engine of this module. It populates all the relevant variables
 126 and calls the requested action.
 127
 128 Anyone subclassing this for a different database abstraction mechanism
 129 needs to provide the following methods:
 130
 131 =head2 template
 132
 133 In this method you do the actual processing of your template. it should use L<paths>
 134 to search for components, and provide the templates with easy access to the contents
 135 of L<vars>. It should put the result in $r->{output} and return OK if processing was
 136 sucessfull, or populate $r->{error} and return ERROR if it fails.
 137
 138 =head1 Other overrides
 139
 140 Additionally, individual derived model classes may want to override the
 141
 142 =head2 new
 143
 144 The default constructor does nothing. You can override this to perform actions
 145 during view initialization.
 146
 147 =head2 paths
 148
 149 Returns search paths for templates. the default method returns factory, custom and
 150 <tablename> under the configured template root.
 151
 152 =head2 vars
 153
 154 returns a hash of data the template should have access to. The default one populates
 155 classmetadata if there is a class, as well as setting the data objects by name if
 156 there is one or more objects available.
 157
 158 =head2 error
 159
 160
 161 =cut