url_params_build implementation

Author: Grinnz

lib/URL/Encode.pod

@@ -14,6 +14,8 @@ URL::Encode - Encoding and decoding of C<application/x-www-form-urlencoded> enco
     $params = url_params_mixed($octets [, $utf8 = false]);
     $params = url_params_multi($octets [, $utf8 = false]);
               url_params_each($octets, $callback [, $utf8 = false]);
+    
+    $octets = url_params_build($params [, $utf8 = false [, delim = '&'] ]);
 
 =head1 DESCRIPTION
 
@@ -117,6 +119,23 @@ Invokes the given callback for each URL-decoded name/value pair.
 
     url_params_each($octets, $callback);
 
+=head2 url_params_build
+
+    $octets = url_params_build($params);
+    $octets = url_params_build($params, $utf8);
+    $octets = url_params_build($params, $utf8, $delim);
+
+Builds a URL-encoded string from the given ARRAY or HASH reference containing
+URL-decoded name/value pairs. Multiple occurrences of a parameter may be
+specified as an ARRAY reference of values in order. Keys of a HASH reference
+will be sorted for consistency.
+
+    $octets = url_params_build({ foo => [ 'A', 'B' ], bar => 'C' });
+    $octets; # bar=C&foo=A&foo=B
+
+    $octets = url_params_build([ foo => 'A', foo => 'B', bar => 'C' ]);
+    $octets; # foo=A&foo=B&bar=C
+
 =head1 EXPORTS
 
 None by default. All functions can be exported using the C<:all> tag or individually.

lib/URL/Encode/PP.pm

@@ -14,7 +14,8 @@ BEGIN {
                          url_params_each
                          url_params_flat
                          url_params_mixed
-                         url_params_multi ];
+                         url_params_multi
+                         url_params_build ];
     require Exporter;
     *import = \&Exporter::import;
 }
@@ -130,5 +131,30 @@ sub url_params_multi {
     return \%p;
 }
 
+sub url_params_build {
+    @_ == 1 || @_ == 2 || Carp::croak(q/Usage: url_params_build(params [, utf8 [, delim] ])/);
+    my ($p, $utf8, $delim) = @_;
+    $delim = '&' unless defined $delim;
+    utf8::encode($delim) if $utf8;
+
+    $p = [map { ($_ => $p->{$_}) } sort keys %$p] if ref $p eq 'HASH';
+
+    my $s = '';
+    while (my ($k, $v) = splice @$p, 0, 2) {
+        my @v = ref $v eq 'ARRAY' ? @$v : $v;
+        for ($k, @v) {
+            $_ = '' unless defined $_;
+            utf8::encode($_) if $utf8;
+            s/([^0-9A-Za-z_.~-])/$EncodeMap{$1}/gs;
+        }
+        for (@v) {
+            $s .= $delim if length $s;
+            $s .= "$k=$_";
+        }
+    }
+
+    return $s;
+}
+
 1;
 

t/020_params.t

@@ -2,12 +2,14 @@ use strict;
 use warnings;
 
 use Test::More;
+use Data::Dumper;
 
 BEGIN {
     use_ok('URL::Encode::PP', qw[ url_params_each
                                   url_params_flat
                                   url_params_mixed
-                                  url_params_multi ]);
+                                  url_params_multi
+                                  url_params_build ]);
 }
 
 {
@@ -123,5 +125,44 @@ BEGIN {
     is($cnt, 3, 'url_params_each(): callback invoked three times');
 }
 
+{
+    my @tests = (
+        [ 'b=&a=',              => [ 'b'    => undef,            'a'  => undef            ] ],
+        [ 'a=&a=&b=',           => [ 'a'    => [ undef, undef ], 'b'  => undef            ] ],
+        [ 'a=&a=&b=&b=',        => [ 'a'    => [ undef, undef ], 'b'  => [ undef, undef ] ] ],
+        [ 'a+=&+b=',            => [ 'a '   => undef,            ' b' => undef            ] ],
+        [ 'a=%3D1&b=%3D2',      => [ 'a'    => '=1',             'b'  => '=2'             ] ],
+        [ 'Fo%252=',            => [ 'Fo%2' => ''                                         ] ],
+        [ '+a+=+1+'             => [ ' a '  => ' 1 '                                      ] ],
+        [ '=&='                 => [ ''     => [ undef, undef ],                          ] ],
+        [ '=&='                 => [ ''     => [ undef, '' ]                              ] ],
+        [ '=&='                 => [ ''     => [ '', undef ]                              ] ],
+        [ '=&='                 => [ ''     => [ '', '' ]                                 ] ],
+        [ '=',                  => [ ''     => '',                                        ] ],
+        [ '',                   => [                                                      ] ],
+        [ 'a=&b=',              => { 'b'    => undef,            'a'  => undef            } ],
+        [ 'a=&a=&b=',           => { 'a'    => [ undef, undef ], 'b'  => undef            } ],
+        [ 'a=&a=&b=&b=',        => { 'a'    => [ undef, undef ], 'b'  => [ undef, undef ] } ],
+        [ '+b=&a+=',            => { 'a '   => undef,            ' b' => undef            } ],
+        [ 'a=%3D1&b=%3D2',      => { 'a'    => '=1',             'b'  => '=2'             } ],
+        [ 'Fo%252=',            => { 'Fo%2' => ''                                         } ],
+        [ '+a+=+1+'             => { ' a '  => ' 1 '                                      } ],
+        [ '=&='                 => { ''     => [ undef, undef ],                          } ],
+        [ '=&='                 => { ''     => [ undef, '' ]                              } ],
+        [ '=&='                 => { ''     => [ '', undef ]                              } ],
+        [ '=&='                 => { ''     => [ '', '' ]                                 } ],
+        [ '=',                  => { ''     => '',                                        } ],
+        [ '',                   => {                                                      } ],
+    );
+
+    foreach my $test (@tests) {
+        my ($expected, $params) = @$test;
+        local $Data::Dumper::Indent = 0;
+        local $Data::Dumper::Terse = 1;
+        my $params_str = Dumper($params);
+        is_deeply(url_params_build($params), $expected, qq[url_params_build("$params_str")]);
+    }
+}
+
 done_testing();