Commit | Line | Data |
fc7ec1d9 |
1 | package Catalyst::Response; |
2 | |
059c085b |
3 | use Moose; |
6680c772 |
4 | use HTTP::Headers; |
faa02805 |
5 | use Moose::Util::TypeConstraints; |
6 | use namespace::autoclean; |
fc7ec1d9 |
7 | |
531f1ab6 |
8 | with 'MooseX::Emulate::Class::Accessor::Fast'; |
9 | |
faa02805 |
10 | has _response_cb => ( |
4f4d49e2 |
11 | is => 'ro', |
12 | isa => 'CodeRef', |
13 | writer => '_set_response_cb', |
14 | clearer => '_clear_response_cb', |
faa02805 |
15 | predicate => '_has_response_cb', |
16 | ); |
17 | |
4f4d49e2 |
18 | subtype 'Catalyst::Engine::Types::Writer', as duck_type( [qw(write close)] ); |
faa02805 |
19 | |
20 | has _writer => ( |
4f4d49e2 |
21 | is => 'ro', |
22 | isa => 'Catalyst::Engine::Types::Writer' |
23 | , #Pointless since we control how this is built |
24 | #writer => '_set_writer', Now that its lazy I think this is safe to remove |
25 | clearer => '_clear_writer', |
faa02805 |
26 | predicate => '_has_writer', |
46fff667 |
27 | lazy => 1, |
4f4d49e2 |
28 | builder => '_build_writer', |
faa02805 |
29 | ); |
30 | |
46fff667 |
31 | sub _build_writer { |
32 | my $self = shift; |
33 | |
34 | ## These two lines are probably crap now... |
4f4d49e2 |
35 | $self->_context->finalize_headers |
36 | unless $self->finalized_headers; |
46fff667 |
37 | |
38 | my @headers; |
4f4d49e2 |
39 | $self->headers->scan( sub { push @headers, @_ } ); |
46fff667 |
40 | |
4f4d49e2 |
41 | my $writer = $self->_response_cb->( [ $self->status, \@headers ] ); |
46fff667 |
42 | $self->_clear_response_cb; |
43 | |
44 | return $writer; |
45 | } |
46 | |
e37f92f5 |
47 | has write_fh => ( |
4f4d49e2 |
48 | is => 'ro', |
49 | predicate => '_has_write_fh', |
50 | lazy => 1, |
51 | builder => '_build_write_fh', |
1f2a8069 |
52 | ); |
53 | |
4f4d49e2 |
54 | sub _build_write_fh { shift->_writer } |
e37f92f5 |
55 | |
56 | sub DEMOLISH { |
4f4d49e2 |
57 | my $self = shift; |
58 | return if $self->_has_write_fh; |
59 | if ( $self->_has_writer ) { |
60 | $self->_writer->close; |
61 | } |
e37f92f5 |
62 | } |
faa02805 |
63 | |
4f4d49e2 |
64 | has cookies => ( is => 'rw', default => sub { {} } ); |
65 | has body => ( is => 'rw', default => undef ); |
66 | sub has_body { defined( $_[0]->body ) } |
67 | |
68 | has location => ( is => 'rw', writer => '_set_location' ); |
69 | has status => ( is => 'rw', default => 200 ); |
70 | has finalized_headers => ( is => 'rw', default => 0 ); |
71 | has headers => ( |
72 | is => 'rw', |
73 | isa => 'HTTP::Headers', |
74 | handles => [qw(content_encoding content_length content_type header)], |
75 | default => sub { HTTP::Headers->new() }, |
76 | required => 1, |
77 | lazy => 1, |
059c085b |
78 | ); |
258733f1 |
79 | has _context => ( |
4f4d49e2 |
80 | is => 'rw', |
81 | weak_ref => 1, |
82 | clearer => '_clear_context', |
258733f1 |
83 | ); |
fc7ec1d9 |
84 | |
4f4d49e2 |
85 | before [ |
86 | qw(status headers content_encoding content_length content_type header)] |
87 | => sub { |
88 | my $self = shift; |
9ae060f0 |
89 | |
4f4d49e2 |
90 | $self->_context->log->warn( |
91 | "Useless setting a header value after finalize_headers called." |
92 | . " Not what you want." ) |
93 | if ( $self->finalized_headers && @_ ); |
94 | }; |
9ae060f0 |
95 | |
059c085b |
96 | sub output { shift->body(@_) } |
97 | |
4f4d49e2 |
98 | sub code { shift->status(@_) } |
aa9e8261 |
99 | |
9c4288ea |
100 | sub write { |
101 | my ( $self, $buffer ) = @_; |
102 | |
103 | # Finalize headers if someone manually writes output |
89ba65d5 |
104 | $self->_context->finalize_headers unless $self->finalized_headers; |
9c4288ea |
105 | |
106 | $buffer = q[] unless defined $buffer; |
107 | |
108 | my $len = length($buffer); |
109 | $self->_writer->write($buffer); |
110 | |
111 | return $len; |
112 | } |
113 | |
9c4288ea |
114 | sub finalize_headers { |
115 | my ($self) = @_; |
9c4288ea |
116 | return; |
117 | } |
118 | |
e67f0874 |
119 | sub from_psgi_response { |
4f4d49e2 |
120 | my ( $self, $psgi_res ) = @_; |
121 | if ( ref $psgi_res eq 'ARRAY' ) { |
122 | my ( $status, $headers, $body ) = @$psgi_res; |
e67f0874 |
123 | $self->status($status); |
4f4d49e2 |
124 | $self->headers( HTTP::Headers->new(@$headers) ); |
8a3dcb98 |
125 | $self->body($body); |
4f4d49e2 |
126 | } elsif ( ref $psgi_res eq 'CODE' ) { |
127 | $psgi_res->( |
128 | sub { |
129 | my $response = shift; |
130 | my ( $status, $headers, $maybe_body ) = @$response; |
131 | $self->status($status); |
132 | $self->headers( HTTP::Headers->new(@$headers) ); |
133 | if ( defined $maybe_body ) { |
134 | $self->body($maybe_body); |
135 | } else { |
136 | return $self->write_fh; |
137 | } |
e67f0874 |
138 | } |
4f4d49e2 |
139 | ); |
140 | } else { |
141 | die |
142 | "You can't set a Catalyst response from that, expect a valid PSGI response"; |
e67f0874 |
143 | } |
144 | } |
145 | |
fc7ec1d9 |
146 | =head1 NAME |
147 | |
910410b8 |
148 | Catalyst::Response - stores output responding to the current client request |
fc7ec1d9 |
149 | |
150 | =head1 SYNOPSIS |
151 | |
fbcc39ad |
152 | $res = $c->response; |
153 | $res->body; |
aa9e8261 |
154 | $res->code; |
fbcc39ad |
155 | $res->content_encoding; |
156 | $res->content_length; |
157 | $res->content_type; |
158 | $res->cookies; |
fbcc39ad |
159 | $res->header; |
160 | $res->headers; |
161 | $res->output; |
162 | $res->redirect; |
163 | $res->status; |
164 | $res->write; |
b22c6668 |
165 | |
fc7ec1d9 |
166 | =head1 DESCRIPTION |
167 | |
910410b8 |
168 | This is the Catalyst Response class, which provides methods for responding to |
46372e65 |
169 | the current client request. The appropriate L<Catalyst::Engine> for your environment |
170 | will turn the Catalyst::Response into a HTTP Response and return it to the client. |
b22c6668 |
171 | |
172 | =head1 METHODS |
fc7ec1d9 |
173 | |
08a2c908 |
174 | =head2 $res->body( $text | $fh | $iohandle_object ) |
e060fe05 |
175 | |
176 | $c->response->body('Catalyst rocks!'); |
06e1b616 |
177 | |
46372e65 |
178 | Sets or returns the output (text or binary data). If you are returning a large body, |
2f381252 |
179 | you might want to use a L<IO::Handle> type of object (Something that implements the read method |
46372e65 |
180 | in the same fashion), or a filehandle GLOB. Catalyst |
181 | will write it piece by piece into the response. |
06e1b616 |
182 | |
490b7a80 |
183 | When using a L<IO::Handle> type of object and no content length has been |
184 | already set in the response headers Catalyst will make a reasonable attempt |
185 | to determine the size of the Handle. Depending on the implementation of your |
186 | handle object, setting the content length may fail. If it is at all possible |
4f4d49e2 |
187 | for you to determine the content length of your handle object, |
4a178c0d |
188 | it is recommended that you set the content length in the response headers |
490b7a80 |
189 | yourself, which will be respected and sent by Catalyst in the response. |
190 | |
02570318 |
191 | =head2 $res->has_body |
192 | |
193 | Predicate which returns true when a body has been set. |
194 | |
aa9e8261 |
195 | =head2 $res->code |
196 | |
197 | Alias for $res->status. |
198 | |
b5ecfcf0 |
199 | =head2 $res->content_encoding |
b5176d9e |
200 | |
910410b8 |
201 | Shortcut for $res->headers->content_encoding. |
b5176d9e |
202 | |
b5ecfcf0 |
203 | =head2 $res->content_length |
b5176d9e |
204 | |
910410b8 |
205 | Shortcut for $res->headers->content_length. |
b5176d9e |
206 | |
b5ecfcf0 |
207 | =head2 $res->content_type |
b5176d9e |
208 | |
910410b8 |
209 | Shortcut for $res->headers->content_type. |
b5176d9e |
210 | |
87e9f9ab |
211 | This value is typically set by your view or plugin. For example, |
212 | L<Catalyst::Plugin::Static::Simple> will guess the mime type based on the file |
213 | it found, while L<Catalyst::View::TT> defaults to C<text/html>. |
214 | |
b5ecfcf0 |
215 | =head2 $res->cookies |
fc7ec1d9 |
216 | |
910410b8 |
217 | Returns a reference to a hash containing cookies to be set. The keys of the |
218 | hash are the cookies' names, and their corresponding values are hash |
7e743798 |
219 | references used to construct a L<CGI::Simple::Cookie> object. |
fc7ec1d9 |
220 | |
221 | $c->response->cookies->{foo} = { value => '123' }; |
222 | |
7e743798 |
223 | The keys of the hash reference on the right correspond to the L<CGI::Simple::Cookie> |
910410b8 |
224 | parameters of the same name, except they are used without a leading dash. |
225 | Possible parameters are: |
ac965e92 |
226 | |
b0ad47c1 |
227 | =over |
ac965e92 |
228 | |
71453caf |
229 | =item value |
ac965e92 |
230 | |
71453caf |
231 | =item expires |
ac965e92 |
232 | |
71453caf |
233 | =item domain |
ac965e92 |
234 | |
71453caf |
235 | =item path |
236 | |
237 | =item secure |
238 | |
b21bc468 |
239 | =item httponly |
240 | |
71453caf |
241 | =back |
ac965e92 |
242 | |
b5ecfcf0 |
243 | =head2 $res->header |
fbcc39ad |
244 | |
910410b8 |
245 | Shortcut for $res->headers->header. |
fbcc39ad |
246 | |
b5ecfcf0 |
247 | =head2 $res->headers |
fc7ec1d9 |
248 | |
910410b8 |
249 | Returns an L<HTTP::Headers> object, which can be used to set headers. |
fc7ec1d9 |
250 | |
251 | $c->response->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); |
252 | |
b5ecfcf0 |
253 | =head2 $res->output |
fc7ec1d9 |
254 | |
910410b8 |
255 | Alias for $res->body. |
fc7ec1d9 |
256 | |
b5ecfcf0 |
257 | =head2 $res->redirect( $url, $status ) |
fc7ec1d9 |
258 | |
2f381252 |
259 | Causes the response to redirect to the specified URL. The default status is |
260 | C<302>. |
fc7ec1d9 |
261 | |
73a52566 |
262 | $c->response->redirect( 'http://slashdot.org' ); |
263 | $c->response->redirect( 'http://slashdot.org', 307 ); |
264 | |
2f381252 |
265 | This is a convenience method that sets the Location header to the |
266 | redirect destination, and then sets the response status. You will |
ee24f3a8 |
267 | want to C< return > or C<< $c->detach() >> to interrupt the normal |
2f381252 |
268 | processing flow if you want the redirect to occur straight away. |
269 | |
824a5eb0 |
270 | B<Note:> do not give a relative URL as $url, i.e: one that is not fully |
271 | qualified (= C<http://...>, etc.) or that starts with a slash |
272 | (= C</path/here>). While it may work, it is not guaranteed to do the right |
273 | thing and is not a standard behaviour. You may opt to use uri_for() or |
274 | uri_for_action() instead. |
275 | |
73a52566 |
276 | =cut |
277 | |
278 | sub redirect { |
279 | my $self = shift; |
fbcc39ad |
280 | |
281 | if (@_) { |
73a52566 |
282 | my $location = shift; |
4f4d49e2 |
283 | my $status = shift || 302; |
73a52566 |
284 | |
5ffaafbd |
285 | $self->location($location); |
73a52566 |
286 | $self->status($status); |
4f4d49e2 |
287 | |
73a52566 |
288 | } |
289 | |
290 | return $self->location; |
291 | } |
fc7ec1d9 |
292 | |
4f4d49e2 |
293 | around '_set_location' => sub { |
294 | my $orig = shift; |
295 | my $self = shift; |
296 | |
297 | if (@_) { |
298 | |
299 | my $location = shift; |
300 | |
301 | if ( $location =~ m/[\n\r]/ ) { # check for header injection |
302 | |
5ffaafbd |
303 | die "blocking header injection"; |
4f4d49e2 |
304 | |
305 | } else { |
306 | |
307 | $self->$orig($location); |
308 | |
309 | } |
310 | |
311 | } else { |
312 | |
313 | $self->$orig(); |
314 | |
315 | } |
316 | |
317 | }; |
318 | |
059c085b |
319 | =head2 $res->location |
320 | |
321 | Sets or returns the HTTP 'Location'. |
322 | |
b5ecfcf0 |
323 | =head2 $res->status |
fc7ec1d9 |
324 | |
910410b8 |
325 | Sets or returns the HTTP status. |
fc7ec1d9 |
326 | |
327 | $c->response->status(404); |
aa9e8261 |
328 | |
329 | $res->code is an alias for this, to match HTTP::Response->code. |
b0ad47c1 |
330 | |
b5ecfcf0 |
331 | =head2 $res->write( $data ) |
fbcc39ad |
332 | |
333 | Writes $data to the output stream. |
334 | |
e37f92f5 |
335 | =head2 $res->write_fh |
336 | |
337 | Returns a PSGI $writer object that has two methods, write and close. You can |
338 | close over this object for asynchronous and nonblocking applications. For |
339 | example (assuming you are using a supporting server, like L<Twiggy> |
340 | |
341 | package AsyncExample::Controller::Root; |
342 | |
343 | use Moose; |
344 | |
345 | BEGIN { extends 'Catalyst::Controller' } |
346 | |
347 | sub prepare_cb { |
348 | my $write_fh = pop; |
349 | return sub { |
350 | my $message = shift; |
351 | $write_fh->write("Finishing: $message\n"); |
352 | $write_fh->close; |
353 | }; |
354 | } |
355 | |
356 | sub anyevent :Local :Args(0) { |
357 | my ($self, $c) = @_; |
358 | my $cb = $self->prepare_cb($c->res->write_fh); |
359 | |
360 | my $watcher; |
361 | $watcher = AnyEvent->timer( |
362 | after => 5, |
363 | cb => sub { |
364 | $cb->(scalar localtime); |
365 | undef $watcher; # cancel circular-ref |
366 | }); |
367 | } |
368 | |
e4cc83b2 |
369 | =head2 $res->print( @data ) |
370 | |
371 | Prints @data to the output stream, separated by $,. This lets you pass |
372 | the response object to functions that want to write to an L<IO::Handle>. |
373 | |
8738b8fe |
374 | =head2 $self->finalize_headers($c) |
375 | |
376 | Writes headers to response if not already written |
377 | |
e67f0874 |
378 | =head2 from_psgi_response |
379 | |
380 | Given a PSGI response (either three element ARRAY reference OR coderef expecting |
381 | a $responder) set the response from it. |
382 | |
383 | Properly supports streaming and delayed response and / or async IO if running |
384 | under an expected event loop. |
385 | |
386 | Example: |
387 | |
388 | package MyApp::Web::Controller::Test; |
389 | |
390 | use base 'Catalyst::Controller'; |
391 | use Plack::App::Directory; |
392 | |
393 | |
394 | my $app = Plack::App::Directory->new({ root => "/path/to/htdocs" }) |
395 | ->to_app; |
396 | |
397 | sub myaction :Local Args { |
398 | my ($self, $c) = @_; |
faa1bcff |
399 | $c->res->from_psgi_response($app->($c->req->env)); |
e67f0874 |
400 | } |
401 | |
402 | Please note this does not attempt to map or nest your PSGI application under |
4f4d49e2 |
403 | the Controller and Action namespace or path. |
e67f0874 |
404 | |
faa02805 |
405 | =head2 DEMOLISH |
406 | |
407 | Ensures that the response is flushed and closed at the end of the |
408 | request. |
409 | |
410 | =head2 meta |
411 | |
412 | Provided by Moose |
413 | |
e4cc83b2 |
414 | =cut |
415 | |
416 | sub print { |
417 | my $self = shift; |
418 | my $data = shift; |
419 | |
420 | defined $self->write($data) or return; |
421 | |
422 | for (@_) { |
423 | defined $self->write($,) or return; |
424 | defined $self->write($_) or return; |
425 | } |
fe3083a8 |
426 | defined $self->write($\) or return; |
b0ad47c1 |
427 | |
e4cc83b2 |
428 | return 1; |
429 | } |
430 | |
910410b8 |
431 | =head1 AUTHORS |
fc7ec1d9 |
432 | |
2f381252 |
433 | Catalyst Contributors, see Catalyst.pm |
fc7ec1d9 |
434 | |
435 | =head1 COPYRIGHT |
436 | |
b0ad47c1 |
437 | This library is free software. You can redistribute it and/or modify |
61b1e958 |
438 | it under the same terms as Perl itself. |
fc7ec1d9 |
439 | |
440 | =cut |
441 | |
e5ecd5bc |
442 | __PACKAGE__->meta->make_immutable; |
443 | |
fc7ec1d9 |
444 | 1; |