merged and resolved conflicts from stable
[catagits/Catalyst-Runtime.git] / lib / Catalyst / Response.pm
index f049ebf..28cf7b7 100644 (file)
@@ -4,9 +4,20 @@ use Moose;
 use HTTP::Headers;
 use Moose::Util::TypeConstraints;
 use namespace::autoclean;
+use Scalar::Util 'blessed';
+use Catalyst::Response::Writer;
+use Catalyst::Utils ();
 
 with 'MooseX::Emulate::Class::Accessor::Fast';
 
+our $DEFAULT_ENCODE_CONTENT_TYPE_MATCH = qr{text|xml$|javascript$};
+
+has encodable_content_type => (
+    is => 'rw',
+    required => 1,
+    default => sub { $DEFAULT_ENCODE_CONTENT_TYPE_MATCH }
+);
+
 has _response_cb => (
     is      => 'ro',
     isa     => 'CodeRef', 
@@ -51,7 +62,17 @@ has write_fh => (
   builder=>'_build_write_fh',
 );
 
-sub _build_write_fh { shift ->_writer }
+sub _build_write_fh {
+  my $writer = $_[0]->_writer; # We need to get the finalize headers side effect...
+  my $requires_encoding = $_[0]->encodable_response;
+  my %fields = (
+    _writer => $writer,
+    _encoding => $_[0]->_context->encoding,
+    _requires_encoding => $requires_encoding,
+  );
+
+  return bless \%fields, 'Catalyst::Response::Writer';
+}
 
 sub DEMOLISH {
   my $self = shift;
@@ -71,7 +92,7 @@ has finalized_headers => (is => 'rw', default => 0);
 has headers   => (
   is      => 'rw',
   isa => 'HTTP::Headers',
-  handles => [qw(content_encoding content_length content_type header)],
+  handles => [qw(content_encoding content_length content_type content_type_charset header)],
   default => sub { HTTP::Headers->new() },
   required => 1,
   lazy => 1,
@@ -86,9 +107,9 @@ before [qw(status headers content_encoding content_length content_type header)]
   my $self = shift;
 
   $self->_context->log->warn( 
-    "Useless setting a header value after finalize_headers called." .
+    "Useless setting a header value after finalize_headers and the response callback has been called." .
     " Not what you want." )
-      if ( $self->finalized_headers && @_ );
+      if ( $self->finalized_headers && !$self->_has_response_cb && @_ );
 };
 
 sub output { shift->body(@_) }
@@ -103,6 +124,10 @@ sub write {
 
     $buffer = q[] unless defined $buffer;
 
+    if($self->encodable_response) {
+      $buffer = $self->_context->encoding->encode( $buffer, $self->_context->_encode_check )
+    }
+
     my $len = length($buffer);
     $self->_writer->write($buffer);
 
@@ -116,6 +141,9 @@ sub finalize_headers {
 
 sub from_psgi_response {
     my ($self, $psgi_res) = @_;
+    if(blessed($psgi_res) && $psgi_res->can('as_psgi')) {
+      $psgi_res = $psgi_res->as_psgi;
+    }
     if(ref $psgi_res eq 'ARRAY') {
         my ($status, $headers, $body) = @$psgi_res;
         $self->status($status);
@@ -175,6 +203,22 @@ you might want to use a L<IO::Handle> type of object (Something that implements
 in the same fashion), or a filehandle GLOB. Catalyst
 will write it piece by piece into the response.
 
+If you are using a filehandle as the body response you are responsible for
+making sure it comforms to the L<PSGI> specification with regards to content
+encoding.  Unlike with scalar body values or when using the streaming interfaces
+we currently do not attempt to normalize and encode your filehandle.  In general
+this means you should be sure to be sending bytes not UTF8 decoded multibyte
+characters.
+
+Most of the time when you do:
+
+    open(my $fh, '<:raw', $path);
+
+You should be fine.  If you open a filehandle with a L<PerlIO> layer you probably
+are not fine.  You can usually fix this by explicitly using binmode to set
+the IOLayer to :raw.  Its possible future versions of L<Catalyst> will try to
+'do the right thing'.
+
 When using a L<IO::Handle> type of object and no content length has been
 already set in the response headers Catalyst will make a reasonable attempt
 to determine the size of the Handle. Depending on the implementation of your
@@ -286,6 +330,10 @@ This value is typically set by your view or plugin. For example,
 L<Catalyst::Plugin::Static::Simple> will guess the mime type based on the file
 it found, while L<Catalyst::View::TT> defaults to C<text/html>.
 
+=head2 $res->content_type_charset
+
+Shortcut for $res->headers->content_type_charset;
+
 =head2 $res->cookies
 
 Returns a reference to a hash containing cookies to be set. The keys of the
@@ -347,6 +395,12 @@ qualified (= C<http://...>, etc.) or that starts with a slash
 thing and is not a standard behaviour. You may opt to use uri_for() or
 uri_for_action() instead.
 
+B<Note:> If $url is an object that does ->as_string (such as L<URI>, which is
+what you get from ->uri_for) we automatically call that to stringify.  This
+should ease the common case usage
+
+    return $c->res->redirect( $c->uri_for(...));
+
 =cut
 
 sub redirect {
@@ -356,6 +410,10 @@ sub redirect {
         my $location = shift;
         my $status   = shift || 302;
 
+        if(blessed($location) && $location->can('as_string')) {
+            $location = $location->as_string;
+        }
+
         $self->location($location);
         $self->status($status);
     }
@@ -377,13 +435,39 @@ $res->code is an alias for this, to match HTTP::Response->code.
 
 =head2 $res->write( $data )
 
-Writes $data to the output stream.
+Writes $data to the output stream.  Calling this method will finalize your
+headers and send the headers and status code response to the client (so changing
+them afterwards is a waste... be sure to set your headers correctly first).
+
+You may call this as often as you want throughout your response cycle.  You may
+even set a 'body' afterward.  So for example you might write your HTTP headers
+and the HEAD section of your document and then set the body from a template
+driven from a database.  In some cases this can seem to the client as if you had
+a faster overall response (but note that unless your server support chunked
+body your content is likely to get queued anyway (L<Starman> and most other 
+http 1.1 webservers support this).
+
+If there is an encoding set, we encode each line of the response (the default
+encoding is UTF-8).
 
 =head2 $res->write_fh
 
-Returns a PSGI $writer object that has two methods, write and close.  You can
-close over this object for asynchronous and nonblocking applications.  For
-example (assuming you are using a supporting server, like L<Twiggy>
+Returns an instance of L<Catalyst::Response::Writer>, which is a lightweight
+decorator over the PSGI C<$writer> object (see L<PSGI.pod\Delayed-Response-and-Streaming-Body>).
+
+In addition to proxying the C<write> and C<close> method from the underlying PSGI
+writer, this proxy object knows any application wide encoding, and provides a method
+C<write_encoded> that will properly encode your written lines based upon your
+encoding settings.  By default in L<Catalyst> responses are UTF-8 encoded and this
+is the encoding used if you respond via C<write_encoded>.  If you want to handle
+encoding yourself, you can use the C<write> method directly.
+
+Encoding only applies to content types for which it matters.  Currently the following
+content types are assumed to need encoding: text (including HTML), xml and javascript.
+
+We provide access to this object so that you can properly close over it for use in
+asynchronous and nonblocking applications.  For example (assuming you are using a supporting
+server, like L<Twiggy>:
 
     package AsyncExample::Controller::Root;
 
@@ -413,6 +497,10 @@ example (assuming you are using a supporting server, like L<Twiggy>
         });
     }
 
+Like the 'write' method, calling this will finalize headers. Unlike 'write' when you
+can this it is assumed you are taking control of the response so the body is never
+finalized (there isn't one anyway) and you need to call the close method.
+
 =head2 $res->print( @data )
 
 Prints @data to the output stream, separated by $,.  This lets you pass
@@ -430,6 +518,8 @@ a $responder) set the response from it.
 Properly supports streaming and delayed response and / or async IO if running
 under an expected event loop.
 
+If passed an object, will expect that object to do a method C<as_psgi>.
+
 Example:
 
     package MyApp::Web::Controller::Test;
@@ -449,6 +539,67 @@ Example:
 Please note this does not attempt to map or nest your PSGI application under
 the Controller and Action namespace or path.  
 
+=head2 encodable_content_type
+
+This is a regular expression used to determine of the current content type
+should be considered encodable.  Currently we apply default encoding (usually
+UTF8) to text type contents.  Here's the default regular expression:
+
+This would match content types like:
+
+    text/plain
+    text/html
+    text/xml
+    application/javascript
+    application/xml
+    application/vnd.user+xml
+
+B<NOTE>: We don't encode JSON content type responses by default since most
+of the JSON serializers that are commonly used for this task will do so
+automatically and we don't want to double encode.  If you are not using a
+tool like L<JSON> to produce JSON type content, (for example you are using
+a template system, or creating the strings manually) you will need to either
+encoding the body yourself:
+
+    $c->response->body( $c->encoding->encode( $body, $c->_encode_check ) );
+
+Or you can alter the regular expression using this attribute.
+
+=head2 encodable_response
+
+Given a L<Catalyst::Response> return true if its one that can be encoded.  
+
+     make sure there is an encoding set on the response
+     make sure the content type is encodable
+     make sure no content type charset has been already set to something different from the global encoding
+     make sure no content encoding is present.
+
+Note this does not inspect a body since we do allow automatic encoding on streaming
+type responses.
+
+=cut
+
+sub encodable_response {
+  my ($self) = @_;
+  return 0 unless $self->_context; # Cases like returning a HTTP Exception response you don't have a context here...
+  return 0 unless $self->_context->encoding;
+
+  my $has_manual_charset = 0;
+  if(my $charset = $self->content_type_charset) {
+    $has_manual_charset = (uc($charset) ne uc($self->_context->encoding->mime_name)) ? 1:0;
+  }
+
+  if(
+      ($self->content_type =~ m/${\$self->encodable_content_type}/) and
+      (!$has_manual_charset) and
+      (!$self->content_encoding || $self->content_encoding eq 'identity' )
+  ) { 
+    return 1;
+  } else {
+    return 0;
+  }
+}
+
 =head2 DEMOLISH
 
 Ensures that the response is flushed and closed at the end of the