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 use Scalar::Util 'blessed';
   8
   9 with 'MooseX::Emulate::Class::Accessor::Fast';
  10
  11 has _response_cb => (
  12     is      => 'ro',
  13     isa     => 'CodeRef',
  14     writer  => '_set_response_cb',
  15     clearer => '_clear_response_cb',
  16     predicate => '_has_response_cb',
  17 );
  18
  19 subtype 'Catalyst::Engine::Types::Writer',
  20     as duck_type([qw(write close)]);
  21
  22 has _writer => (
  23     is      => 'ro',
  24     isa     => 'Catalyst::Engine::Types::Writer', #Pointless since we control how this is built
  25     #writer  => '_set_writer', Now that its lazy I think this is safe to remove
  26     clearer => '_clear_writer',
  27     predicate => '_has_writer',
  28     lazy      => 1,
  29     builder => '_build_writer',
  30 );
  31
  32 sub _build_writer {
  33     my $self = shift;
  34
  35     ## These two lines are probably crap now...
  36     $self->_context->finalize_headers unless
  37       $self->finalized_headers;
  38
  39     my @headers;
  40     $self->headers->scan(sub { push @headers, @_ });
  41
  42     my $writer = $self->_response_cb->([ $self->status, \@headers ]);
  43     $self->_clear_response_cb;
  44
  45     return $writer;
  46 }
  47
  48 has write_fh => (
  49   is=>'ro',
  50   predicate=>'_has_write_fh',
  51   lazy=>1,
  52   builder=>'_build_write_fh',
  53 );
  54
  55 sub _build_write_fh { shift ->_writer }
  56
  57 sub DEMOLISH {
  58   my $self = shift;
  59   return if $self->_has_write_fh;
  60   if($self->_has_writer) {
  61     $self->_writer->close
  62   }
  63 }
  64
  65 has cookies   => (is => 'rw', default => sub { {} });
  66 has body      => (is => 'rw', default => undef);
  67 sub has_body { defined($_[0]->body) }
  68
  69 has location  => (is => 'rw');
  70 has status    => (is => 'rw', default => 200);
  71 has finalized_headers => (is => 'rw', default => 0);
  72 has headers   => (
  73   is      => 'rw',
  74   isa => 'HTTP::Headers',
  75   handles => [qw(content_encoding content_length content_type header)],
  76   default => sub { HTTP::Headers->new() },
  77   required => 1,
  78   lazy => 1,
  79 );
  80 has _context => (
  81   is => 'rw',
  82   weak_ref => 1,
  83   clearer => '_clear_context',
  84 );
  85
  86 before [qw(status headers content_encoding content_length content_type header)] => sub {
  87   my $self = shift;
  88
  89   $self->_context->log->warn(
  90     "Useless setting a header value after finalize_headers called." .
  91     " Not what you want." )
  92       if ( $self->finalized_headers && @_ );
  93 };
  94
  95 sub output { shift->body(@_) }
  96
  97 sub code   { shift->status(@_) }
  98
  99 sub write {
 100     my ( $self, $buffer ) = @_;
 101
 102     # Finalize headers if someone manually writes output
 103     $self->_context->finalize_headers unless $self->finalized_headers;
 104
 105     $buffer = q[] unless defined $buffer;
 106
 107     my $len = length($buffer);
 108     $self->_writer->write($buffer);
 109
 110     return $len;
 111 }
 112
 113 sub finalize_headers {
 114     my ($self) = @_;
 115     return;
 116 }
 117
 118 sub from_psgi_response {
 119     my ($self, $psgi_res) = @_;
 120     if(blessed($psgi_res) && $psgi_res->can('as_psgi')) {
 121       $psgi_res = $psgi_res->as_psgi;
 122     }
 123     if(ref $psgi_res eq 'ARRAY') {
 124         my ($status, $headers, $body) = @$psgi_res;
 125         $self->status($status);
 126         $self->headers(HTTP::Headers->new(@$headers));
 127         $self->body($body);
 128     } elsif(ref $psgi_res eq 'CODE') {
 129         $psgi_res->(sub {
 130             my $response = shift;
 131             my ($status, $headers, $maybe_body) = @$response;
 132             $self->status($status);
 133             $self->headers(HTTP::Headers->new(@$headers));
 134             if(defined $maybe_body) {
 135                 $self->body($maybe_body);
 136             } else {
 137                 return $self->write_fh;
 138             }
 139         });
 140      } else {
 141         die "You can't set a Catalyst response from that, expect a valid PSGI response";
 142     }
 143 }
 144
 145 =head1 NAME
 146
 147 Catalyst::Response - stores output responding to the current client request
 148
 149 =head1 SYNOPSIS
 150
 151     $res = $c->response;
 152     $res->body;
 153     $res->code;
 154     $res->content_encoding;
 155     $res->content_length;
 156     $res->content_type;
 157     $res->cookies;
 158     $res->header;
 159     $res->headers;
 160     $res->output;
 161     $res->redirect;
 162     $res->status;
 163     $res->write;
 164
 165 =head1 DESCRIPTION
 166
 167 This is the Catalyst Response class, which provides methods for responding to
 168 the current client request. The appropriate L<Catalyst::Engine> for your environment
 169 will turn the Catalyst::Response into a HTTP Response and return it to the client.
 170
 171 =head1 METHODS
 172
 173 =head2 $res->body( $text | $fh | $iohandle_object )
 174
 175     $c->response->body('Catalyst rocks!');
 176
 177 Sets or returns the output (text or binary data). If you are returning a large body,
 178 you might want to use a L<IO::Handle> type of object (Something that implements the read method
 179 in the same fashion), or a filehandle GLOB. Catalyst
 180 will write it piece by piece into the response.
 181
 182 When using a L<IO::Handle> type of object and no content length has been
 183 already set in the response headers Catalyst will make a reasonable attempt
 184 to determine the size of the Handle. Depending on the implementation of your
 185 handle object, setting the content length may fail. If it is at all possible
 186 for you to determine the content length of your handle object,
 187 it is recommended that you set the content length in the response headers
 188 yourself, which will be respected and sent by Catalyst in the response.
 189
 190 Please note that the object needs to implement C<getline>, not just
 191 C<read>.
 192
 193 Starting from version 5.90060, when using an L<IO::Handle> object, you
 194 may want to use L<Plack::Middleware::XSendfile>, to delegate the
 195 actual serving to the frontend server. To do so, you need to pass to
 196 C<body> an IO object with a C<path> method. This can be achieved in
 197 two ways.
 198
 199 Either using L<Plack::Util>:
 200
 201   my $fh = IO::File->new($file, 'r');
 202   Plack::Util::set_io_path($fh, $file);
 203
 204 Or using L<IO::File::WithPath>
 205
 206   my $fh = IO::File::WithPath->new($file, 'r');
 207
 208 And then passing the filehandle to body and setting headers, if needed.
 209
 210   $c->response->body($fh);
 211   $c->response->headers->content_type('text/plain');
 212   $c->response->headers->content_length(-s $file);
 213   $c->response->headers->last_modified((stat($file))[9]);
 214
 215 L<Plack::Middleware::XSendfile> can be loaded in the application so:
 216
 217  __PACKAGE__->config(
 218      psgi_middleware => [
 219          'XSendfile',
 220          # other middlewares here...
 221         ],
 222  );
 223
 224 B<Beware> that loading the middleware without configuring the
 225 webserver to set the request header C<X-Sendfile-Type> to a supported
 226 type (C<X-Accel-Redirect> for nginx, C<X-Sendfile> for Apache and
 227 Lighttpd), could lead to the disclosure of private paths to malicious
 228 clients setting that header.
 229
 230 Nginx needs the additional X-Accel-Mapping header to be set in the
 231 webserver configuration, so the middleware will replace the absolute
 232 path of the IO object with the internal nginx path. This is also
 233 useful to prevent a buggy app to server random files from the
 234 filesystem, as it's an internal redirect.
 235
 236 An nginx configuration for FastCGI could look so:
 237
 238  server {
 239      server_name example.com;
 240      root /my/app/root;
 241      location /private/repo/ {
 242          internal;
 243          alias /my/app/repo/;
 244      }
 245      location /private/staging/ {
 246          internal;
 247          alias /my/app/staging/;
 248      }
 249      location @proxy {
 250          include /etc/nginx/fastcgi_params;
 251          fastcgi_param SCRIPT_NAME '';
 252          fastcgi_param PATH_INFO   $fastcgi_script_name;
 253          fastcgi_param HTTP_X_SENDFILE_TYPE X-Accel-Redirect;
 254          fastcgi_param HTTP_X_ACCEL_MAPPING /my/app=/private;
 255          fastcgi_pass  unix:/my/app/run/app.sock;
 256     }
 257  }
 258
 259 In the example above, passing filehandles with a local path matching
 260 /my/app/staging or /my/app/repo will be served by nginx. Passing paths
 261 with other locations will lead to an internal server error.
 262
 263 Setting the body to a filehandle without the C<path> method bypasses
 264 the middleware completely.
 265
 266 For Apache and Lighttpd, the mapping doesn't apply and setting the
 267 X-Sendfile-Type is enough.
 268
 269 =head2 $res->has_body
 270
 271 Predicate which returns true when a body has been set.
 272
 273 =head2 $res->code
 274
 275 Alias for $res->status.
 276
 277 =head2 $res->content_encoding
 278
 279 Shortcut for $res->headers->content_encoding.
 280
 281 =head2 $res->content_length
 282
 283 Shortcut for $res->headers->content_length.
 284
 285 =head2 $res->content_type
 286
 287 Shortcut for $res->headers->content_type.
 288
 289 This value is typically set by your view or plugin. For example,
 290 L<Catalyst::Plugin::Static::Simple> will guess the mime type based on the file
 291 it found, while L<Catalyst::View::TT> defaults to C<text/html>.
 292
 293 =head2 $res->cookies
 294
 295 Returns a reference to a hash containing cookies to be set. The keys of the
 296 hash are the cookies' names, and their corresponding values are hash
 297 references used to construct a L<CGI::Simple::Cookie> object.
 298
 299     $c->response->cookies->{foo} = { value => '123' };
 300
 301 The keys of the hash reference on the right correspond to the L<CGI::Simple::Cookie>
 302 parameters of the same name, except they are used without a leading dash.
 303 Possible parameters are:
 304
 305 =over
 306
 307 =item value
 308
 309 =item expires
 310
 311 =item domain
 312
 313 =item path
 314
 315 =item secure
 316
 317 =item httponly
 318
 319 =back
 320
 321 =head2 $res->header
 322
 323 Shortcut for $res->headers->header.
 324
 325 =head2 $res->headers
 326
 327 Returns an L<HTTP::Headers> object, which can be used to set headers.
 328
 329     $c->response->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
 330
 331 =head2 $res->output
 332
 333 Alias for $res->body.
 334
 335 =head2 $res->redirect( $url, $status )
 336
 337 Causes the response to redirect to the specified URL. The default status is
 338 C<302>.
 339
 340     $c->response->redirect( 'http://slashdot.org' );
 341     $c->response->redirect( 'http://slashdot.org', 307 );
 342
 343 This is a convenience method that sets the Location header to the
 344 redirect destination, and then sets the response status.  You will
 345 want to C< return > or C<< $c->detach() >> to interrupt the normal
 346 processing flow if you want the redirect to occur straight away.
 347
 348 B<Note:> do not give a relative URL as $url, i.e: one that is not fully
 349 qualified (= C<http://...>, etc.) or that starts with a slash
 350 (= C</path/here>). While it may work, it is not guaranteed to do the right
 351 thing and is not a standard behaviour. You may opt to use uri_for() or
 352 uri_for_action() instead.
 353
 354 B<Note:> If $url is an object that does ->as_string (such as L<URI>, which is
 355 what you get from ->uri_for) we automatically call that to stringify.  This
 356 should ease the common case usage
 357
 358     return $c->res->redirect( $c->uri_for(...));
 359
 360 =cut
 361
 362 sub redirect {
 363     my $self = shift;
 364
 365     if (@_) {
 366         my $location = shift;
 367         my $status   = shift || 302;
 368
 369         if(blessed($location) && $location->can('as_string')) {
 370             $location = $location->as_string;
 371         }
 372
 373         $self->location($location);
 374         $self->status($status);
 375     }
 376
 377     return $self->location;
 378 }
 379
 380 =head2 $res->location
 381
 382 Sets or returns the HTTP 'Location'.
 383
 384 =head2 $res->status
 385
 386 Sets or returns the HTTP status.
 387
 388     $c->response->status(404);
 389
 390 $res->code is an alias for this, to match HTTP::Response->code.
 391
 392 =head2 $res->write( $data )
 393
 394 Writes $data to the output stream.
 395
 396 =head2 $res->write_fh
 397
 398 Returns a PSGI $writer object that has two methods, write and close.  You can
 399 close over this object for asynchronous and nonblocking applications.  For
 400 example (assuming you are using a supporting server, like L<Twiggy>
 401
 402     package AsyncExample::Controller::Root;
 403
 404     use Moose;
 405
 406     BEGIN { extends 'Catalyst::Controller' }
 407
 408     sub prepare_cb {
 409       my $write_fh = pop;
 410       return sub {
 411         my $message = shift;
 412         $write_fh->write("Finishing: $message\n");
 413         $write_fh->close;
 414       };
 415     }
 416
 417     sub anyevent :Local :Args(0) {
 418       my ($self, $c) = @_;
 419       my $cb = $self->prepare_cb($c->res->write_fh);
 420
 421       my $watcher;
 422       $watcher = AnyEvent->timer(
 423         after => 5,
 424         cb => sub {
 425           $cb->(scalar localtime);
 426           undef $watcher; # cancel circular-ref
 427         });
 428     }
 429
 430 =head2 $res->print( @data )
 431
 432 Prints @data to the output stream, separated by $,.  This lets you pass
 433 the response object to functions that want to write to an L<IO::Handle>.
 434
 435 =head2 $self->finalize_headers($c)
 436
 437 Writes headers to response if not already written
 438
 439 =head2 from_psgi_response
 440
 441 Given a PSGI response (either three element ARRAY reference OR coderef expecting
 442 a $responder) set the response from it.
 443
 444 Properly supports streaming and delayed response and / or async IO if running
 445 under an expected event loop.
 446
 447 If passed an object, will expect that object to do a method C<as_psgi>.
 448
 449 Example:
 450
 451     package MyApp::Web::Controller::Test;
 452
 453     use base 'Catalyst::Controller';
 454     use Plack::App::Directory;
 455
 456
 457     my $app = Plack::App::Directory->new({ root => "/path/to/htdocs" })
 458       ->to_app;
 459
 460     sub myaction :Local Args {
 461       my ($self, $c) = @_;
 462       $c->res->from_psgi_response($app->($c->req->env));
 463     }
 464
 465 Please note this does not attempt to map or nest your PSGI application under
 466 the Controller and Action namespace or path.
 467
 468 =head2 DEMOLISH
 469
 470 Ensures that the response is flushed and closed at the end of the
 471 request.
 472
 473 =head2 meta
 474
 475 Provided by Moose
 476
 477 =cut
 478
 479 sub print {
 480     my $self = shift;
 481     my $data = shift;
 482
 483     defined $self->write($data) or return;
 484
 485     for (@_) {
 486         defined $self->write($,) or return;
 487         defined $self->write($_) or return;
 488     }
 489     defined $self->write($\) or return;
 490
 491     return 1;
 492 }
 493
 494 =head1 AUTHORS
 495
 496 Catalyst Contributors, see Catalyst.pm
 497
 498 =head1 COPYRIGHT
 499
 500 This library is free software. You can redistribute it and/or modify
 501 it under the same terms as Perl itself.
 502
 503 =cut
 504
 505 __PACKAGE__->meta->make_immutable;
 506
 507 1;