From: Christian Hansen Date: Wed, 23 Mar 2005 02:36:20 +0000 (+0000) Subject: added C::E::CGI::NPH X-Git-Tag: 5.7099_04~1723 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=e646f111fbeb0ab42406b5be7e6a488df3f1483f;hp=9ada3267f9ef5287152340b192a00be0742a26ab added C::E::CGI::NPH added C::E::Test updated C::Test to use engine updated help scripts --- diff --git a/MANIFEST b/MANIFEST index e2a7648..bd11672 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4,8 +4,10 @@ lib/Catalyst/Base.pm lib/Catalyst/Engine.pm lib/Catalyst/Engine/Apache.pm lib/Catalyst/Engine/CGI.pm +lib/Catalyst/Engine/CGI/NPH.pm lib/Catalyst/Engine/FCGI.pm lib/Catalyst/Engine/Server.pm +lib/Catalyst/Engine/Test.pm lib/Catalyst/Helper.pm lib/Catalyst/Log.pm lib/Catalyst/Manual.pod diff --git a/lib/Catalyst/Engine/Apache.pm b/lib/Catalyst/Engine/Apache.pm index aca61ad..5b48ab6 100644 --- a/lib/Catalyst/Engine/Apache.pm +++ b/lib/Catalyst/Engine/Apache.pm @@ -188,6 +188,8 @@ sub prepare_uploads { } } +sub run { } + =back =head1 SEE ALSO diff --git a/lib/Catalyst/Engine/CGI.pm b/lib/Catalyst/Engine/CGI.pm index b48cf2f..5f930ed 100644 --- a/lib/Catalyst/Engine/CGI.pm +++ b/lib/Catalyst/Engine/CGI.pm @@ -75,7 +75,7 @@ This class overloads some methods from C. sub finalize_headers { my $c = shift; - my %headers = ( -nph => 1 ); + my %headers; $headers{-status} = $c->response->status if $c->response->status; for my $name ( $c->response->headers->header_field_names ) { $headers{"-$name"} = $c->response->headers->header($name); diff --git a/lib/Catalyst/Engine/CGI/NPH.pm b/lib/Catalyst/Engine/CGI/NPH.pm new file mode 100644 index 0000000..96699a0 --- /dev/null +++ b/lib/Catalyst/Engine/CGI/NPH.pm @@ -0,0 +1,68 @@ +package Catalyst::Engine::CGI::NPH; + +use strict; +use base 'Catalyst::Engine::CGI'; + +=head1 NAME + +Catalyst::Engine::CGI::NPH - Catalyst CGI Engine + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +This Catalyst engine returns a complete HTTP response message. + +=head1 OVERLOADED METHODS + +This class overloads some methods from C. + +=over 4 + +=item $c->finalize_headers + +=cut + +sub finalize_headers { + my $c = shift; + my %headers = ( -nph => 1 ); + $headers{-status} = $c->response->status if $c->response->status; + for my $name ( $c->response->headers->header_field_names ) { + $headers{"-$name"} = $c->response->headers->header($name); + } + my @cookies; + while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) { + push @cookies, $c->cgi->cookie( + -name => $name, + -value => $cookie->{value}, + -expires => $cookie->{expires}, + -domain => $cookie->{domain}, + -path => $cookie->{path}, + -secure => $cookie->{secure} || 0 + ); + } + $headers{-cookie} = \@cookies if @cookies; + print $c->cgi->header(%headers); +} + +=back + +=head1 SEE ALSO + +L, L. + +=head1 AUTHOR + +Sebastian Riedel, C +Christian Hansen, C + +=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/Engine/FCGI.pm b/lib/Catalyst/Engine/FCGI.pm index 0ee022b..10db5cf 100644 --- a/lib/Catalyst/Engine/FCGI.pm +++ b/lib/Catalyst/Engine/FCGI.pm @@ -31,14 +31,7 @@ sub run { my $class = shift; my $request = FCGI::Request(); while ( $request->Accept() >= 0 ) { - my $output; - { - local (*STDOUT); - open( STDOUT, '>', \$output ); - $class->NEXT::run; - } - $output =~ s!^HTTP/\d+.\d+ \d\d\d.*?\n!!s; - print $output; + $class->handler; } } diff --git a/lib/Catalyst/Engine/Server.pm b/lib/Catalyst/Engine/Server.pm index 47aa7f6..468494d 100644 --- a/lib/Catalyst/Engine/Server.pm +++ b/lib/Catalyst/Engine/Server.pm @@ -1,7 +1,7 @@ package Catalyst::Engine::Server; use strict; -use base 'Catalyst::Engine::CGI'; +use base 'Catalyst::Engine::CGI::NPH'; =head1 NAME @@ -17,7 +17,7 @@ This is the Catalyst engine specialized for development and testing. =head1 OVERLOADED METHODS -This class overloads some methods from C. +This class overloads some methods from C. =over 4 diff --git a/lib/Catalyst/Engine/Test.pm b/lib/Catalyst/Engine/Test.pm new file mode 100644 index 0000000..45da156 --- /dev/null +++ b/lib/Catalyst/Engine/Test.pm @@ -0,0 +1,101 @@ +package Catalyst::Engine::Test; + +use strict; +use base 'Catalyst::Engine::CGI::NPH'; + +use HTTP::Request; +use HTTP::Response; +use IO::File; +use URI; + +=head1 NAME + +Catalyst::Engine::Test - Catalyst Test Engine + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +This is the Catalyst engine specialized for testing. + +=head1 OVERLOADED METHODS + +This class overloads some methods from C. + +=over 4 + +=item $c->run + +=cut + +sub run { + my $class = shift; + 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; + 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); + } + + 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); +} + +=back + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Sebastian Riedel, C +Christian Hansen, C + +=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 8f16fb8..abbc829 100644 --- a/lib/Catalyst/Helper.pm +++ b/lib/Catalyst/Helper.pm @@ -325,7 +325,7 @@ sub _mk_cgi { $self->mk_file( "$script\/nph-cgi.pl", <<"EOF"); $Config{startperl} -w -BEGIN { \$ENV{CATALYST_ENGINE} = 'CGI' } +BEGIN { \$ENV{CATALYST_ENGINE} = 'CGI::NPH' } use strict; use FindBin; @@ -483,11 +483,14 @@ sub _mk_test { $self->mk_file( "$script/test.pl", <<"EOF"); $Config{startperl} -w +BEGIN { \$ENV{CATALYST_ENGINE} = 'Test' } + use strict; use Getopt::Long; use Pod::Usage; use FindBin; use lib "\$FindBin::Bin/../lib"; +use $name; my \$help = 0; @@ -495,10 +498,7 @@ GetOptions( 'help|?' => \\\$help ); pod2usage(1) if ( \$help || !\$ARGV[0] ); -require Catalyst::Test; -import Catalyst::Test '$name'; - -print get(\$ARGV[0]) . "\n"; +print $name->run(\$ARGV[0])->content . "\n"; 1; __END__ diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm index 824c577..0f2762e 100644 --- a/lib/Catalyst/Test.pm +++ b/lib/Catalyst/Test.pm @@ -2,16 +2,10 @@ package Catalyst::Test; use strict; use UNIVERSAL::require; -use IO::File; -use HTTP::Request; -use HTTP::Response; -use Socket; -use URI; require Catalyst; my $class; -$ENV{CATALYST_ENGINE} = 'CGI'; =head1 NAME @@ -66,55 +60,19 @@ sub import { unless ( $INC{'Test/Builder.pm'} ) { die qq/Couldn't load "$class", "$@"/ if $@; } - my $caller = caller(0); + no strict 'refs'; - *{"$caller\::request"} = \&request; - *{"$caller\::get"} = sub { request(@_)->content }; - } -} -sub request { - 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; - 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; + unless ( $class->engine->isa('Catalyst::Engine::Test') ) { + require Catalyst::Engine::Test; + splice( @{"$class\::ISA"}, @{"$class\::ISA"} - 1, + 0, 'Catalyst::Engine::Test' ); } - $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: $!"); + + my $caller = caller(0); + *{"$caller\::request"} = sub { $class->run(@_) }; + *{"$caller\::get"} = sub { $class->run(@_)->content }; } - open( STDOUT, '>', \$output ); - $class->handler; - %ENV = %clean; - return HTTP::Response->parse($output); } =head1 SEE ALSO