use strict;
use UNIVERSAL::require;
+use IO::File;
+use HTTP::Request;
use HTTP::Response;
use Socket;
use URI;
=head1 SYNOPSIS
+ # Helper
+ script/cgi-server.pl
+ script/server.pl
+ script/test.pl
+
# Tests
use Catalyst::Test 'TestApp';
request('index.html');
}
sub request {
- my $uri = shift;
- local *STDOUT;
- my $output = '';
- open STDOUT, '>', \$output;
- $uri = URI->new($uri);
+ my $request = shift;
+ unless ( ref $request ) {
+ $request = URI->new( $request, 'http' );
+ }
+ unless ( ref $request eq 'HTTP::Request' ) {
+ $request = HTTP::Request->new( 'GET', $request );
+ }
+ local ( *STDIN, *STDOUT );
my %clean = %ENV;
- $ENV{REQUEST_METHOD} ||= 'GET';
- $ENV{HTTP_HOST} ||= $uri->authority || 'localhost';
- $ENV{SCRIPT_NAME} ||= $uri->path || '/';
- $ENV{QUERY_STRING} ||= $uri->query || '';
- $ENV{CONTENT_TYPE} ||= 'text/plain';
+ $ENV{CONTENT_TYPE} ||= $request->header('Content-Type') || '';
+ $ENV{CONTENT_LENGTH} ||= $request->header('Content-Length') || '';
+ $ENV{GATEWAY_INTERFACE} ||= 'CGI/1.1';
+ $ENV{HTTP_HOST} ||= $request->uri->host || 'localhost';
+ $ENV{QUERY_STRING} ||= $request->uri->query || '';
+ $ENV{REQUEST_METHOD} ||= $request->method;
+ $ENV{SCRIPT_NAME} ||= $request->uri->path || '/';
+ $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);
+ }
+ 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: $!");
+ }
+ open( STDOUT, '>', \$output );
$class->handler;
%ENV = %clean;
return HTTP::Response->parse($output);
--- /dev/null
+package TestApp;
+
+use Catalyst;
+
+__PACKAGE__->action(
+ echo => sub {
+ my ( $self, $c ) = @_;
+
+ for my $field ( $c->req->headers->header_field_names ) {
+ my $header = ( $field =~ /^X-/ ) ? $field : "X-$field";
+ $c->res->headers->header(
+ $header => $c->req->headers->header($field) );
+ }
+
+ $c->res->headers->content_type('text/plain');
+ $c->res->output('ok');
+ }
+);
+
+package main;
+
+use Test::More tests => 5;
+use Catalyst::Test 'TestApp';
+use HTTP::Request::Common;
+
+my $request = POST(
+ 'http://localhost/echo',
+ 'X-Whats-Cool' => 'Catalyst',
+ 'Content-Type' => 'form-data',
+ 'Content' => [
+ catalyst => 'Rocks!',
+ file => [$0],
+ ]
+);
+
+ok( my $response = request($request) );
+ok( $response->content_type eq 'text/plain' );
+ok( $response->headers->header('X-Content-Type') =~ /^multipart\/form-data/ );
+ok( $response->headers->header('X-Content-Length') ==
+ $request->content_length );
+ok( $response->headers->header('X-Whats-Cool') eq 'Catalyst' );