X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole.pm;h=908662f844431fdfa6ca4dc2664abb672f9a8b86;hb=808f88dcc99bd004c98cbefb759da90512da58eb;hp=ad3912592d6e2cc1a2cf7ca3bd26fae7bdc08d6a;hpb=3cb5688a5b221bf3060590eb1f9713d77ce3aaaf;p=maypole.git

diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index ad39125..908662f 100644
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -11,7 +11,8 @@ our $VERSION = '2.10';
 
 # proposed privacy conventions:
 # - no leading underscore     - public to custom application code and plugins
-# - single leading underscore - private to the main Maypole stack - *not* including plugins
+# - single leading underscore - private to the main Maypole stack - *not*
+#     including plugins
 # - double leading underscore - private to the current package
 
 __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
@@ -63,6 +64,18 @@ sub init
 
 }
 
+sub new
+{
+    my ($class) = @_;
+    
+    my $self = bless {
+        template_args => {},
+        config        => $class->config,
+    }, $class;
+    
+    return $self;
+}
+
 # handler() has a method attribute so that mod_perl will invoke
 # BeerDB->handler() as a method rather than a plain function
 # BeerDB::handler() and so this inherited implementation will be
@@ -75,27 +88,22 @@ sub handler : method
     
     $class->init unless $class->init_done;
 
-    # Create the request object
-    my $r = bless {
-        template_args => {},
-        config        => $class->config
-    }, $class;
-    
-    $r->headers_out(Maypole::Headers->new);
+    my $self = $class->new;
     
-    $r->get_request($req);
+    # initialise the request
+    $self->headers_out(Maypole::Headers->new);
+    $self->get_request($req);
+    $self->parse_location;
     
-    $r->parse_location;
-    
-    my $status = $r->handler_guts;
+    my $status = $self->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;
+    #$status = $self->__call_process_view unless $self->output;
     
     return $status unless $status == OK;
     
-    $r->send_output;
+    $self->send_output;
     
     return $status;
 }
