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 =cut
 355
 356 sub redirect {
 357     my $self = shift;
 358
 359     if (@_) {
 360         my $location = shift;
 361         my $status   = shift || 302;
 362
 363         $self->location($location);
 364         $self->status($status);
 365     }
 366
 367     return $self->location;
 368 }
 369
 370 =head2 $res->location
 371
 372 Sets or returns the HTTP 'Location'.
 373
 374 =head2 $res->status
 375
 376 Sets or returns the HTTP status.
 377
 378     $c->response->status(404);
 379
 380 $res->code is an alias for this, to match HTTP::Response->code.
 381
 382 =head2 $res->write( $data )
 383
 384 Writes $data to the output stream.
 385
 386 =head2 $res->write_fh
 387
 388 Returns a PSGI $writer object that has two methods, write and close.  You can
 389 close over this object for asynchronous and nonblocking applications.  For
 390 example (assuming you are using a supporting server, like L<Twiggy>
 391
 392     package AsyncExample::Controller::Root;
 393
 394     use Moose;
 395
 396     BEGIN { extends 'Catalyst::Controller' }
 397
 398     sub prepare_cb {
 399       my $write_fh = pop;
 400       return sub {
 401         my $message = shift;
 402         $write_fh->write("Finishing: $message\n");
 403         $write_fh->close;
 404       };
 405     }
 406
 407     sub anyevent :Local :Args(0) {
 408       my ($self, $c) = @_;
 409       my $cb = $self->prepare_cb($c->res->write_fh);
 410
 411       my $watcher;
 412       $watcher = AnyEvent->timer(
 413         after => 5,
 414         cb => sub {
 415           $cb->(scalar localtime);
 416           undef $watcher; # cancel circular-ref
 417         });
 418     }
 419
 420 =head2 $res->print( @data )
 421
 422 Prints @data to the output stream, separated by $,.  This lets you pass
 423 the response object to functions that want to write to an L<IO::Handle>.
 424
 425 =head2 $self->finalize_headers($c)
 426
 427 Writes headers to response if not already written
 428
 429 =head2 from_psgi_response
 430
 431 Given a PSGI response (either three element ARRAY reference OR coderef expecting
 432 a $responder) set the response from it.
 433
 434 Properly supports streaming and delayed response and / or async IO if running
 435 under an expected event loop.
 436
 437 If passed an object, will expect that object to do a method C<as_psgi>.
 438
 439 Example:
 440
 441     package MyApp::Web::Controller::Test;
 442
 443     use base 'Catalyst::Controller';
 444     use Plack::App::Directory;
 445
 446
 447     my $app = Plack::App::Directory->new({ root => "/path/to/htdocs" })
 448       ->to_app;
 449
 450     sub myaction :Local Args {
 451       my ($self, $c) = @_;
 452       $c->res->from_psgi_response($app->($c->req->env));
 453     }
 454
 455 Please note this does not attempt to map or nest your PSGI application under
 456 the Controller and Action namespace or path.
 457
 458 =head2 DEMOLISH
 459
 460 Ensures that the response is flushed and closed at the end of the
 461 request.
 462
 463 =head2 meta
 464
 465 Provided by Moose
 466
 467 =cut
 468
 469 sub print {
 470     my $self = shift;
 471     my $data = shift;
 472
 473     defined $self->write($data) or return;
 474
 475     for (@_) {
 476         defined $self->write($,) or return;
 477         defined $self->write($_) or return;
 478     }
 479     defined $self->write($\) or return;
 480
 481     return 1;
 482 }
 483
 484 =head1 AUTHORS
 485
 486 Catalyst Contributors, see Catalyst.pm
 487
 488 =head1 COPYRIGHT
 489
 490 This library is free software. You can redistribute it and/or modify
 491 it under the same terms as Perl itself.
 492
 493 =cut
 494
 495 __PACKAGE__->meta->make_immutable;
 496
 497 1;