make stringy first argument into expert mode

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 64c097c..6523d21 100644 (file)
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -1506,6 +1506,15 @@ relative to the application root (if it does). It is then merged with
 C<< $c->request->base >>; any C<@args> are appended as additional path
 components; and any C<%query_values> are appended as C<?foo=bar> parameters.
 
+B<NOTE> If you are using this 'stringy' first argument, we skip encoding and
+allow you to declare something like:
+
+    $c->uri_for('/foo/bar#baz')
+
+Where 'baz' is a URI fragment.  We consider this first argument string to be
+'expert' mode where you are expected to create a valid URL and we for the most
+part just pass it through without a lot of internal effort to escape and encode.
+
 If the first argument is a L<Catalyst::Action> it represents an action which
 will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
 optional C<\@captures> argument (an arrayref) allows passing the captured
@@ -1548,13 +1557,24 @@ sub uri_for {
         $path .= '/';
     }
 
-    undef($path) if (defined $path && $path eq '');
-
     my $fragment =  ((scalar(@args) && ref($args[-1]) eq 'SCALAR') ? pop @args : undef );
 
+    unless(blessed $path) {
+      if ($path =~ s/#(.+)$//)  {
+        if(defined($1) and $fragment) {
+          carp "Abiguious fragment declaration: You cannot define a fragment in '$path' and as an argument '$fragment'";
+        }
+        if(defined($1)) {
+          $fragment = $1;
+        }
+      }
+    }
+
     my $params =
       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
 
+    undef($path) if (defined $path && $path eq '');
+
     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
 
     my $target_action = $path->$_isa('Catalyst::Action') ? $path : undef;
@@ -1663,9 +1683,11 @@ sub uri_for {
     $args =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
 
     if(defined $fragment) {
-      $fragment = encode_utf8(${$fragment});
-      $fragment =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
-      $fragment =~ s/ /+/g;
+      if(blessed $path) {
+        $fragment = encode_utf8(${$fragment});
+        $fragment =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
+        $fragment =~ s/ /+/g;
+      }
       $query .= "#$fragment";
     }
 

diff --git a/lib/Catalyst/Delta.pod b/lib/Catalyst/Delta.pod
index e75a052..8ae07c7 100755 (executable)
--- a/lib/Catalyst/Delta.pod
+++ b/lib/Catalyst/Delta.pod
@@ -22,6 +22,13 @@ follow the new, supported specification:
 This will be a breaking change for some codebases, we recommend testing if
 you are creating URLs with fragments.
 
+B<NOTE> If you are using the alternative:
+
+    $c->uri_for('/foo/bar#baz')
+
+construction, we do not attempt to encode this and it will make a URL with a
+fragment of 'baz'.
+
 =head2 VERSION 5.90094
 
 =head3 Multipart form POST with character set headers

diff --git a/lib/Catalyst/Upgrading.pod b/lib/Catalyst/Upgrading.pod
index 6055442..ac230c1 100644 (file)
--- a/lib/Catalyst/Upgrading.pod
+++ b/lib/Catalyst/Upgrading.pod
@@ -37,7 +37,15 @@ for a URI via ->uri_for:
 If you are relying on the previous side effect behavior your URLs will now encode the '#'
 delimiter, which is going to be a breaking change for you.  You need to alter your code
 to match the new specification or modify uri_for for your local case.  Patches to solve
-this are very welcomed, as long as they don't break existing test cases. 
+this are very welcomed, as long as they don't break existing test cases.
+
+B<NOTE> If you are using the alternative:
+
+    $c->uri_for('/foo/bar#baz')
+
+construction, we do not attempt to encode this and it will make a URL with a
+fragment of 'baz'.
+
 
 =head1 Upgrading to Catalyst 5.90095
 

diff --git a/t/aggregate/unit_core_uri_for.t b/t/aggregate/unit_core_uri_for.t
index 2f4fb11..a541508 100644 (file)
--- a/t/aggregate/unit_core_uri_for.t
+++ b/t/aggregate/unit_core_uri_for.t
@@ -61,31 +61,22 @@ is(
 
 is(
     Catalyst::uri_for( $context, '/bar#fragment', { param1 => 'value1' } )->as_string,
-    'http://127.0.0.1/foo/bar%23fragment?param1=value1',
+    'http://127.0.0.1/foo/bar?param1=value1#fragment',
     'URI for path with fragment and query params 1'
 );
 
-
-is(
-    Catalyst::uri_for( $context, '/bar#fragment\x{2620}', { param1 => 'value1' } )->as_string,
-    'http://127.0.0.1/foo/bar%23fragment%5Cx%7B2620%7D?param1=value1',
-    'URI for path with fragment and query params 2'
-);
-
-
 is(
     Catalyst::uri_for( $context, '/bar#fragment^%$', { param1 => 'value1' } )->as_string,
-    'http://127.0.0.1/foo/bar%23fragment%5E%$?param1=value1',
+    'http://127.0.0.1/foo/bar?param1=value1#fragment^%$',
     'URI for path with fragment and query params 3'
 );
 
 is(
-    Catalyst::uri_for( $context, '/bar', { param1 => 'value1' }, \'fragment\x{2620}' )->as_string,
-    'http://127.0.0.1/foo/bar?param1=value1#fragment%5Cx%7B2620%7D',
-    'URI for path with fragment and query params 2'
+    Catalyst::uri_for( $context, '/foo#bar/baz', { param1 => 'value1' } )->as_string,
+    'http://127.0.0.1/foo/foo?param1=value1#bar/baz',
+    'URI for path with fragment and query params 3'
 );
 
-
 # test with utf-8
 is(
     Catalyst::uri_for( $context, 'quux', { param1 => "\x{2620}" } )->as_string,