Commit | Line | Data |
fc7ec1d9 |
1 | package Catalyst::Engine::CGI; |
2 | |
3 | use strict; |
c2e8e6fa |
4 | use base 'Catalyst::Engine::CGI::Base'; |
e7c0c583 |
5 | |
a2f2cde9 |
6 | use Catalyst::Exception; |
e7c0c583 |
7 | use CGI; |
fc7ec1d9 |
8 | |
66294129 |
9 | our @compile = qw[ |
10 | delete |
11 | http |
12 | new_MultipartBuffer |
13 | param |
14 | parse_keywordlist |
15 | read_from_client |
16 | read_multipart |
17 | tmpFileName |
18 | uploadInfo |
19 | url_param |
20 | user_agent |
21 | ]; |
22 | |
23 | CGI->compile(@compile); |
24 | |
e2fd5b5f |
25 | __PACKAGE__->mk_accessors('cgi'); |
26 | |
fc7ec1d9 |
27 | =head1 NAME |
28 | |
29 | Catalyst::Engine::CGI - The CGI Engine |
30 | |
31 | =head1 SYNOPSIS |
32 | |
23f9d934 |
33 | A script using the Catalyst::Engine::CGI module might look like: |
34 | |
9a33da6a |
35 | #!/usr/bin/perl -w |
36 | |
37 | use strict; |
38 | use lib '/path/to/MyApp/lib'; |
39 | use MyApp; |
40 | |
41 | MyApp->run; |
42 | |
23f9d934 |
43 | The application module (C<MyApp>) would use C<Catalyst>, which loads the |
44 | appropriate engine module. |
fc7ec1d9 |
45 | |
46 | =head1 DESCRIPTION |
47 | |
23f9d934 |
48 | This is the Catalyst engine specialized for the CGI environment (using the |
66294129 |
49 | C<CGI> and C<CGI::Cookie> modules). |
9a33da6a |
50 | |
e2fd5b5f |
51 | =head1 METHODS |
52 | |
53 | =over 4 |
54 | |
55 | =item $c->cgi |
56 | |
57 | Contains the C<CGI> object. |
58 | |
59 | =back |
60 | |
23f9d934 |
61 | =head1 OVERLOADED METHODS |
fc7ec1d9 |
62 | |
c2e8e6fa |
63 | This class overloads some methods from C<Catalyst::Engine::CGI::Base>. |
fc7ec1d9 |
64 | |
23f9d934 |
65 | =over 4 |
66 | |
06e1b616 |
67 | =item $c->prepare_body |
fc7ec1d9 |
68 | |
69 | =cut |
70 | |
06e1b616 |
71 | sub prepare_body { |
fc7ec1d9 |
72 | my $c = shift; |
06e1b616 |
73 | |
74 | # XXX this is undocumented in CGI.pm. If Content-Type is not |
75 | # application/x-www-form-urlencoded or multipart/form-data |
76 | # CGI.pm will read STDIN into a param, POSTDATA. |
77 | |
e060fe05 |
78 | $c->request->body( $c->cgi->param('POSTDATA') ); |
fc7ec1d9 |
79 | } |
80 | |
23f9d934 |
81 | =item $c->prepare_parameters |
fc7ec1d9 |
82 | |
83 | =cut |
84 | |
85 | sub prepare_parameters { |
e7c0c583 |
86 | my $c = shift; |
bfde09a2 |
87 | |
5b387dfc |
88 | my ( @params ); |
bfde09a2 |
89 | |
b9e9fff6 |
90 | if ( $c->request->method eq 'POST' ) { |
b9e9fff6 |
91 | for my $param ( $c->cgi->url_param ) { |
92 | for my $value ( $c->cgi->url_param($param) ) { |
93 | push ( @params, $param, $value ); |
94 | } |
5b387dfc |
95 | } |
fc7ec1d9 |
96 | } |
08cf3dd6 |
97 | |
bfde09a2 |
98 | for my $param ( $c->cgi->param ) { |
08cf3dd6 |
99 | for my $value ( $c->cgi->param($param) ) { |
5b387dfc |
100 | push ( @params, $param, $value ); |
101 | } |
102 | } |
bfde09a2 |
103 | |
104 | $c->request->param(@params); |
fc7ec1d9 |
105 | } |
106 | |
23f9d934 |
107 | =item $c->prepare_request |
fc7ec1d9 |
108 | |
109 | =cut |
110 | |
bfde09a2 |
111 | sub prepare_request { |
316bf0f0 |
112 | my ( $c, $object ) = @_; |
113 | |
114 | my $cgi; |
115 | |
116 | if ( defined($object) && ref($object) ) { |
117 | |
118 | if ( $object->isa('Apache') ) { # MP 1.3 |
119 | $cgi = CGI->new($object); |
120 | } |
121 | |
122 | elsif ( $object->isa('Apache::RequestRec') ) { # MP 1.99 |
123 | $cgi = CGI->new($object); |
124 | } |
125 | |
126 | elsif ( $object->isa('Apache2::RequestRec') ) { # MP 2.00 |
127 | $cgi = CGI->new($object); |
128 | } |
129 | |
130 | elsif ( $object->isa('CGI') ) { |
131 | $cgi = $object; |
132 | } |
133 | |
134 | else { |
135 | my $class = ref($object); |
a2f2cde9 |
136 | |
137 | Catalyst::Exception->throw( |
138 | message => qq/Unknown object '$object'/ |
139 | ); |
316bf0f0 |
140 | } |
141 | } |
142 | |
3f822a28 |
143 | $c->cgi( $cgi || CGI->new ); |
e7c0c583 |
144 | } |
fc7ec1d9 |
145 | |
23f9d934 |
146 | =item $c->prepare_uploads |
fc7ec1d9 |
147 | |
148 | =cut |
149 | |
150 | sub prepare_uploads { |
151 | my $c = shift; |
e7c0c583 |
152 | |
153 | my @uploads; |
bfde09a2 |
154 | |
e7c0c583 |
155 | for my $param ( $c->cgi->param ) { |
bfde09a2 |
156 | |
e7c0c583 |
157 | my @values = $c->cgi->param($param); |
158 | |
159 | next unless ref( $values[0] ); |
160 | |
161 | for my $fh (@values) { |
162 | |
163 | next unless my $size = ( stat $fh )[7]; |
164 | |
165 | my $info = $c->cgi->uploadInfo($fh); |
166 | my $tempname = $c->cgi->tmpFileName($fh); |
167 | my $type = $info->{'Content-Type'}; |
168 | my $disposition = $info->{'Content-Disposition'}; |
169 | my $filename = ( $disposition =~ / filename="([^;]*)"/ )[0]; |
170 | |
146554c5 |
171 | my $upload = Catalyst::Request::Upload->new( |
e7c0c583 |
172 | filename => $filename, |
173 | size => $size, |
174 | tempname => $tempname, |
175 | type => $type |
146554c5 |
176 | ); |
bfde09a2 |
177 | |
e7c0c583 |
178 | push( @uploads, $param, $upload ); |
179 | } |
fc7ec1d9 |
180 | } |
bfde09a2 |
181 | |
182 | $c->request->upload(@uploads); |
fc7ec1d9 |
183 | } |
184 | |
23f9d934 |
185 | =back |
186 | |
fc7ec1d9 |
187 | =head1 SEE ALSO |
188 | |
c2e8e6fa |
189 | L<Catalyst> L<Catalyst::Engine> L<Catalyst::Engine::CGI::Base>. |
fc7ec1d9 |
190 | |
191 | =head1 AUTHOR |
192 | |
193 | Sebastian Riedel, C<sri@cpan.org> |
c2e8e6fa |
194 | Christian Hansen, C<ch@ngmedia.com> |
fc7ec1d9 |
195 | |
196 | =head1 COPYRIGHT |
197 | |
198 | This program is free software, you can redistribute it and/or modify it under |
199 | the same terms as Perl itself. |
200 | |
201 | =cut |
202 | |
203 | 1; |