From: Christian Hansen Date: Thu, 5 May 2005 03:42:13 +0000 (+0000) Subject: Minor engine cleanup X-Git-Tag: 5.7099_04~1404 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=d837e1a7eadff19ff04373ad19d22fa293e19db5 Minor engine cleanup --- diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 36e6da0..0c22ee4 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -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; diff --git a/lib/Catalyst/Engine/Apache.pm b/lib/Catalyst/Engine/Apache.pm index a9bd2c8..2e0f374 100644 --- a/lib/Catalyst/Engine/Apache.pm +++ b/lib/Catalyst/Engine/Apache.pm @@ -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; diff --git a/lib/Catalyst/Engine/Apache/Base.pm b/lib/Catalyst/Engine/Apache/Base.pm index 8bfb479..8d383da 100644 --- a/lib/Catalyst/Engine/Apache/Base.pm +++ b/lib/Catalyst/Engine/Apache/Base.pm @@ -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; diff --git a/lib/Catalyst/Engine/HTTP/Base.pm b/lib/Catalyst/Engine/HTTP/Base.pm index d51c1db..a5df9b8 100644 --- a/lib/Catalyst/Engine/HTTP/Base.pm +++ b/lib/Catalyst/Engine/HTTP/Base.pm @@ -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 => '$', diff --git a/lib/Catalyst/Engine/HTTP/Daemon.pm b/lib/Catalyst/Engine/HTTP/Daemon.pm index 2c7fd07..ec6ffcd 100644 --- a/lib/Catalyst/Engine/HTTP/Daemon.pm +++ b/lib/Catalyst/Engine/HTTP/Daemon.pm @@ -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, diff --git a/lib/Catalyst/Engine/Test.pm b/lib/Catalyst/Engine/Test.pm index 91553ba..a5f9ca4 100644 --- a/lib/Catalyst/Engine/Test.pm +++ b/lib/Catalyst/Engine/Test.pm @@ -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. =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, diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm index 2f91020..a9f74e5 100644 --- a/lib/Catalyst/Test.pm +++ b/lib/Catalyst/Test.pm @@ -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; } diff --git a/lib/Catalyst/Utils.pm b/lib/Catalyst/Utils.pm index 440daa3..e4c5db8 100644 --- a/lib/Catalyst/Utils.pm +++ b/lib/Catalyst/Utils.pm @@ -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 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