1 package Catalyst::Engine::Apache::Base;
4 use base qw[Catalyst::Engine Catalyst::Engine::Apache];
10 __PACKAGE__->mk_accessors(qw/apache/);
14 Catalyst::Engine::Apache::Base - Base class for Apache Engines
22 This is a base class for Apache Engines.
30 Returns an C<Apache::Request> object.
34 =head1 OVERLOADED METHODS
36 This class overloads some methods from C<Catalyst::Engine>.
40 =item $c->finalize_body
46 $c->apache->print( $c->response->body );
49 =item $c->prepare_body
56 my $length = $c->request->content_length;
57 my ( $buffer, $content );
61 $c->apache->read( $buffer, ( $length < 8192 ) ? $length : 8192 );
63 $length -= length($buffer);
67 $c->request->body($content);
70 =item $c->prepare_connection
74 sub prepare_connection {
76 $c->request->address( $c->apache->connection->remote_ip );
77 $c->request->hostname( $c->apache->connection->remote_host );
78 $c->request->protocol( $c->apache->protocol );
79 $c->request->user( $c->apache->user );
81 if ( $ENV{HTTPS} && uc( $ENV{HTTPS} ) eq 'ON' ) {
82 $c->request->secure(1);
85 if ( $c->apache->get_server_port == 443 ) {
86 $c->request->secure(1);
90 =item $c->prepare_headers
96 $c->request->method( $c->apache->method );
97 $c->request->header( %{ $c->apache->headers_in } );
100 =item $c->prepare_path
104 # XXX needs fixing, only work with <Location> directive,
105 # not <Directory> directive
110 my $path = $c->apache->uri;
112 if ( my $location = $c->apache->location ) {
114 if ( index( $path, $location ) == 0 ) {
115 $path = substr( $path, length($location) );
121 if ( $c->apache->filename && -e $c->apache->filename ) {
123 my $filename = ( File::Spec->splitpath( $c->apache->filename ) )[2];
125 if ( index( $path, $filename ) == 0 ) {
126 $path = substr( $path, length($filename) );
132 $c->request->path($path);
136 my $scheme = $c->request->secure ? 'https' : 'http';
137 my $host = $c->apache->hostname;
138 my $port = $c->apache->get_server_port;
139 my $path = $c->apache->uri;
141 if ( length( $c->request->path ) ) {
143 $path = substr( $path, 0, length($path) - length($c->req->path) );
146 unless ( $path =~ /\/$/ ) {
151 $base->scheme($scheme);
156 $c->request->base( $base->canonical->as_string );
160 =item $c->prepare_request($r)
164 sub prepare_request {
173 sub run { shift->handler(@_) }
179 L<Catalyst> L<Catalyst::Engine>.
183 Sebastian Riedel, C<sri@cpan.org>
184 Christian Hansen C<ch@ngmedia.com>
188 This program is free software, you can redistribute it and/or modify it under
189 the same terms as Perl itself.