actually use the new keywords
[catagits/Catalyst-Runtime.git] / lib / Catalyst / Engine.pm
index 349bc43..166a02d 100644 (file)
@@ -7,16 +7,12 @@ use CGI::Simple::Cookie;
 use Data::Dump qw/dump/;
 use Errno 'EWOULDBLOCK';
 use HTML::Entities;
-use HTTP::Body;
 use HTTP::Headers;
-use URI::QueryParam;
 use Plack::Loader;
 use Catalyst::EngineLoader;
-use Encode ();
+use Encode 2.21 'decode_utf8';
 use Plack::Request::Upload;
 use Hash::MultiValue;
-use utf8;
-
 use namespace::clean -except => 'meta';
 
 # Amount of data to read from input on each pass
@@ -75,6 +71,7 @@ sub finalize_body {
     ## doing something custom and is expected to close the response
     return if $res->_has_write_fh;
 
+    my $body = $res->body; # save some typing
     if($res->_has_response_cb) {
         ## we have not called the response callback yet, so we are safe to send
         ## the whole body to PSGI
@@ -82,37 +79,55 @@ sub finalize_body {
         my @headers;
         $res->headers->scan(sub { push @headers, @_ });
 
-        ## We need to figure out what kind of body we have...
-        my $body = $res->body;
+        # We need to figure out what kind of body we have and normalize it to something
+        # PSGI can deal with
         if(defined $body) {
-            if( 
-                (blessed($body) && $body->can('getline'))
-                or ref($body) eq 'GLOB'
-            ) {
-              # Body is an IO handle that meets the PSGI spec
-            } elsif(blessed($body) && $body->can('read')) {
-                # In the past, Catalyst only looked for read not getline.  It is very possible
-                # that one might have an object that respected read but did not have getline.
-                # As a result, we need to handle this case for backcompat.
+            # Handle objects first
+            if(blessed($body)) {
+                if($body->can('getline')) {
+                    # Body is an IO handle that meets the PSGI spec.  Nothing to normalize
+                } elsif($body->can('read')) {
+
+                    # In the past, Catalyst only looked for ->read not ->getline.  It is very possible
+                    # that one might have an object that respected read but did not have getline.
+                    # As a result, we need to handle this case for backcompat.
                 
-                # We will just do the old loop for now but someone could write a proxy
-                # object to wrap getline and proxy read
-                my $got;
-                do {
-                    $got = read $body, my ($buffer), $CHUNKSIZE;
-                    $got = 0 unless $self->write($c, $buffer );
-                } while $got > 0;
-
-                close $body;
-                return;
+                    # We will just do the old loop for now.  In a future version of Catalyst this support
+                    # will be removed and one will have to rewrite their custom object or use 
+                    # Plack::Middleware::AdaptFilehandleRead.  In anycase support for this is officially
+                    # deprecated and described as such as of 5.90060
+                   
+                    my $got;
+                    do {
+                        $got = read $body, my ($buffer), $CHUNKSIZE;
+                        $got = 0 unless $self->write($c, $buffer );
+                    } while $got > 0;
+
+                    close $body;
+                    return;
+                } else {
+                    # Looks like for  backcompat reasons we need to be able to deal
+                    # with stringyfiable objects.
+                    $body = ["$body"]; 
+                }
+            } elsif(ref $body) {
+                if( (ref($body) eq 'GLOB') or (ref($body) eq 'ARRAY')) {
+                  # Again, PSGI can just accept this, no transform needed.  We don't officially
+                  # document the body as arrayref at this time (and there's not specific test
+                  # cases.  we support it because it simplifies some plack compatibility logic
+                  # and we might make it official at some point.
+                } else {
+                   $c->log->error("${\ref($body)} is not a valid value for Response->body");
+                   return;
+                }
             } else {
-              # Looks like for  backcompat reasons we need to be able to deal
-              # with stringyfiable objects.
-              $body = "$body" if blessed($body); # Assume there's some sort of overloading..
-              $body = [$body];  
+                # Body is defined and not an object or reference.  We assume a simple value
+                # and wrap it in an array for PSGI
+                $body = [$body];
             }
         } else {
-          $body = [undef];
+            # There's no body...
+            $body = [];
         }
 
         $res->_response_cb->([ $res->status, \@headers, $body]);
@@ -128,11 +143,11 @@ sub finalize_body {
         ## We'll just use the old, existing code for this (or most of it)
 
         if(my $body = $res->body) {
-          no warnings 'uninitialized';
+
           if ( blessed($body) && $body->can('read') or ref($body) eq 'GLOB' ) {
 
               ## In this case we have no choice and will fall back on the old
-              ## manual streaming stuff.
+              ## manual streaming stuff.  Not optimal.  This is deprecated as of 5.900560+
 
               my $got;
               do {
@@ -143,6 +158,11 @@ sub finalize_body {
               close $body;
           }
           else {
+              
+              # Case where body was set afgter calling ->write.  We'd prefer not to
+              # support this, but I can see some use cases with the way most of the
+              # views work.
+
               $self->write($c, $body );
           }
         }
@@ -281,6 +301,7 @@ sub finalize_error {
 (pt) Por favor volte mais tarde
 (ru) Попробуйте еще раз позже
 (ua) Спробуйте ще раз пізніше
+(it) Per favore riprova più tardi
 </pre>
 
         $name = '';
@@ -568,7 +589,9 @@ sub prepare_query_parameters {
     # Check for keywords (no = signs)
     # (yes, index() is faster than a regex :))
     if ( index( $query_string, '=' ) < 0 ) {
-        $c->request->query_keywords($self->unescape_uri($query_string));
+        my $keywords = $self->unescape_uri($query_string);
+        $keywords = decode_utf8 $keywords;
+        $c->request->query_keywords($keywords);
         return;
     }
 
@@ -582,10 +605,13 @@ sub prepare_query_parameters {
     for my $item ( @params ) {
 
         my ($param, $value)
-            = map { $self->unescape_uri($_) }
+            = map { decode_utf8($self->unescape_uri($_)) }
               split( /=/, $item, 2 );
 
-        $param = $self->unescape_uri($item) unless defined $param;
+        unless(defined $param) {
+            $param = $self->unescape_uri($item);
+            $param = decode_utf8 $param;
+        }
 
         if ( exists $query{$param} ) {
             if ( ref $query{$param} ) {
@@ -643,20 +669,25 @@ sub prepare_uploads {
     my $request = $c->request;
     return unless $request->_body;
 
+    my $enc = $c->encoding;
     my $uploads = $request->_body->upload;
     my $parameters = $request->parameters;
     foreach my $name (keys %$uploads) {
+        $name = $c->_handle_unicode_decoding($name) if $enc;
         my $files = $uploads->{$name};
         my @uploads;
         for my $upload (ref $files eq 'ARRAY' ? @$files : ($files)) {
             my $headers = HTTP::Headers->new( %{ $upload->{headers} } );
+            my $filename = $upload->{filename};
+            $filename = $c->_handle_unicode_decoding($filename) if $enc;
+
             my $u = Catalyst::Request::Upload->new
               (
                size => $upload->{size},
                type => scalar $headers->content_type,
                headers => $headers,
                tempname => $upload->{tempname},
-               filename => $upload->{filename},
+               filename => $filename,
               );
             push @uploads, $u;
         }