Re: Patch for URI::_query

"Gisle Aas" <[email protected]>
Newsgroups gmane.comp.lang.perl.modules.lwp
Message-ID <[email protected]>
On Thu, Jun 12, 2008 at 9:48 AM, Paul Talacko <[email protected]> wrote:
> One of the most commonly requested fixes for URI.pm is the ability to
> generate (and process) query strings separated by ';' rather than '&'.

This is certainly true.  The problem is that no approach has been
suggested that is backwards compatible, practical and not too ugly
yet.

> The inability of URI.pm to generate query strings with ';' is particularly
> frustrating if you're trying to create web pages that are valid XHTML!

I'm not sure I buy this argument.  The issue is exactly the same with
plain old HTML and if you have a program that generates your pages and
your URLs then having the program also escape the attribute values
does not seem like much of hardship.

> The attached patch deals with this.  It gives people the opportunity to
> create query strings separated by ';' or '&' or, because of
> 'query_form_generic' anything else they can think of.
>
> The patch also ensures that all the tests pass.
>
> So, surely there's no reason not to apply it to the URI distribution.

Since you changed the tests it's quite obvious that you changed the
documented behaviour of the method, so this is not a backwards
compatible change.  It also make the docs lie as the query will not be
on the I<application/x-www-form-urlencoded> format any more which
breaks HTTP::Request::Common. So, surely there are a few reasons not
to apply your patch.

But, since so many insist on this I've come up with my own patch for
this that I think is acceptable.  It adds a $delim parameter to the
query_form() method which you can set to ";" or "&".  If you don't
provide this parameter the method now looks at the the existing query
for what delimiter to use, then at the global
$URI::DEFAULT_QUERY_FORM_DELIMITER and then finally defaults to '&'
for backwards compatibility. I hope this works for everybody.

Regards,
Gisle
uri_query_form_semi.patch (application/octet-stream, 4.9 KB)
commit d549f27f719dd489eaf399d40c02269804848449
Author: Gisle Aas <[email protected]>
Date:   Thu Jun 12 16:25:31 2008 +0200

    Support ";" delimiter in $u->query_form
    
    The query_form will now accept both "&" and ";" when parsing, and
    when setting you can override the delimiter by passing a final parameter
    or by setting a global.

diff --git a/URI.pm b/URI.pm
index 9f2524a..621654f 100644
--- a/URI.pm
+++ b/URI.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw($VERSION);
 $VERSION = "1.36";
 
-use vars qw($ABS_REMOTE_LEADING_DOTS $ABS_ALLOW_RELATIVE_SCHEME);
+use vars qw($ABS_REMOTE_LEADING_DOTS $ABS_ALLOW_RELATIVE_SCHEME $DEFAULT_QUERY_FORM_DELIMITER);
 
 my %implements;  # mapping from scheme to implementor class
 
@@ -586,10 +586,16 @@ the $uri.
 
 =item $uri->query_form( $key1 => $val1, $key2 => $val2, ... )
 
+=item $uri->query_form( $key1 => $val1, $key2 => $val2, ..., $delim )
+
 =item $uri->query_form( \@key_value_pairs )
 
+=item $uri->query_form( \@key_value_pairs, $delim )
+
 =item $uri->query_form( \%hash )
 
+=item $uri->query_form( \%hash, $delim )
+
 Sets and returns query components that use the
 I<application/x-www-form-urlencoded> format.  Key/value pairs are
 separated by "&", and the key is separated from the value by a "="
@@ -614,6 +620,13 @@ All the following statements have the same effect:
     $uri->query_form([ foo => [1, 2] ]);
     $uri->query_form({ foo => [1, 2] });
 
+The $delim parameter can be passed as ";" to force the key/value pairs
+to be delimited by ";" instead of "&" in the query string.  This
+practice is often recommened for URLs embedded in HTML or XML
+documents as this avoids the trouble of escaping the "&" character.
+You might also set the $URI::DEFAULT_QUERY_FORM_DELIMITER variable to
+";" for the same global effect.
+
 The C<URI::QueryParam> module can be loaded to add further methods to
 manipulate the form of a URI.  See L<URI::QueryParam> for details.
 
