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=0bba6ad8666f801533a79ed12336e75534e73790;hpb=7833fdfca73ff8a03769523ec85c2343a3994360;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Engine/Apache.pm b/lib/Catalyst/Engine/Apache.pm index 0bba6ad..a6b763c 100644 --- a/lib/Catalyst/Engine/Apache.pm +++ b/lib/Catalyst/Engine/Apache.pm @@ -1,29 +1,12 @@ package Catalyst::Engine::Apache; use strict; -use mod_perl; -use constant MP2 => $mod_perl::VERSION >= 1.99; use base 'Catalyst::Engine'; -use URI; - -# mod_perl -if (MP2) { - require Apache2; - require Apache::RequestIO; - require Apache::RequestRec; - require Apache::SubRequest; - require Apache::RequestUtil; - require APR::URI; - require Apache::URI; -} -else { require Apache } -# libapreq -require Apache::Request; -require Apache::Cookie; -require Apache::Upload if MP2; +use URI; +use URI::http; -__PACKAGE__->mk_accessors(qw/apache_request original_request/); +__PACKAGE__->mk_accessors(qw/apache/); =head1 NAME @@ -35,140 +18,120 @@ See L. =head1 DESCRIPTION -The Apache Engine. +This is a base class engine specialized for Apache (i.e. for mod_perl). -=head2 METHODS +=head1 METHODS -=head3 apache_request +=over 4 -Returns an C object. +=item $c->apache -=head3 original_request +Returns an C object. -Returns the original Apache request object. +=back -=head2 OVERLOADED METHODS +=head1 OVERLOADED METHODS This class overloads some methods from C. -=head3 finalize_headers +=over 4 + +=item $c->finalize_body =cut -sub finalize_headers { +sub finalize_body { my $c = shift; - for my $name ( $c->response->headers->header_field_names ) { - next if $name =~ /Content-Type/i; - $c->original_request->headers_out->set( - $name => $c->response->headers->header($name) ); - } - while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) { - my %cookie = ( -name => $name, -value => $cookie->{value} ); - $cookie->{-expires} = $cookie->{expires} if $cookie->{expires}; - $cookie->{-domain} = $cookie->{domain} if $cookie->{domain}; - $cookie->{-path} = $cookie->{path} if $cookie->{path}; - $cookie->{-secure} = $cookie->{secure} if $cookie->{secure}; - my $cookie = Apache::Cookie->new( $c->original_request, %cookie ); - MP2 - ? $c->apache_request->err_headers_out->add( - 'Set-Cookie' => $cookie->as_string ) - : $cookie->bake; - } - $c->original_request->status( $c->response->status ); - $c->original_request->content_type( $c->response->headers->content_type - || 'text/plain' ); - MP2 || $c->apache_request->send_http_header; - return 0; + $c->apache->print( $c->response->body ); } -=head3 finalize_output +=item $c->prepare_body =cut -sub finalize_output { +sub prepare_body { my $c = shift; - $c->original_request->print( $c->response->{output} ); + + my $length = $c->request->content_length; + my ( $buffer, $content ); + + while ($length) { + + $c->apache->read( $buffer, ( $length < 8192 ) ? $length : 8192 ); + + $length -= length($buffer); + $content .= $buffer; + } + + $c->request->body($content); } -=head3 prepare_cookies +=item $c->prepare_connection =cut -sub prepare_cookies { +sub prepare_connection { my $c = shift; - MP2 - ? $c->req->cookies( { Apache::Cookie->fetch } ) - : $c->req->cookies( - { Apache::Cookie->new( $c->apache_request )->fetch } ); + $c->request->hostname( $c->apache->connection->remote_host ); + $c->request->address( $c->apache->connection->remote_ip ); } -=head3 prepare_headers +=item $c->prepare_headers =cut sub prepare_headers { my $c = shift; - $c->req->method( $c->apache_request->method ); - $c->req->headers->header( %{ $c->apache_request->headers_in } ); + $c->request->method( $c->apache->method ); + $c->request->header( %{ $c->apache->headers_in } ); } -=head3 prepare_parameters +=item $c->prepare_parameters =cut sub prepare_parameters { my $c = shift; - my %args; - foreach my $key ( $c->apache_request->param ) { - my @values = $c->apache_request->param($key); - $args{$key} = @values == 1 ? $values[0] : \@values; - } - $c->req->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 ); } -=head3 prepare_path +=item $c->prepare_path =cut +# XXX needs fixing, only work with directive, +# not directive sub prepare_path { my $c = shift; - $c->req->path( $c->apache_request->uri ); - my $loc = $c->apache_request->location; + $c->request->path( $c->apache->uri ); + my $loc = $c->apache->location; no warnings 'uninitialized'; $c->req->{path} =~ s/^($loc)?\///; my $base = URI->new; - $base->scheme( $c->apache_request->protocol =~ /HTTPS/ ? 'https' : 'http' ); - $base->host( $c->apache_request->hostname ); - $base->port( $c->apache_request->get_server_port ); - $base->path( $c->apache_request->location ); - $c->req->base( $base->as_string ); + $base->scheme( $ENV{HTTPS} ? 'https' : 'http' ); + $base->host( $c->apache->hostname ); + $base->port( $c->apache->get_server_port ); + my $path = $c->apache->location; + $base->path( $path =~ /\/$/ ? $path : "$path/" ); + $c->request->base( $base->as_string ); } -=head3 prepare_request +=item $c->run =cut -sub prepare_request { - my ( $c, $r ) = @_; - $c->apache_request( Apache::Request->new($r) ); - $c->original_request($r); -} - -=head3 prepare_uploads +sub run { } -=cut - -sub prepare_uploads { - my $c = shift; - for my $upload ( $c->apache_request->upload ) { - $upload = $c->apache_request->upload($upload) if MP2; - $c->req->uploads->{ $upload->filename } = { - fh => $upload->fh, - size => $upload->size, - type => $upload->type - }; - } -} +=back =head1 SEE ALSO @@ -177,6 +140,7 @@ L. =head1 AUTHOR Sebastian Riedel, C +Christian Hansen C =head1 COPYRIGHT