lib/Catalyst/Engine/CGI.pm

   1 package Catalyst::Engine::CGI;
   2
   3 use strict;
   4 use base 'Catalyst::Engine::CGI::Base';
   5
   6 use CGI;
   7
   8 __PACKAGE__->mk_accessors('cgi');
   9
  10 =head1 NAME
  11
  12 Catalyst::Engine::CGI - The CGI Engine
  13
  14 =head1 SYNOPSIS
  15
  16 A script using the Catalyst::Engine::CGI module might look like:
  17
  18     #!/usr/bin/perl -w
  19
  20     use strict;
  21     use lib '/path/to/MyApp/lib';
  22     use MyApp;
  23
  24     MyApp->run;
  25
  26 The application module (C<MyApp>) would use C<Catalyst>, which loads the
  27 appropriate engine module.
  28
  29 =head1 DESCRIPTION
  30
  31 This is the Catalyst engine specialized for the CGI environment (using the
  32 C<CGI> and C<CGI::Cookie> modules).  Normally Catalyst will select the
  33 appropriate engine according to the environment that it detects, however you
  34 can force Catalyst to use the CGI engine by specifying the following in your
  35 application module:
  36
  37     use Catalyst qw(-Engine=CGI);
  38
  39 The performance of this way of using Catalyst is not expected to be
  40 useful in production applications, but it may be helpful for development.
  41
  42 =head1 METHODS
  43
  44 =over 4
  45
  46 =item $c->cgi
  47
  48 Contains the C<CGI> object.
  49
  50 =back
  51
  52 =head1 OVERLOADED METHODS
  53
  54 This class overloads some methods from C<Catalyst::Engine::CGI::Base>.
  55
  56 =over 4
  57
  58 =item $c->prepare_body
  59
  60 =cut
  61
  62 sub prepare_body {
  63     my $c = shift;
  64
  65     # XXX this is undocumented in CGI.pm. If Content-Type is not
  66     # application/x-www-form-urlencoded or multipart/form-data
  67     # CGI.pm will read STDIN into a param, POSTDATA.
  68
  69     $c->request->body( $c->cgi->param('POSTDATA') );
  70 }
  71
  72 =item $c->prepare_parameters
  73
  74 =cut
  75
  76 sub prepare_parameters {
  77     my $c = shift;
  78
  79     my ( @params );
  80
  81     if ( $c->request->method eq 'POST' ) {
  82         for my $param ( $c->cgi->url_param ) {
  83             for my $value (  $c->cgi->url_param($param) ) {
  84                 push ( @params, $param, $value );
  85             }
  86         }
  87     }
  88
  89     for my $param ( $c->cgi->param ) {
  90         for my $value (  $c->cgi->param($param) ) {
  91             push ( @params, $param, $value );
  92         }
  93     }
  94
  95     $c->request->param(@params);
  96 }
  97
  98 =item $c->prepare_request
  99
 100 =cut
 101
 102 sub prepare_request {
 103     my ( $c, $cgi ) = @_;
 104     $c->cgi( $cgi || CGI->new );
 105     $c->cgi->_reset_globals;
 106 }
 107
 108 =item $c->prepare_uploads
 109
 110 =cut
 111
 112 sub prepare_uploads {
 113     my $c = shift;
 114
 115     my @uploads;
 116
 117     for my $param ( $c->cgi->param ) {
 118
 119         my @values = $c->cgi->param($param);
 120
 121         next unless ref( $values[0] );
 122
 123         for my $fh (@values) {
 124
 125             next unless my $size = ( stat $fh )[7];
 126
 127             my $info        = $c->cgi->uploadInfo($fh);
 128             my $tempname    = $c->cgi->tmpFileName($fh);
 129             my $type        = $info->{'Content-Type'};
 130             my $disposition = $info->{'Content-Disposition'};
 131             my $filename    = ( $disposition =~ / filename="([^;]*)"/ )[0];
 132
 133             my $upload = Catalyst::Request::Upload->new(
 134                 filename => $filename,
 135                 size     => $size,
 136                 tempname => $tempname,
 137                 type     => $type
 138             );
 139
 140             push( @uploads, $param, $upload );
 141         }
 142     }
 143
 144     $c->request->upload(@uploads);
 145 }
 146
 147 =back
 148
 149 =head1 SEE ALSO
 150
 151 L<Catalyst> L<Catalyst::Engine> L<Catalyst::Engine::CGI::Base>.
 152
 153 =head1 AUTHOR
 154
 155 Sebastian Riedel, C<sri@cpan.org>
 156 Christian Hansen, C<ch@ngmedia.com>
 157
 158 =head1 COPYRIGHT
 159
 160 This program is free software, you can redistribute it and/or modify it under
 161 the same terms as Perl itself.
 162
 163 =cut
 164
 165 1;