Hostnames are now resolved on demand unless provieded by engine

[catagits/Catalyst-Runtime.git] / lib / Catalyst / Engine / Apache / Base.pm

diff --git a/lib/Catalyst/Engine/Apache/Base.pm b/lib/Catalyst/Engine/Apache/Base.pm
index 8bfb479..ce4b33f 100644 (file)
--- a/lib/Catalyst/Engine/Apache/Base.pm
+++ b/lib/Catalyst/Engine/Apache/Base.pm
@@ -1,8 +1,9 @@
 package Catalyst::Engine::Apache::Base;
 
 use strict;
-use base 'Catalyst::Engine';
+use base qw[Catalyst::Engine Catalyst::Engine::Apache];
 
+use File::Spec;
 use URI;
 use URI::http;
 
@@ -75,8 +76,13 @@ sub prepare_connection {
     $c->request->address( $c->apache->connection->remote_ip );
     $c->request->hostname( $c->apache->connection->remote_host );
     $c->request->protocol( $c->apache->protocol );
-    
-    if ( $ENV{HTTPS} || $c->apache->get_server_port == 443 ) {
+    $c->request->user( $c->apache->user );
+
+    if ( $ENV{HTTPS} && uc( $ENV{HTTPS} ) eq 'ON' ) {
+        $c->request->secure(1);
+    }
+
+    if ( $c->apache->get_server_port == 443 ) {
         $c->request->secure(1);
     }
 }
@@ -91,24 +97,6 @@ sub prepare_headers {
     $c->request->header( %{ $c->apache->headers_in } );
 }
 
-=item $c->prepare_parameters
-
-=cut
-
-sub prepare_parameters {
-    my $c = shift;
-
-    my @params;
-    
-    $c->apache->param->do( sub {
-        my ( $field, $value ) = @_;
-        push( @params, $field, $value );
-        return 1;    
-    });
-    
-    $c->request->param(@params);
-}
-
 =item $c->prepare_path
 
 =cut
@@ -117,41 +105,72 @@ sub prepare_parameters {
 # not <Directory> directive
 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 ( $c->apache->filename && -x $c->apache->filename ) {
+
+            my $filename = ( File::Spec->splitpath( $c->apache->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/^\///;
+}
+
+=item $c->prepare_request($r)
+
+=cut
 
-    $c->req->base($base);
-    $c->req->path($path);
+sub prepare_request {
+    my ( $c, $r ) = @_;
+    $c->apache($r);
 }
 
 =item $c->run
 
 =cut
 
-sub run { }
+sub run { shift->handler(@_) }
 
 =back