[dw-free] Non-Apache-specific way to to grab multiple form values

[fu]

[commit: http://hg.dwscoalition.org/dw-free/rev/4a41024ab8ed]

http://bugs.dwscoalition.org/show_bug.cgi?id=3729

Use Hash::MultiValue as the backer for post_args and get_args . When we
expect an array, use get_all instead of get. Works with both new code and
legacy BML \0 separators.

Patch by exor674; additional modifications to controllers by
fu

Files modified:

• bin/checkconfig.pl
• cgi-bin/DW/Controller/Rename.pm
• cgi-bin/DW/Request.pm
• cgi-bin/DW/Request/Apache2.pm
• cgi-bin/DW/Request/Base.pm
• cgi-bin/DW/Request/Standard.pm
• cgi-bin/DW/Template/Plugin/FormHTML.pm
• cgi-bin/ljtextutil.pl
• t/request-multi.t

--------------------------------------------------------------------------------
diff -r 29ee796ebdae -r 4a41024ab8ed bin/checkconfig.pl
--- a/bin/checkconfig.pl	Mon Oct 03 15:27:38 2011 +0800
+++ b/bin/checkconfig.pl	Mon Oct 03 17:16:38 2011 +0800
@@ -207,6 +207,7 @@
                    'deb' => "libbusiness-creditcard-perl",
                    'opt' => "Required for taking credit/debit cards in the shop.",
                },
+               "Hash::MultiValue" => {},
               );
 
 
diff -r 29ee796ebdae -r 4a41024ab8ed cgi-bin/DW/Controller/Rename.pm
--- a/cgi-bin/DW/Controller/Rename.pm	Mon Oct 03 15:27:38 2011 +0800
+++ b/cgi-bin/DW/Controller/Rename.pm	Mon Oct 03 17:16:38 2011 +0800
@@ -115,9 +115,9 @@
                 touser      => $post_args->{touser} || $get_args->{to} || "",
                 redirect    => $post_args->{redirect} || "disconnect",
                 rel_types   => \@rel_types,
-                rel_options => %$post_args ? { map { $_ => 1 } $post_args->get( "rel_options" ) }
+                rel_options => %$post_args ? { map { $_ => 1 } $post_args->get_all( "rel_options" ) }
                                             : { map { $_ => 1 } @rel_types },
-                others      => %$post_args ? { map { $_ => 1 } $post_args->get( "others" ) }
+                others      => %$post_args ? { map { $_ => 1 } $post_args->get_all( "others" ) }
                                             : { email => 0 },
             };
 
@@ -152,7 +152,7 @@
 
     # since you can't recover deleted relationships, but you can delete the relationships later if something was missed
     # negate the form submission so we're explicitly stating which rels we want to delete, rather than deleting everything not listed
-    my %keep_rel = map { $_ => 1 } $post_args->get( "rel_options" );
+    my %keep_rel = map { $_ => 1 } $post_args->get_all( "rel_options" );
     my %del_rel = map { +"del_$_" => ! $keep_rel{$_} } qw( trusted_by watched_by trusted watched communities );
 
     my %other_opts = map { $_ => 1 } $post_args->get( "others" );
