X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine%2FApache.pm;h=f7154562fbee85ec776aa6d9abc832d1e118f693;hb=6dc87a0f8301391acfe25ee5bcaad0fe48dad559;hp=fc69b1c2d74220f25aba82de5c74a4286ea0e030;hpb=5ae68c0dadf8ba61ab612cde229ef30de9ca911d;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Engine/Apache.pm b/lib/Catalyst/Engine/Apache.pm index fc69b1c..f715456 100644 --- a/lib/Catalyst/Engine/Apache.pm +++ b/lib/Catalyst/Engine/Apache.pm @@ -6,24 +6,7 @@ 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; - -__PACKAGE__->mk_accessors(qw/apache_request original_request/); +__PACKAGE__->mk_accessors(qw/apache/); =head1 NAME @@ -35,135 +18,134 @@ See L. =head1 DESCRIPTION -The Apache Engine. +This is the Catalyst 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_headers =cut sub finalize_headers { 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) ); + my @values = $c->response->header($name); + $c->apache->headers_out->add( $name => $_ ) for @values; } - 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; + + 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->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; + + $c->apache->status( $c->response->status ); + $c->apache->content_type( $c->response->header('Content-Type') ); + + unless ( MP2 ) { + $c->apache->send_http_header; + } + return 0; } -=head3 finalize_output +=item $c->finalize_output =cut sub finalize_output { my $c = shift; - $c->original_request->print( $c->response->{output} ); + $c->apache->print( $c->response->{output} ); } -=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); + foreach my $key ( $c->apache->param ) { + my @values = $c->apache->param($key); $args{$key} = @values == 1 ? $values[0] : \@values; } - $c->req->parameters( \%args ); + $c->request->parameters( \%args ); } -=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( $ENV{HTTPS} ? 'https' : 'http' ); - $base->host( $c->apache_request->hostname ); - $base->port( $c->apache_request->get_server_port ); - my $path = $c->apache_request->location; + $base->host( $c->apache->hostname ); + $base->port( $c->apache->get_server_port ); + my $path = $c->apache->location; $base->path( $path =~ /\/$/ ? $path : "$path/" ); - $c->req->base( $base->as_string ); + $c->request->base( $base->as_string ); } -=head3 prepare_request +=item $c->prepare_request($r) =cut sub prepare_request { my ( $c, $r ) = @_; - $c->apache_request( Apache::Request->new($r) ); - $c->original_request($r); + $c->apache( Apache::Request->new($r) ); } -=head3 prepare_uploads +=item $c->prepare_uploads =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 } = { + 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 @@ -171,6 +153,14 @@ sub prepare_uploads { } } +=item $c->run + +=cut + +sub run { } + +=back + =head1 SEE ALSO L.