[Catalyst-commits] r13966 - in Catalyst-Runtime/5.80/trunk: . lib/Catalyst/Request t/lib/TestApp/Controller/Engine/Request

[t0m at dev.catalyst.perl.org]

Author: t0m
Date: 2011-02-15 16:10:03 +0000 (Tue, 15 Feb 2011)
New Revision: 13966

Modified:
   Catalyst-Runtime/5.80/trunk/Changes
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/Request/Upload.pm
   Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Engine/Request/Uploads.pm
Log:
Fix 5.80 bug which causes slurp to fail if called multiple times

Modified: Catalyst-Runtime/5.80/trunk/Changes
===================================================================
--- Catalyst-Runtime/5.80/trunk/Changes	2011-02-14 21:35:11 UTC (rev 13965)
+++ Catalyst-Runtime/5.80/trunk/Changes	2011-02-15 16:10:03 UTC (rev 13966)
@@ -7,6 +7,10 @@
     returning true.
     Having a response body is indicated by $c->res->body being defined.
 
+  - Fix bug with calling $upload->slurp multiple times in one request
+    not working as expected as the file handle wasn't returned to
+    the zero position. (Adam Sjøgren)
+
 5.80031 2011-01-31 08:13:02
 
  Bug fixes:

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Request/Upload.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Request/Upload.pm	2011-02-14 21:35:11 UTC (rev 13965)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Request/Upload.pm	2011-02-15 16:10:03 UTC (rev 13966)
@@ -5,7 +5,7 @@
 
 use Catalyst::Exception;
 use File::Copy ();
-use IO::File   ();
+use IO::File   qw( SEEK_SET );
 use File::Spec::Unix;
 
 has filename => (is => 'rw');
@@ -128,6 +128,10 @@
 
 Returns a scalar containing the contents of the temporary file.
 
+Note that this method will cause the filehandle pointed to by
+C<< $upload->fh >> to be seeked to the start of the file,
+and the file handle to be put into binary mode.
+
 =cut
 
 sub slurp {
@@ -142,10 +146,12 @@
 
     binmode( $handle, $layer );
 
+    $handle->seek(0, SEEK_SET);
     while ( $handle->sysread( my $buffer, 8192 ) ) {
         $content .= $buffer;
     }
 
+    $handle->seek(0, SEEK_SET);
     return $content;
 }
 

Modified: Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Engine/Request/Uploads.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Engine/Request/Uploads.pm	2011-02-14 21:35:11 UTC (rev 13965)
+++ Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Engine/Request/Uploads.pm	2011-02-15 16:10:03 UTC (rev 13966)
@@ -6,6 +6,10 @@
 sub slurp : Relative {
     my ( $self, $c ) = @_;
     $c->response->content_type('text/plain; charset=utf-8');
+    my $upload = $c->request->upload('slurp');
+    my $contents = $upload->slurp;
+    my $contents2 = $upload->slurp;
+    die("Slurp not callable multiple times") unless $contents eq $contents2;
     $c->response->output( $c->request->upload('slurp')->slurp );
 }