[Catalyst-commits] r10097 - in Catalyst-Runtime/5.80/trunk: . lib lib/Catalyst/DispatchType t/aggregate

[t0m at dev.catalyst.perl.org]

Author: t0m
Date: 2009-05-12 17:26:59 +0000 (Tue, 12 May 2009)
New Revision: 10097

Modified:
   Catalyst-Runtime/5.80/trunk/Changes
   Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/DispatchType/Chained.pm
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/DispatchType/Regex.pm
   Catalyst-Runtime/5.80/trunk/t/aggregate/unit_core_uri_for_action.t
Log:
Add a few more tests for this issue in various other positions and dispatch types, and fix them all

Modified: Catalyst-Runtime/5.80/trunk/Changes
===================================================================
--- Catalyst-Runtime/5.80/trunk/Changes	2009-05-12 17:08:16 UTC (rev 10096)
+++ Catalyst-Runtime/5.80/trunk/Changes	2009-05-12 17:26:59 UTC (rev 10097)
@@ -8,6 +8,8 @@
           (Phil Mitchell)
         - Add 'use Catalyst' to documentation for a Moose MyApp class as
           noted by dmaki. (t0m)
+        - Fix so that / (and other special characters) are URL encoded when
+          passed into $c->uri_for as Args/CaptureArgs (t0m)
 
 5.80003 2009-04-29 16:23:53
         - Various POD tweaks. (hdp, dandv)

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/DispatchType/Chained.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/DispatchType/Chained.pm	2009-05-12 17:08:16 UTC (rev 10096)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/DispatchType/Chained.pm	2009-05-12 17:26:59 UTC (rev 10097)
@@ -329,7 +329,9 @@
         if (my $cap = $curr->attributes->{CaptureArgs}) {
             return undef unless @captures >= $cap->[0]; # not enough captures
             if ($cap->[0]) {
-                unshift(@parts, splice(@captures, -$cap->[0]));
+                unshift(@parts,
+                    map { s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go; $_; }
+                    splice(@captures, -$cap->[0]));
             }
         }
         if (my $pp = $curr->attributes->{PartPath}) {

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/DispatchType/Regex.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/DispatchType/Regex.pm	2009-05-12 17:08:16 UTC (rev 10096)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/DispatchType/Regex.pm	2009-05-12 17:26:59 UTC (rev 10097)
@@ -148,7 +148,7 @@
             $re =~ s/^\^//;
             $re =~ s/\$$//;
             my $final = '/';
-            my @captures = @$captures;
+            my @captures =  map { s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go; $_; } @$captures;
             while (my ($front, $rest) = split(/\(/, $re, 2)) {
                 last unless defined $rest;
                 ($rest, $re) =

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm	2009-05-12 17:08:16 UTC (rev 10096)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm	2009-05-12 17:26:59 UTC (rev 10097)
@@ -1188,7 +1188,7 @@
       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
 
     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
-    s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
+    s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go for @args;
 
     unshift(@args, $path);
 
@@ -1222,7 +1222,7 @@
               $_ = "$_";
               utf8::encode( $_ ) if utf8::is_utf8($_);
               # using the URI::Escape pattern here so utf8 chars survive
-              s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
+              s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go;
               s/ /+/g;
               "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
       } @keys);

Modified: Catalyst-Runtime/5.80/trunk/t/aggregate/unit_core_uri_for_action.t
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/aggregate/unit_core_uri_for_action.t	2009-05-12 17:08:16 UTC (rev 10096)
+++ Catalyst-Runtime/5.80/trunk/t/aggregate/unit_core_uri_for_action.t	2009-05-12 17:26:59 UTC (rev 10097)
@@ -8,7 +8,7 @@
 
 use Test::More;
 
-plan tests => 30;
+plan tests => 33;
 
 use_ok('TestApp');
 
@@ -54,6 +54,10 @@
    "/action/regexp/foo/123",
    "Regex action interpolates captures correctly");
 
+is($dispatcher->uri_for_action($regex_action, [ 'foo/bar', 123 ]),
+   "/action/regexp/foo%2Fbar/123",
+   "Regex action interpolates captures correctly and url encodes /");
+
 #
 #   Index Action
 #
@@ -105,6 +109,10 @@
    "http://127.0.0.1/foo/action/relative/relative/one/two?q=1",
    "uri_for correct for path action with args and query");
 
+is($context->uri_for($path_action, qw|one/quux two|),
+   "http://127.0.0.1/foo/action/relative/relative/one%2Fquux/two",
+   "uri_for correctly url encoded for path action with args containing /");
+
 ok(!defined($context->uri_for($path_action, [ 'blah' ])),
    "no URI returned by uri_for for Path action with snippets");
 
@@ -161,9 +169,13 @@
         'uri_for_action returns uri with empty arg on undef last argument' );
 
     is( $context->uri_for_action($action_needs_two, [ 'foo' , 'bar/baz' ], (3,4)),
-        'http://127.0.0.1/foo/chained/foo2/foo/bar%2Fbaz/end2/3/',
-        'uri_for_action returns uri with empty arg on undef last argument' );
+        'http://127.0.0.1/foo/chained/foo2/foo/bar%2Fbaz/end2/3/4',
+        'uri_for_action works correctly when CaptureArg contains /' );
 
+    is( $context->uri_for_action($action_needs_two, [ 'foo' , 'bar' ], ('3/baz',4)),
+        'http://127.0.0.1/foo/chained/foo2/foo/bar/end2/3%2Fbaz/4',
+        'uri_for_action works correctly when Args contains /' );
+
     my $complex_chained = '/action/chained/empty_chain_f';
     is( $context->uri_for_action( $complex_chained, [23], (13), {q => 3} ),
         'http://127.0.0.1/foo/chained/empty/23/13?q=3',