X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine%2FTest.pm;h=d5fb8a748da0b660310ef3b28b34fbb3bcd256f9;hb=5b387dfc825bb5a5a78672693497f5d7e792e9d4;hp=59a6246e70c6b44b56af5374aaa874631fc3ab99;hpb=75fd617a0395f9a49cd215c17bb21f4fadf14db4;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Engine/Test.pm b/lib/Catalyst/Engine/Test.pm index 59a6246..d5fb8a7 100644 --- a/lib/Catalyst/Engine/Test.pm +++ b/lib/Catalyst/Engine/Test.pm @@ -3,17 +3,16 @@ package Catalyst::Engine::Test; use strict; use base 'Catalyst::Engine'; -use CGI::Simple::Cookie; use Class::Struct (); use HTTP::Headers::Util 'split_header_words'; use HTTP::Request; use HTTP::Response; -use IO::File; +use File::Temp; use URI; -__PACKAGE__->mk_accessors(qw/lwp/); +__PACKAGE__->mk_accessors(qw/http/); -Class::Struct::struct 'Catalyst::Engine::Test::LWP' => { +Class::Struct::struct 'Catalyst::Engine::Test::HTTP' => { request => 'HTTP::Request', response => 'HTTP::Response', hostname => '$', @@ -57,24 +56,11 @@ This class overloads some methods from C. sub finalize_headers { my $c = shift; - my $status = $c->response->status || 200; - my $headers = $c->response->headers; - my $response = HTTP::Response->new( $status, undef, $headers ); - - while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) { - my $cookie = CGI::Simple::Cookie->new( - -name => $name, - -value => $cookie->{value}, - -expires => $cookie->{expires}, - -domain => $cookie->{domain}, - -path => $cookie->{path}, - -secure => $cookie->{secure} || 0 - ); - - $response->header( 'Set-Cookie' => $cookie->as_string ); - } + $c->http->response->code( $c->response->status ); - $c->lwp->response($response); + for my $name ( $c->response->headers->header_field_names ) { + $c->http->response->push_header( $name => [ $c->response->header($name) ] ); + } } =item $c->finalize_output @@ -83,7 +69,7 @@ sub finalize_headers { sub finalize_output { my $c = shift; - $c->lwp->response->content_ref( \$c->response->{output} ); + $c->http->response->content( $c->response->output ); } =item $c->prepare_connection @@ -92,20 +78,8 @@ sub finalize_output { sub prepare_connection { my $c = shift; - $c->req->hostname( $c->lwp->hostname ); - $c->req->address( $c->lwp->address ); -} - -=item $c->prepare_cookies - -=cut - -sub prepare_cookies { - my $c = shift; - - if ( my $header = $c->request->headers->header('Cookie') ) { - $c->req->cookies( { CGI::Simple::Cookie->parse($header) } ); - } + $c->req->hostname( $c->http->hostname ); + $c->req->address( $c->http->address ); } =item $c->prepare_headers @@ -114,8 +88,8 @@ sub prepare_cookies { sub prepare_headers { my $c = shift; - $c->req->method( $c->lwp->request->method ); - $c->req->headers( $c->lwp->request->headers ); + $c->req->method( $c->http->request->method ); + $c->req->headers( $c->http->request->headers ); } =item $c->prepare_parameters @@ -125,8 +99,9 @@ sub prepare_headers { sub prepare_parameters { my $c = shift; - my @params = (); - my $request = $c->lwp->request; + my ( @params, @uploads ); + + my $request = $c->http->request; push( @params, $request->uri->query_form ); @@ -145,38 +120,30 @@ sub prepare_parameters { if ( $parameters{filename} ) { - my $fh = IO::File->new_tmpfile; + my $fh = File::Temp->new( UNLINK => 0 ); $fh->write( $part->content ) or die $!; - $fh->seek( SEEK_SET, 0 ) or die $!; - - $c->req->uploads->{ $parameters{filename} } = { - fh => $fh, - size => ( stat $fh )[7], - type => $part->content_type - }; - - push( @params, $parameters{filename}, $fh ); + $fh->flush or die $!; + + my $upload = Catalyst::Request::Upload->new( + filename => $parameters{filename}, + size => ( $fh->stat )[7], + tempname => $fh->filename, + type => $part->content_type + ); + + $fh->close; + + push( @uploads, $parameters{name}, $upload ); + push( @params, $parameters{name}, $parameters{filename} ); } else { push( @params, $parameters{name}, $part->content ); } } } - - my $parameters = $c->req->parameters; - - while ( my ( $name, $value ) = splice( @params, 0, 2 ) ) { - - if ( exists $parameters->{$name} ) { - for ( $parameters->{$name} ) { - $_ = [$_] unless ref($_) eq "ARRAY"; - push( @$_, $value ); - } - } - else { - $parameters->{$name} = $value; - } - } + + $c->req->_assign_values( $c->req->parameters, \@params ); + $c->req->_assign_values( $c->req->uploads, \@uploads ); } =item $c->prepare_path @@ -188,9 +155,9 @@ sub prepare_path { my $base; { - my $scheme = $c->lwp->request->uri->scheme; - my $host = $c->lwp->request->uri->host; - my $port = $c->lwp->request->uri->port; + my $scheme = $c->http->request->uri->scheme; + my $host = $c->http->request->uri->host; + my $port = $c->http->request->uri->port; $base = URI->new; $base->scheme($scheme); @@ -200,7 +167,8 @@ sub prepare_path { $base = $base->canonical->as_string; } - my $path = $c->lwp->request->uri->path || '/'; + my $path = $c->http->request->uri->path || '/'; + $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; $path =~ s/^\///; $c->req->base($base); @@ -212,8 +180,8 @@ sub prepare_path { =cut sub prepare_request { - my ( $c, $lwp ) = @_; - $c->lwp($lwp); + my ( $c, $http ) = @_; + $c->http($http); } =item $c->prepare_uploads @@ -234,7 +202,8 @@ sub run { unless ( ref $request ) { - my $uri = ( $request =~ m/http/i ) + my $uri = + ( $request =~ m/http/i ) ? URI->new($request) : URI->new( 'http://localhost' . $request ); @@ -245,15 +214,21 @@ sub run { $request = HTTP::Request->new( 'GET', $request ); } - my $lwp = Catalyst::Engine::Test::LWP->new( - request => $request, + my $host = sprintf( '%s:%d', $request->uri->host, $request->uri->port ); + $request->header( 'Host' => $host ); + + my $http = Catalyst::Engine::Test::HTTP->new( address => '127.0.0.1', - hostname => 'localhost' + hostname => 'localhost', + request => $request, + response => HTTP::Response->new ); - $class->handler($lwp); + $http->response->date(time); + + $class->handler($http); - return $lwp->response; + return $http->response; } =back