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     $buffer = $self->_context->encoding->encode( $buffer, $self->_context->_encode_check );
 107
 108     my $len = length($buffer);
 109     $self->_writer->write($buffer);
 110
 111     return $len;
 112 }
 113
 114 sub finalize_headers {
 115     my ($self) = @_;
 116     return;
 117 }
 118
 119 sub from_psgi_response {
 120     my ($self, $psgi_res) = @_;
 121     if(blessed($psgi_res) && $psgi_res->can('as_psgi')) {
 122       $psgi_res = $psgi_res->as_psgi;
 123     }
 124     if(ref $psgi_res eq 'ARRAY') {
 125         my ($status, $headers, $body) = @$psgi_res;
 126         $self->status($status);
 127         $self->headers(HTTP::Headers->new(@$headers));
 128         $self->body($body);
 129     } elsif(ref $psgi_res eq 'CODE') {
 130         $psgi_res->(sub {
 131             my $response = shift;
 132             my ($status, $headers, $maybe_body) = @$response;
 133             $self->status($status);
 134             $self->headers(HTTP::Headers->new(@$headers));
 135             if(defined $maybe_body) {
 136                 $self->body($maybe_body);
 137             } else {
 138                 return $self->write_fh;
 139             }
 140         });
 141      } else {
 142         die "You can't set a Catalyst response from that, expect a valid PSGI response";
 143     }
 144 }
 145
 146 =head1 NAME
 147
 148 Catalyst::Response - stores output responding to the current client request
 149
 150 =head1 SYNOPSIS
 151
 152     $res = $c->response;
 153     $res->body;
 154     $res->code;
 155     $res->content_encoding;
 156     $res->content_length;
 157     $res->content_type;
 158     $res->cookies;
 159     $res->header;
 160     $res->headers;
 161     $res->output;
 162     $res->redirect;
 163     $res->status;
 164     $res->write;
 165
 166 =head1 DESCRIPTION
 167
 168 This is the Catalyst Response class, which provides methods for responding to
 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.
 171
 172 =head1 METHODS
 173
 174 =head2 $res->body( $text | $fh | $iohandle_object )
 175
 176     $c->response->body('Catalyst rocks!');
 177
 178 Sets or returns the output (text or binary data). If you are returning a large body,
 179 you might want to use a L<IO::Handle> type of object (Something that implements the read method
 180 in the same fashion), or a filehandle GLOB. Catalyst
 181 will write it piece by piece into the response.
 182
 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
 187 for you to determine the content length of your handle object,
 188 it is recommended that you set the content length in the response headers
 189 yourself, which will be respected and sent by Catalyst in the response.
 190
 191 Please note that the object needs to implement C<getline>, not just
 192 C<read>.
 193
 194 Starting from version 5.90060, when using an L<IO::Handle> object, you
 195 may want to use L<Plack::Middleware::XSendfile>, to delegate the
 196 actual serving to the frontend server. To do so, you need to pass to
 197 C<body> an IO object with a C<path> method. This can be achieved in
 198 two ways.
 199
 200 Either using L<Plack::Util>:
 201
 202   my $fh = IO::File->new($file, 'r');
 203   Plack::Util::set_io_path($fh, $file);
 204
 205 Or using L<IO::File::WithPath>
 206
 207   my $fh = IO::File::WithPath->new($file, 'r');
 208
 209 And then passing the filehandle to body and setting headers, if needed.
 210
 211   $c->response->body($fh);
 212   $c->response->headers->content_type('text/plain');
 213   $c->response->headers->content_length(-s $file);
 214   $c->response->headers->last_modified((stat($file))[9]);
 215
 216 L<Plack::Middleware::XSendfile> can be loaded in the application so:
 217
 218  __PACKAGE__->config(
 219      psgi_middleware => [
 220          'XSendfile',
 221          # other middlewares here...
 222         ],
 223  );
 224
 225 B<Beware> that loading the middleware without configuring the
 226 webserver to set the request header C<X-Sendfile-Type> to a supported
 227 type (C<X-Accel-Redirect> for nginx, C<X-Sendfile> for Apache and
 228 Lighttpd), could lead to the disclosure of private paths to malicious
 229 clients setting that header.
 230
 231 Nginx needs the additional X-Accel-Mapping header to be set in the
 232 webserver configuration, so the middleware will replace the absolute
 233 path of the IO object with the internal nginx path. This is also
 234 useful to prevent a buggy app to server random files from the
 235 filesystem, as it's an internal redirect.
 236
 237 An nginx configuration for FastCGI could look so:
 238
 239  server {
 240      server_name example.com;
 241      root /my/app/root;
 242      location /private/repo/ {
 243          internal;
 244          alias /my/app/repo/;
 245      }
 246      location /private/staging/ {
 247          internal;
 248          alias /my/app/staging/;
 249      }
 250      location @proxy {
 251          include /etc/nginx/fastcgi_params;
 252          fastcgi_param SCRIPT_NAME '';
 253          fastcgi_param PATH_INFO   $fastcgi_script_name;
 254          fastcgi_param HTTP_X_SENDFILE_TYPE X-Accel-Redirect;
 255          fastcgi_param HTTP_X_ACCEL_MAPPING /my/app=/private;
 256          fastcgi_pass  unix:/my/app/run/app.sock;
 257     }
 258  }
 259
 260 In the example above, passing filehandles with a local path matching
 261 /my/app/staging or /my/app/repo will be served by nginx. Passing paths
 262 with other locations will lead to an internal server error.
 263
 264 Setting the body to a filehandle without the C<path> method bypasses
 265 the middleware completely.
 266
 267 For Apache and Lighttpd, the mapping doesn't apply and setting the
 268 X-Sendfile-Type is enough.
 269
 270 =head2 $res->has_body
 271
 272 Predicate which returns true when a body has been set.
 273
 274 =head2 $res->code
 275
 276 Alias for $res->status.
 277
 278 =head2 $res->content_encoding
 279
 280 Shortcut for $res->headers->content_encoding.
 281
 282 =head2 $res->content_length
 283
 284 Shortcut for $res->headers->content_length.
 285
 286 =head2 $res->content_type
 287
 288 Shortcut for $res->headers->content_type.
 289
 290 This value is typically set by your view or plugin. For example,
 291 L<Catalyst::Plugin::Static::Simple> will guess the mime type based on the file
 292 it found, while L<Catalyst::View::TT> defaults to C<text/html>.
 293
 294 =head2 $res->cookies
 295
 296 Returns a reference to a hash containing cookies to be set. The keys of the
 297 hash are the cookies' names, and their corresponding values are hash
 298 references used to construct a L<CGI::Simple::Cookie> object.
 299
 300     $c->response->cookies->{foo} = { value => '123' };
 301
 302 The keys of the hash reference on the right correspond to the L<CGI::Simple::Cookie>
 303 parameters of the same name, except they are used without a leading dash.
 304 Possible parameters are:
 305
 306 =over
 307
 308 =item value
 309
 310 =item expires
 311
 312 =item domain
 313
 314 =item path
 315
 316 =item secure
 317
 318 =item httponly
 319
 320 =back
 321
 322 =head2 $res->header
 323
 324 Shortcut for $res->headers->header.
 325
 326 =head2 $res->headers
 327
 328 Returns an L<HTTP::Headers> object, which can be used to set headers.
 329
 330     $c->response->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
 331
 332 =head2 $res->output
 333
 334 Alias for $res->body.
 335
 336 =head2 $res->redirect( $url, $status )
 337
 338 Causes the response to redirect to the specified URL. The default status is
 339 C<302>.
 340
 341     $c->response->redirect( 'http://slashdot.org' );
 342     $c->response->redirect( 'http://slashdot.org', 307 );
 343
 344 This is a convenience method that sets the Location header to the
 345 redirect destination, and then sets the response status.  You will
 346 want to C< return > or C<< $c->detach() >> to interrupt the normal
 347 processing flow if you want the redirect to occur straight away.
 348
 349 B<Note:> do not give a relative URL as $url, i.e: one that is not fully
 350 qualified (= C<http://...>, etc.) or that starts with a slash
 351 (= C</path/here>). While it may work, it is not guaranteed to do the right
 352 thing and is not a standard behaviour. You may opt to use uri_for() or
 353 uri_for_action() instead.
 354
 355 B<Note:> If $url is an object that does ->as_string (such as L<URI>, which is
 356 what you get from ->uri_for) we automatically call that to stringify.  This
 357 should ease the common case usage
 358
 359     return $c->res->redirect( $c->uri_for(...));
 360
 361 =cut
 362
 363 sub redirect {
 364     my $self = shift;
 365
 366     if (@_) {
 367         my $location = shift;
 368         my $status   = shift || 302;
 369
 370         if(blessed($location) && $location->can('as_string')) {
 371             $location = $location->as_string;
 372         }
 373
 374         $self->location($location);
 375         $self->status($status);
 376     }
 377
 378     return $self->location;
 379 }
 380
 381 =head2 $res->location
 382
 383 Sets or returns the HTTP 'Location'.
 384
 385 =head2 $res->status
 386
 387 Sets or returns the HTTP status.
 388
 389     $c->response->status(404);
 390
 391 $res->code is an alias for this, to match HTTP::Response->code.
 392
 393 =head2 $res->write( $data )
 394
 395 Writes $data to the output stream.  Calling this method will finalize your
 396 headers and send the headers and status code response to the client (so changing
 397 them afterwards is a waste... be sure to set your headers correctly first).
 398
 399 You may call this as often as you want throughout your response cycle.  You may
 400 even set a 'body' afterward.  So for example you might write your HTTP headers
 401 and the HEAD section of your document and then set the body from a template
 402 driven from a database.  In some cases this can seem to the client as if you had
 403 a faster overall response (but note that unless your server support chunked
 404 body your content is likely to get queued anyway (L<Starman> and most other
 405 http 1.1 webservers support this).
 406
 407 If there is an encoding set, we encode each line of the response (the default
 408 encoding is UTF-8).
 409
 410 =head2 $res->write_fh
 411
 412 Returns a PSGI $writer object that has two methods, write and close.  You can
 413 close over this object for asynchronous and nonblocking applications.  For
 414 example (assuming you are using a supporting server, like L<Twiggy>
 415
 416     package AsyncExample::Controller::Root;
 417
 418     use Moose;
 419
 420     BEGIN { extends 'Catalyst::Controller' }
 421
 422     sub prepare_cb {
 423       my $write_fh = pop;
 424       return sub {
 425         my $message = shift;
 426         $write_fh->write("Finishing: $message\n");
 427         $write_fh->close;
 428       };
 429     }
 430
 431     sub anyevent :Local :Args(0) {
 432       my ($self, $c) = @_;
 433       my $cb = $self->prepare_cb($c->res->write_fh);
 434
 435       my $watcher;
 436       $watcher = AnyEvent->timer(
 437         after => 5,
 438         cb => sub {
 439           $cb->(scalar localtime);
 440           undef $watcher; # cancel circular-ref
 441         });
 442     }
 443
 444 Like the 'write' method, calling this will finalize headers. Unlike 'write' when you
 445 can this it is assumed you are taking control of the response so the body is never
 446 finalized (there isn't one anyway) and you need to call the close method.
 447
 448 =head2 $res->print( @data )
 449
 450 Prints @data to the output stream, separated by $,.  This lets you pass
 451 the response object to functions that want to write to an L<IO::Handle>.
 452
 453 =head2 $self->finalize_headers($c)
 454
 455 Writes headers to response if not already written
 456
 457 =head2 from_psgi_response
 458
 459 Given a PSGI response (either three element ARRAY reference OR coderef expecting
 460 a $responder) set the response from it.
 461
 462 Properly supports streaming and delayed response and / or async IO if running
 463 under an expected event loop.
 464
 465 If passed an object, will expect that object to do a method C<as_psgi>.
 466
 467 Example:
 468
 469     package MyApp::Web::Controller::Test;
 470
 471     use base 'Catalyst::Controller';
 472     use Plack::App::Directory;
 473
 474
 475     my $app = Plack::App::Directory->new({ root => "/path/to/htdocs" })
 476       ->to_app;
 477
 478     sub myaction :Local Args {
 479       my ($self, $c) = @_;
 480       $c->res->from_psgi_response($app->($c->req->env));
 481     }
 482
 483 Please note this does not attempt to map or nest your PSGI application under
 484 the Controller and Action namespace or path.
 485
 486 =head2 DEMOLISH
 487
 488 Ensures that the response is flushed and closed at the end of the
 489 request.
 490
 491 =head2 meta
 492
 493 Provided by Moose
 494
 495 =cut
 496
 497 sub print {
 498     my $self = shift;
 499     my $data = shift;
 500
 501     defined $self->write($data) or return;
 502
 503     for (@_) {
 504         defined $self->write($,) or return;
 505         defined $self->write($_) or return;
 506     }
 507     defined $self->write($\) or return;
 508
 509     return 1;
 510 }
 511
 512 =head1 AUTHORS
 513
 514 Catalyst Contributors, see Catalyst.pm
 515
 516 =head1 COPYRIGHT
 517
 518 This library is free software. You can redistribute it and/or modify
 519 it under the same terms as Perl itself.
 520
 521 =cut
 522
 523 __PACKAGE__->meta->make_immutable;
 524
 525 1;