1 package Catalyst::Engine::CGI;
4 use base 'Catalyst::Engine';
10 __PACKAGE__->mk_accessors('cgi');
14 Catalyst::Engine::CGI - The CGI Engine
18 A script using the Catalyst::Engine::CGI module might look like:
23 use lib '/path/to/MyApp/lib';
28 The application module (C<MyApp>) would use C<Catalyst>, which loads the
29 appropriate engine module.
33 This is the Catalyst engine specialized for the CGI environment (using the
34 C<CGI> and C<CGI::Cookie> modules). Normally Catalyst will select the
35 appropriate engine according to the environment that it detects, however you
36 can force Catalyst to use the CGI engine by specifying the following in your
39 use Catalyst qw(-Engine=CGI);
41 The performance of this way of using Catalyst is not expected to be
42 useful in production applications, but it may be helpful for development.
50 This config parameter contains the C<CGI> object.
54 =head1 OVERLOADED METHODS
56 This class overloads some methods from C<Catalyst::Engine>.
60 =item $c->finalize_headers
64 sub finalize_headers {
67 $c->response->header( Status => $c->response->status );
69 print $c->response->headers->as_string("\015\012");
73 =item $c->finalize_output
75 Prints the response output to STDOUT.
81 print $c->response->output;
84 =item $c->prepare_connection
88 sub prepare_connection {
90 $c->req->hostname( $ENV{REMOTE_HOST} );
91 $c->req->address( $ENV{REMOTE_ADDR} );
94 =item $c->prepare_headers
101 while ( my ( $header, $value ) = each %ENV ) {
103 next unless $header =~ /^(HTTP|CONTENT)/i;
105 ( my $field = $header ) =~ s/^HTTPS?_//;
107 $c->req->headers->header( $field => $value );
110 $c->req->method( $ENV{REQUEST_METHOD} || 'GET' );
113 =item $c->prepare_parameters
117 sub prepare_parameters {
120 for my $param ( $c->cgi->param ) {
121 my @values = $c->cgi->param($param);
122 $c->req->parameters->{$param} = ( @values > 1 ) ? \@values : $values[0];
126 =item $c->prepare_path
135 my $scheme = $ENV{HTTPS} ? 'https' : 'http';
136 my $host = $ENV{HTTP_HOST} || $ENV{SERVER_NAME};
137 my $port = $ENV{SERVER_PORT} || 80;
138 my $path = $ENV{SCRIPT_NAME} || '/';
141 $base->scheme($scheme);
146 $base = $base->canonical->as_string;
149 my $path = $ENV{PATH_INFO} || '/';
150 $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
153 $c->req->base($base);
154 $c->req->path($path);
157 =item $c->prepare_request
161 sub prepare_request {
164 $c->cgi->_reset_globals;
167 =item $c->prepare_uploads
171 sub prepare_uploads {
176 for my $param ( $c->cgi->param ) {
178 my @values = $c->cgi->param($param);
180 next unless ref( $values[0] );
182 for my $fh (@values) {
184 next unless my $size = ( stat $fh )[7];
186 my $info = $c->cgi->uploadInfo($fh);
187 my $tempname = $c->cgi->tmpFileName($fh);
188 my $type = $info->{'Content-Type'};
189 my $disposition = $info->{'Content-Disposition'};
190 my $filename = ( $disposition =~ / filename="([^;]*)"/ )[0];
192 my $upload = Catalyst::Request::Upload->new(
193 filename => $filename,
195 tempname => $tempname,
199 push( @uploads, $param, $upload );
203 $c->req->_assign_values( $c->req->uploads, \@uploads );
210 sub run { shift->handler }
220 Sebastian Riedel, C<sri@cpan.org>
224 This program is free software, you can redistribute it and/or modify it under
225 the same terms as Perl itself.