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