]> git.decadent.org.uk Git - maypole.git/blobdiff - lib/Maypole.pm
Maypole::Application supports Maypole::HTTPD (which needs a patch).
[maypole.git] / lib / Maypole.pm
index 087f2b9daae744671f8cf3af72cd4886531edab8..dbae33be3580d65f667d6e79044ef9b30ca94634 100644 (file)
@@ -199,7 +199,7 @@ __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
 __PACKAGE__->mk_accessors(
     qw( params query objects model_class template_args output path
         args action template error document_encoding content_type table
-        headers_in headers_out stash session user)
+        headers_in headers_out stash status)
 );
 
 __PACKAGE__->config( Maypole::Config->new() );
@@ -243,6 +243,9 @@ enable/disable debugging.
 
 You can also set the C<debug> flag via L<Maypole::Application>.
 
+Some packages respond to higher debug levels, try increasing it to 2 or 3.
+
+
 =cut
 
 sub debug { 0 }      
@@ -312,10 +315,6 @@ sub setup_model
         $class->load_model_subclass($subclass);
         
         $config->model->adopt($subclass) if $config->model->can("adopt");
-
-#      eval "use $subclass"; 
-#      die "Error loading $subclass: $@"  
-#            if $@ and $@ !~ /Can\'t locate \S+ in \@INC/;
     }
 }
 
@@ -348,7 +347,7 @@ sub load_model_subclass
         (my $filename = $subclass) =~ s!::!/!g;
         die "Loading '$subclass' failed: $@\n"
                unless $@ =~ /Can\'t locate \Q$filename\E\.pm/;
-        warn "Did not find external module for '$subclass'\n
+        warn "No external module for '$subclass'
             if $class->debug > 1;
    }
 }
@@ -433,13 +432,17 @@ sub handler : method
     
     # hook useful for declining static requests e.g. images, or perhaps for 
     # sanitizing request parameters
-    my $status = $self->start_request_hook;
-    return $status unless $status == Maypole::Constants::OK();
+    $self->status(Maypole::Constants::OK());      # set the default
+    $self->__call_hook('start_request_hook');
+    return $self->status unless $self->status == Maypole::Constants::OK();
+    
+    die "status undefined after start_request_hook()" unless defined
+        $self->status;
     
-    $self->session($self->get_session);
-    $self->user($self->get_user);
+    $self->get_session;
+    $self->get_user;
     
-    $status = $self->handler_guts;
+    my $status = $self->handler_guts;
     
     # moving this here causes unit test failures - need to check why
     # before committing the move
@@ -453,6 +456,39 @@ sub handler : method
     return $status;
 }
 
+# Instead of making plugin authors use the NEXT::DISTINCT hoopla to ensure other 
+# plugins also get to call the hook, we can cycle through the application's 
+# @ISA and call them all here. Doesn't work for setup() though, because it's 
+# too ingrained in the stack. We could add a run_setup() method, but we'd break 
+# lots of existing code.
+sub __call_hook
+{
+    my ($self, $hook) = @_;
+    
+    my @plugins;
+    {
+        my $class = ref($self);
+        no strict 'refs';
+        @plugins = @{"$class\::ISA"};
+    }
+    
+    # this is either a custom method in the driver, or the method in the 1st 
+    # plugin, or the 'null' method in the frontend (i.e. inherited from 
+    # Maypole.pm) - we need to be careful to only call it once
+    my $first_hook = $self->can($hook);
+    $self->$first_hook;  
+    
+    my %seen = ( $first_hook => 1 );
+
+    # @plugins includes the frontend
+    foreach my $plugin (@plugins)
+    {
+        next unless my $plugin_hook = $plugin->can($hook);
+        next if $seen{$plugin_hook}++;
+        $self->$plugin_hook;
+    }
+}
+
 =item handler_guts
 
 This is the main request handling method and calls various methods to handle the
@@ -602,23 +638,45 @@ sub parse_location
 =item start_request_hook
 
 This is called immediately after setting up the basic request. The default
-method simply returns C<Maypole::Constants::OK>.
+method does nothing. 
 
-Any other return value causes Maypole to abort further processing of the
-request. This is useful for filtering out requests for static files, e.g.
-images, which should not be processed by Maypole or by the templating engine:
+The value of C<< $r->status >> is set to C<OK> before this hook is run. Your 
+implementation can change the status code, or leave it alone. 
+
+After this hook has run, Maypole will check the value of C<status>. For any
+value other than C<OK>, Maypole returns the C<status> immediately. 
+
+This is useful for filtering out requests for static files, e.g. images, which
+should not be processed by Maypole or by the templating engine:
 
     sub start_request_hook
     {
         my ($r) = @_;
        
-       return Maypole::Constants::DECLINED if $r->path =~ /\.jpg$/;
-       return Maypole::Constants::OK;
+        $r->status(DECLINED) if $r->path =~ /\.jpg$/;
     }
+    
+Multiple plugins, and the driver, can define this hook - Maypole will call all
+of them. You should check for and probably not change any non-OK C<status>
+value:
 
+    package Maypole::Plugin::MyApp::SkipFavicon;
+    
+    sub start_request_hook
+    {
+        my ($r) = @_;
+        
+        # check if a previous plugin has already DECLINED this request
+        # - probably unnecessary in this example, but you get the idea
+        return unless $r->status == OK;
+        
+        # then do our stuff
+        $r->status(DECLINED) if $r->path =~ /favicon\.ico/;
+    }        
+     
 =cut
 
-sub start_request_hook { Maypole::Constants::OK }
+sub start_request_hook { }
 
 =item is_applicable
 
@@ -684,7 +742,7 @@ sub is_model_applicable
     my $action = $self->action;
     return 1 if $self->model_class->is_public($action);
     
-    warn "The action '$action' is not applicable to the table $table"
+    warn "The action '$action' is not applicable to the table '$table'"
         if $self->debug;
     
     return 0;
@@ -1328,3 +1386,55 @@ You may distribute this code under the same terms as Perl itself.
 =cut
 
 1;
+
+__END__
+
+ =item register_cleanup($coderef)
+
+Analogous to L<Apache>'s C<register_cleanup>. If an Apache request object is
+available, this call simply redispatches there. If not, the cleanup is
+registered in the Maypole request, and executed when the request is
+C<DESTROY>ed.
+
+This method is only useful in persistent environments, where you need to ensure
+that some code runs when the request finishes, no matter how it finishes (e.g.
+after an unexpected error). 
+
+ =cut
+
+{
+    my @_cleanups;
+
+    sub register_cleanup
+    {
+        my ($self, $cleanup) = @_;
+        
+        die "register_cleanup() is an instance method, not a class method" 
+            unless ref $self;
+        die "Cleanup must be a coderef" unless ref($cleanup) eq 'CODE';
+        
+        if ($self->can('ar') && $self->ar)
+        {
+            $self->ar->register_cleanup($cleanup);
+        }
+        else
+        {
+            push @_cleanups, $cleanup;
+        }
+    }
+
+    sub DESTROY
+    {
+        my ($self) = @_;
+        
+        while (my $cleanup = shift @_cleanups)
+        {
+            eval { $cleanup->() };
+            if ($@)
+            {
+                warn "Error during request cleanup: $@";
+            }
+        }        
+    }    
+}
+