X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine%2FTest.pm;h=a5f9ca472e27018a8fd5fecde75ad76bec4a6906;hb=89f2bd8df56fe92071bdb7559c9631dc316e9922;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..a5f9ca4 100644 --- a/lib/Catalyst/Engine/Test.pm +++ b/lib/Catalyst/Engine/Test.pm @@ -1,12 +1,9 @@ package Catalyst::Engine::Test; use strict; -use base 'Catalyst::Engine::CGI::NPH'; +use base 'Catalyst::Engine::HTTP::Base'; -use HTTP::Request; -use HTTP::Response; -use IO::File; -use URI; +use Catalyst::Utils; =head1 NAME @@ -14,7 +11,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 +31,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 @@ -31,53 +40,26 @@ This class overloads some methods from C. =cut sub run { - my $class = shift; - my $request = shift || '/'; + my ( $class, $request ) = @_; + + $request = Catalyst::Utils::request($request); - unless ( ref $request ) { - $request = URI->new( $request, 'http' ); - } - unless ( ref $request eq 'HTTP::Request' ) { - $request = HTTP::Request->new( 'GET', $request ); - } + $request->header( + 'Host' => sprintf( '%s:%d', $request->uri->host, $request->uri->port ) + ); - 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 $http = Catalyst::Engine::HTTP::Base::struct->new( + address => '127.0.0.1', + hostname => 'localhost', + request => $request, + response => HTTP::Response->new + ); - 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: $!"); - } + $http->response->date(time); + + $class->handler($http); - open( STDOUT, '>', \$output ); - $class->handler; - %ENV = %clean; - return HTTP::Response->parse($output); + return $http->response; } =back