Improve escaping of unwanted characters

Fixes #74

2 files changed, 63 insertions, 2 deletions

diff --git a/lib/URI/Escape.pm b/lib/URI/Escape.pm
index d434488..cec5d56 100644
--- a/lib/URI/Escape.pm
+++ b/lib/URI/Escape.pm
@@ -163,7 +163,14 @@ sub uri_escape {
     if (defined $patn){
         unless (exists  $subst{$patn}) {
             # Because we can't compile the regex we fake it with a cached sub
-            (my $tmp = $patn) =~ s,/,\\/,g;
+            my @parts = $patn =~ m/(
+                (?: ^ \^? -? )
+                | (?: .-. )
+                | (?: \[:[^:]+:\] )
+                | .
+            )/gx;
+
+            my $tmp = join '', shift @parts, map { length > 1 ? $_ : quotemeta } @parts;
             eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }";
             Carp::croak("uri_escape: $@") if $@;
         }
diff --git a/t/escape.t b/t/escape.t
index 6b4d5e6..63dfb06 100644
--- a/t/escape.t
+++ b/t/escape.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 12;
+use Test::More tests => 21;
 
 use URI::Escape qw( %escapes uri_escape uri_escape_utf8 uri_unescape );
 
@@ -19,6 +19,60 @@ is uri_unescape("%7Cabc%e5"), "|abcĺ";
 
 is_deeply [uri_unescape("%40A%42", "CDE", "F%47H")], [qw(@AB CDE FGH)];
 
+is
+    uri_escape ('/', '/'),
+    '%2F',
+    'it should accept slash in unwanted characters',
+    ;
+
+is
+    uri_escape ('][', ']['),
+    '%5D%5B',
+    'it should accept regex char group terminator in unwanted characters',
+    ;
+
+is
+    uri_escape ('[]\\', '][\\'),
+    '%5B%5D%5C',
+    'it should accept regex escape character at the end of unwanted characters',
+    ;
+
+is
+    uri_escape ('[]\\${}', '][\\${`kill -0 -1`}'),
+    '%5B%5D%5C%24%7B%7D',
+    'it should recognize scalar interpolation injection in unwanted characters',
+    ;
+
+is
+    uri_escape ('[]\\@{}', '][\\@{`kill -0 -1`}'),
+    '%5B%5D%5C%40%7B%7D',
+    'it should recognize array interpolation injection in unwanted characters',
+    ;
+
+is
+    uri_escape ('[]\\%{}', '][\\%{`kill -0 -1`}'),
+    '%5B%5D%5C%25%7B%7D',
+    'it should recognize hash interpolation injection in unwanted characters',
+    ;
+
+is
+    uri_escape ('a-b', '-bc'),
+    'a%2D%62',
+    'it should recognize leading minus',
+    ;
+
+is
+    uri_escape ('a-b', '^-bc'),
+    '%61-b',
+    'it should recognize leading ^-'
+    ;
+
+is
+    uri_escape ('a-b-1', '[:alpha:][:digit:]'),
+    '%61-%62-%31',
+    'it should recognize character groups'
+    ;
+
 is $escapes{"%"}, "%25";
 
 is uri_escape_utf8("|abcĺ"), "%7Cabc%C3%A5";