lib/Catalyst/Response.pm

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