package Catalyst::Engine::CGI;
use strict;
-use base 'Catalyst::Engine';
+use base 'Catalyst::Engine::CGI::Base';
+use Catalyst::Exception;
use CGI;
-use URI;
-use URI::http;
+
+our @compile = qw[
+ delete
+ http
+ new_MultipartBuffer
+ param
+ parse_keywordlist
+ read_from_client
+ read_multipart
+ tmpFileName
+ uploadInfo
+ url_param
+ user_agent
+];
+
+CGI->compile(@compile);
__PACKAGE__->mk_accessors('cgi');
=head1 DESCRIPTION
This is the Catalyst engine specialized for the CGI environment (using the
-C<CGI> and C<CGI::Cookie> modules). Normally Catalyst will select the
-appropriate engine according to the environment that it detects, however you
-can force Catalyst to use the CGI engine by specifying the following in your
-application module:
-
- use Catalyst qw(-Engine=CGI);
-
-The performance of this way of using Catalyst is not expected to be
-useful in production applications, but it may be helpful for development.
+C<CGI> and C<CGI::Cookie> modules).
=head1 METHODS
=item $c->cgi
-This config parameter contains the C<CGI> object.
+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
# application/x-www-form-urlencoded or multipart/form-data
# CGI.pm will read STDIN into a param, POSTDATA.
- $c->request->input( $c->cgi->param('POSTDATA') );
-}
-
-=item $c->prepare_connection
-
-=cut
-
-sub prepare_connection {
- my $c = shift;
- $c->req->hostname( $ENV{REMOTE_HOST} );
- $c->req->address( $ENV{REMOTE_ADDR} );
-}
-
-=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' );
+ $c->request->body( $c->cgi->param('POSTDATA') );
}
=item $c->prepare_parameters
sub prepare_parameters {
my $c = shift;
-
+
my ( @params );
- for my $param ( $c->cgi->url_param ) {
- for my $value ( $c->cgi->url_param($param) ) {
- push ( @params, $param, $value );
+ if ( $c->request->method eq 'POST' ) {
+ for my $param ( $c->cgi->url_param ) {
+ for my $value ( $c->cgi->url_param($param) ) {
+ push ( @params, $param, $value );
+ }
}
}
- for my $param ( $c->cgi->param ) {
+ for my $param ( $c->cgi->param ) {
for my $value ( $c->cgi->param($param) ) {
push ( @params, $param, $value );
}
}
-
- $c->req->_assign_values( $c->req->parameters, \@params );
+
+ $c->request->param(@params);
}
-=item $c->prepare_path
+=item $c->prepare_request
=cut
-sub prepare_path {
- my $c = shift;
+sub prepare_request {
+ my ( $c, $object ) = @_;
- my $base;
- {
- my $scheme = $ENV{HTTPS} ? 'https' : 'http';
- my $host = $ENV{HTTP_HOST} || $ENV{SERVER_NAME};
- my $port = $ENV{SERVER_PORT} || 80;
- my $path = $ENV{SCRIPT_NAME} || '/';
+ my $cgi;
- $base = URI->new;
- $base->scheme($scheme);
- $base->host($host);
- $base->port($port);
- $base->path($path);
+ if ( defined($object) && ref($object) ) {
- $base = $base->canonical->as_string;
- }
+ if ( $object->isa('Apache') ) { # MP 1.3
+ $cgi = CGI->new($object);
+ }
- my $path = $ENV{PATH_INFO} || '/';
- $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
- $path =~ s/^\///;
+ elsif ( $object->isa('Apache::RequestRec') ) { # MP 1.99
+ $cgi = CGI->new($object);
+ }
- $c->req->base($base);
- $c->req->path($path);
-}
+ elsif ( $object->isa('Apache2::RequestRec') ) { # MP 2.00
+ $cgi = CGI->new($object);
+ }
-=item $c->prepare_request
+ elsif ( $object->isa('CGI') ) {
+ $cgi = $object;
+ }
-=cut
+ else {
+ my $class = ref($object);
+
+ Catalyst::Exception->throw(
+ message => qq/Unknown object '$object'/
+ );
+ }
+ }
-sub prepare_request {
- my $c = shift;
- $c->cgi( CGI->new );
- $c->cgi->_reset_globals;
+ $c->cgi( $cgi || CGI->new );
}
=item $c->prepare_uploads
my $c = shift;
my @uploads;
-
+
for my $param ( $c->cgi->param ) {
-
+
my @values = $c->cgi->param($param);
next unless ref( $values[0] );
tempname => $tempname,
type => $type
);
-
+
push( @uploads, $param, $upload );
}
}
-
- $c->req->_assign_values( $c->req->uploads, \@uploads );
-}
-=item $c->run
-
-=cut
-
-sub run { shift->handler }
+ $c->request->upload(@uploads);
+}
=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
projects / catagits/Catalyst-Runtime.git / blobdiff