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_body
62 Prints the response output to STDOUT.
68 print $c->response->output;
71 =item $c->finalize_headers
75 sub finalize_headers {
78 $c->response->header( Status => $c->response->status );
80 print $c->response->headers->as_string("\015\012");
84 =item $c->prepare_body
91 # XXX this is undocumented in CGI.pm. If Content-Type is not
92 # application/x-www-form-urlencoded or multipart/form-data
93 # CGI.pm will read STDIN into a param, POSTDATA.
95 $c->request->body( $c->cgi->param('POSTDATA') );
98 =item $c->prepare_connection
102 sub prepare_connection {
104 $c->request->address( $ENV{REMOTE_ADDR} );
105 $c->request->hostname( $ENV{REMOTE_HOST} );
106 $c->request->protocol( $ENV{SERVER_PROTOCOL} );
108 if ( $ENV{HTTPS} || $ENV{SERVER_PORT} == 443 ) {
109 $c->request->secure(1);
113 =item $c->prepare_headers
117 sub prepare_headers {
120 while ( my ( $header, $value ) = each %ENV ) {
122 next unless $header =~ /^(HTTP|CONTENT)/i;
124 ( my $field = $header ) =~ s/^HTTPS?_//;
126 $c->req->headers->header( $field => $value );
129 $c->req->method( $ENV{REQUEST_METHOD} || 'GET' );
132 =item $c->prepare_parameters
136 sub prepare_parameters {
141 if ( $c->request->method eq 'POST' ) {
142 for my $param ( $c->cgi->url_param ) {
143 for my $value ( $c->cgi->url_param($param) ) {
144 push ( @params, $param, $value );
149 for my $param ( $c->cgi->param ) {
150 for my $value ( $c->cgi->param($param) ) {
151 push ( @params, $param, $value );
155 $c->request->param(@params);
158 =item $c->prepare_path
167 my $scheme = $c->request->secure ? 'https' : 'http';
168 my $host = $ENV{HTTP_HOST} || $ENV{SERVER_NAME};
169 my $port = $ENV{SERVER_PORT} || 80;
170 my $path = $ENV{SCRIPT_NAME} || '/';
172 unless ( $path =~ /\/$/ ) {
177 $base->scheme($scheme);
182 $base = $base->canonical->as_string;
185 my $path = $ENV{PATH_INFO} || '/';
186 $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
189 $c->req->base($base);
190 $c->req->path($path);
193 =item $c->prepare_request
197 sub prepare_request {
198 my ( $c, $cgi ) = @_;
199 $c->cgi( $cgi || CGI->new );
200 $c->cgi->_reset_globals;
203 =item $c->prepare_uploads
207 sub prepare_uploads {
212 for my $param ( $c->cgi->param ) {
214 my @values = $c->cgi->param($param);
216 next unless ref( $values[0] );
218 for my $fh (@values) {
220 next unless my $size = ( stat $fh )[7];
222 my $info = $c->cgi->uploadInfo($fh);
223 my $tempname = $c->cgi->tmpFileName($fh);
224 my $type = $info->{'Content-Type'};
225 my $disposition = $info->{'Content-Disposition'};
226 my $filename = ( $disposition =~ / filename="([^;]*)"/ )[0];
228 my $upload = Catalyst::Request::Upload->new(
229 filename => $filename,
231 tempname => $tempname,
235 push( @uploads, $param, $upload );
239 $c->request->upload(@uploads);
246 sub run { shift->handler }
256 Sebastian Riedel, C<sri@cpan.org>
260 This program is free software, you can redistribute it and/or modify it under
261 the same terms as Perl itself.