Fixed uri handling in MP engines. Updated Changes

diff --git a/Changes b/Changes
index 55fed63..281d41a 100644 (file)
--- a/Changes
+++ b/Changes
@@ -16,7 +16,9 @@ This file documents the revision history for Perl extension Catalyst.
         - allow multiple Catalyst apps to run on the same mod_perl instance
           (not the same app!)
         - fixed MP2 engines
-        - removed apreq dependency from all MP engines.
+        - removed apreq dependency from all MP engines
+        - added support for MP registry scripts
+        - added support for LocationMatch and ScriptAliasMatch in MP engines
         - added SpeedyCGI engine
 
 5.10  Sat Apr 23 11:16:00 2005

diff --git a/lib/Catalyst/Engine/Apache/Base.pm b/lib/Catalyst/Engine/Apache/Base.pm
index d40f050..d32b246 100644 (file)
--- a/lib/Catalyst/Engine/Apache/Base.pm
+++ b/lib/Catalyst/Engine/Apache/Base.pm
@@ -3,6 +3,7 @@ package Catalyst::Engine::Apache::Base;
 use strict;
 use base qw[Catalyst::Engine Catalyst::Engine::Apache];
 
+use File::Spec;
 use URI;
 use URI::http;
 
@@ -101,33 +102,55 @@ sub prepare_headers {
 sub prepare_path {
     my $c = shift;
     
-    my $base;
+    {
+        my $path = $c->apache->uri;
+
+        if ( my $location = $c->apache->location ) {
+
+            if ( index( $path, $location ) == 0 ) {
+                $path = substr( $path, length($location) );
+            }
+        }
+
+        $path =~ s/^\///;
+
+        if ( my $filename = $c->apache->filename ) {
+
+            $filename = ( File::Spec->splitpath($filename) )[2];
+
+            if ( index( $path, $filename ) == 0 ) {
+                $path = substr( $path, length($filename) );
+            }
+        }
+
+        $path =~ s/^\///;
+
+        $c->request->path($path);
+    }
+
     {
         my $scheme = $c->request->secure ? 'https' : 'http';
         my $host   = $c->apache->hostname;
         my $port   = $c->apache->get_server_port;
-        my $path   = $c->apache->location || '/';
+        my $path   = $c->apache->uri;
         
+        if ( length( $c->request->path ) ) {
+            $path =~ s/\/$//;
+            $path = substr( $path, 0, length($path) - length($c->req->path) );
+        }
+
         unless ( $path =~ /\/$/ ) {
             $path .= '/';
         }
 
-        $base = URI->new;
+        my $base = URI->new;
         $base->scheme($scheme);
         $base->host($host);
         $base->port($port);
         $base->path($path);
-
-        $base = $base->canonical->as_string;
+        
+        $c->request->base( $base->canonical->as_string );
     }
-    
-    my $location = $c->apache->location || '/';
-    my $path = $c->apache->uri || '/';
-    $path =~ s/^($location)?\///;
-    $path =~ s/^\///;
-
-    $c->req->base($base);
-    $c->req->path($path);
 }
 
 =item $c->prepare_request($r)
@@ -143,7 +166,7 @@ sub prepare_request {
 
 =cut
 
-sub run { }
+sub run { shift->handler(@_) }
 
 =back
 

diff --git a/lib/Catalyst/Engine/Apache/MP13.pm b/lib/Catalyst/Engine/Apache/MP13.pm
index 27066c3..b0a7d1c 100644 (file)
--- a/lib/Catalyst/Engine/Apache/MP13.pm
+++ b/lib/Catalyst/Engine/Apache/MP13.pm
@@ -26,7 +26,7 @@ and C<Catalyst::Engine::CGI>.
 
 =cut
 
-sub prepare_body { 
+sub prepare_body {
     shift->Catalyst::Engine::CGI::prepare_body(@_);
 }
 
@@ -34,7 +34,7 @@ sub prepare_body {
 
 =cut
 
-sub prepare_parameters { 
+sub prepare_parameters {
     shift->Catalyst::Engine::CGI::prepare_parameters(@_);
 }
 
@@ -44,11 +44,23 @@ sub prepare_parameters {
 
 sub prepare_request {
     my ( $c, $r, @arguments ) = @_;
-    
-    $ENV{CONTENT_TYPE}   = $r->header_in("Content-Type");
-    $ENV{CONTENT_LENGTH} = $r->header_in("Content-Length");
-    $ENV{QUERY_STRING}   = $r->args;
-    $ENV{REQUEST_METHOD} = $r->method;
+
+    unless ( $ENV{REQUEST_METHOD} ) {
+
+        $ENV{CONTENT_TYPE}   = $r->header_in("Content-Type");
+        $ENV{CONTENT_LENGTH} = $r->header_in("Content-Length");
+        $ENV{QUERY_STRING}   = $r->args;
+        $ENV{REQUEST_METHOD} = $r->method;
+
+        my $cleanup = sub {
+            delete( $ENV{$_} ) for qw( CONTENT_TYPE
+                                       CONTENT_LENGTH
+                                       QUERY_STRING
+                                       REQUEST_METHOD );
+        };
+
+        $r->register_cleanup($cleanup);
+    }
 
     $c->SUPER::prepare_request($r);
     $c->Catalyst::Engine::CGI::prepare_request( $r, @arguments );
@@ -58,7 +70,7 @@ sub prepare_request {
 
 =cut
 
-sub prepare_uploads { 
+sub prepare_uploads {
     shift->Catalyst::Engine::CGI::prepare_uploads(@_);
 }
 

diff --git a/lib/Catalyst/Engine/Apache/MP19.pm b/lib/Catalyst/Engine/Apache/MP19.pm
index 5a44984..a3e2da3 100644 (file)
--- a/lib/Catalyst/Engine/Apache/MP19.pm
+++ b/lib/Catalyst/Engine/Apache/MP19.pm
@@ -26,7 +26,7 @@ and C<Catalyst::Engine::CGI>.
 
 =cut
 
-sub prepare_body { 
+sub prepare_body {
     shift->Catalyst::Engine::CGI::prepare_body(@_);
 }
 
@@ -34,7 +34,7 @@ sub prepare_body {
 
 =cut
 
-sub prepare_parameters { 
+sub prepare_parameters {
     shift->Catalyst::Engine::CGI::prepare_parameters(@_);
 }
 
@@ -44,11 +44,23 @@ sub prepare_parameters {
 
 sub prepare_request {
     my ( $c, $r, @arguments ) = @_;
-    
-    $ENV{CONTENT_TYPE}   = $r->headers_in->get("Content-Type");
-    $ENV{CONTENT_LENGTH} = $r->headers_in->get("Content-Length");
-    $ENV{QUERY_STRING}   = $r->args;
-    $ENV{REQUEST_METHOD} = $r->method;
+
+    unless ( $ENV{REQUEST_METHOD} ) {
+
+        $ENV{CONTENT_TYPE}   = $r->headers_in->get("Content-Type");
+        $ENV{CONTENT_LENGTH} = $r->headers_in->get("Content-Length");
+        $ENV{QUERY_STRING}   = $r->args;
+        $ENV{REQUEST_METHOD} = $r->method;
+
+        my $cleanup = sub {
+            delete( $ENV{$_} ) for qw( CONTENT_TYPE
+                                       CONTENT_LENGTH
+                                       QUERY_STRING
+                                       REQUEST_METHOD );
+        };
+
+        $r->pool->cleanup_register($cleanup);
+    }
 
     $c->SUPER::prepare_request($r);
     $c->Catalyst::Engine::CGI::prepare_request( $r, @arguments );
@@ -58,7 +70,7 @@ sub prepare_request {
 
 =cut
 
-sub prepare_uploads { 
+sub prepare_uploads {
     shift->Catalyst::Engine::CGI::prepare_uploads(@_);
 }
 

diff --git a/lib/Catalyst/Engine/Apache/MP20.pm b/lib/Catalyst/Engine/Apache/MP20.pm
index d03ae88..b20fea8 100644 (file)
--- a/lib/Catalyst/Engine/Apache/MP20.pm
+++ b/lib/Catalyst/Engine/Apache/MP20.pm
@@ -26,7 +26,7 @@ and C<Catalyst::Engine::CGI>.
 
 =cut
 
-sub prepare_body { 
+sub prepare_body {
     shift->Catalyst::Engine::CGI::prepare_body(@_);
 }
 
@@ -34,7 +34,7 @@ sub prepare_body {
 
 =cut
 
-sub prepare_parameters { 
+sub prepare_parameters {
     shift->Catalyst::Engine::CGI::prepare_parameters(@_);
 }
 
@@ -45,10 +45,22 @@ sub prepare_parameters {
 sub prepare_request {
     my ( $c, $r, @arguments ) = @_;
 
-    $ENV{CONTENT_TYPE}   = $r->headers_in->get("Content-Type");
-    $ENV{CONTENT_LENGTH} = $r->headers_in->get("Content-Length");
-    $ENV{QUERY_STRING}   = $r->args;
-    $ENV{REQUEST_METHOD} = $r->method;
+    unless ( $ENV{REQUEST_METHOD} ) {
+
+        $ENV{CONTENT_TYPE}   = $r->headers_in->get("Content-Type");
+        $ENV{CONTENT_LENGTH} = $r->headers_in->get("Content-Length");
+        $ENV{QUERY_STRING}   = $r->args;
+        $ENV{REQUEST_METHOD} = $r->method;
+
+        my $cleanup = sub {
+            delete( $ENV{$_} ) for qw( CONTENT_TYPE
+                                       CONTENT_LENGTH
+                                       QUERY_STRING
+                                       REQUEST_METHOD );
+        };
+
+        $r->pool->cleanup_register($cleanup);
+    }
 
     $c->SUPER::prepare_request($r);
     $c->Catalyst::Engine::CGI::prepare_request( $r, @arguments );
@@ -58,7 +70,7 @@ sub prepare_request {
 
 =cut
 
-sub prepare_uploads { 
+sub prepare_uploads {
     shift->Catalyst::Engine::CGI::prepare_uploads(@_);
 }
 

diff --git a/lib/Catalyst/Engine/CGI/Base.pm b/lib/Catalyst/Engine/CGI/Base.pm
index 8db3fe6..90420bc 100644 (file)
--- a/lib/Catalyst/Engine/CGI/Base.pm
+++ b/lib/Catalyst/Engine/CGI/Base.pm
@@ -136,7 +136,7 @@ sub prepare_path {
 
 =cut
 
-sub run { shift->handler }
+sub run { shift->handler(@_) }
 
 =back