Using Scalar::Util::reftype instead of just ref(), but mindful this time about definedness to avoid warnings

Jacques Deguest · oalders · commit 85c5a5c6a366 · 2024-03-21T21:32:57.000-04:00
Added tests for array objects

Ensuring array objects do not stringifies before using them as array

Created a function to check if value is an array with no stringification

Added tests as requested for stringifyable arrays
diff --git a/Changes b/Changes
@@ -1,6 +1,8 @@
 Revision history for URI
 
 {{$NEXT}}
+    - Using Scalar::Util::reftype instead of just ref(), but mindful this time
+      about definedness to avoid warnings (GH#140) (Jacques Deguest)
 
 5.27      2024-02-09 15:01:24Z
     - Add missing NAME section to POD of URI::geo (GH#142) (gregor herrmann)
diff --git a/lib/URI/_query.pm b/lib/URI/_query.pm
@@ -5,6 +5,7 @@ use warnings;
 
 use URI ();
 use URI::Escape qw(uri_unescape);
+use Scalar::Util ();
 
 our $VERSION = '5.28';
 
@@ -34,7 +35,7 @@ sub query_form {
         # Try to set query string
         my $delim;
         my $r = $_[0];
-        if (ref($r) eq "ARRAY") {
+        if (_is_array($r)) {
             $delim = $_[1];
             @_ = @$r;
         }
@@ -49,7 +50,7 @@ sub query_form {
             $key = '' unless defined $key;
 	    $key =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
 	    $key =~ s/ /+/g;
-	    $vals = [ref($vals) eq "ARRAY" ? @$vals : $vals];
+	    $vals = [_is_array($vals) ? @$vals : $vals];
             for my $val (@$vals) {
                 if (defined $val) {
                     $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
@@ -86,7 +87,7 @@ sub query_keywords
     if (@_) {
         # Try to set query string
 	my @copy = @_;
-	@copy = @{$copy[0]} if @copy == 1 && ref($copy[0]) eq "ARRAY";
+	@copy = @{$copy[0]} if @copy == 1 && _is_array($copy[0]);
 	for (@copy) { s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; }
 	$self->query(@copy ? join('+', @copy) : undef);
     }
@@ -114,7 +115,7 @@ sub query_param {
     if (@_) {
         my @new = @old;
         my @new_i = @i;
-        my @vals = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
+        my @vals = map { _is_array($_) ? @$_ : $_ } @_;
 
         while (@new_i > @vals) {
             splice @new, pop @new_i, 2;
@@ -139,7 +140,7 @@ sub query_param {
 sub query_param_append {
     my $self = shift;
     my $key = shift;
-    my @vals = map { ref $_ eq 'ARRAY' ? @$_ : $_ } @_;
+    my @vals = map { _is_array($_) ? @$_ : $_ } @_;
     $self->query_form($self->query_form, $key => \@vals);  # XXX
     return;
 }
@@ -168,7 +169,7 @@ sub query_form_hash {
     while (my($k, $v) = splice(@old, 0, 2)) {
         if (exists $hash{$k}) {
             for ($hash{$k}) {
-                $_ = [$_] unless ref($_) eq "ARRAY";
+                $_ = [$_] unless _is_array($_);
                 push(@$_, $v);
             }
         }
@@ -179,4 +180,15 @@ sub query_form_hash {
     return \%hash;
 }
 
+sub _is_array {
+    return(
+        defined($_[0]) &&
+        ( Scalar::Util::reftype($_[0]) || '' ) eq "ARRAY" && 
+        !(
+            Scalar::Util::blessed( $_[0] ) && 
+            overload::Method( $_[0], '""' )
+        )
+    );
+}
+
 1;
diff --git a/t/old-base.t b/t/old-base.t
@@ -348,6 +348,19 @@ sub parts_test {
     $url->query_form(a => ['foo', 'bar'], b => 'foo', c => ['bar', 'foo']);
     is($url->as_string, 'http://web?a=foo&a=bar&b=foo&c=bar&c=foo', ref($url) . '->as_string');
 
+    # Same, but using array object
+    {
+        package
+            Foo::Bar::Array;
+        sub new
+        {
+            my $this = shift( @_ );
+            return( bless( ( @_ == 1 && ref( $_[0] || '' ) eq 'ARRAY' ) ? shift( @_ ) : [@_] => ( ref( $this ) || $this ) ) );
+        }
+    }
+    $url->query_form(a => Foo::Bar::Array->new(['foo', 'bar']), b => 'foo', c => Foo::Bar::Array->new(['bar', 'foo']));
+    is($url->as_string, 'http://web?a=foo&a=bar&b=foo&c=bar&c=foo', ref($url) . '->as_string');
+
     subtest 'netloc_test' => \&netloc_test;
     subtest 'port_test' => \&port_test;
 
diff --git a/t/query-param.t b/t/query-param.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 19;
+use Test::More tests => 20;
 
 use URI ();
 use URI::QueryParam;
@@ -68,4 +68,19 @@ $u->query_param('b' => []);
 
 ok ! $u->query;
 
+# Same, but using array object
+{
+    package
+        Foo::Bar::Array;
+    sub new
+    {
+        my $this = shift( @_ );
+        return( bless( ( @_ == 1 && ref( $_[0] || '' ) eq 'ARRAY' ) ? shift( @_ ) : [@_] => ( ref( $this ) || $this ) ) );
+    }
+}
+$u->query_param('a' => Foo::Bar::Array->new);
+$u->query_param('b' => Foo::Bar::Array->new);
+
+ok ! $u->query;
+
 is $u->as_string, 'http://www.sol.no';
diff --git a/t/query.t b/t/query.t
@@ -1,12 +1,36 @@
 use strict;
 use warnings;
 
-use Test::More tests => 26;
+use Test::More tests => 37;
 
 use URI ();
 my $u = URI->new("", "http");
 my @q;
 
+# For tests using array object
+{
+    package
+        Foo::Bar::Array;
+    sub new
+    {
+        my $this = shift( @_ );
+        return( bless( ( @_ == 1 && ref( $_[0] || '' ) eq 'ARRAY' ) ? shift( @_ ) : [@_] => ( ref( $this ) || $this ) ) );
+    }
+
+    package
+        Foo::Bar::Stringy;
+    push( @Foo::Bar::Stringy::ISA, 'Foo::Bar::Array' );
+    use overload (
+        '""' => '_as_string',
+    );
+    sub _as_string
+    {
+        my $self = shift;
+        local $" = '_hello_';
+        return( "@$self" );
+    }
+}
+
 $u->query_form(a => 3, b => 4);
 is $u, "?a=3&b=4";
 
@@ -40,24 +64,56 @@ is $u, "?%20+?=%23";
 $u->query_keywords([qw(a b)]);
 is $u, "?a+b";
 
+# Same, but using array object
+$u->query_keywords(Foo::Bar::Array->new([qw(a b)]));
+is $u, "?a+b";
+
+# Same, but using a stringifyable array object
+$u->query_keywords(Foo::Bar::Stringy->new([qw(a b)]));
+is $u, "?a_hello_b";
+
 $u->query_keywords([]);
 is $u, "";
 
+# Same, but using array object
+$u->query_keywords(Foo::Bar::Array->new([]));
+is $u, "";
+
+# Same, but using a stringifyable array object
+$u->query_keywords(Foo::Bar::Stringy->new([]));
+is $u, "?";
+
 $u->query_form({ a => 1, b => 2 });
 ok $u eq "?a=1&b=2" || $u eq "?b=2&a=1";
 
 $u->query_form([ a => 1, b => 2 ]);
 is $u, "?a=1&b=2";
 
+# Same, but using array object
+$u->query_form(Foo::Bar::Array->new([ a => 1, b => 2 ]));
+is $u, "?a=1&b=2";
+
 $u->query_form({});
 is $u, "";
 
 $u->query_form([a => [1..4]]);
 is $u, "?a=1&a=2&a=3&a=4";
 
+# Same, but using array object
+$u->query_form(Foo::Bar::Array->new([a => [1..4]]));
+is $u, "?a=1&a=2&a=3&a=4";
+
 $u->query_form([]);
 is $u, "";
 
+# Same, but using array object
+$u->query_form(Foo::Bar::Array->new([]));
+is $u, "";
+
+# Same, but using a strngifyable array object
+$u->query_form(Foo::Bar::Stringy->new([]));
+is $u, "";
+
 $u->query_form(a => { foo => 1 });
 ok "$u" =~ /^\?a=HASH\(/;
 
@@ -73,13 +129,29 @@ is $u, "?a=1&c=2";
 $u->query_form([a => 1, b => 2], ';');
 is $u, "?a=1;b=2";
 
+# Same, but using array object
+$u->query_form(Foo::Bar::Array->new([a => 1, b => 2]), ';');
+is $u, "?a=1;b=2";
+
+# Same, but using a stringifyable array object
+$u->query_form("c" => Foo::Bar::Stringy->new([a => 1, b => 2]), "d" => "e", ';');
+is $u, "?c=a_hello_1_hello_b_hello_2;d=e";
+
 $u->query_form([]);
 {
     local $URI::DEFAULT_QUERY_FORM_DELIMITER = ';';
     $u->query_form(a => 1, b => 2);
 }
 is $u, "?a=1;b=2";
 
+# Same, but using array object
+$u->query_form(Foo::Bar::Array->new([]));
+{
+    local $URI::DEFAULT_QUERY_FORM_DELIMITER = ';';
+    $u->query_form(a => 1, b => 2);
+}
+is $u, "?a=1;b=2";
+
 $u->query('a&b=2');
 @q = $u->query_form;
 is join(":", map { defined($_) ? $_ : '' } @q), "a::b:2";
