Minor engine cleanup
Christian Hansen [Thu, 5 May 2005 03:42:13 +0000 (03:42 +0000)]
lib/Catalyst.pm
lib/Catalyst/Engine/Apache.pm
lib/Catalyst/Engine/Apache/Base.pm
lib/Catalyst/Engine/HTTP/Base.pm
lib/Catalyst/Engine/HTTP/Daemon.pm
lib/Catalyst/Engine/Test.pm
lib/Catalyst/Test.pm
lib/Catalyst/Utils.pm

index 36e6da0..0c22ee4 100644 (file)
@@ -153,20 +153,25 @@ sub import {
     my $engine     = 'Catalyst::Engine::CGI';
     my $dispatcher = 'Catalyst::Dispatcher';
 
-    # Detect mod_perl
     if ( $ENV{MOD_PERL} ) {
+    
+        mod_perl->require;
 
-        require mod_perl;
-
-        if ( $ENV{MOD_PERL_API_VERSION} == 2 ) {
+        if ( $mod_perl::VERSION >= 1.99_90_22 ) {
             $engine = 'Catalyst::Engine::Apache::MP20';
         }
-        elsif ( $mod_perl::VERSION >= 1.99 ) {
+
+        elsif ( $mod_perl::VERSION >= 1.99_01 ) {
             $engine = 'Catalyst::Engine::Apache::MP19';
         }
-        else {
+
+        elsif ( $mod_perl::VERSION >= 1.27 ) {
             $engine = 'Catalyst::Engine::Apache::MP13';
         }
+
+        else {
+            die( qq/Unsupported mod_perl version: "$mod_perl::VERSION"/ );
+        }
     }
 
     $caller->log->info( "You are running an old helper script! "
@@ -239,10 +244,12 @@ sub import {
 
     $engine->require;
     die qq/Couldn't load engine "$engine", "$@"/ if $@;
+
     {
         no strict 'refs';
         push @{"$caller\::ISA"}, $engine;
     }
+
     $caller->engine($engine);
     $caller->log->debug(qq/Loaded engine "$engine"/) if $caller->debug;
 
index a9bd2c8..2e0f374 100644 (file)
@@ -1,7 +1,24 @@
 package Catalyst::Engine::Apache;
 
 use strict;
-use UNIVERSAL::require;
+
+# 1.27     MP13
+# 1.28     MP13
+# 1.29     MP13
+# 1.2901   MP13
+# 1.30     MP13 TBR
+
+# 1.9901   MP19
+# 1.9920   MP19
+# 1.999020 MP19 RC3
+# 1.999021 MP19 RC4
+
+# 1.999022 MP20 RC5
+# 1.999023 MP20 RC6
+
+1;
+
+__END__
 
 =head1 NAME
 
@@ -30,5 +47,3 @@ This program is free software, you can redistribute it and/or modify it under
 the same terms as Perl itself.
 
 =cut
-
-1;
index 8bfb479..8d383da 100644 (file)
@@ -1,7 +1,7 @@
 package Catalyst::Engine::Apache::Base;
 
 use strict;
-use base 'Catalyst::Engine';
+use base qw[Catalyst::Engine Catalyst::Engine::Apache];
 
 use URI;
 use URI::http;
index d51c1db..a5df9b8 100644 (file)
@@ -12,7 +12,7 @@ use URI;
 
 __PACKAGE__->mk_accessors(qw/http/);
 
-Class::Struct::struct 'Catalyst::Engine::Test::HTTP' => {
+Class::Struct::struct 'Catalyst::Engine::HTTP::Base::struct' => {
     request  => 'HTTP::Request',
     response => 'HTTP::Response',
     hostname => '$',
index 2c7fd07..ec6ffcd 100644 (file)
@@ -43,7 +43,7 @@ sub run {
     my $class = shift;
     my $port  = shift || 3000;
 
-    my $daemon = Catalyst::Engine::HTTP::Catalyst->new(
+    my $daemon = Catalyst::Engine::HTTP::Base::struct->new(
         Listen    => SOMAXCONN,
         LocalPort => $port,
         ReuseAddr => 1,
@@ -70,7 +70,7 @@ sub run {
             
             my $hostname = gethostbyaddr( $connection->peeraddr, AF_INET );
 
-            my $http = Catalyst::Engine::Test::HTTP->new(
+            my $http = Catalyst::Engine::HTTP::Base::struct->new(
                 address  => $connection->peerhost,
                 hostname => $hostname || $connection->peerhost,
                 request  => $request,
index 91553ba..a5f9ca4 100644 (file)
@@ -3,6 +3,8 @@ package Catalyst::Engine::Test;
 use strict;
 use base 'Catalyst::Engine::HTTP::Base';
 
+use Catalyst::Utils;
+
 =head1 NAME
 
 Catalyst::Engine::Test - Catalyst Test Engine
@@ -38,27 +40,15 @@ This class overloads some methods from C<Catalyst::Engine::HTTP::Base>.
 =cut
 
 sub run {
-    my $class   = shift;
-    my $request = shift || '/';
-
-    unless ( ref $request ) {
-
-        my $uri =
-          ( $request =~ m/http/i )
-          ? URI->new($request)
-          : URI->new( 'http://localhost' . $request );
-
-        $request = $uri->canonical;
-    }
-
-    unless ( ref $request eq 'HTTP::Request' ) {
-        $request = HTTP::Request->new( 'GET', $request );
-    }
+    my ( $class, $request ) = @_;
+    
+    $request = Catalyst::Utils::request($request);
 
-    my $host = sprintf( '%s:%d', $request->uri->host, $request->uri->port );
-    $request->header( 'Host' => $host );
+    $request->header( 
+        'Host' => sprintf( '%s:%d', $request->uri->host, $request->uri->port )
+    );
 
-    my $http = Catalyst::Engine::Test::HTTP->new(
+    my $http = Catalyst::Engine::HTTP::Base::struct->new(
         address  => '127.0.0.1',
         hostname => 'localhost',
         request  => $request,
index 2f91020..a9f74e5 100644 (file)
@@ -1,6 +1,8 @@
 package Catalyst::Test;
 
 use strict;
+
+use Catalyst::Utils;
 use UNIVERSAL::require;
 
 $ENV{CATALYST_ENGINE} = 'Test';
@@ -100,25 +102,12 @@ Do an actual remote rquest using LWP.
 =cut
 
 sub remote_request {
-    my $request = shift;
-
-    require LWP::UserAgent;
-
-    unless ( ref $request ) {
-
-        my $uri =
-          ( $request =~ m/http/i )
-          ? URI->new($request)
-          : URI->new( 'http://localhost' . $request );
-
-        $request = $uri->canonical;
-    }
 
-    unless ( ref $request eq 'HTTP::Request' ) {
-        $request = HTTP::Request->new( 'GET', $request );
-    }
+    require LWP::UserAgent; 
+    
+    my $request = Catalyst::Utils::request( shift(@_) );
 
-    my $server = URI->new( $ENV{CATALYST_SERVER} );
+    my $server  = URI->new( $ENV{CATALYST_SERVER} );
 
     if ( $server->path =~ m|^(.+)?/$| ) {
         $server->path("$1");    # need to be quoted
@@ -129,14 +118,14 @@ sub remote_request {
     $request->uri->port( $server->port );
     $request->uri->path( $server->path . $request->uri->path );
 
-    unless ($agent) {
-        $agent = LWP::UserAgent->new(
+    unless ( $agent ) {
 
-            #  cookie_jar   => {},
+        $agent = LWP::UserAgent->new(
             keep_alive   => 1,
             max_redirect => 0,
             timeout      => 60,
         );
+
         $agent->env_proxy;
     }
 
index 440daa3..e4c5db8 100644 (file)
@@ -2,7 +2,9 @@ package Catalyst::Utils;
 
 use strict;
 use attributes ();
+use HTTP::Request;
 use Path::Class;
+use URI;
 
 =head1 NAME
 
@@ -152,6 +154,34 @@ sub reflect_actions {
 
 =back
 
+=item request($string);
+
+Returns an C<HTTP::Request> from a string.
+
+=cut
+
+sub request {
+    my $request = shift;
+
+    unless ( ref $request ) {
+
+        if ( $request =~ m/http/i ) {
+            $request = URI->new($request)->canonical;
+        }
+        else {
+            $request = URI->new( 'http://localhost' . $request )->canonical;
+        }
+    }
+
+    unless ( ref $request eq 'HTTP::Request' ) {
+        $request = HTTP::Request->new( 'GET', $request );
+    }
+
+    return $request;
+}
+
+=back
+
 =head1 AUTHOR
 
 Sebastian Riedel, C<sri@cpan.org>