Updated Catalyst::Test to use HTTP::Request::AsCGI

diff --git a/Build.PL b/Build.PL
index 1d3264d..3926b92 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -18,6 +18,7 @@ my $build = Module::Build->new(
         'HTTP::Headers'                     => 1.59,
         'HTTP::Request'                     => 0,
         'HTTP::Response'                    => 0,
+        'HTTP::Request::AsCGI'              => 0,
         'LWP::UserAgent'                    => 0,
         'MIME::Types'                       => 0,
         'Module::Pluggable::Fast'           => 0.16,
@@ -32,8 +33,11 @@ my $build = Module::Build->new(
         'Tree::Simple::Visitor::FindByPath' => 0,
         'URI'                               => 1.35,
     },
-    recommends =>
-      { 'Catalyst::Engine::Apache' => '1.00', FCGI => 0, 'FCGI::ProcManager' => 0 },
+    recommends => {
+        'Catalyst::Engine::Apache' => '1.00',
+        FCGI                       => 0,
+        'FCGI::ProcManager'        => 0
+    },
     create_makefile_pl => 'passthrough',
     create_readme      => 1,
     script_files       => [ glob('script/*') ],

diff --git a/Changes b/Changes
index 01a2e1c..bc31240 100644 (file)
--- a/Changes
+++ b/Changes
@@ -5,6 +5,7 @@ This file documents the revision history for Perl extension Catalyst.
           request. (Sam Vilain)
         - Updated benchmarking to work with detach
         - Fixed dispatcher, so $c->req->action(undef) works again
+        - Updated Catalyst::Test to use HTTP::Request::AsCGI
 
 5.55    2005-11-15 12:55:00
         - Fixed multiple cookie handling

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 6559d20..1075c43 100644 (file)
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -43,7 +43,7 @@ our $DETACH    = "catalyst_detach\n";
 require Module::Pluggable::Fast;
 
 # Helper script generation
-our $CATALYST_SCRIPT_GEN = 11;
+our $CATALYST_SCRIPT_GEN = 12;
 
 __PACKAGE__->mk_classdata($_)
   for qw/components arguments dispatcher engine log dispatcher_class

diff --git a/lib/Catalyst/Engine/Test.pm b/lib/Catalyst/Engine/Test.pm
deleted file mode 100644 (file)
index 0f452fc..0000000
--- a/lib/Catalyst/Engine/Test.pm
+++ /dev/null
@@ -1,141 +0,0 @@
-package Catalyst::Engine::Test;
-
-use strict;
-use base 'Catalyst::Engine::CGI';
-use Catalyst::Utils;
-use HTTP::Headers;
-use HTTP::Response;
-use HTTP::Status;
-use NEXT;
-
-=head1 NAME
-
-Catalyst::Engine::Test - Catalyst Test Engine
-
-=head1 SYNOPSIS
-
-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
-
-This is the Catalyst engine specialized for testing.
-
-=head1 OVERLOADED METHODS
-
-This class overloads some methods from C<Catalyst::Engine::CGI>.
-
-=over 4
-
-=item finalize_headers
-
-=cut
-
-sub finalize_headers {
-    my ( $self, $c ) = @_;
-    my $protocol = $c->request->protocol;
-    my $status   = $c->response->status;
-    my $message  = status_message($status);
-    print "$protocol $status $message\n";
-    $c->response->headers->date(time);
-    $self->NEXT::finalize_headers($c);
-}
-
-=item $self->run($c)
-
-=cut
-
-sub run {
-    my ( $self, $class, $request ) = @_;
-
-    $request = Catalyst::Utils::request($request);
-
-    $request->header(
-        'Host' => sprintf( '%s:%d', $request->uri->host, $request->uri->port )
-    );
-
-    # We emulate CGI
-    local %ENV = (
-        PATH_INFO    => $request->uri->path  || '',
-        QUERY_STRING => $request->uri->query || '',
-        REMOTE_ADDR  => '127.0.0.1',
-        REMOTE_HOST  => 'localhost',
-        REQUEST_METHOD  => $request->method,
-        SERVER_NAME     => 'localhost',
-        SERVER_PORT     => $request->uri->port,
-        SERVER_PROTOCOL => 'HTTP/1.1',
-        %ENV,
-    );
-
-    # Headers
-    for my $header ( $request->header_field_names ) {
-        my $name = uc $header;
-        $name = 'COOKIE' if $name eq 'COOKIES';
-        $name =~ tr/-/_/;
-        $name = 'HTTP_' . $name
-          unless $name =~ m/\A(?:CONTENT_(?:LENGTH|TYPE)|COOKIE)\z/;
-        my $value = $request->header($header);
-        if ( exists $ENV{$name} ) {
-            $ENV{$name} .= "; $value";
-        }
-        else {
-            $ENV{$name} = $value;
-        }
-    }
-
-    # STDIN
-    local *STDIN;
-    my $input = $request->content;
-    open STDIN, '<', \$input;
-
-    # STDOUT
-    local *STDOUT;
-    my $output = '';
-    open STDOUT, '>', \$output;
-
-    # Process
-    $class->handle_request;
-
-    # Response
-    return HTTP::Response->parse($output);
-}
-
-=item $self->read_chunk($c, $buffer, $length)
-
-=cut
-
-sub read_chunk { shift; shift; *STDIN->read(@_); }
-
-=back
-
-=head1 SEE ALSO
-
-L<Catalyst>.
-
-=head1 AUTHORS
-
-Sebastian Riedel, <sri@cpan.org>
-
-Christian Hansen, <ch@ngmedia.com>
-
-Andy Grundman, <andy@hybridized.org>
-
-=head1 COPYRIGHT
-
-This program is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=cut
-
-1;

diff --git a/lib/Catalyst/Helper.pm b/lib/Catalyst/Helper.pm
index 00a5434..d63c7c1 100644 (file)
--- a/lib/Catalyst/Helper.pm
+++ b/lib/Catalyst/Helper.pm
@@ -839,14 +839,12 @@ it under the same terms as Perl itself.
 __test__
 [% startperl %] -w
 
-BEGIN { $ENV{CATALYST_ENGINE} ||= 'Test' }
-
 use strict;
 use Getopt::Long;
 use Pod::Usage;
 use FindBin;
 use lib "$FindBin::Bin/../lib";
-use [% name %];
+use Catalyst::Test '[% name %]';
 
 my $help = 0;
 
@@ -854,7 +852,7 @@ GetOptions( 'help|?' => \$help );
 
 pod2usage(1) if ( $help || !$ARGV[0] );
 
-print [% name %]->run($ARGV[0])->content . "\n";
+print request($ARGV[0])->content . "\n";
 
 1;
 

diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm
index 3af0f15..17ec18d 100644 (file)
--- a/lib/Catalyst/Test.pm
+++ b/lib/Catalyst/Test.pm
@@ -6,25 +6,8 @@ use warnings;
 use Catalyst::Exception;
 use Catalyst::Utils;
 use UNIVERSAL::require;
-use HTTP::Headers;
-
-$ENV{CATALYST_ENGINE} = 'Test';
-
-# Bypass a HTTP::Headers bug
-{
-    no warnings 'redefine';
-
-    sub HTTP::Headers::new {
-        my $class = shift;
-        my $self = bless {}, $class;
-        if (@_) {
-            while ( my ( $field, $val ) = splice( @_, 0, 2 ) ) {
-                $self->push_header( $field, $val );
-            }
-        }
-        return $self;
-    }
-}
+
+$ENV{CATALYST_ENGINE} = 'CGI';
 
 =head1 NAME
 
@@ -100,8 +83,8 @@ sub import {
         die if $@ && $@ !~ /^Can't locate /;
         $class->import;
 
-        $request = sub { $class->run(@_) };
-        $get     = sub { $class->run(@_)->content };
+        $request = sub { local_request( $class, @_ ) };
+        $get     = sub { local_request( $class, @_ )->content };
     }
 
     no strict 'refs';
@@ -110,6 +93,23 @@ sub import {
     *{"$caller\::get"}     = $get;
 }
 
+=item local_request
+
+=cut
+
+sub local_request {
+    my $class = shift;
+
+    require HTTP::Request::AsCGI;
+
+    my $request = Catalyst::Utils::request( shift(@_) );
+    my $cgi     = HTTP::Request::AsCGI->new( $request, %ENV )->setup;
+
+    $class->handle_request;
+
+    return $cgi->restore->response;
+}
+
 my $agent;
 
 =item remote_request
@@ -123,8 +123,7 @@ sub remote_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