From a3f96169b002e1fa747713654edfa9f528d17cbb Mon Sep 17 00:00:00 2001
From: Graham Knop <haarg@haarg.org>
Date: Mon, 10 Oct 2022 20:12:21 +0200
Subject: uri_escape: allow characters to escape to be specified as a Regexp
 object

---
 lib/URI/Escape.pm | 13 +++++++++++++
 t/escape.t        | 12 ++++++++++++
 2 files changed, 25 insertions(+)

diff --git a/lib/URI/Escape.pm b/lib/URI/Escape.pm
index 4d8bc5e..87479ca 100644
--- a/lib/URI/Escape.pm
+++ b/lib/URI/Escape.pm
@@ -71,6 +71,13 @@ as the reserved characters.  I.e. the default is:
 
     "^A-Za-z0-9\-\._~"
 
+The second argument can also be specified as a regular expression object:
+
+  qr/[^A-Za-z]/
+
+Any strings matched by this regular expression will have all of their
+characters escaped.
+
 =item uri_escape_utf8( $string )
 
 =item uri_escape_utf8( $string, $unsafe )
@@ -162,6 +169,12 @@ sub uri_escape {
     return undef unless defined $text;
     my $re;
     if (defined $patn){
+        if (ref $patn eq 'Regexp') {
+            $text =~ s{($patn)}{
+                join('', map +($escapes{$_} || _fail_hi($_)), split //, "$1")
+            }ge;
+            return $text;
+        }
         $re = $subst{$patn};
         if (!defined $re) {
             $re = $patn;
diff --git a/t/escape.t b/t/escape.t
index 16694dd..6450b18 100644
--- a/t/escape.t
+++ b/t/escape.t
@@ -104,6 +104,18 @@ like join('', warnings {
 }xs,
   'bad escapes emit warnings';
 
+is
+    uri_escape ('abcd-[]', qr/[bc]/),
+    'a%62%63d-[]',
+    'allows regexp objects',
+    ;
+
+is
+    uri_escape ('a12b21c12d', qr/12/),
+    'a%31%32b21c%31%32d',
+    'allows regexp objects matching multiple characters',
+    ;
+
 is $escapes{"%"}, "%25";
 
 is uri_escape_utf8("|abcå"), "%7Cabc%C3%A5";
-- 
cgit v1.2.1