package Catalyst::Engine::CGI;
use strict;
-use base 'Catalyst::Engine';
-use URI;
-use URI::http;
+use base 'Catalyst::Engine::CGI::Base';
-require CGI::Simple;
-
-$CGI::Simple::POST_MAX = 1048576;
-$CGI::Simple::DISABLE_UPLOADS = 0;
+use CGI;
__PACKAGE__->mk_accessors('cgi');
=head1 DESCRIPTION
This is the Catalyst engine specialized for the CGI environment (using the
-C<CGI::Simple> and C<CGI::Cookie> modules). Normally Catalyst will select 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:
=item $c->cgi
-This config parameter contains the C<CGI::Simple> 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_headers
+=item $c->prepare_body
=cut
-sub finalize_headers {
+sub prepare_body {
my $c = shift;
- my %headers;
-
- $headers{-status} = $c->response->status if $c->response->status;
- for my $name ( $c->response->headers->header_field_names ) {
- $headers{"-$name"} = $c->response->header($name);
- }
+ # XXX this is undocumented in CGI.pm. If Content-Type is not
+ # application/x-www-form-urlencoded or multipart/form-data
+ # CGI.pm will read STDIN into a param, POSTDATA.
- print $c->cgi->header(%headers);
+ $c->request->body( $c->cgi->param('POSTDATA') );
}
-=item $c->finalize_output
-
-Prints the response output to STDOUT.
+=item $c->prepare_parameters
=cut
-sub finalize_output {
+sub prepare_parameters {
my $c = shift;
- print $c->response->output;
-}
-=item $c->prepare_connection
+ my ( @params );
-=cut
+ 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 );
+ }
+ }
+ }
-sub prepare_connection {
- my $c = shift;
- $c->req->hostname( $c->cgi->remote_host );
- $c->req->address( $c->cgi->remote_addr );
+ for my $param ( $c->cgi->param ) {
+ for my $value ( $c->cgi->param($param) ) {
+ push ( @params, $param, $value );
+ }
+ }
+
+ $c->request->param(@params);
}
-=item $c->prepare_headers
+=item $c->prepare_request
=cut
-sub prepare_headers {
- my $c = shift;
- $c->req->method( $c->cgi->request_method );
- for my $header ( $c->cgi->http ) {
- ( my $field = $header ) =~ s/^HTTPS?_//;
- $c->req->headers->header( $field => $c->cgi->http($header) );
- }
- $c->req->headers->header( 'Content-Type' => $c->cgi->content_type );
- $c->req->headers->header( 'Content-Length' => $c->cgi->content_length );
-}
+sub prepare_request {
+ my ( $c, $object ) = @_;
-=item $c->prepare_parameters
+ my $cgi;
-=cut
+ if ( defined($object) && ref($object) ) {
-sub prepare_parameters {
- my $c = shift;
-
- $c->cgi->parse_query_string;
-
- my %vars = $c->cgi->Vars;
- while ( my ( $key, $value ) = each %vars ) {
- my @values = split "\0", $value;
- $vars{$key} = @values <= 1 ? $values[0] : \@values;
+ if ( $object->isa('Apache') ) { # MP 1.3
+ $cgi = CGI->new($object);
+ }
+
+ elsif ( $object->isa('Apache::RequestRec') ) { # MP 1.99
+ $cgi = CGI->new($object);
+ }
+
+ elsif ( $object->isa('Apache2::RequestRec') ) { # MP 2.00
+ $cgi = CGI->new($object);
+ }
+
+ elsif ( $object->isa('CGI') ) {
+ $cgi = $object;
+ }
+
+ else {
+ my $class = ref($object);
+ die( qq/Invalid argument $object/ );
+ }
}
- $c->req->parameters( {%vars} );
+
+ $c->cgi( $cgi || CGI->new );
}
-=item $c->prepare_path
+=item $c->prepare_uploads
=cut
-sub prepare_path {
+sub prepare_uploads {
my $c = shift;
- 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 @uploads;
- $base = URI->new;
- $base->scheme($scheme);
- $base->host($host);
- $base->port($port);
- $base->path($path);
+ for my $param ( $c->cgi->param ) {
- $base = $base->canonical->as_string;
- }
-
- my $path = $ENV{PATH_INFO} || '/';
- $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
- $path =~ s/^\///;
+ my @values = $c->cgi->param($param);
- $c->req->base($base);
- $c->req->path($path);
-}
-
-=item $c->prepare_request
+ next unless ref( $values[0] );
-=cut
+ for my $fh (@values) {
-sub prepare_request { shift->cgi( CGI::Simple->new ) }
+ next unless my $size = ( stat $fh )[7];
-=item $c->prepare_uploads
+ my $info = $c->cgi->uploadInfo($fh);
+ my $tempname = $c->cgi->tmpFileName($fh);
+ my $type = $info->{'Content-Type'};
+ my $disposition = $info->{'Content-Disposition'};
+ my $filename = ( $disposition =~ / filename="([^;]*)"/ )[0];
-=cut
+ my $upload = Catalyst::Request::Upload->new(
+ filename => $filename,
+ size => $size,
+ tempname => $tempname,
+ type => $type
+ );
-sub prepare_uploads {
- my $c = shift;
- for my $name ( $c->cgi->upload ) {
- next unless defined $name;
- $c->req->uploads->{$name} = {
- fh => $c->cgi->upload($name),
- size => $c->cgi->upload_info( $name, 'size' ),
- type => $c->cgi->upload_info( $name, 'mime' )
- };
+ push( @uploads, $param, $upload );
+ }
}
-}
-
-=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