Removed last direct accesses to hash keys. Broke

out some code into a couple of extra methods for clarity.

git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@384 48953598-375a-da11-a14b-00016c27c3ee

diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index 73c9e75ed61d9918a180c1b0e6aedaee3a21ae10..bc4a5aac96d06376fbb7a01b4bd704adab4f2939 100644 (file)
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -35,8 +35,8 @@ sub setup
     
     $config->model || $config->model('Maypole::Model::CDBI');
     
-    $config->model->require or die 
-        "Couldn't load the model class $config->{model}: $@";
+    $config->model->require or die sprintf 
+        "Couldn't load the model class %s: %s", $config->model, $@;
     
     $config->model->setup_database($config, $calling_class, @_);
     
@@ -85,9 +85,13 @@ sub handler : method
     
     $r->get_request($req);
     
-    $r->parse_location();
+    $r->parse_location;
     
-    my $status = $r->handler_guts();
+    my $status = $r->handler_guts;
+    
+    # moving this here causes unit test failures - need to check why
+    # before committing the move
+    #$status = $r->__call_process_view unless $r->output;
     
     return $status unless $status == OK;
     
@@ -103,20 +107,10 @@ sub handler_guts
     
     $r->__load_model;
 
-    my $applicable = $r->is_applicable;
+    my $applicable = __to_boolean $r->is_applicable;
+    
+    $r->__setup_plain_template unless $applicable;
     
-    unless ( $applicable == OK ) 
-    {
-        # It's just a plain template
-        $r->model_class(undef);
-        
-        my $path = $r->path;
-        $path =~ s{/$}{};    # De-absolutify
-        $r->path($path);
-        
-        $r->template($r->path);
-    }
-
     # We authenticate every request, needed for proper session management
     my $status;
     
@@ -144,13 +138,14 @@ sub handler_guts
     # We run additional_data for every request
     $r->additional_data;
     