@@ -352,7 +352,7 @@
     if( $post_args->{override_relationships} ) {
         # since you can't recover deleted relationships, but you can delete the relationships later if something was missed
         # negate the form submission so we're explicitly stating which rels we want to delete, rather than deleting everything not listed
-        my %keep_rel = map { $_ => 1 } $post_args->get( "rel_options" );
+        my %keep_rel = map { $_ => 1 } $post_args->get_all( "rel_options" );
         my %del_rel = map { +"del_$_" => ! $keep_rel{$_} } qw( trusted_by watched_by trusted watched communities );
 
         $rename_opts{del} = \%del_rel;
@@ -360,7 +360,7 @@
 
 
     if( $post_args->{override_others} ) {
-        my %other_opts = map { $_ => 1 } $post_args->get( "others" );
+        my %other_opts = map { $_ => 1 } $post_args->get_all( "others" );
 
         # force email to false if we can't support forwarding for this user
         if ( $other_opts{email} ) {
diff -r 29ee796ebdae -r 4a41024ab8ed cgi-bin/DW/Request.pm
--- a/cgi-bin/DW/Request.pm	Mon Oct 03 15:27:38 2011 +0800
+++ b/cgi-bin/DW/Request.pm	Mon Oct 03 17:16:38 2011 +0800
@@ -29,6 +29,7 @@
 use strict;
 use DW::Request::Apache2;
 use DW::Request::Standard;
+use Hash::MultiValue;
 
 our ( $cur_req, $determined );
 
@@ -166,7 +167,7 @@
 
 =head2 C<< $r->post_args >>
 
-Get the POST arguments.
+Return the POST arguments.
 
 =head2 C<< $r->print( $string ) >>
 
diff -r 29ee796ebdae -r 4a41024ab8ed cgi-bin/DW/Request/Apache2.pm
--- a/cgi-bin/DW/Request/Apache2.pm	Mon Oct 03 15:27:38 2011 +0800
+++ b/cgi-bin/DW/Request/Apache2.pm	Mon Oct 03 17:16:38 2011 +0800
@@ -28,6 +28,7 @@
 use Apache2::RequestUtil ();
 use Apache2::RequestIO ();
 use Apache2::SubProcess ();
+use Hash::MultiValue;
 
 use fields (
             'r',         # The Apache2::Request object
@@ -35,7 +36,6 @@
             # these are mutually exclusive; if you use one you can't use the other
             'content',   # raw content
             'post_args', # hashref of POST arguments
-            'get_args',  # hashref of GET arguments
         );
 
 # creates a new DW::Request object, based on what type of server environment we
@@ -101,26 +101,25 @@
     return $self->{content} = $buff;
 }
 
-# get POST arguments as an APR::Table object (which is a tied hashref)
 sub post_args {
     my DW::Request::Apache2 $self = $_[0];
 
     die "already loaded content\n"
         if defined $self->{content};
 
-    unless ( defined $self->{post_args} ) {
-        my $tmp_r = Apache2::Request->new( $self->{r} );
-        $self->{post_args} = $tmp_r->body;
+    return $self->{post_args} if defined $self->{post_args};
+
+    my $tmp_r = Apache2::Request->new( $self->{r} );
+    my $data = $tmp_r->body;
+
+    my @out;
+    foreach my $key ( keys %$data ) {
+        my @val = $data->get( $key );
+        next unless @val;
+        push @out, map { $key => $_ } @val;
     }
-    return $self->{post_args};
-}
 
-sub get_args {
-    my DW::Request::Apache2 $self = $_[0];
-    return $self->{get_args} if defined $self->{get_args};
-
-    my %gets = LJ::parse_args( $self->query_string );
-    return $self->{get_args} = \%gets;
+    return $self->{post_args} = Hash::MultiValue->new( @out );
 }
 
 # searches for a given note and returns the value, or sets it
diff -r 29ee796ebdae -r 4a41024ab8ed cgi-bin/DW/Request/Base.pm
--- a/cgi-bin/DW/Request/Base.pm	Mon Oct 03 15:27:38 2011 +0800
+++ b/cgi-bin/DW/Request/Base.pm	Mon Oct 03 17:16:38 2011 +0800
@@ -24,6 +24,8 @@
 use fields (
             'cookies_in',
             'cookies_in_multi',
+
+            'get_args',
         );
 
 sub new {
@@ -33,6 +35,8 @@
 
     $self->{cookies_in} = undef;
     $self->{cookies_in_multi} = undef;
+
+    $self->{get_args} = undef;
 }
 
 sub cookie {
@@ -76,6 +80,29 @@
     return $self->add_cookie( %args );
 }
 
+# FIXME: This relies on the behavior parse_args
+#   and the \0 seperated arguments. This should be cleaned
+#   up at the same point parse_args is.
+sub _string_to_multivalue {
+    my %gets = LJ::parse_args( $_[1] );
+
+    my @out;
+    foreach my $key ( keys %gets ) {
+        my @parts = split(/\0/, $gets{$key});
+        push @out, map { $key => $_ } @parts;
+    }
+
+    return Hash::MultiValue->new( @out );
+}
+
+sub get_args {
+    my DW::Request $self = $_[0];
+    return $self->{get_args} if defined $self->{get_args};
+
+    return $self->{get_args} =
+        $self->_string_to_multivalue( $self->query_string );
+}
+
 #
 # Following sub was copied from CGI::Cookie and modified.
 #
diff -r 29ee796ebdae -r 4a41024ab8ed cgi-bin/DW/Request/Standard.pm
--- a/cgi-bin/DW/Request/Standard.pm	Mon Oct 03 15:27:38 2011 +0800
+++ b/cgi-bin/DW/Request/Standard.pm	Mon Oct 03 17:16:38 2011 +0800
@@ -35,7 +35,6 @@
             # these are mutually exclusive; if you use one you can't use the other
             'content',   # raw content
             'post_args', # hashref of POST arguments
-            'get_args',  # hashref of GET arguments
 
             # we have to parse these out ourselves
             'uri',
@@ -124,7 +123,6 @@
     return $self->{res}->as_string;
 }
 
-# get POST arguments as an APR::Table object (which is a tied hashref)
 sub post_args {
     my DW::Request::Standard $self = $_[0];
 
@@ -135,13 +133,8 @@
 
     # get the content and parse it.  I would have expected there to be some
     # official method of doing this on HTTP::Request?  guess not.
-    return $self->{post_args} = { LJ::parse_args( $self->{req}->content ) };
-}
-
-sub get_args {
-    my DW::Request::Standard $self = $_[0];
-    return $self->{get_args} if defined $self->{get_args};
-    return $self->{get_args} = { LJ::parse_args( $self->query_string ) };
+    return $self->{post_args} =
+        $self->_string_to_multivalue( $self->{req}->content );
 }
 
 # searches for a given note and returns the value, or sets it
diff -r 29ee796ebdae -r 4a41024ab8ed cgi-bin/DW/Template/Plugin/FormHTML.pm
--- a/cgi-bin/DW/Template/Plugin/FormHTML.pm	Mon Oct 03 15:27:38 2011 +0800
+++ b/cgi-bin/DW/Template/Plugin/FormHTML.pm	Mon Oct 03 17:16:38 2011 +0800
@@ -26,7 +26,7 @@
 
 The form plugin generates HTML elements with attributes suitably escaped, and values automatically prepopulated, depending on the form's data field.
 
-The "data" field is a hashref, with the keys being the form element's name, and the values being the form element's desired value.
+The "data" field is an instance of Hash::MultiValue, with the keys being the form element's name, and the values being the form element's desired value.
 
 If a "formdata" property is available via the context, this is used to automatically populate the plugin's data field.
 =cut
@@ -79,10 +79,8 @@
 
     my $ret = "";
 
-    # FIXME: check an array of args, rather than expecting this to be an APR::RequestTable
-    # processes any previous form submissions. Doing this out here as it's special-cased
     if ( ! defined $args->{selected} && $self->{data} ) {
-        my %selected = map { $_ => 1 } $self->{data}->get( $args->{name} );
+        my %selected = map { $_ => 1 } $self->{data}->get_all( $args->{name} );
         $args->{selected} = $selected{$args->{value}};
     }
 
@@ -121,10 +119,8 @@
 
     my $ret = "";
 
-    # FIXME: check an array of args, rather than expecting this to be an APR::RequestTable
-    # processes any previous form submissions. Doing this out here as it's special-cased
     if ( ! defined $args->{selected} && $self->{data} ) {
-        my %selected = map { $_ => 1 } $self->{data}->get( $args->{name} );
+        my %selected = map { $_ => 1 } $self->{data}->get_all( $args->{name} );
         $args->{selected} = $selected{$args->{value}};
     }
 
diff -r 29ee796ebdae -r 4a41024ab8ed cgi-bin/ljtextutil.pl
--- a/cgi-bin/ljtextutil.pl	Mon Oct 03 15:27:38 2011 +0800
+++ b/cgi-bin/ljtextutil.pl	Mon Oct 03 17:16:38 2011 +0800
@@ -36,6 +36,10 @@
 
 # similar to decode_url_string below, but a nicer calling convention.  returns
 # a hash of items parsed from the string passed in as the only argument.
+
+# FIXME: This method using \0 is being used in legacy locations
+#  however should be factored out ( to Hash::MultiValue )
+#  as soon as the need for the legacy use is removed.
 sub parse_args {
     my $args = $_[0];
     return unless defined $args;
diff -r 29ee796ebdae -r 4a41024ab8ed t/request-multi.t
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/request-multi.t	Mon Oct 03 17:16:38 2011 +0800
@@ -0,0 +1,76 @@
+# -*-perl-*-
+use strict;
+use Test::More tests => 2;
+use lib "$ENV{LJHOME}/cgi-bin";
+
+require 'ljlib.pl';
+use DW::Request::Standard;
+use HTTP::Request;
+
+check_get(
+    "foo=bar&bar=baz&foo=qux",
+    sub {
+        plan tests => 6;
+
+        my $r = DW::Request->get;
+        my $args = $r->get_args;
+
+        is( 'qux', $args->{foo} );
+        is( 'qux', $args->get('foo') );
+        is_deeply( ['bar','qux'], [ $args->get_all('foo') ] );
+
+        is( 'baz', $args->{bar} );
+        is( 'baz', $args->get('bar') );
+        is_deeply( ['baz'], [ $args->get_all('bar') ] );
+    }
+);
+
+check_post(
+    "foo=bar&bar=baz&foo=qux",
+    sub {
+        plan tests => 6;
+
+        my $r = DW::Request->get;
+        my $args = $r->post_args;
+
+        is( 'qux', $args->{foo} );
+        is( 'qux', $args->get('foo') );
+        is_deeply( ['bar','qux'], [ $args->get_all('foo') ] );
+
+        is( 'baz', $args->{bar} );
+        is( 'baz', $args->get('bar') );
+        is_deeply( ['baz'], [ $args->get_all('bar') ] );
+    }
+);
+
+sub check_get {
+    my ( $args, $sv ) = @_;
+
+    # Telling Test::Builder ( which Test::More uses ) to
+    # look one level further up the call stack.
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+    my $rq = HTTP::Request->new(GET => "http://www.example.com/test?$args");
+
+    DW::Request->reset;
+    my $r = DW::Request::Standard->new( $rq );
+
+    subtest "GET $args", sub { $sv->() };
+}
+
+sub check_post {
+    my ( $args, $sv ) = @_;
+
+    # Telling Test::Builder ( which Test::More uses ) to
+    # look one level further up the call stack.
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+    my $rq = HTTP::Request->new(POST => "http://www.example.com/test");
+    $rq->header( 'Content-Type' => 'multipart/form-data' );
+    $rq->add_content_utf8( $args );
+
+    DW::Request->reset;
+    my $r = DW::Request::Standard->new( $rq );
+
+    subtest "POST $args", sub { $sv->() };
+}
--------------------------------------------------------------------------------