[Catalyst-commits] r7995 - in Catalyst-Runtime/5.70/trunk: . lib/Catalyst t

[bricas at dev.catalyst.perl.org]

Author: bricas
Date: 2008-06-23 23:01:06 +0100 (Mon, 23 Jun 2008)
New Revision: 7995

Modified:
   Catalyst-Runtime/5.70/trunk/Changes
   Catalyst-Runtime/5.70/trunk/Makefile.PL
   Catalyst-Runtime/5.70/trunk/lib/Catalyst/Engine.pm
   Catalyst-Runtime/5.70/trunk/t/live_engine_request_uploads.t
Log:
Update HTTP::Body dep so that the uploadtmp config value will work (RT #22540)

Modified: Catalyst-Runtime/5.70/trunk/Changes
===================================================================
--- Catalyst-Runtime/5.70/trunk/Changes	2008-06-23 21:21:21 UTC (rev 7994)
+++ Catalyst-Runtime/5.70/trunk/Changes	2008-06-23 22:01:06 UTC (rev 7995)
@@ -1,6 +1,7 @@
 # This file documents the revision history for Perl extension Catalyst.
 
 5.7xxx  xxx
+        - Update HTTP::Body dep so that the uploadtmp config value will work (RT #22540)
         - Fix for LocalRegex when used in the Root controller
         - Get some of the optional_* tests working from dirs with spaces (RT #26455)
         - Fix Catalyst::Utils::home() when application .pm is in the current dir (RT #34437)

Modified: Catalyst-Runtime/5.70/trunk/Makefile.PL
===================================================================
--- Catalyst-Runtime/5.70/trunk/Makefile.PL	2008-06-23 21:21:21 UTC (rev 7994)
+++ Catalyst-Runtime/5.70/trunk/Makefile.PL	2008-06-23 22:01:06 UTC (rev 7995)
@@ -13,7 +13,7 @@
 requires 'Data::Dump';
 requires 'File::Modified';
 requires 'HTML::Entities';
-requires 'HTTP::Body'    => '0.9';
+requires 'HTTP::Body'    => '1.04'; # makes uploadtmp work
 requires 'HTTP::Headers' => '1.64';
 requires 'HTTP::Request';
 requires 'HTTP::Response';

Modified: Catalyst-Runtime/5.70/trunk/lib/Catalyst/Engine.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/lib/Catalyst/Engine.pm	2008-06-23 21:21:21 UTC (rev 7994)
+++ Catalyst-Runtime/5.70/trunk/lib/Catalyst/Engine.pm	2008-06-23 22:01:06 UTC (rev 7995)
@@ -314,7 +314,7 @@
         unless ( $c->request->{_body} ) {
             my $type = $c->request->header('Content-Type');
             $c->request->{_body} = HTTP::Body->new( $type, $length );
-            $c->request->{_body}->{tmpdir} = $c->config->{uploadtmp}
+            $c->request->{_body}->tmpdir( $c->config->{uploadtmp} )
               if exists $c->config->{uploadtmp};
         }
         

Modified: Catalyst-Runtime/5.70/trunk/t/live_engine_request_uploads.t
===================================================================
--- Catalyst-Runtime/5.70/trunk/t/live_engine_request_uploads.t	2008-06-23 21:21:21 UTC (rev 7994)
+++ Catalyst-Runtime/5.70/trunk/t/live_engine_request_uploads.t	2008-06-23 22:01:06 UTC (rev 7995)
@@ -6,7 +6,7 @@
 use FindBin;
 use lib "$FindBin::Bin/lib";
 
-use Test::More tests => 75;
+use Test::More tests => 88;
 use Catalyst::Test 'TestApp';
 
 use Catalyst::Request;
@@ -242,3 +242,62 @@
         is( $upload->filename, 'catalyst_130pix.gif' );
     }
 }
+
+# test uploadtmp config var
+
+{
+    my $creq;
+
+    my $dir = "$FindBin::Bin/";
+    local TestApp->config->{ uploadtmp } = $dir;
+
+    my $request = POST(
+        'http://localhost/dump/request/',
+        'Content-Type' => 'multipart/form-data',
+        'Content'      => [
+            'testfile' => ["$FindBin::Bin/live_engine_request_uploads.t"],
+        ]
+    );
+
+    ok( my $response = request($request), 'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    is( $response->content_type, 'text/plain', 'Response Content-Type' );
+    like(
+        $response->content,
+        qr/^bless\( .* 'Catalyst::Request' \)$/s,
+        'Content is a serialized Catalyst::Request'
+    );
+
+    {
+        no strict 'refs';
+        ok(
+            eval '$creq = ' . $response->content,
+            'Unserialize Catalyst::Request'
+        );
+    }
+
+    isa_ok( $creq, 'Catalyst::Request' );
+    is( $creq->method, 'POST', 'Catalyst::Request method' );
+    is( $creq->content_type, 'multipart/form-data',
+        'Catalyst::Request Content-Type' );
+    is( $creq->content_length, $request->content_length,
+        'Catalyst::Request Content-Length' );
+
+    for my $part ( $request->parts ) {
+
+        my $disposition = $part->header('Content-Disposition');
+        my %parameters  = @{ ( split_header_words($disposition) )[0] };
+
+        next unless exists $parameters{filename};
+
+        my $upload = $creq->{uploads}->{ $parameters{name} };
+
+        isa_ok( $upload, 'Catalyst::Request::Upload' );
+
+        is( $upload->type, $part->content_type, 'Upload Content-Type' );
+        is( $upload->size, length( $part->content ), 'Upload Content-Length' );
+
+        like( $upload->tempname, qr{\Q$dir\E}, 'uploadtmp' );
+    }
+}
+