-    if ( $applicable == OK ) 
+    if ($applicable) 
     {
         eval { $r->model_class->process($r) };
         
         if ( my $error = $@ ) 
         {
             $status = $r->call_exception($error);
+            
             if ( $status != OK ) 
             {
                 warn "caught model error: $error";
@@ -166,6 +161,25 @@ sub handler_guts
     return $r->__call_process_view;
 }
 
+# is_applicable() returned false, so set up a plain template. Model processing 
+# will be skipped, but need to remove the model anyway so the template can't 
+# access it. 
+sub __setup_plain_template
+{
+    my ($r) = @_;
+    
+    # It's just a plain template
+    $r->model_class(undef);
+    
+    my $path = $r->path;
+    $path =~ s{/$}{};    # De-absolutify
+    $r->path($path);
+    
+    $r->template($r->path);
+}
+
+# The model has been processed or skipped (if is_applicable returned false), 
+# any exceptions have been handled, and there's no content in $r->output
 sub __call_process_view
 {
     my ($r) = @_;
@@ -194,48 +208,72 @@ sub __load_model
     $r->model_class( $r->config->model->class_of($r, $r->table) );
 }
 
-sub is_applicable {
-    my $self   = shift;
-    my $config = $self->config;
+# is_applicable() should return true or false, not OK or DECLINED, because 
+# the return value is never used as the return value from handler(). There's 
+# probably a lot of code out there supplying the return codes though, so instead 
+# of changing is_applicable() to return 0 or 1, the return value is passed through 
+# __to_boolean. I think it helps handler_guts() if we don't have multiple sets of 
+# return codes being checked for different things.
+sub is_applicable 
+{
+    my ($r) = @_;
+    
+    my $config = $r->config;
+    
     $config->ok_tables || $config->ok_tables( $config->display_tables );
+    
     $config->ok_tables( { map { $_ => 1 } @{ $config->ok_tables } } )
       if ref $config->ok_tables eq "ARRAY";
-    warn "We don't have that table ($self->{table}).\n"
+      
+    my $table = $r->table;
+    
+    warn "We don't have that table ($table).\n"
       . "Available tables are: "
-      . join( ",", @{ $config->{display_tables} } )
-      if $self->debug
-      and not $config->ok_tables->{ $self->{table} }
-      and $self->{action};
-    return DECLINED() unless exists $config->ok_tables->{ $self->{table} };
+      . join( ",", @{ $config->display_tables } )
+            if $r->debug
+                and not $config->ok_tables->{$table}
+                        and $r->action; # I think this is always true
+                        
+    return DECLINED unless exists $config->ok_tables->{$table};
 
     # Is it public?
-    return DECLINED unless $self->model_class->is_public( $self->{action} );
-    return OK();
+    return DECLINED unless $r->model_class->is_public( $r->action );
+    
+    return OK;
 }
 
-sub call_authenticate {
-    my $self = shift;
+# *only* intended for translating the return code from is_applicable()
+sub __to_boolean ($) { $_[0] == OK ? 1 : 0 }
+
+
+
+sub call_authenticate 
+{
+    my ($r) = @_;
 
     # Check if we have a model class
-    if ( $self->{model_class} ) {
-        return $self->model_class->authenticate($self)
-          if $self->model_class->can("authenticate");
-    }
-    return $self->authenticate($self);   # Interface consistency is a Good Thing
+    return $r->model_class->authenticate($r) 
+        if  $r->model_class 
+        and $r->model_class->can('authenticate');
+    
+    # passing $r is unnecessary and redundant, but there's probably 
+    # a lot of code out there now using the 2nd instead of the 1st $r,
+    # so we may as well leave it
+    return $r->authenticate($r);   
 }
 
-sub call_exception {
-    my $self = shift;
-    my ($error) = @_;
+sub call_exception 
+{
+    my ($r, $error) = @_;
 
     # Check if we have a model class
-    if (   $self->{model_class}
-        && $self->model_class->can('exception') )
+    if ( $r->model_class && $r->model_class->can('exception') )
     {
-        my $status = $self->model_class->exception( $self, $error );
+        my $status = $r->model_class->exception( $r, $error );
         return $status if $status == OK;
     }
-    return $self->exception($error);
+    
+    return $r->exception($error);
 }
 
 sub additional_data { }
@@ -244,35 +282,38 @@ sub authenticate { return OK }
 
 sub exception { return ERROR }
 
-sub parse_path {
-    my $self = shift;
-    $self->{path} ||= "frontpage";
-    my @pi = $self->{path} =~ m{([^/]+)/?}g;
-    $self->{table}  = shift @pi;
-    $self->{action} = shift @pi;
-    $self->{action} ||= "index";
-    $self->{args}   = \@pi;
+sub parse_path 
+{
+    my ($r) = @_;
+    
+    $r->path || $r->path('frontpage');
+    
+    my @pi = grep {length} split '/', $r->path;
+    
+    $r->table(shift @pi);
+    
+    $r->action( shift @pi or 'index' );
+    
+    $r->args(\@pi);
 }
 
-sub param { # like CGI::param(), but read-only
-    my $r = shift;
-    my ($key) = @_;
-    if (defined $key) {
-        unless (exists $r->{params}{$key}) {
-            return wantarray() ? () : undef;
-        }
-        my $val = $r->{params}{$key};
-        if (wantarray()) {
-            return ref $val ? @$val : $val;
-        } else {
-            return ref $val ? $val->[0] : $val;
-        }
-    } else {
-        return keys %{$r->{params}};
-    }
+# like CGI::param(), but read only 
+sub param 
+{ 
+    my ($r, $key) = @_;
+    
+    return keys %{$r->params} unless defined $key;
+    
+    return unless exists $r->params->{$key};
+    
+    my $val = $r->params->{$key};
+    
+    return ref $val ? @$val : ($val) if wantarray;
+        
+    return ref $val ? $val->[0] : $val;
 }
 
-sub get_template_root { "." }
+sub get_template_root {'.'}
 sub get_request       { }
 
 sub parse_location {