From: Christian Hansen Date: Mon, 16 May 2005 22:13:52 +0000 (+0000) Subject: Fixed MP2, removed dependency of libapreq in MP engines, fixed C::E::C::APR X-Git-Tag: 5.7099_04~1386 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=316bf0f004c0de103e628994a4384e6cf4b45377 Fixed MP2, removed dependency of libapreq in MP engines, fixed C::E::C::APR --- diff --git a/Build.PL b/Build.PL index 7922e24..b346735 100644 --- a/Build.PL +++ b/Build.PL @@ -6,10 +6,12 @@ my $build = Module::Build->new( license => 'perl', module_name => 'Catalyst', requires => { + 'perl' => '5.8.1', 'UNIVERSAL::require' => 0, 'CGI' => 0, 'Class::Accessor::Fast' => 0, 'Class::Data::Inheritable' => 0, + 'File::Temp' => 0.14, 'HTTP::Daemon' => 0, 'HTML::Entities' => 0, 'HTTP::Headers' => 0, diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index e573b0d..be14489 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -154,23 +154,52 @@ sub import { my $dispatcher = 'Catalyst::Dispatcher'; if ( $ENV{MOD_PERL} ) { - - mod_perl->require; - if ( $mod_perl::VERSION >= 1.99_90_22 ) { - $engine = 'Catalyst::Engine::Apache::MP20'; - } + my ( $software, $version ) = $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/; + + $version =~ s/_//g; + $version =~ s/(\.[^.]+)\./$1/g; + + if ( $software eq 'mod_perl') { + + if ( $version >= 1.99922 ) { + + $engine = 'Catalyst::Engine::Apache::MP20'; + + if ( Apache2::Request->require ) { + $engine = 'Catalyst::Engine::Apache::MP20::APR'; + } + } + + elsif ( $version >= 1.9901 ) { + + $engine = 'Catalyst::Engine::Apache::MP19'; - elsif ( $mod_perl::VERSION >= 1.99_01 ) { - $engine = 'Catalyst::Engine::Apache::MP19'; + if ( Apache::Request->require ) { + $engine = 'Catalyst::Engine::Apache::MP19::APR'; + } + } + + elsif ( $version >= 1.24 ) { + + $engine = 'Catalyst::Engine::Apache::MP13'; + + if ( Apache::Request->require ) { + $engine = 'Catalyst::Engine::Apache::MP13::APR'; + } + } + + else { + die( qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ ); + } } - elsif ( $mod_perl::VERSION >= 1.27 ) { - $engine = 'Catalyst::Engine::Apache::MP13'; + elsif ( $software eq 'Zeus-Perl' ) { + $engine = 'Catalyst::Engine::Zeus'; } else { - die( qq/Unsupported mod_perl version: "$mod_perl::VERSION"/ ); + die( qq/Unsupported mod_perl: $ENV{MOD_PERL}/ ); } } diff --git a/lib/Catalyst/Engine/Apache/Base.pm b/lib/Catalyst/Engine/Apache/Base.pm index 8d383da..bcf8458 100644 --- a/lib/Catalyst/Engine/Apache/Base.pm +++ b/lib/Catalyst/Engine/Apache/Base.pm @@ -91,24 +91,6 @@ sub prepare_headers { $c->request->header( %{ $c->apache->headers_in } ); } -=item $c->prepare_parameters - -=cut - -sub prepare_parameters { - my $c = shift; - - my @params; - - $c->apache->param->do( sub { - my ( $field, $value ) = @_; - push( @params, $field, $value ); - return 1; - }); - - $c->request->param(@params); -} - =item $c->prepare_path =cut @@ -147,6 +129,15 @@ sub prepare_path { $c->req->path($path); } +=item $c->prepare_request($r) + +=cut + +sub prepare_request { + my ( $c, $r ) = @_; + $c->apache($r); +} + =item $c->run =cut diff --git a/lib/Catalyst/Engine/Apache/MP13.pm b/lib/Catalyst/Engine/Apache/MP13.pm index 6415457..27066c3 100644 --- a/lib/Catalyst/Engine/Apache/MP13.pm +++ b/lib/Catalyst/Engine/Apache/MP13.pm @@ -1,13 +1,7 @@ package Catalyst::Engine::Apache::MP13; use strict; -use base 'Catalyst::Engine::Apache::Base'; - -use Apache (); -use Apache::Constants (); -use Apache::Request (); - -Apache::Constants->import(':common'); +use base qw[Catalyst::Engine::Apache::MP13::Base Catalyst::Engine::CGI]; =head1 NAME @@ -23,75 +17,49 @@ This is the Catalyst engine specialized for Apache mod_perl version 1.3x. =head1 OVERLOADED METHODS -This class overloads some methods from C. +This class overloads some methods from C +and C. =over 4 -=item $c->finalize_headers +=item $c->prepare_body =cut -sub finalize_headers { - my $c = shift; - - for my $name ( $c->response->headers->header_field_names ) { - next if $name =~ /Content-Type/i; - my @values = $c->response->header($name); - $c->apache->headers_out->add( $name => $_ ) for @values; - } - - if ( $c->response->header('Set-Cookie') && $c->response->status >= 300 ) { - my @values = $c->response->header('Set-Cookie'); - $c->apache->err_headers_out->add( 'Set-Cookie' => $_ ) for @values; - } - - $c->apache->status( $c->response->status ); - $c->apache->content_type( $c->response->header('Content-Type') ); - - $c->apache->send_http_header; - - return 0; +sub prepare_body { + shift->Catalyst::Engine::CGI::prepare_body(@_); } -=item $c->handler +=item $c->prepare_parameters =cut -sub handler ($$) { - shift->SUPER::handler(@_); +sub prepare_parameters { + shift->Catalyst::Engine::CGI::prepare_parameters(@_); } -=item $c->prepare_request($r) +=item $c->prepare_request =cut sub prepare_request { - my ( $c, $r ) = @_; - $c->apache( Apache::Request->new($r) ); + my ( $c, $r, @arguments ) = @_; + + $ENV{CONTENT_TYPE} = $r->header_in("Content-Type"); + $ENV{CONTENT_LENGTH} = $r->header_in("Content-Length"); + $ENV{QUERY_STRING} = $r->args; + $ENV{REQUEST_METHOD} = $r->method; + + $c->SUPER::prepare_request($r); + $c->Catalyst::Engine::CGI::prepare_request( $r, @arguments ); } =item $c->prepare_uploads =cut -sub prepare_uploads { - my $c = shift; - - my @uploads; - - for my $upload ( $c->apache->upload ) { - - my $object = Catalyst::Request::Upload->new( - filename => $upload->filename, - size => $upload->size, - tempname => $upload->tempname, - type => $upload->type - ); - - push( @uploads, $upload->name, $object ); - } - - $c->request->upload(@uploads); +sub prepare_uploads { + shift->Catalyst::Engine::CGI::prepare_uploads(@_); } =back diff --git a/lib/Catalyst/Engine/Apache/MP13/APR.pm b/lib/Catalyst/Engine/Apache/MP13/APR.pm new file mode 100644 index 0000000..d978f9c --- /dev/null +++ b/lib/Catalyst/Engine/Apache/MP13/APR.pm @@ -0,0 +1,96 @@ +package Catalyst::Engine::Apache::MP13::APR; + +use strict; +use base 'Catalyst::Engine::Apache::MP13::Base'; + +use Apache::Request (); + +=head1 NAME + +Catalyst::Engine::Apache::MP13::APR - APR class for MP 1.3 Engines + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +This is the Catalyst engine specialized for Apache mod_perl version 1.3x. + +=head1 OVERLOADED METHODS + +This class overloads some methods from C. + +=over 4 + +=item $c->prepare_request($r) + +=cut + +sub prepare_request { + my ( $c, $r ) = @_; + $c->apache( Apache::Request->new($r) ); +} + + +=item $c->prepare_parameters + +=cut + +sub prepare_parameters { + my $c = shift; + + my @params; + + $c->apache->param->do( sub { + my ( $field, $value ) = @_; + push( @params, $field, $value ); + return 1; + }); + + $c->request->param(@params); +} + +=item $c->prepare_uploads + +=cut + +sub prepare_uploads { + my $c = shift; + + my @uploads; + + for my $upload ( $c->apache->upload ) { + + my $object = Catalyst::Request::Upload->new( + filename => $upload->filename, + size => $upload->size, + tempname => $upload->tempname, + type => $upload->type + ); + + push( @uploads, $upload->name, $object ); + } + + $c->request->upload(@uploads); +} + +=back + +=head1 SEE ALSO + +L, 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/Apache/MP13/Base.pm b/lib/Catalyst/Engine/Apache/MP13/Base.pm new file mode 100644 index 0000000..ca38f40 --- /dev/null +++ b/lib/Catalyst/Engine/Apache/MP13/Base.pm @@ -0,0 +1,81 @@ +package Catalyst::Engine::Apache::MP13::Base; + +use strict; +use base 'Catalyst::Engine::Apache::Base'; + +use Apache (); +use Apache::Constants (); + +Apache::Constants->import(':common'); + +=head1 NAME + +Catalyst::Engine::Apache::MP13::Base - Base class for MP 1.3 Engines + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +This is a base class for MP 1.3 Engines. + +=head1 OVERLOADED METHODS + +This class overloads some methods from C. + +=over 4 + +=item $c->finalize_headers + +=cut + +sub finalize_headers { + my $c = shift; + + for my $name ( $c->response->headers->header_field_names ) { + next if $name =~ /Content-Type/i; + my @values = $c->response->header($name); + $c->apache->headers_out->add( $name => $_ ) for @values; + } + + if ( $c->response->header('Set-Cookie') && $c->response->status >= 300 ) { + my @values = $c->response->header('Set-Cookie'); + $c->apache->err_headers_out->add( 'Set-Cookie' => $_ ) for @values; + } + + $c->apache->status( $c->response->status ); + $c->apache->content_type( $c->response->header('Content-Type') ); + + $c->apache->send_http_header; + + return 0; +} + +=item $c->handler + +=cut + +sub handler ($$) { + shift->SUPER::handler(@_); +} + +=back + +=head1 SEE ALSO + +L, 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/Apache/MP19.pm b/lib/Catalyst/Engine/Apache/MP19.pm index a22c8e0..5a44984 100644 --- a/lib/Catalyst/Engine/Apache/MP19.pm +++ b/lib/Catalyst/Engine/Apache/MP19.pm @@ -1,18 +1,7 @@ package Catalyst::Engine::Apache::MP19; use strict; -use base 'Catalyst::Engine::Apache::Base'; - -use Apache2 (); -use Apache::Connection (); -use Apache::Const (); -use Apache::RequestIO (); -use Apache::RequestRec (); -use Apache::RequestUtil (); -use Apache::Request (); -use Apache::Upload (); - -Apache::Const->import( -compile => ':common' ); +use base qw[Catalyst::Engine::Apache::MP19::Base Catalyst::Engine::CGI]; =head1 NAME @@ -28,79 +17,49 @@ This is the Catalyst engine specialized for Apache mod_perl version 1.9x. =head1 OVERLOADED METHODS -This class overloads some methods from C. +This class overloads some methods from C +and C. =over 4 -=item $c->finalize_headers +=item $c->prepare_body =cut -sub finalize_headers { - my $c = shift; - - for my $name ( $c->response->headers->header_field_names ) { - next if $name =~ /Content-Type/i; - my @values = $c->response->header($name); - $c->apache->headers_out->add( $name => $_ ) for @values; - } - - if ( $c->response->header('Set-Cookie') && $c->response->status >= 300 ) { - my @values = $c->response->header('Set-Cookie'); - $c->apache->err_headers_out->add( 'Set-Cookie' => $_ ) for @values; - } - - $c->apache->status( $c->response->status ); - $c->apache->content_type( $c->response->header('Content-Type') ); - - return 0; +sub prepare_body { + shift->Catalyst::Engine::CGI::prepare_body(@_); } -=item $c->handler +=item $c->prepare_parameters =cut -sub handler : method { - shift->SUPER::handler(@_); +sub prepare_parameters { + shift->Catalyst::Engine::CGI::prepare_parameters(@_); } -=item $c->prepare_request($r) +=item $c->prepare_request =cut sub prepare_request { - my ( $c, $r ) = @_; - $c->apache( Apache::Request->new($r) ); + my ( $c, $r, @arguments ) = @_; + + $ENV{CONTENT_TYPE} = $r->headers_in->get("Content-Type"); + $ENV{CONTENT_LENGTH} = $r->headers_in->get("Content-Length"); + $ENV{QUERY_STRING} = $r->args; + $ENV{REQUEST_METHOD} = $r->method; + + $c->SUPER::prepare_request($r); + $c->Catalyst::Engine::CGI::prepare_request( $r, @arguments ); } =item $c->prepare_uploads =cut -sub prepare_uploads { - my $c = shift; - - # This is a workaround for a know bug with libapreq <= 2.0.4 - # http://svn.apache.org/viewcvs.cgi?rev=122925&view=rev - - my @uploads; - - for my $field ( $c->request->param ) { - - for my $upload ( $c->apache->upload($field) ) { - - my $object = Catalyst::Request::Upload->new( - filename => $upload->filename, - size => $upload->size, - tempname => $upload->tempname, - type => $upload->type - ); - - push( @uploads, $field, $object ); - } - } - - $c->request->upload(@uploads); +sub prepare_uploads { + shift->Catalyst::Engine::CGI::prepare_uploads(@_); } =back diff --git a/lib/Catalyst/Engine/Apache/MP19/APR.pm b/lib/Catalyst/Engine/Apache/MP19/APR.pm new file mode 100644 index 0000000..b8c507d --- /dev/null +++ b/lib/Catalyst/Engine/Apache/MP19/APR.pm @@ -0,0 +1,102 @@ +package Catalyst::Engine::Apache::MP19::APR; + +use strict; +use base 'Catalyst::Engine::Apache::MP19::Base'; + +use Apache::Request (); +use Apache::Upload (); + +=head1 NAME + +Catalyst::Engine::Apache::MP19::APR - APR class for MP 1.9 Engines + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +This is the Catalyst engine specialized for Apache mod_perl version 1.99. + +=head1 OVERLOADED METHODS + +This class overloads some methods from C. + +=over 4 + +=item $c->prepare_parameters + +=cut + +sub prepare_parameters { + my $c = shift; + + my @params; + + $c->apache->param->do( sub { + my ( $field, $value ) = @_; + push( @params, $field, $value ); + return 1; + }); + + $c->request->param(@params); +} + +=item $c->prepare_request($r) + +=cut + +sub prepare_request { + my ( $c, $r ) = @_; + $c->apache( Apache::Request->new($r) ); +} + +=item $c->prepare_uploads + +=cut + +sub prepare_uploads { + my $c = shift; + + # This is a workaround for a know bug with libapreq <= 2.0.4 + # http://svn.apache.org/viewcvs.cgi?rev=122925&view=rev + + my @uploads; + + for my $field ( $c->request->param ) { + + for my $upload ( $c->apache->upload($field) ) { + + my $object = Catalyst::Request::Upload->new( + filename => $upload->filename, + size => $upload->size, + tempname => $upload->tempname, + type => $upload->type + ); + + push( @uploads, $field, $object ); + } + } + + $c->request->upload(@uploads); +} + +=back + +=head1 SEE ALSO + +L, 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/Apache/MP19/Base.pm b/lib/Catalyst/Engine/Apache/MP19/Base.pm new file mode 100644 index 0000000..0a08ba1 --- /dev/null +++ b/lib/Catalyst/Engine/Apache/MP19/Base.pm @@ -0,0 +1,83 @@ +package Catalyst::Engine::Apache::MP19::Base; + +use strict; +use base 'Catalyst::Engine::Apache::Base'; + +use Apache2 (); +use Apache::Connection (); +use Apache::Const (); +use Apache::RequestIO (); +use Apache::RequestRec (); +use Apache::RequestUtil (); + +Apache::Const->import( -compile => ':common' ); + +=head1 NAME + +Catalyst::Engine::Apache::MP19::Base - Base class for MP 1.9 Engines + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +This is a base class for MP 1.99 Engines. + +=head1 OVERLOADED METHODS + +This class overloads some methods from C. + +=over 4 + +=item $c->finalize_headers + +=cut + +sub finalize_headers { + my $c = shift; + + for my $name ( $c->response->headers->header_field_names ) { + next if $name =~ /Content-Type/i; + my @values = $c->response->header($name); + $c->apache->headers_out->add( $name => $_ ) for @values; + } + + if ( $c->response->header('Set-Cookie') && $c->response->status >= 300 ) { + my @values = $c->response->header('Set-Cookie'); + $c->apache->err_headers_out->add( 'Set-Cookie' => $_ ) for @values; + } + + $c->apache->status( $c->response->status ); + $c->apache->content_type( $c->response->header('Content-Type') ); + + return 0; +} + +=item $c->handler + +=cut + +sub handler : method { + shift->SUPER::handler(@_); +} + +=back + +=head1 SEE ALSO + +L, 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/Apache/MP20.pm b/lib/Catalyst/Engine/Apache/MP20.pm index c09722a..d03ae88 100644 --- a/lib/Catalyst/Engine/Apache/MP20.pm +++ b/lib/Catalyst/Engine/Apache/MP20.pm @@ -1,17 +1,7 @@ package Catalyst::Engine::Apache::MP20; use strict; -use base 'Catalyst::Engine::Apache::Base'; - -use Apache2::Connection (); -use Apache2::Const (); -use Apache2::RequestIO (); -use Apache2::RequestRec (); -use Apache2::RequestUtil (); -use Apache2::Request (); -use Apache2::Upload (); - -Apache2::Const->import( -compile => ':common' ); +use base qw[Catalyst::Engine::Apache::MP20::Base Catalyst::Engine::CGI]; =head1 NAME @@ -27,76 +17,49 @@ This is the Catalyst engine specialized for Apache mod_perl version 2.0. =head1 OVERLOADED METHODS -This class overloads some methods from C. +This class overloads some methods from C +and C. =over 4 -=item $c->finalize_headers +=item $c->prepare_body =cut -sub finalize_headers { - my $c = shift; - - for my $name ( $c->response->headers->header_field_names ) { - next if $name =~ /Content-Type/i; - my @values = $c->response->header($name); - $c->apache->headers_out->add( $name => $_ ) for @values; - } - - if ( $c->response->header('Set-Cookie') && $c->response->status >= 300 ) { - my @values = $c->response->header('Set-Cookie'); - $c->apache->err_headers_out->add( 'Set-Cookie' => $_ ) for @values; - } - - $c->apache->status( $c->response->status ); - $c->apache->content_type( $c->response->header('Content-Type') ); - - return 0; +sub prepare_body { + shift->Catalyst::Engine::CGI::prepare_body(@_); } -=item $c->handler +=item $c->prepare_parameters =cut -sub handler : method { - shift->SUPER::handler(@_); +sub prepare_parameters { + shift->Catalyst::Engine::CGI::prepare_parameters(@_); } -=item $c->prepare_request($r) +=item $c->prepare_request =cut sub prepare_request { - my ( $c, $r ) = @_; - $c->apache( Apache2::Request->new($r) ); + my ( $c, $r, @arguments ) = @_; + + $ENV{CONTENT_TYPE} = $r->headers_in->get("Content-Type"); + $ENV{CONTENT_LENGTH} = $r->headers_in->get("Content-Length"); + $ENV{QUERY_STRING} = $r->args; + $ENV{REQUEST_METHOD} = $r->method; + + $c->SUPER::prepare_request($r); + $c->Catalyst::Engine::CGI::prepare_request( $r, @arguments ); } =item $c->prepare_uploads =cut -sub prepare_uploads { - my $c = shift; - - my @uploads; - - $c->apache->upload->do( sub { - my ( $field, $upload ) = @_; - - my $object = Catalyst::Request::Upload->new( - filename => $upload->filename, - size => $upload->size, - tempname => $upload->tempname, - type => $upload->type - ); - - push( @uploads, $field, $object ); - - return 1; - }); - - $c->request->upload(@uploads); +sub prepare_uploads { + shift->Catalyst::Engine::CGI::prepare_uploads(@_); } =back diff --git a/lib/Catalyst/Engine/Apache/MP20/APR.pm b/lib/Catalyst/Engine/Apache/MP20/APR.pm new file mode 100644 index 0000000..a7352c5 --- /dev/null +++ b/lib/Catalyst/Engine/Apache/MP20/APR.pm @@ -0,0 +1,102 @@ +package Catalyst::Engine::Apache::MP20::APR; + +use strict; +use base 'Catalyst::Engine::Apache::MP20::Base'; + +use Apache2::Request (); +use Apache2::Upload (); + +=head1 NAME + +Catalyst::Engine::Apache::MP20 - APR class for MP 2.0 Engines + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +This is the Catalyst engine specialized for Apache mod_perl version 2.0. + +=head1 OVERLOADED METHODS + +This class overloads some methods from C. + +=over 4 + +=item $c->prepare_parameters + +=cut + +sub prepare_parameters { + my $c = shift; + + my @params; + + if ( my $table = $c->apache->param ) { + + $table->do( sub { + my ( $field, $value ) = @_; + push( @params, $field, $value ); + return 1; + }); + + $c->request->param(@params); + } +} + +=item $c->prepare_request($r) + +=cut + +sub prepare_request { + my ( $c, $r ) = @_; + $c->apache( Apache2::Request->new($r) ); +} + +=item $c->prepare_uploads + +=cut + +sub prepare_uploads { + my $c = shift; + + my @uploads; + + $c->apache->upload->do( sub { + my ( $field, $upload ) = @_; + + my $object = Catalyst::Request::Upload->new( + filename => $upload->filename, + size => $upload->size, + tempname => $upload->tempname, + type => $upload->type + ); + + push( @uploads, $field, $object ); + + return 1; + }); + + $c->request->upload(@uploads); +} + +=back + +=head1 SEE ALSO + +L, 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/Apache/MP20/Base.pm b/lib/Catalyst/Engine/Apache/MP20/Base.pm new file mode 100644 index 0000000..72b111d --- /dev/null +++ b/lib/Catalyst/Engine/Apache/MP20/Base.pm @@ -0,0 +1,82 @@ +package Catalyst::Engine::Apache::MP20::Base; + +use strict; +use base 'Catalyst::Engine::Apache::Base'; + +use Apache2::Connection (); +use Apache2::Const (); +use Apache2::RequestIO (); +use Apache2::RequestRec (); +use Apache2::RequestUtil (); + +Apache2::Const->import( -compile => ':common' ); + +=head1 NAME + +Catalyst::Engine::Apache::MP20::Base - Base class for MP 2.0 Engines + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +This is a base class for MP 2.0 Engines. + +=head1 OVERLOADED METHODS + +This class overloads some methods from C. + +=over 4 + +=item $c->finalize_headers + +=cut + +sub finalize_headers { + my $c = shift; + + for my $name ( $c->response->headers->header_field_names ) { + next if $name =~ /Content-Type/i; + my @values = $c->response->header($name); + $c->apache->headers_out->add( $name => $_ ) for @values; + } + + if ( $c->response->header('Set-Cookie') && $c->response->status >= 300 ) { + my @values = $c->response->header('Set-Cookie'); + $c->apache->err_headers_out->add( 'Set-Cookie' => $_ ) for @values; + } + + $c->apache->status( $c->response->status ); + $c->apache->content_type( $c->response->header('Content-Type') ); + + return 0; +} + +=item $c->handler + +=cut + +sub handler : method { + shift->SUPER::handler(@_); +} + +=back + +=head1 SEE ALSO + +L, 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/CGI.pm b/lib/Catalyst/Engine/CGI.pm index 0044681..1a8f37c 100644 --- a/lib/Catalyst/Engine/CGI.pm +++ b/lib/Catalyst/Engine/CGI.pm @@ -100,9 +100,35 @@ sub prepare_parameters { =cut sub prepare_request { - my ( $c, $cgi ) = @_; + my ( $c, $object ) = @_; + + my $cgi; + + if ( defined($object) && ref($object) ) { + + if ( $object->isa('Apache') ) { # MP 1.3 + $cgi = CGI->new($object); + } + + elsif ( $object->isa('Apache::RequestRec') ) { # MP 1.99 + $cgi = CGI->new($object); + } + + elsif ( $object->isa('Apache2::RequestRec') ) { # MP 2.00 + $cgi = CGI->new($object); + } + + elsif ( $object->isa('CGI') ) { + $cgi = $object; + } + + else { + my $class = ref($object); + die( qq/Invalid argument $object/ ); + } + } + $c->cgi( $cgi || CGI->new ); - $c->cgi->_reset_globals; } =item $c->prepare_uploads diff --git a/lib/Catalyst/Engine/CGI/APR.pm b/lib/Catalyst/Engine/CGI/APR.pm index 964e879..81cfb6a 100644 --- a/lib/Catalyst/Engine/CGI/APR.pm +++ b/lib/Catalyst/Engine/CGI/APR.pm @@ -9,7 +9,7 @@ use APR::Request; use APR::Request::CGI; use APR::Request::Param; -__PACKAGE__->mk_accessors('apr'); +__PACKAGE__->mk_accessors( qw[apr pool] ); =head1 NAME @@ -43,6 +43,10 @@ This Catalyst engine uses C for parsing of message body. Contains the C object. +=item $c->pool + +Contains the C object. + =back =head1 OVERLOADED METHODS @@ -59,14 +63,17 @@ sub prepare_parameters { my $c = shift; my @params; - - $c->apr->param->do( sub { - my ( $field, $value ) = @_; - push( @params, $field, $value ); - return 1; - }); - - $c->request->param(@params); + + if ( my $table = $c->apr->param ) { + + $table->do( sub { + my ( $field, $value ) = @_; + push( @params, $field, $value ); + return 1; + }); + + $c->request->param(@params); + } } =item $c->prepare_request @@ -75,7 +82,8 @@ sub prepare_parameters { sub prepare_request { my $c = shift; - $c->apr( APR::Request::CGI->handle( APR::Pool->new ) ); + $c->pool( APR::Pool->new ); + $c->apr( APR::Request::CGI->handle( $c->pool ) ); } =item $c->prepare_uploads @@ -86,23 +94,28 @@ sub prepare_uploads { my $c = shift; my @uploads; + + if ( my $body = $c->apr->body ) { + + $body->param_class('APR::Request::Param'); - $c->apr->upload->do( sub { - my ( $field, $upload ) = @_; + $body->uploads( $c->pool )->do( sub { + my ( $field, $upload ) = @_; - my $object = Catalyst::Request::Upload->new( - filename => $upload->filename, - size => $upload->size, - tempname => $upload->tempname, - type => $upload->type - ); + my $object = Catalyst::Request::Upload->new( + filename => $upload->upload_filename, + size => $upload->upload_size, + tempname => $upload->upload_tempname, + type => $upload->upload_type + ); - push( @uploads, $field, $object ); + push( @uploads, $field, $object ); - return 1; - }); + return 1; + }); - $c->request->upload(@uploads); + $c->request->upload(@uploads); + } } =back diff --git a/lib/Catalyst/Engine/CGI/Base.pm b/lib/Catalyst/Engine/CGI/Base.pm index 3b62454..a76537b 100644 --- a/lib/Catalyst/Engine/CGI/Base.pm +++ b/lib/Catalyst/Engine/CGI/Base.pm @@ -121,7 +121,9 @@ sub prepare_path { $base = $base->canonical->as_string; } + my $location = $ENV{SCRIPT_NAME} || '/'; my $path = $ENV{PATH_INFO} || '/'; + $path =~ s/^($location)?\///; $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; $path =~ s/^\///; diff --git a/lib/Catalyst/Engine/FastCGI.pm b/lib/Catalyst/Engine/FastCGI.pm index e9215f8..1bf8d18 100644 --- a/lib/Catalyst/Engine/FastCGI.pm +++ b/lib/Catalyst/Engine/FastCGI.pm @@ -55,6 +55,7 @@ sub prepare_parameters { sub prepare_request { my ( $c, $fastcgi, @arguments ) = @_; + CGI::_reset_globals(); $c->SUPER::prepare_request($fastcgi); $c->Catalyst::Engine::CGI::prepare_request(@arguments); } diff --git a/lib/Catalyst/Engine/SpeedyCGI.pm b/lib/Catalyst/Engine/SpeedyCGI.pm index 0afabff..4735cd4 100644 --- a/lib/Catalyst/Engine/SpeedyCGI.pm +++ b/lib/Catalyst/Engine/SpeedyCGI.pm @@ -55,6 +55,7 @@ sub prepare_parameters { sub prepare_request { my ( $c, $speedycgi, @arguments ) = @_; + $speedycgi->register_cleanup( \&CGI::_reset_globals ); $c->SUPER::prepare_request($speedycgi); $c->Catalyst::Engine::CGI::prepare_request(@arguments); } diff --git a/t/lib/TestApp/Controller/Dump.pm b/t/lib/TestApp/Controller/Dump.pm index 0a259e9..df33eb5 100644 --- a/t/lib/TestApp/Controller/Dump.pm +++ b/t/lib/TestApp/Controller/Dump.pm @@ -8,6 +8,12 @@ sub default : Action Private { $c->forward('TestApp::View::Dump'); } +sub env : Action Relative { + my ( $self, $c ) = @_; + $c->stash( env => \%ENV ); + $c->forward('TestApp::View::Dump'); +} + sub parameters : Action Relative { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Parameters');