X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FView%2FBase.pm;h=81e50446693305c9491e603fe0d46f20e7b11867;hb=a5321bee0139be5c35a1e1ceee47c57138f22f18;hp=8229d2193387f1c7b8c0f9862d882f35d75f05ba;hpb=5c9dc9134cf6a75aa65f91dc5eb02c4a294d21b8;p=maypole.git

diff --git a/lib/Maypole/View/Base.pm b/lib/Maypole/View/Base.pm
index 8229d21..81e5044 100644
--- a/lib/Maypole/View/Base.pm
+++ b/lib/Maypole/View/Base.pm
@@ -1,102 +1,177 @@
 package Maypole::View::Base;
+use Class::C3;
 use File::Spec;
 use UNIVERSAL::moniker;
 use strict;
 use Maypole::Constants;
+use Carp;
 
-sub new { bless {}, shift } # By default, do nothing.
+sub new { bless {}, shift }    # By default, do nothing.
 
 sub paths {
-    my ($self, $r) = @_;
-    my $root = $r->{config}{template_root} || $r->get_template_root;
-    return (
-        $root,
-        ($r->model_class && 
-            File::Spec->catdir($root, $r->model_class->moniker)),
-        File::Spec->catdir($root, "custom"),
-        File::Spec->catdir($root, "factory")
-    );
+    my ( $self, $r ) = @_;
+    my $root = $r->config->template_root || $r->get_template_root;
+    if(ref($root) ne 'ARRAY') {
+	$root = [ $root ];
+    }
+    my @output = ();
+    my $i = 0;
+    foreach my $path (@$root) {
+	push(@output,
+	     (
+              $r->model_class
+	      && File::Spec->catdir( $path, $r->model_class->table )
+	      )
+	     );
+	push(@output, File::Spec->catdir( $path, "custom" )) unless ($i);
+	push(@output, $path);
+	push(@output, File::Spec->catdir( $path, "factory" )) unless ($i);
+	$i = 1;
+    }
+
+    return grep( $_, @output);
 }
 
 sub vars {
-    my ($self, $r) = @_;
+    my ( $self, $r ) = @_;
     my $class = $r->model_class;
+    my $base  = $r->config->uri_base;
+    $base =~ s/\/+$//;
     my %args = (
         request => $r,
         objects => $r->objects,
-        base    => $r->config->{uri_base},
-        config  => $r->config
-        # ...
-    ) ;
-    if ($class) { 
-        $args{classmetadata} = {
-            name => $class,
-            table => $class->table,
-            columns => [ $class->display_columns ],
-            colnames => { $class->column_names },
-            related_accessors => [ $class->related($r) ],
-            moniker => $class->moniker,
-            plural  => $class->plural_moniker,
-            cgi => { $class->to_cgi },
-        };
+        base    => $base,
+        config  => $r->config,
+    );
+
+    $args{object} = $r->object if ($r->can('object'));
+
+    if ($class) {
+        my $classmeta = $r->template_args->{classmetadata} ||= {};
+        $classmeta->{name}              ||= $class;
+        $classmeta->{table}             ||= $class->table;
+        $classmeta->{columns}           ||= [ $class->display_columns ] if ($class->can('display_columns'));
+        $classmeta->{list_columns}      ||= [ $class->list_columns ] if ($class->can('list_columns'));
+        $classmeta->{colnames}          ||= { $class->column_names } if ($class->can('column_names'));
+        $classmeta->{related_accessors} ||= [ $class->related($r) ];
+        $classmeta->{moniker}           ||= $class->moniker;
+        $classmeta->{plural}            ||= $class->plural_moniker;
+        $classmeta->{cgi}               ||= { $class->to_cgi } if ($r->build_form_elements && $class->can('to_cgi'));
+	$classmeta->{stringify_column}  ||= $class->stringify_column if ($class->can('stringify_column'));
 
         # User-friendliness facility for custom template writers.
-        if (@{$r->objects || []} > 1) { 
-            $args{$r->model_class->plural_moniker} = $r->objects;
-        } else {
-            ($args{$r->model_class->moniker}) = @{$r->objects ||[]};
+        if ( @{ $r->objects || [] } > 1 ) {
+            $args{ $r->model_class->plural_moniker } = $r->objects;
+        }
+        else {
+            ( $args{ $r->model_class->moniker } ) = @{ $r->objects || [] };
         }
     }
 
     # Overrides
-    %args = (%args, %{$r->{template_args}||{}});
+    %args = ( %args, %{ $r->template_args || {} } );
     %args;
 }
 
 sub process {
-    my ($self, $r) = @_;
+    my ( $self, $r ) = @_;
     my $status = $self->template($r);
     return $self->error($r) if $status != OK;
-    $r->{content_type} ||= "text/html";
     return OK;
 }
 
 sub error {
-    my ($self, $r) = @_;
-    warn $r->{error};
-    if ($r->{error} =~ /not found$/) { 
+    my ( $self, $r, $desc ) = @_;
+    $desc = $desc ? "$desc: " : "";
+    if ( $r->{error} =~ /not found$/ ) {
+	warn "template not found error : ", $r->{error};
         # This is a rough test to see whether or not we're a template or
         # a static page
-        return -1 unless @{$r->{objects}||[]}; 
+        return -1 unless @{ $r->{objects} || [] };
 
+	my $template_error = $r->{error};
         $r->{error} = <<EOF;
+<h1> Template not found </h1>
 
-<H1> Template not found </H1>
-
-This template was not found while processing the following request:
+A template was not found while processing the following request:
 
-<B>@{[$r->{action}]}</B> on table <B>@{[ $r->{table} ]}</B> with objects:
+<strong>@{[$r->{action}]}</strong> on table
+<strong>@{[ $r->{table} ]}</strong> with objects:
 
-<PRE>
+<pre>
 @{[join "\n", @{$r->{objects}}]}
-</PRE>
+</pre>
 
-Looking for template <B>@{[$r->{template}]}</B> in paths:
 
-<PRE>
+The main template is <strong>@{[$r->{template}]}</strong>.
+The template subsystem's error message was
+<pre>
+$template_error
+</pre>
+We looked in paths:
+
+<pre>
 @{[ join "\n", $self->paths($r) ]}
-</PRE>
+</pre>
 EOF
         $r->{content_type} = "text/html";
-        $r->{output} = $r->{error};
+        $r->{output}       = $r->{error};
         return OK;
     }
-    $r->{content_type} = "text/plain";
-    $r->{output} = $r->{error};
-    $r->send_output;
     return ERROR;
 }
 
-sub template { die shift()." didn't define a decent template method!" }
+sub template { die shift() . " didn't define a decent template method!" }
 
 1;
+
+
+=head1 NAME
+
+Maypole::View::Base - Base class for view classes
+
+=head1 DESCRIPTION
+
+This is the base class for Maypole view classes. This is an abstract class
+that defines the interface, and can't be used directly.
+
+=head2 process
+
+This is the entry point for the view. It templates the request and returns a
+C<Maypole::Constant> indicate success or failure for the view phase.
+
+Anyone subclassing this for a different rendering mechanism needs to provide
+the following methods:
+
+=head2 template
+
+In this method you do the actual processing of your template. it should use
+L<paths> to search for components, and provide the templates with easy access
+to the contents of L<vars>. It should put the result in C<$r-E<gt>output> and
+return C<OK> if processing was sucessfull, or populate C<$r-E<gt>error> and
+return C<ERROR> if it fails.
+
+=head1 Other overrides
+
+Additionally, individual derived model classes may want to override the
+
+=head2 new
+
+The default constructor does nothing. You can override this to perform actions
+during view initialization.
+
+=head2 paths
+
+Returns search paths for templates. the default method returns folders for the
+model class's C<moniker>, factory, custom under the configured template root.
+
+=head2 vars
+
+returns a hash of data the template should have access to. The default one
+populates classmetadata if there is a table class, as well as setting the data
+objects by name if there is one or more objects available.
+
+=head2 error
+
+
+=cut