X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine%2FApache.pm;h=a6b763c5fa7e34c52b95597198bcb7fdf211b73f;hb=b9e9fff6b976cb138c6d56f10c37ebc20216b74f;hp=f7154562fbee85ec776aa6d9abc832d1e118f693;hpb=6dc87a0f8301391acfe25ee5bcaad0fe48dad559;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Engine/Apache.pm b/lib/Catalyst/Engine/Apache.pm index f715456..a6b763c 100644 --- a/lib/Catalyst/Engine/Apache.pm +++ b/lib/Catalyst/Engine/Apache.pm @@ -1,10 +1,10 @@ package Catalyst::Engine::Apache; use strict; -use mod_perl; -use constant MP2 => $mod_perl::VERSION >= 1.99; use base 'Catalyst::Engine'; + use URI; +use URI::http; __PACKAGE__->mk_accessors(qw/apache/); @@ -18,7 +18,7 @@ See L. =head1 DESCRIPTION -This is the Catalyst engine specialized for Apache (i.e. for mod_perl). +This is a base class engine specialized for Apache (i.e. for mod_perl). =head1 METHODS @@ -36,41 +36,34 @@ This class overloads some methods from C. =over 4 -=item $c->finalize_headers +=item $c->finalize_body =cut -sub finalize_headers { +sub finalize_body { my $c = shift; + $c->apache->print( $c->response->body ); +} - 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; - } +=item $c->prepare_body - 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') ); +=cut - unless ( MP2 ) { - $c->apache->send_http_header; - } +sub prepare_body { + my $c = shift; - return 0; -} + my $length = $c->request->content_length; + my ( $buffer, $content ); -=item $c->finalize_output + while ($length) { -=cut + $c->apache->read( $buffer, ( $length < 8192 ) ? $length : 8192 ); -sub finalize_output { - my $c = shift; - $c->apache->print( $c->response->{output} ); + $length -= length($buffer); + $content .= $buffer; + } + + $c->request->body($content); } =item $c->prepare_connection @@ -99,19 +92,23 @@ sub prepare_headers { sub prepare_parameters { my $c = shift; - my %args; - foreach my $key ( $c->apache->param ) { - my @values = $c->apache->param($key); - $args{$key} = @values == 1 ? $values[0] : \@values; - } - $c->request->parameters( \%args ); + + my @params; + + $c->apache->param->do( sub { + my ( $field, $value ) = @_; + push( @params, $field, $value ); + return 1; + }); + + $c->req->_assign_values( $c->req->parameters, \@params ); } =item $c->prepare_path =cut -# XXX needs fixing, only work with directive, +# XXX needs fixing, only work with directive, # not directive sub prepare_path { my $c = shift; @@ -128,31 +125,6 @@ sub prepare_path { $c->request->base( $base->as_string ); } -=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; - for my $upload ( $c->apache->upload ) { - $upload = $c->apache->upload($upload) if MP2; - $c->request->uploads->{ $upload->filename } = { - fh => $upload->fh, - size => $upload->size, - type => $upload->type - }; - } -} - =item $c->run =cut @@ -168,6 +140,7 @@ L. =head1 AUTHOR Sebastian Riedel, C +Christian Hansen C =head1 COPYRIGHT