X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FResponse.pm;h=e558e4d0be81b706da08f0646880e04a9de1479e;hb=dd4530ecdc4684838d9c0e9dc00adebb6100b022;hp=b27da58ab1052d05ccd68dd7be7d19e4dacf05bf;hpb=d200092825d92139d59f660eaa895790442cdf8b;p=catagits%2FCatalyst-Runtime.git

diff --git a/lib/Catalyst/Response.pm b/lib/Catalyst/Response.pm
index b27da58..e558e4d 100644
--- a/lib/Catalyst/Response.pm
+++ b/lib/Catalyst/Response.pm
@@ -7,6 +7,7 @@ use namespace::autoclean;
 use Scalar::Util 'blessed';
 use Catalyst::Response::Writer;
 use Catalyst::Utils ();
+use Ref::Util qw(is_plain_arrayref is_plain_coderef);
 
 with 'MooseX::Emulate::Class::Accessor::Fast';
 
@@ -103,13 +104,25 @@ has _context => (
   clearer => '_clear_context',
 );
 
-before [qw(status headers content_encoding content_length content_type header)] => sub {
+before [qw(status headers content_encoding content_length content_type )] => sub {
   my $self = shift;
 
-  $self->_context->log->warn( 
+  $self->_context->log->warn(
     "Useless setting a header value after finalize_headers and the response callback has been called." .
-    " Not what you want." )
-      if ( $self->finalized_headers && !$self->_has_response_cb && @_ );
+    " Since we don't support tail headers this will not work as you might expect." )
+      if ( $self->_context && $self->finalized_headers && !$self->_has_response_cb && @_ );
+};
+
+# This has to be different since the first param to ->header is the header name and presumably
+# you should be able to request the header even after finalization, just not try to change it.
+before 'header' => sub {
+  my $self = shift;
+  my $header = shift;
+
+  $self->_context->log->warn(
+    "Useless setting a header value after finalize_headers and the response callback has been called." .
+    " Since we don't support tail headers this will not work as you might expect." )
+      if ( $self->_context && $self->finalized_headers && !$self->_has_response_cb && @_ );
 };
 
 sub output { shift->body(@_) }
@@ -134,6 +147,20 @@ sub write {
     return $len;
 }
 
+sub unencoded_write {
+    my ( $self, $buffer ) = @_;
+
+    # Finalize headers if someone manually writes output
+    $self->_context->finalize_headers unless $self->finalized_headers;
+
+    $buffer = q[] unless defined $buffer;
+
+    my $len = length($buffer);
+    $self->_writer->write($buffer);
+
+    return $len;
+}
+
 sub finalize_headers {
     my ($self) = @_;
     return;
@@ -144,19 +171,23 @@ sub from_psgi_response {
     if(blessed($psgi_res) && $psgi_res->can('as_psgi')) {
       $psgi_res = $psgi_res->as_psgi;
     }
-    if(ref $psgi_res eq 'ARRAY') {
+    if(is_plain_arrayref($psgi_res)) {
         my ($status, $headers, $body) = @$psgi_res;
         $self->status($status);
         $self->headers(HTTP::Headers->new(@$headers));
-        $self->body(join('', @$body));
-    } elsif(ref $psgi_res eq 'CODE') {
+        # Can be arrayref or filehandle...
+        if(defined $body) { # probably paranoia
+          is_plain_arrayref($body) ? $self->body(join('', @$body)) : $self->body($body);
+        }
+    } elsif(is_plain_coderef($psgi_res)) {
         $psgi_res->(sub {
             my $response = shift;
             my ($status, $headers, $maybe_body) = @$response;
             $self->status($status);
             $self->headers(HTTP::Headers->new(@$headers));
             if(defined $maybe_body) {
-                $self->body(join('', @$maybe_body));
+                # Can be arrayref or filehandle...
+                is_plain_arrayref($maybe_body) ? $self->body(join('', @$maybe_body)) : $self->body($maybe_body);
             } else {
                 return $self->write_fh;
             }
@@ -169,6 +200,8 @@ sub from_psgi_response {
     # to assume its properly encoded and NOT encode for this response.  Otherwise
     # We risk double encoding.
     if($self->content_type_charset) {
+      # We have to do this since for backcompat reasons having a charset doesn't always
+      # mean that the body is already encoded :(
       $self->_context->clear_encoding;
     }
 }
@@ -462,6 +495,12 @@ 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->unencoded_write( $data )
+
+Works just like ->write but we don't apply any content encoding to C<$data>.  Use
+this if you are already encoding the $data or the data is arriving from an encoded
+storage.
+
 =head2 $res->write_fh
 
 Returns an instance of L<Catalyst::Response::Writer>, which is a lightweight
@@ -549,7 +588,13 @@ Example:
     }
 
 Please note this does not attempt to map or nest your PSGI application under
-the Controller and Action namespace or path.  
+the Controller and Action namespace or path. You may wish to review 'PSGI Helpers'
+under L<Catalyst::Utils> for help in properly nesting applications.
+
+B<NOTE> If your external PSGI application returns a response that has a character
+set associated with the content type (such as "text/html; charset=UTF-8") we set
+$c->clear_encoding to remove any additional content type encoding processing later
+in the application (this is done to avoid double encoding issues).
 
 =head2 encodable_content_type