@@ -958,6 +971,11 @@ examples:
   URI->new("../../../foo")->abs("http://host/a/b")
       ==> "http://host/foo"
 
+=item $URI::DEFAULT_QUERY_FORM_DELIMITER
+
+This value can be set to ";" to have the query form C<key=value> pairs
+delimited by ";" instead of "&" which is the default.
+
 =back
 
 =head1 BUGS
diff --git a/URI/_query.pm b/URI/_query.pm
index cb9abc1..0c6aa28 100644
--- a/URI/_query.pm
+++ b/URI/_query.pm
@@ -27,18 +27,20 @@ sub query_form {
     my $old = $self->query;
     if (@_) {
         # Try to set query string
-	my @new = @_;
-	if (@new == 1) {
-	    my $n = $new[0];
-	    if (ref($n) eq "ARRAY") {
-		@new = @$n;
-	    }
-	    elsif (ref($n) eq "HASH") {
-		@new = %$n;
-	    }
-	}
+        my $delim;
+        my $r = $_[0];
+        if (ref($r) eq "ARRAY") {
+            $delim = $_[1];
+            @_ = @$r;
+        }
+        elsif (ref($r) eq "HASH") {
+            $delim = $_[1];
+            @_ = %$r;
+        }
+        $delim = pop if @_ % 2;
+
         my @query;
-        while (my($key,$vals) = splice(@new, 0, 2)) {
+        while (my($key,$vals) = splice(@_, 0, 2)) {
             $key = '' unless defined $key;
 	    $key =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
 	    $key =~ s/ /+/g;
@@ -50,12 +52,21 @@ sub query_form {
                 push(@query, "$key=$val");
             }
         }
-        $self->query(@query ? join('&', @query) : undef);
+        if (@query) {
+            unless ($delim) {
+                $delim = $1 if $old && $old =~ /([&;])/;
+                $delim ||= $URI::DEFAULT_QUERY_FORM_DELIMITER || "&";
+            }
+            $self->query(join($delim, @query));
+        }
+        else {
+            $self->query(undef);
+        }
     }
     return if !defined($old) || !length($old) || !defined(wantarray);
     return unless $old =~ /=/; # not a form
     map { s/\+/ /g; uri_unescape($_) }
-         map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/&/, $old);
+         map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]/, $old);
 }
 
 # Handle ...?dog+bones type of query
diff --git a/t/query.t b/t/query.t
index 2918175..dc740e6 100644
--- a/t/query.t
+++ b/t/query.t
@@ -1,6 +1,6 @@
 #!perl -w
 
-print "1..18\n";
+print "1..23\n";
 
 use strict;
 use URI ();
@@ -80,6 +80,30 @@ $u->query_form(a => { foo => 1 });
 print "not " unless "$u" =~ /^\?a=HASH\(/;
 print "ok 18\n";
 
+$u->query_form(a => 1, b => 2, ';');
+print "not " unless $u eq "?a=1;b=2";
+print "ok 19\n";
+
+$u->query_form(a => 1, c => 2);
+print "not " unless $u eq "?a=1;c=2";
+print "ok 20\n";
+
+$u->query_form(a => 1, c => 2, '&');
+print "not " unless $u eq "?a=1&c=2";
+print "ok 21\n";
+
+$u->query_form([a => 1, b => 2], ';');
+print "not " unless $u eq "?a=1;b=2";
+print "ok 22\n";
+
+$u->query_form([]);
+{
+    local $URI::DEFAULT_QUERY_FORM_DELIMITER = ';';
+    $u->query_form(a => 1, b => 2);
+}
+print "not " unless $u eq "?a=1;b=2";
+print "ok 23\n";
+
 __END__
 # Some debugging while writing new tests
 print "\@q='", join(":", @q), "'\n";
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.