Commit | Line | Data |
fc7ec1d9 |
1 | package Catalyst::Engine::Apache; |
2 | |
3 | use strict; |
4 | use mod_perl; |
5 | use constant MP2 => $mod_perl::VERSION >= 1.99; |
6 | use base 'Catalyst::Engine'; |
7 | use URI; |
8 | |
9 | # mod_perl |
10 | if (MP2) { |
11 | require Apache2; |
12 | require Apache::RequestIO; |
13 | require Apache::RequestRec; |
14 | require Apache::SubRequest; |
15 | require Apache::RequestUtil; |
16 | require APR::URI; |
17 | require Apache::URI; |
18 | } |
19 | else { require Apache } |
20 | |
21 | # libapreq |
22 | require Apache::Request; |
23 | require Apache::Cookie; |
24 | require Apache::Upload if MP2; |
25 | |
26 | __PACKAGE__->mk_accessors(qw/apache_request original_request/); |
27 | |
28 | =head1 NAME |
29 | |
30 | Catalyst::Engine::Apache - Catalyst Apache Engine |
31 | |
32 | =head1 SYNOPSIS |
33 | |
34 | See L<Catalyst>. |
35 | |
36 | =head1 DESCRIPTION |
37 | |
38 | The Apache Engine. |
39 | |
40 | =head2 METHODS |
41 | |
42 | =head3 apache_request |
43 | |
44 | Returns an C<Apache::Request> object. |
45 | |
46 | =head3 original_request |
47 | |
48 | Returns the original Apache request object. |
49 | |
50 | =head2 OVERLOADED METHODS |
51 | |
52 | This class overloads some methods from C<Catalyst::Engine>. |
53 | |
54 | =head3 finalize_headers |
55 | |
56 | =cut |
57 | |
58 | sub finalize_headers { |
59 | my $c = shift; |
60 | for my $name ( $c->response->headers->header_field_names ) { |
61 | next if $name =~ /Content-Type/i; |
62 | $c->original_request->headers_out->set( |
63 | $name => $c->response->headers->header($name) ); |
64 | } |
65 | while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) { |
66 | my %cookie = ( -name => $name, -value => $cookie->{value} ); |
67 | $cookie->{-expires} = $cookie->{expires} if $cookie->{expires}; |
68 | $cookie->{-domain} = $cookie->{domain} if $cookie->{domain}; |
69 | $cookie->{-path} = $cookie->{path} if $cookie->{path}; |
70 | $cookie->{-secure} = $cookie->{secure} if $cookie->{secure}; |
71 | my $cookie = Apache::Cookie->new( $c->original_request, %cookie ); |
72 | MP2 |
73 | ? $c->apache_request->err_headers_out->add( |
74 | 'Set-Cookie' => $cookie->as_string ) |
75 | : $cookie->bake; |
76 | } |
77 | $c->original_request->status( $c->response->status ); |
78 | $c->original_request->content_type( $c->response->headers->content_type |
79 | || 'text/plain' ); |
80 | MP2 || $c->apache_request->send_http_header; |
81 | return 0; |
82 | } |
83 | |
84 | =head3 finalize_output |
85 | |
86 | =cut |
87 | |
88 | sub finalize_output { |
89 | my $c = shift; |
90 | $c->original_request->print( $c->response->{output} ); |
91 | } |
92 | |
93 | =head3 prepare_cookies |
94 | |
95 | =cut |
96 | |
97 | sub prepare_cookies { |
98 | my $c = shift; |
99 | MP2 |
100 | ? $c->req->cookies( { Apache::Cookie->fetch } ) |
101 | : $c->req->cookies( |
102 | { Apache::Cookie->new( $c->apache_request )->fetch } ); |
103 | } |
104 | |
105 | =head3 prepare_headers |
106 | |
107 | =cut |
108 | |
109 | sub prepare_headers { |
110 | my $c = shift; |
111 | $c->req->method( $c->apache_request->method ); |
112 | $c->req->headers->header( %{ $c->apache_request->headers_in } ); |
113 | } |
114 | |
115 | =head3 prepare_parameters |
116 | |
117 | =cut |
118 | |
119 | sub prepare_parameters { |
120 | my $c = shift; |
121 | my %args; |
122 | foreach my $key ( $c->apache_request->param ) { |
123 | my @values = $c->apache_request->param($key); |
124 | $args{$key} = @values == 1 ? $values[0] : \@values; |
125 | } |
126 | $c->req->parameters( \%args ); |
127 | } |
128 | |
129 | =head3 prepare_path |
130 | |
131 | =cut |
132 | |
133 | sub prepare_path { |
134 | my $c = shift; |
135 | $c->req->path( $c->apache_request->uri ); |
136 | my $loc = $c->apache_request->location; |
137 | no warnings 'uninitialized'; |
138 | $c->req->{path} =~ s/^($loc)?\///; |
139 | my $base = URI->new; |
5ae68c0d |
140 | $base->scheme( $ENV{HTTPS} ? 'https' : 'http' ); |
fc7ec1d9 |
141 | $base->host( $c->apache_request->hostname ); |
142 | $base->port( $c->apache_request->get_server_port ); |
3803e98f |
143 | my $path = $c->apache_request->location; |
144 | $base->path( $path =~ /\/$/ ? $path : "$path/" ); |
fc7ec1d9 |
145 | $c->req->base( $base->as_string ); |
146 | } |
147 | |
148 | =head3 prepare_request |
149 | |
150 | =cut |
151 | |
152 | sub prepare_request { |
153 | my ( $c, $r ) = @_; |
154 | $c->apache_request( Apache::Request->new($r) ); |
155 | $c->original_request($r); |
156 | } |
157 | |
158 | =head3 prepare_uploads |
159 | |
160 | =cut |
161 | |
162 | sub prepare_uploads { |
163 | my $c = shift; |
164 | for my $upload ( $c->apache_request->upload ) { |
165 | $upload = $c->apache_request->upload($upload) if MP2; |
7833fdfc |
166 | $c->req->uploads->{ $upload->filename } = { |
167 | fh => $upload->fh, |
168 | size => $upload->size, |
169 | type => $upload->type |
fc7ec1d9 |
170 | }; |
171 | } |
172 | } |
173 | |
174 | =head1 SEE ALSO |
175 | |
176 | L<Catalyst>. |
177 | |
178 | =head1 AUTHOR |
179 | |
180 | Sebastian Riedel, C<sri@cpan.org> |
181 | |
182 | =head1 COPYRIGHT |
183 | |
184 | This program is free software, you can redistribute it and/or modify it under |
185 | the same terms as Perl itself. |
186 | |
187 | =cut |
188 | |
189 | 1; |