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! "
$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;
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
the same terms as Perl itself.
=cut
-
-1;
package Catalyst::Engine::Apache::Base;
use strict;
-use base 'Catalyst::Engine';
+use base qw[Catalyst::Engine Catalyst::Engine::Apache];
use URI;
use URI::http;
__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 => '$',
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,
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,
use strict;
use base 'Catalyst::Engine::HTTP::Base';
+use Catalyst::Utils;
+
=head1 NAME
Catalyst::Engine::Test - Catalyst Test Engine
=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,
package Catalyst::Test;
use strict;
+
+use Catalyst::Utils;
use UNIVERSAL::require;
$ENV{CATALYST_ENGINE} = 'Test';
=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
$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;
}
use strict;
use attributes ();
+use HTTP::Request;
use Path::Class;
+use URI;
=head1 NAME
=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>