X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine%2FTest.pm;h=fcd145e3718e86ae216c42a061846102409169e8;hb=6f4e1683d466d0123cc7507b29a55b474ddca594;hp=45da15690e3e3ee07cf64a98bbdba010b28297ad;hpb=e646f111fbeb0ab42406b5be7e6a488df3f1483f;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Engine/Test.pm b/lib/Catalyst/Engine/Test.pm index 45da156..fcd145e 100644 --- a/lib/Catalyst/Engine/Test.pm +++ b/lib/Catalyst/Engine/Test.pm @@ -1,12 +1,7 @@ package Catalyst::Engine::Test; use strict; -use base 'Catalyst::Engine::CGI::NPH'; - -use HTTP::Request; -use HTTP::Response; -use IO::File; -use URI; +use base 'Catalyst::Engine::LWP'; =head1 NAME @@ -14,7 +9,19 @@ Catalyst::Engine::Test - Catalyst Test Engine =head1 SYNOPSIS -See L. +A script using the Catalyst::Engine::Test module might look like: + + #!/usr/bin/perl -w + + BEGIN { + $ENV{CATALYST_ENGINE} = 'Test'; + } + + use strict; + use lib '/path/to/MyApp/lib'; + use MyApp; + + MyApp->run('/a/path'); =head1 DESCRIPTION @@ -22,7 +29,7 @@ This is the Catalyst engine specialized for testing. =head1 OVERLOADED METHODS -This class overloads some methods from C. +This class overloads some methods from C. =over 4 @@ -35,49 +42,27 @@ sub run { my $request = shift || '/'; unless ( ref $request ) { - $request = URI->new( $request, 'http' ); + + 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 ); } - local ( *STDIN, *STDOUT ); - - my %clean = %ENV; - my $output = ''; - $ENV{CONTENT_TYPE} ||= $request->header('Content-Type') || ''; - $ENV{CONTENT_LENGTH} ||= $request->header('Content-Length') || ''; - $ENV{GATEWAY_INTERFACE} ||= 'CGI/1.1'; - $ENV{HTTP_USER_AGENT} ||= 'Catalyst'; - $ENV{HTTP_HOST} ||= $request->uri->host || 'localhost'; - $ENV{QUERY_STRING} ||= $request->uri->query || ''; - $ENV{REQUEST_METHOD} ||= $request->method; - $ENV{PATH_INFO} ||= $request->uri->path || '/'; - $ENV{SCRIPT_NAME} ||= '/'; - $ENV{SERVER_NAME} ||= $request->uri->host || 'localhost'; - $ENV{SERVER_PORT} ||= $request->uri->port; - $ENV{SERVER_PROTOCOL} ||= 'HTTP/1.1'; - - for my $field ( $request->header_field_names ) { - if ( $field =~ /^Content-(Length|Type)$/ ) { - next; - } - $field =~ s/-/_/g; - $ENV{ 'HTTP_' . uc($field) } = $request->header($field); - } + my $lwp = Catalyst::Engine::LWP::HTTP->new( + request => $request, + address => '127.0.0.1', + hostname => 'localhost' + ); - if ( $request->content_length ) { - my $body = IO::File->new_tmpfile; - $body->print( $request->content ) or die $!; - $body->seek( 0, SEEK_SET ) or die $!; - open( STDIN, "<&=", $body->fileno ) - or die("Failed to dup \$body: $!"); - } + $class->handler($lwp); - open( STDOUT, '>', \$output ); - $class->handler; - %ENV = %clean; - return HTTP::Response->parse($output); + return $lwp->response; } =back