Commit | Line | Data |
fc7ec1d9 |
1 | package Catalyst::Engine::CGI; |
2 | |
3 | use strict; |
c2e8e6fa |
4 | use base 'Catalyst::Engine::CGI::Base'; |
e7c0c583 |
5 | |
6 | use CGI; |
fc7ec1d9 |
7 | |
8 | =head1 NAME |
9 | |
10 | Catalyst::Engine::CGI - The CGI Engine |
11 | |
12 | =head1 SYNOPSIS |
13 | |
23f9d934 |
14 | A script using the Catalyst::Engine::CGI module might look like: |
15 | |
9a33da6a |
16 | #!/usr/bin/perl -w |
17 | |
18 | use strict; |
19 | use lib '/path/to/MyApp/lib'; |
20 | use MyApp; |
21 | |
22 | MyApp->run; |
23 | |
23f9d934 |
24 | The application module (C<MyApp>) would use C<Catalyst>, which loads the |
25 | appropriate engine module. |
fc7ec1d9 |
26 | |
27 | =head1 DESCRIPTION |
28 | |
23f9d934 |
29 | This is the Catalyst engine specialized for the CGI environment (using the |
e7c0c583 |
30 | C<CGI> and C<CGI::Cookie> modules). Normally Catalyst will select the |
23f9d934 |
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); |
fc7ec1d9 |
36 | |
9a33da6a |
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 | |
23f9d934 |
40 | =head1 OVERLOADED METHODS |
fc7ec1d9 |
41 | |
c2e8e6fa |
42 | This class overloads some methods from C<Catalyst::Engine::CGI::Base>. |
fc7ec1d9 |
43 | |
23f9d934 |
44 | =over 4 |
45 | |
06e1b616 |
46 | =item $c->prepare_body |
fc7ec1d9 |
47 | |
48 | =cut |
49 | |
06e1b616 |
50 | sub prepare_body { |
fc7ec1d9 |
51 | my $c = shift; |
06e1b616 |
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 | |
e060fe05 |
57 | $c->request->body( $c->cgi->param('POSTDATA') ); |
fc7ec1d9 |
58 | } |
59 | |
23f9d934 |
60 | =item $c->prepare_parameters |
fc7ec1d9 |
61 | |
62 | =cut |
63 | |
64 | sub prepare_parameters { |
e7c0c583 |
65 | my $c = shift; |
bfde09a2 |
66 | |
5b387dfc |
67 | my ( @params ); |
bfde09a2 |
68 | |
b9e9fff6 |
69 | if ( $c->request->method eq 'POST' ) { |
b9e9fff6 |
70 | for my $param ( $c->cgi->url_param ) { |
71 | for my $value ( $c->cgi->url_param($param) ) { |
72 | push ( @params, $param, $value ); |
73 | } |
5b387dfc |
74 | } |
fc7ec1d9 |
75 | } |
08cf3dd6 |
76 | |
bfde09a2 |
77 | for my $param ( $c->cgi->param ) { |
08cf3dd6 |
78 | for my $value ( $c->cgi->param($param) ) { |
5b387dfc |
79 | push ( @params, $param, $value ); |
80 | } |
81 | } |
bfde09a2 |
82 | |
83 | $c->request->param(@params); |
fc7ec1d9 |
84 | } |
85 | |
23f9d934 |
86 | =item $c->prepare_request |
fc7ec1d9 |
87 | |
88 | =cut |
89 | |
bfde09a2 |
90 | sub prepare_request { |
3f822a28 |
91 | my ( $c, $cgi ) = @_; |
92 | $c->cgi( $cgi || CGI->new ); |
e7c0c583 |
93 | $c->cgi->_reset_globals; |
94 | } |
fc7ec1d9 |
95 | |
23f9d934 |
96 | =item $c->prepare_uploads |
fc7ec1d9 |
97 | |
98 | =cut |
99 | |
100 | sub prepare_uploads { |
101 | my $c = shift; |
e7c0c583 |
102 | |
103 | my @uploads; |
bfde09a2 |
104 | |
e7c0c583 |
105 | for my $param ( $c->cgi->param ) { |
bfde09a2 |
106 | |
e7c0c583 |
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 | |
146554c5 |
121 | my $upload = Catalyst::Request::Upload->new( |
e7c0c583 |
122 | filename => $filename, |
123 | size => $size, |
124 | tempname => $tempname, |
125 | type => $type |
146554c5 |
126 | ); |
bfde09a2 |
127 | |
e7c0c583 |
128 | push( @uploads, $param, $upload ); |
129 | } |
fc7ec1d9 |
130 | } |
bfde09a2 |
131 | |
132 | $c->request->upload(@uploads); |
fc7ec1d9 |
133 | } |
134 | |
23f9d934 |
135 | =back |
136 | |
fc7ec1d9 |
137 | =head1 SEE ALSO |
138 | |
c2e8e6fa |
139 | L<Catalyst> L<Catalyst::Engine> L<Catalyst::Engine::CGI::Base>. |
fc7ec1d9 |
140 | |
141 | =head1 AUTHOR |
142 | |
143 | Sebastian Riedel, C<sri@cpan.org> |
c2e8e6fa |
144 | Christian Hansen, C<ch@ngmedia.com> |
fc7ec1d9 |
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; |