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