From: Graham Knop <haarg@haarg.org>
Date: Sun, 21 Oct 2018 03:10:22 +0000 (+0200)
Subject: fix decoded uploads
X-Git-Tag: v5.90_121~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=2d48c2fc524aa2c1c077ba4be61970ed698af12d

fix decoded uploads

sysread can't be used against UTF8 handles (deprecated since perl 5.24,
fatal since 5.30).  The only reasonable way to slurp an entire file
through an encoding layer is to use readline.  Using a read loop would
not be faster.
---

diff --git a/lib/Catalyst/Request/Upload.pm b/lib/Catalyst/Request/Upload.pm
index bf9318f..486653c 100644
--- a/lib/Catalyst/Request/Upload.pm
+++ b/lib/Catalyst/Request/Upload.pm
@@ -211,14 +211,20 @@ sub slurp {
         $layer = ':raw';
     }
 
-    my $content = undef;
+    my $content = '';
     my $handle  = $self->fh;
 
     binmode( $handle, $layer );
 
     $handle->seek(0, IO::File::SEEK_SET);
-    while ( $handle->sysread( my $buffer, 8192 ) ) {
-        $content .= $buffer;
+
+    if ($layer eq ':raw') {
+        while ( $handle->sysread( my $buffer, 8192 ) ) {
+            $content .= $buffer;
+        }
+    }
+    else {
+        $content = do { local $/; $handle->getline };
     }
 
     $handle->seek(0, IO::File::SEEK_SET);
@@ -237,11 +243,9 @@ sub decoded_slurp {
     my ( $self, $layer ) = @_;
     my $handle = $self->decoded_fh($layer);
 
-    my $content = undef;
     $handle->seek(0, IO::File::SEEK_SET);
-    while ( $handle->sysread( my $buffer, 8192 ) ) {
-        $content .= $buffer;
-    }
+
+    my $content = do { local $/; $handle->getline };
 
     $handle->seek(0, IO::File::SEEK_SET);
     return $content;
diff --git a/t/utf_incoming.t b/t/utf_incoming.t
index 39f5c51..a95f58a 100644
--- a/t/utf_incoming.t
+++ b/t/utf_incoming.t
@@ -409,9 +409,7 @@ use Catalyst::Test 'MyApp';
   is $res->content_charset, 'UTF-8';
 }
 
-SKIP:
 {
-  skip 'skipped: sysread isn\'t allowed on :utf8 handles (starting with 5.029004)', 4 if $] >= '5.029004';
   ok my $path = File::Spec->catfile('t', 'utf8.txt');
   ok my $req = POST '/root/file_upload',
     Content_Type => 'form-data',
@@ -421,9 +419,7 @@ SKIP:
   is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n";
 }
 
-SKIP:
 {
-  skip 'skipped: sysread isn\'t allowed on :utf8 handles (starting with 5.029004)', 5 if $] >= '5.029004';
   ok my $path = File::Spec->catfile('t', 'utf8.txt');
   ok my $req = POST '/root/file_upload_utf8_param',
     Content_Type => 'form-data',