@@ -103,62 +111,64 @@ sub handler : method
 # The root of all evil
 sub handler_guts 
 {
-    my ($r) = @_;
+    my ($self) = @_;
     
-    $r->__load_model;
+    $self->__load_model;
 
-    my $applicable = __to_boolean( $r->is_applicable );
+    my $applicable = __to_boolean( $self->is_applicable );
     
-    $r->__setup_plain_template unless $applicable;
+    $self->__setup_plain_template unless $applicable;
     
     # We authenticate every request, needed for proper session management
     my $status;
     
-    eval { $status = $r->call_authenticate };
+    eval { $status = $self->call_authenticate };
     
     if ( my $error = $@ ) 
     {
-        $status = $r->call_exception($error);
+        $status = $self->call_exception($error);
         
         if ( $status != OK ) 
         {
             warn "caught authenticate error: $error";
-            return $r->debug ? $r->view_object->error($r, $error) : ERROR;
+            return $self->debug ? 
+                    $self->view_object->error($self, $error) : ERROR;
         }
     }
     
-    if ( $r->debug and $status != OK and $status != DECLINED ) 
+    if ( $self->debug and $status != OK and $status != DECLINED ) 
     {
-        $r->view_object->error( $r,
+        $self->view_object->error( $self,
             "Got unexpected status $status from calling authentication" );
     }
     
     return $status unless $status == OK;
 
     # We run additional_data for every request
-    $r->additional_data;
+    $self->additional_data;
     
     if ($applicable) 
     {
-        eval { $r->model_class->process($r) };
+        eval { $self->model_class->process($self) };
         
         if ( my $error = $@ ) 
         {
-            $status = $r->call_exception($error);
+            $status = $self->call_exception($error);
             
             if ( $status != OK ) 
             {
                 warn "caught model error: $error";
-                return $r->debug ? $r->view_object->error($r, $error) : ERROR;
+                return $self->debug ? 
+                    $self->view_object->error($self, $error) : ERROR;
             }
         }
     }
     
-    # unusual path - perhaps output has been set to an error message
-    return OK if $r->output;
+    # less frequent path - perhaps output has been set to an error message
+    return OK if $self->output;
     
     # normal path - no output has been generated yet
-    return $r->__call_process_view;
+    return $self->__call_process_view;
 }
 
 # is_applicable() returned false, so set up a plain template. Model processing 
@@ -166,36 +176,37 @@ sub handler_guts
 # access it. 
 sub __setup_plain_template
 {
-    my ($r) = @_;
+    my ($self) = @_;
     
     # It's just a plain template
-    $r->model_class(undef);
+    $self->model_class(undef);
     
-    my $path = $r->path;
+    my $path = $self->path;
     $path =~ s{/$}{};    # De-absolutify
-    $r->path($path);
+    $self->path($path);
     
-    $r->template($r->path);
+    $self->template($self->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
+# any exceptions have been handled, and there's no content in $self->output
 sub __call_process_view
 {
-    my ($r) = @_;
+    my ($self) = @_;
     
     my $status;
     
-    eval { $status = $r->view_object->process($r) };
+    eval { $status = $self->view_object->process($self) };
     
     if ( my $error = $@ ) 
     {
-        $status = $r->call_exception($error);
+        $status = $self->call_exception($error);
         
         if ( $status != OK ) 
         {
-            warn "caught view error: $error" if $r->debug;
-            return $r->debug ? $r->view_object->error($r, $error) : ERROR;
+            warn "caught view error: $error" if $self->debug;
+            return $self->debug ? 
+                $self->view_object->error($self, $error) : ERROR;
         }
     }
     
@@ -204,40 +215,40 @@ sub __call_process_view
 
 sub __load_model
 {
-    my ($r) = @_;
-    $r->model_class( $r->config->model->class_of($r, $r->table) );
+    my ($self) = @_;
+    $self->model_class( $self->config->model->class_of($self, $self->table) );
 }
 
 # 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.
+# 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 -drb.
 sub is_applicable 
 {
-    my ($r) = @_;
+    my ($self) = @_;
     
-    my $config = $r->config;
+    my $config = $self->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";
+        if ref $config->ok_tables eq "ARRAY";
       
-    my $table = $r->table;
+    my $table = $self->table;
     
     warn "We don't have that table ($table).\n"
-      . "Available tables are: "
-      . join( ",", @{ $config->display_tables } )
-            if $r->debug
+        . "Available tables are: "
+        . join( ",", @{ $config->display_tables } )
+            if $self->debug
                 and not $config->ok_tables->{$table}
-                        and $r->action; # I think this is always true
+                        and $self->action; # this is probably always true
                         
     return DECLINED unless exists $config->ok_tables->{$table};
 
     # Is it public?
-    return DECLINED unless $r->model_class->is_public( $r->action );
+    return DECLINED unless $self->model_class->is_public($self->action);
     
     return OK;
 }
@@ -245,34 +256,33 @@ sub is_applicable
 # *only* intended for translating the return code from is_applicable()
 sub __to_boolean { $_[0] == OK ? 1 : 0 }
 
-
-
 sub call_authenticate 
 {
-    my ($r) = @_;
+    my ($self) = @_;
 
-    # Check if we have a model class
-    return $r->model_class->authenticate($r) 
-        if  $r->model_class 
-        and $r->model_class->can('authenticate');
+    # Check if we have a model class with an authenticate() to delegate to
+    return $self->model_class->authenticate($self) 
+        if $self->model_class and $self->model_class->can('authenticate');
     
-    # if the driver ($r) and the request ($r) ever get separated out 
-    # properly, then passing the request as an argument will make more sense
-    return $r->authenticate($r);   
+    # Interface consistency is a Good Thing - 
+    # the invocant and the argument may one day be different things 
+    # (i.e. controller and request), like they are when authenticate() 
+    # is called on a model class (i.e. model and request)
+    return $self->authenticate($self);   
 }
 
 sub call_exception 
 {
-    my ($r, $error) = @_;
+    my ($self, $error) = @_;
 
-    # Check if we have a model class
-    if ( $r->model_class && $r->model_class->can('exception') )
+    # Check if we have a model class with an exception() to delegate to
+    if ( $self->model_class && $self->model_class->can('exception') )
     {
-        my $status = $r->model_class->exception( $r, $error );
+        my $status = $self->model_class->exception( $self, $error );
         return $status if $status == OK;
     }
     
-    return $r->exception($error);
+    return $self->exception($error);
 }
 
 sub additional_data { }
@@ -283,29 +293,29 @@ sub exception { return ERROR }
 
 sub parse_path 
 {
-    my ($r) = @_;
+    my ($self) = @_;
     
-    $r->path || $r->path('frontpage');
+    $self->path || $self->path('frontpage');
     
-    my @pi = grep {length} split '/', $r->path;
+    my @pi = grep {length} split '/', $self->path;
     
-    $r->table(shift @pi);
+    $self->table(shift @pi);
     
-    $r->action( shift @pi or 'index' );
+    $self->action( shift @pi or 'index' );
     
-    $r->args(\@pi);
+    $self->args(\@pi);
 }
 
 # like CGI::param(), but read only 
 sub param 
 { 
-    my ($r, $key) = @_;
+    my ($self, $key) = @_;
     
-    return keys %{$r->params} unless defined $key;
+    return keys %{$self->params} unless defined $key;
     
-    return unless exists $r->params->{$key};
+    return unless exists $self->params->{$key};
     
-    my $val = $r->params->{$key};
+    my $val = $self->params->{$key};
     
     return ref $val ? @$val : ($val) if wantarray;
         
@@ -376,6 +386,10 @@ You should not call this directly, but you may wish to override this to
 add
 application-specific initialisation.
 
+=head3 new
+
+Constructs a very minimal new Maypole request object.
+
 =head3 view_object
 
 Get/set the Maypole::View object
@@ -475,9 +489,9 @@ or CGI request object, it defaults to blank.
 
 Returns a Maypole::Constant to indicate whether the request is valid.
 
-The default implementation checks that C<$r-E<gt>table> is publicly
+The default implementation checks that C<$self-E<gt>table> is publicly
 accessible
-and that the model class is configured to handle the C<$r-E<gt>action>
+and that the model class is configured to handle the C<$self-E<gt>action>
 
 =head3 authenticate
 
@@ -505,7 +519,7 @@ Get/set a list of model objects. The objects will be accessible in the
 view
 templates.
 
-If the first item in C<$r-E<gt>args> can be C<retrieve()>d by the model
+If the first item in C<$self-E<gt>args> can be C<retrieve()>d by the model
 class,
 it will be removed from C<args> and the retrieved object will be added
 to the
@@ -513,14 +527,14 @@ C<objects> list. See L<Maypole::Model> for more information.
 
 =head3 template_args
 
-    $r->template_args->{foo} = 'bar';
+    $self->template_args->{foo} = 'bar';
 
 Get/set a hash of template variables.
 
 =head3 template
 
 Get/set the template to be used by the view. By default, it returns
-C<$r-E<gt>action>
+C<$self-E<gt>action>
 
 =head3 exception
 
@@ -574,7 +588,8 @@ exception method of your Maypole application.
 
 =head3 make_random_id
 
-returns a unique id for this request can be used to prevent or detect repeat submissions.
+returns a unique id for this request can be used to prevent or detect repeat
+submissions.
 
 =head3 handler