package Catalyst::Engine::Apache;
use strict;
-use base 'Catalyst::Engine';
-
-use URI;
-use URI::http;
-
-__PACKAGE__->mk_accessors(qw/apache/);
+use UNIVERSAL::require;
=head1 NAME
=head1 DESCRIPTION
-This is a base class engine specialized for Apache (i.e. for mod_perl).
-
-=head1 METHODS
-
-=over 4
-
-=item $c->apache
-
-Returns an C<Apache::Request> object.
-
-=back
-
-=head1 OVERLOADED METHODS
-
-This class overloads some methods from C<Catalyst::Engine>.
-
-=over 4
-
-=item $c->finalize_body
-
-=cut
-
-sub finalize_body {
- my $c = shift;
- $c->apache->print( $c->response->body );
-}
-
-=item $c->prepare_body
-
-=cut
-
-sub prepare_body {
- my $c = shift;
-
- 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);
-}
-
-=item $c->prepare_connection
-
-=cut
-
-sub prepare_connection {
- my $c = shift;
- $c->request->address( $c->apache->connection->remote_ip );
- $c->request->hostname( $c->apache->connection->remote_host );
- $c->request->protocol( $c->apache->protocol );
-
- if ( $ENV{HTTPS} || $c->apache->get_server_port == 443 ) {
- $c->request->secure(1);
- }
-}
-
-=item $c->prepare_headers
-
-=cut
-
-sub prepare_headers {
- my $c = shift;
- $c->request->method( $c->apache->method );
- $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
-
-# XXX needs fixing, only work with <Location> directive,
-# not <Directory> directive
-sub prepare_path {
- my $c = shift;
-
- my $base;
- {
- my $scheme = $c->request->secure ? 'https' : 'http';
- my $host = $c->apache->hostname;
- my $port = $c->apache->get_server_port;
- my $path = $c->apache->location || '/';
-
- unless ( $path =~ /\/$/ ) {
- $path .= '/';
- }
-
- $base = URI->new;
- $base->scheme($scheme);
- $base->host($host);
- $base->port($port);
- $base->path($path);
-
- $base = $base->canonical->as_string;
- }
-
- my $location = $c->apache->location || '/';
- my $path = $c->apache->uri || '/';
- $path =~ s/^($location)?\///;
- $path =~ s/^\///;
-
- $c->req->base($base);
- $c->req->path($path);
-}
-
-=item $c->run
-
-=cut
-
-sub run { }
-
-=back
+This class will load the correct MP Engine.
=head1 SEE ALSO
--- /dev/null
+package Catalyst::Engine::Apache::Base;
+
+use strict;
+use base 'Catalyst::Engine';
+
+use URI;
+use URI::http;
+
+__PACKAGE__->mk_accessors(qw/apache/);
+
+=head1 NAME
+
+Catalyst::Engine::Apache::Base - Base class for Apache Engines
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+This is a base class for Apache Engines.
+
+=head1 METHODS
+
+=over 4
+
+=item $c->apache
+
+Returns an C<Apache::Request> object.
+
+=back
+
+=head1 OVERLOADED METHODS
+
+This class overloads some methods from C<Catalyst::Engine>.
+
+=over 4
+
+=item $c->finalize_body
+
+=cut
+
+sub finalize_body {
+ my $c = shift;
+ $c->apache->print( $c->response->body );
+}
+
+=item $c->prepare_body
+
+=cut
+
+sub prepare_body {
+ my $c = shift;
+
+ 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);
+}
+
+=item $c->prepare_connection
+
+=cut
+
+sub prepare_connection {
+ my $c = shift;
+ $c->request->address( $c->apache->connection->remote_ip );
+ $c->request->hostname( $c->apache->connection->remote_host );
+ $c->request->protocol( $c->apache->protocol );
+
+ if ( $ENV{HTTPS} || $c->apache->get_server_port == 443 ) {
+ $c->request->secure(1);
+ }
+}
+
+=item $c->prepare_headers
+
+=cut
+
+sub prepare_headers {
+ my $c = shift;
+ $c->request->method( $c->apache->method );
+ $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
+
+# XXX needs fixing, only work with <Location> directive,
+# not <Directory> directive
+sub prepare_path {
+ my $c = shift;
+
+ my $base;
+ {
+ my $scheme = $c->request->secure ? 'https' : 'http';
+ my $host = $c->apache->hostname;
+ my $port = $c->apache->get_server_port;
+ my $path = $c->apache->location || '/';
+
+ unless ( $path =~ /\/$/ ) {
+ $path .= '/';
+ }
+
+ $base = URI->new;
+ $base->scheme($scheme);
+ $base->host($host);
+ $base->port($port);
+ $base->path($path);
+
+ $base = $base->canonical->as_string;
+ }
+
+ my $location = $c->apache->location || '/';
+ my $path = $c->apache->uri || '/';
+ $path =~ s/^($location)?\///;
+ $path =~ s/^\///;
+
+ $c->req->base($base);
+ $c->req->path($path);
+}
+
+=item $c->run
+
+=cut
+
+sub run { }
+
+=back
+
+=head1 SEE ALSO
+
+L<Catalyst> L<Catalyst::Engine>.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen C<ch@ngmedia.com>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
package Catalyst::Engine::Apache::MP13;
use strict;
-use base 'Catalyst::Engine::Apache';
+use base 'Catalyst::Engine::Apache::Base';
use Apache ();
use Apache::Constants ();
=head1 OVERLOADED METHODS
-This class overloads some methods from C<Catalyst::Engine::Apache>.
+This class overloads some methods from C<Catalyst::Engine::Apache::Base>.
=over 4
=head1 SEE ALSO
-L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::Apache>.
+L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::Apache::Base>.
=head1 AUTHOR
package Catalyst::Engine::Apache::MP19;
use strict;
-use base 'Catalyst::Engine::Apache';
+use base 'Catalyst::Engine::Apache::Base';
use Apache2 ();
use Apache::Connection ();
=head1 OVERLOADED METHODS
-This class overloads some methods from C<Catalyst::Engine::Apache>.
+This class overloads some methods from C<Catalyst::Engine::Apache::Base>.
=over 4
=head1 SEE ALSO
-L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::Apache>.
+L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::Apache::Base>.
=head1 AUTHOR
package Catalyst::Engine::Apache::MP20;
use strict;
-use base 'Catalyst::Engine::Apache';
+use base 'Catalyst::Engine::Apache::Base';
use Apache2::Connection ();
use Apache2::Const ();
=head1 OVERLOADED METHODS
-This class overloads some methods from C<Catalyst::Engine::Apache>.
+This class overloads some methods from C<Catalyst::Engine::Apache::Base>.
=over 4
=head1 SEE ALSO
-L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::Apache>.
+L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::Apache::Base>.
=head1 AUTHOR
package Catalyst::Engine::CGI;
use strict;
-use base 'Catalyst::Engine';
+use base 'Catalyst::Engine::CGI::Base';
use CGI;
-use URI;
-use URI::http;
-
-__PACKAGE__->mk_accessors('cgi');
=head1 NAME
The performance of this way of using Catalyst is not expected to be
useful in production applications, but it may be helpful for development.
-=head1 METHODS
-
-=over 4
-
-=item $c->cgi
-
-This config parameter contains the C<CGI> object.
-
-=back
-
=head1 OVERLOADED METHODS
-This class overloads some methods from C<Catalyst::Engine>.
+This class overloads some methods from C<Catalyst::Engine::CGI::Base>.
=over 4
-=item $c->finalize_body
-
-Prints the response output to STDOUT.
-
-=cut
-
-sub finalize_body {
- my $c = shift;
- print $c->response->output;
-}
-
-=item $c->finalize_headers
-
-=cut
-
-sub finalize_headers {
- my $c = shift;
-
- $c->response->header( Status => $c->response->status );
-
- print $c->response->headers->as_string("\015\012");
- print "\015\012";
-}
-
=item $c->prepare_body
=cut
$c->request->body( $c->cgi->param('POSTDATA') );
}
-=item $c->prepare_connection
-
-=cut
-
-sub prepare_connection {
- my $c = shift;
- $c->request->address( $ENV{REMOTE_ADDR} );
- $c->request->hostname( $ENV{REMOTE_HOST} );
- $c->request->protocol( $ENV{SERVER_PROTOCOL} );
-
- if ( $ENV{HTTPS} || $ENV{SERVER_PORT} == 443 ) {
- $c->request->secure(1);
- }
-}
-
-=item $c->prepare_headers
-
-=cut
-
-sub prepare_headers {
- my $c = shift;
-
- while ( my ( $header, $value ) = each %ENV ) {
-
- next unless $header =~ /^(HTTP|CONTENT)/i;
-
- ( my $field = $header ) =~ s/^HTTPS?_//;
-
- $c->req->headers->header( $field => $value );
- }
-
- $c->req->method( $ENV{REQUEST_METHOD} || 'GET' );
-}
-
=item $c->prepare_parameters
=cut
$c->request->param(@params);
}
-=item $c->prepare_path
-
-=cut
-
-sub prepare_path {
- my $c = shift;
-
- my $base;
- {
- my $scheme = $c->request->secure ? 'https' : 'http';
- my $host = $ENV{HTTP_HOST} || $ENV{SERVER_NAME};
- my $port = $ENV{SERVER_PORT} || 80;
- my $path = $ENV{SCRIPT_NAME} || '/';
-
- unless ( $path =~ /\/$/ ) {
- $path .= '/';
- }
-
- $base = URI->new;
- $base->scheme($scheme);
- $base->host($host);
- $base->port($port);
- $base->path($path);
-
- $base = $base->canonical->as_string;
- }
-
- my $path = $ENV{PATH_INFO} || '/';
- $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
- $path =~ s/^\///;
-
- $c->req->base($base);
- $c->req->path($path);
-}
-
=item $c->prepare_request
=cut
$c->request->upload(@uploads);
}
-=item $c->run
-
-=cut
-
-sub run { shift->handler }
-
=back
=head1 SEE ALSO
-L<Catalyst>.
+L<Catalyst> L<Catalyst::Engine> L<Catalyst::Engine::CGI::Base>.
=head1 AUTHOR
Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen, C<ch@ngmedia.com>
=head1 COPYRIGHT
--- /dev/null
+package Catalyst::Engine::CGI::Base;
+
+use strict;
+use base 'Catalyst::Engine';
+
+use URI;
+use URI::http;
+
+__PACKAGE__->mk_accessors('cgi');
+
+=head1 NAME
+
+Catalyst::Engine::CGI::Base - Base class for CGI Engines
+
+=head1 DESCRIPTION
+
+This is a base class for CGI engines.
+
+=head1 METHODS
+
+=over 4
+
+=item $c->cgi
+
+This config parameter contains the C<CGI> object.
+
+=back
+
+=head1 OVERLOADED METHODS
+
+This class overloads some methods from C<Catalyst::Engine>.
+
+=over 4
+
+=item $c->finalize_body
+
+Prints the response output to STDOUT.
+
+=cut
+
+sub finalize_body {
+ my $c = shift;
+ print $c->response->output;
+}
+
+=item $c->finalize_headers
+
+=cut
+
+sub finalize_headers {
+ my $c = shift;
+
+ $c->response->header( Status => $c->response->status );
+
+ print $c->response->headers->as_string("\015\012");
+ print "\015\012";
+}
+
+=item $c->prepare_connection
+
+=cut
+
+sub prepare_connection {
+ my $c = shift;
+ $c->request->address( $ENV{REMOTE_ADDR} );
+ $c->request->hostname( $ENV{REMOTE_HOST} );
+ $c->request->protocol( $ENV{SERVER_PROTOCOL} );
+
+ if ( $ENV{HTTPS} || $ENV{SERVER_PORT} == 443 ) {
+ $c->request->secure(1);
+ }
+}
+
+=item $c->prepare_headers
+
+=cut
+
+sub prepare_headers {
+ my $c = shift;
+
+ while ( my ( $header, $value ) = each %ENV ) {
+
+ next unless $header =~ /^(HTTP|CONTENT)/i;
+
+ ( my $field = $header ) =~ s/^HTTPS?_//;
+
+ $c->req->headers->header( $field => $value );
+ }
+
+ $c->req->method( $ENV{REQUEST_METHOD} || 'GET' );
+}
+
+=item $c->prepare_path
+
+=cut
+
+sub prepare_path {
+ my $c = shift;
+
+ my $base;
+ {
+ my $scheme = $c->request->secure ? 'https' : 'http';
+ my $host = $ENV{HTTP_HOST} || $ENV{SERVER_NAME};
+ my $port = $ENV{SERVER_PORT} || 80;
+ my $path = $ENV{SCRIPT_NAME} || '/';
+
+ unless ( $path =~ /\/$/ ) {
+ $path .= '/';
+ }
+
+ $base = URI->new;
+ $base->scheme($scheme);
+ $base->host($host);
+ $base->port($port);
+ $base->path($path);
+
+ $base = $base->canonical->as_string;
+ }
+
+ my $path = $ENV{PATH_INFO} || '/';
+ $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+ $path =~ s/^\///;
+
+ $c->req->base($base);
+ $c->req->path($path);
+}
+
+=item $c->run
+
+=cut
+
+sub run { shift->handler }
+
+=back
+
+=head1 SEE ALSO
+
+L<Catalyst>.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen, C<ch@ngmedia.com>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
package Catalyst::Engine::FCGI;
use strict;
-use base 'Catalyst::Engine::CGI';
-use FCGI;
+use base qw(Catalyst::Engine::FCGI::Base Catalyst::Engine::CGI);
=head1 NAME
This is the Catalyst engine for FastCGI.
-=head1 OVERLOADED METHODS
-
-This class overloads some methods from C<Catalyst::Engine::CGI>.
-
-=over 4
-
-=item $c->run
-
-=cut
-
-sub run {
- my $class = shift;
- my $request = FCGI::Request();
- while ( $request->Accept() >= 0 ) {
- $class->handler;
- }
-}
-
-=back
-
=head1 SEE ALSO
-L<Catalyst>.
+L<Catalyst>, L<Catalyst::Engine::CGI>.
=head1 AUTHOR
Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen, C<ch@ngmedia.com>
=head1 COPYRIGHT
--- /dev/null
+package Catalyst::Engine::FCGI::Base;
+
+use strict;
+use FCGI;
+
+=head1 NAME
+
+Catalyst::Engine::FCGI::Base - Base class for FastCGI Engines
+
+=head1 DESCRIPTION
+
+This is a base class for FastCGI engines.
+
+=head1 METHODS
+
+=over 4
+
+=item $c->run
+
+=cut
+
+sub run {
+ my $class = shift;
+ my $request = FCGI::Request();
+ while ( $request->Accept() >= 0 ) {
+ $class->handler;
+ }
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<Catalyst>.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen, C<ch@ngmedia.com>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
package Catalyst::Engine::HTTP;
use strict;
-use base 'Catalyst::Engine::Test';
-
-use IO::Socket qw(AF_INET INADDR_ANY SOCK_STREAM SOMAXCONN);
+use base 'Catalyst::Engine::HTTP::Daemon';
=head1 NAME
This is the Catalyst engine specialized for development and testing.
-=head1 OVERLOADED METHODS
-
-This class overloads some methods from C<Catalyst::Engine::Test>.
-
-=over 4
-
-=item $c->run
-
-=cut
-
-$SIG{'PIPE'} = 'IGNORE';
-
-sub run {
- my $class = shift;
- my $port = shift || 3000;
-
- my $daemon = Catalyst::Engine::HTTP::Catalyst->new(
- Listen => SOMAXCONN,
- LocalPort => $port,
- ReuseAddr => 1,
- Type => SOCK_STREAM,
- );
-
- unless ($daemon) {
- die("Failed to create daemon: $!\n");
- }
-
- my $base = URI->new( $daemon->url )->canonical;
-
- printf( "You can connect to your server at %s\n", $base );
-
- while ( my $connection = $daemon->accept ) {
-
- $connection->timeout(5);
-
- while ( my $request = $connection->get_request ) {
-
- $request->uri->scheme('http'); # Force URI::http
- $request->uri->host( $request->header('Host') || $base->host );
- $request->uri->port( $base->port );
-
- my $hostname = gethostbyaddr( $connection->peeraddr, AF_INET );
-
- my $http = Catalyst::Engine::Test::HTTP->new(
- address => $connection->peerhost,
- hostname => $hostname || $connection->peerhost,
- request => $request,
- response => HTTP::Response->new
- );
-
- $class->handler($http);
- $connection->send_response( $http->response );
-
- }
-
- $connection->close;
- undef($connection);
- }
-}
-
-=back
-
=head1 SEE ALSO
-L<Catalyst>, L<HTTP::Daemon>.
+L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::HTTP::Daemon>.
=head1 AUTHOR
=cut
-package Catalyst::Engine::HTTP::Catalyst;
-
-use strict;
-use base 'HTTP::Daemon';
-
-sub product_tokens {
- "Catalyst/$Catalyst::VERSION";
-}
-
1;
package Catalyst::Engine::Test;
use strict;
-use base 'Catalyst::Engine';
-
-use Class::Struct ();
-use HTTP::Headers::Util 'split_header_words';
-use HTTP::Request;
-use HTTP::Response;
-use File::Temp;
-use URI;
-
-__PACKAGE__->mk_accessors(qw/http/);
-
-Class::Struct::struct 'Catalyst::Engine::Test::HTTP' => {
- request => 'HTTP::Request',
- response => 'HTTP::Response',
- hostname => '$',
- address => '$'
-};
+use base 'Catalyst::Engine::HTTP::Base';
=head1 NAME
=head1 OVERLOADED METHODS
-This class overloads some methods from C<Catalyst::Engine>.
+This class overloads some methods from C<Catalyst::Engine::HTTP::Base>.
=over 4
-=item $c->finalize_body
-
-=cut
-
-sub finalize_body {
- my $c = shift;
- $c->http->response->content( $c->response->body );
-}
-
-=item $c->finalize_headers
-
-=cut
-
-sub finalize_headers {
- my $c = shift;
-
- $c->http->response->code( $c->response->status );
-
- for my $name ( $c->response->headers->header_field_names ) {
- $c->http->response->push_header( $name => [ $c->response->header($name) ] );
- }
-}
-
-=item $c->prepare_body
-
-=cut
-
-sub prepare_body {
- my $c = shift;
- $c->request->body( $c->http->request->content );
-}
-
-=item $c->prepare_connection
-
-=cut
-
-sub prepare_connection {
- my $c = shift;
- $c->request->address( $c->http->address );
- $c->request->hostname( $c->http->hostname );
- $c->request->protocol( $c->http->request->protocol );
-}
-
-=item $c->prepare_headers
-
-=cut
-
-sub prepare_headers {
- my $c = shift;
- $c->request->method( $c->http->request->method );
- $c->request->headers( $c->http->request->headers );
-}
-
-=item $c->prepare_parameters
-
-=cut
-
-sub prepare_parameters {
- my $c = shift;
-
- my ( @params, @uploads );
-
- my $request = $c->http->request;
-
- push( @params, $request->uri->query_form );
-
- if ( $request->content_type eq 'application/x-www-form-urlencoded' ) {
- my $uri = URI->new('http:');
- $uri->query( $request->content );
- push( @params, $uri->query_form );
- }
-
- if ( $request->content_type eq 'multipart/form-data' ) {
-
- for my $part ( $request->parts ) {
-
- my $disposition = $part->header('Content-Disposition');
- my %parameters = @{ ( split_header_words($disposition) )[0] };
-
- if ( $parameters{filename} ) {
-
- my $fh = File::Temp->new( UNLINK => 0 );
- $fh->write( $part->content ) or die $!;
- $fh->flush or die $!;
-
- my $upload = Catalyst::Request::Upload->new(
- filename => $parameters{filename},
- size => ( $fh->stat )[7],
- tempname => $fh->filename,
- type => $part->content_type
- );
-
- $fh->close;
-
- push( @uploads, $parameters{name}, $upload );
- push( @params, $parameters{name}, $parameters{filename} );
- }
- else {
- push( @params, $parameters{name}, $part->content );
- }
- }
- }
-
- $c->request->param(@params);
- $c->request->upload(@uploads);
-}
-
-=item $c->prepare_path
-
-=cut
-
-sub prepare_path {
- my $c = shift;
-
- my $base;
- {
- my $scheme = $c->http->request->uri->scheme;
- my $host = $c->http->request->uri->host;
- my $port = $c->http->request->uri->port;
-
- $base = URI->new;
- $base->scheme($scheme);
- $base->host($host);
- $base->port($port);
-
- $base = $base->canonical->as_string;
- }
-
- my $path = $c->http->request->uri->path || '/';
- $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
- $path =~ s/^\///;
-
- $c->req->base($base);
- $c->req->path($path);
-}
-
-=item $c->prepare_request($r)
-
-=cut
-
-sub prepare_request {
- my ( $c, $http ) = @_;
- $c->http($http);
-}
-
-=item $c->prepare_uploads
-
-=cut
-
-sub prepare_uploads {
- my $c = shift;
-}
-
=item $c->run
=cut
projects / catagits/Catalyst-Runtime.git / commitdiff