Commit | Line | Data |
e05d67cf |
1 | package Catalyst::Engine::CGI::APR; |
2 | |
3 | use strict; |
4 | use base 'Catalyst::Engine::CGI::Base'; |
5 | |
6 | use APR; |
7 | use APR::Pool; |
8 | use APR::Request; |
9 | use APR::Request::CGI; |
10 | use APR::Request::Param; |
11 | |
316bf0f0 |
12 | __PACKAGE__->mk_accessors( qw[apr pool] ); |
e2fd5b5f |
13 | |
e05d67cf |
14 | =head1 NAME |
15 | |
16 | Catalyst::Engine::CGI::APR - The CGI APR Engine |
17 | |
18 | =head1 SYNOPSIS |
19 | |
20 | A script using the Catalyst::Engine::CGI::APR module might look like: |
21 | |
22 | #!/usr/bin/perl -w |
23 | |
24 | BEGIN { |
25 | $ENV{CATALYST_ENGINE} = 'CGI::APR'; |
26 | } |
27 | |
28 | use strict; |
29 | use lib '/path/to/MyApp/lib'; |
30 | use MyApp; |
31 | |
32 | MyApp->run; |
33 | |
34 | =head1 DESCRIPTION |
35 | |
e2fd5b5f |
36 | This Catalyst engine uses C<APR::Request::CGI> for parsing of message body. |
37 | |
38 | =head1 METHODS |
39 | |
40 | =over 4 |
41 | |
42 | =item $c->apr |
43 | |
44 | Contains the C<APR::Request::CGI> object. |
45 | |
316bf0f0 |
46 | =item $c->pool |
47 | |
48 | Contains the C<APR::Pool> object. |
49 | |
e2fd5b5f |
50 | =back |
e05d67cf |
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_parameters |
59 | |
60 | =cut |
61 | |
62 | sub prepare_parameters { |
63 | my $c = shift; |
64 | |
65 | my @params; |
316bf0f0 |
66 | |
67 | if ( my $table = $c->apr->param ) { |
68 | |
69 | $table->do( sub { |
70 | my ( $field, $value ) = @_; |
71 | push( @params, $field, $value ); |
72 | return 1; |
73 | }); |
74 | |
75 | $c->request->param(@params); |
76 | } |
e05d67cf |
77 | } |
78 | |
79 | =item $c->prepare_request |
80 | |
81 | =cut |
82 | |
83 | sub prepare_request { |
84 | my $c = shift; |
316bf0f0 |
85 | $c->pool( APR::Pool->new ); |
86 | $c->apr( APR::Request::CGI->handle( $c->pool ) ); |
e05d67cf |
87 | } |
88 | |
89 | =item $c->prepare_uploads |
90 | |
91 | =cut |
92 | |
93 | sub prepare_uploads { |
94 | my $c = shift; |
95 | |
96 | my @uploads; |
316bf0f0 |
97 | |
98 | if ( my $body = $c->apr->body ) { |
99 | |
100 | $body->param_class('APR::Request::Param'); |
e05d67cf |
101 | |
316bf0f0 |
102 | $body->uploads( $c->pool )->do( sub { |
103 | my ( $field, $upload ) = @_; |
e05d67cf |
104 | |
316bf0f0 |
105 | my $object = Catalyst::Request::Upload->new( |
106 | filename => $upload->upload_filename, |
107 | size => $upload->upload_size, |
108 | tempname => $upload->upload_tempname, |
109 | type => $upload->upload_type |
110 | ); |
e05d67cf |
111 | |
316bf0f0 |
112 | push( @uploads, $field, $object ); |
e05d67cf |
113 | |
316bf0f0 |
114 | return 1; |
115 | }); |
e05d67cf |
116 | |
316bf0f0 |
117 | $c->request->upload(@uploads); |
118 | } |
e05d67cf |
119 | } |
120 | |
121 | =back |
122 | |
123 | =head1 SEE ALSO |
124 | |
e2fd5b5f |
125 | L<Catalyst>, L<APR::Request::CGI>, L<Catalyst::Engine::CGI::Base>. |
e05d67cf |
126 | |
127 | =head1 AUTHOR |
128 | |
129 | Sebastian Riedel, C<sri@cpan.org> |
130 | Christian Hansen, C<ch@ngmedia.com> |
131 | |
132 | =head1 COPYRIGHT |
133 | |
134 | This program is free software, you can redistribute it and/or modify it under |
135 | the same terms as Perl itself. |
136 | |
137 | =cut |
138 | |
139 | 1; |