Skip Menu |
 

This queue is for tickets about the libwww-perl CPAN distribution.

Report information
The Basics
Id: 35607
Status: resolved
Priority: 0/
Queue: libwww-perl

People
Owner: Nobody in particular
Requestors: MARKSTOS [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Critical
Broken in: 5.812
Fixed in: (no value)



Subject: PATCH: Regression: multiple forms with same-named <select> elements don't get parsed properly
Download (untitled) / with headers
text/plain 689b
The attached patch adds a test and code to illustrate and fixe a regression we found in HTML::Form when running it against our project test suite. When two forms both contained a <select> tag with the same name, the values of the <select> in the second form were getting parsed improperly. I fixed it by moving a cache of which "select" tags had been seen from a global data structure to a local one. This should be tested against the rest of the HTML::Form suite to make sure that doesn't open up a new hole. The one potential problem I would see would be with very invalid HTML where a <select> tag is opened in one <form> tag and closed in a second <form> tag declaration (!).
Subject: HTML-Form-multi-select.patch
Fri May 2 18:02:19 EDT 2008 mark@summersault.com * Patch HTML::Form to fix bug triggered by multiple <select> forms with same-named elements diff -rN -u old/lib/HTML/Form.pm old/lib/HTML/Form.pm --- old/lib/HTML/Form.pm 2008-05-02 18:06:24.000000000 -0400 +++ new/lib/HTML/Form.pm 2008-05-02 18:06:27.000000000 -0400 @@ -137,8 +138,6 @@ my @forms; my $f; # current form - my %openselect; # index to the open instance of a select - while (my $t = $p->get_tag) { my($tag,$attr) = @$t; if ($tag eq "form") { @@ -201,7 +200,8 @@ if exists $attr->{$_}; } # count this new select option separately - $openselect{$attr->{name}}++; + # "openselect" is used index to the open instance of a select + $f->{openselect}{$attr->{name}}++; while ($t = $p->get_tag) { my $tag = shift @$t; @@ -221,7 +221,7 @@ $a{value_name} = $p->get_trimmed_text; $a{value} = delete $a{value_name} unless defined $a{value}; - $a{idx} = $openselect{$attr->{name}}; + $a{idx} = $f->{openselect}{$attr->{name}}; $f->push_input("option", \%a); } else { @@ -253,6 +253,7 @@ warn("<$tag> outside <form> in $base_uri\n") if $verbose; } } + for (@forms) { $_->fixup; } diff -rN -u old/t/HTML-Form-multiple-forms-with-select.pl new/t/HTML-Form-multiple-forms-with-select.pl --- old/t/HTML-Form-multiple-forms-with-select.pl 1969-12-31 19:00:00.000000000 -0500 +++ new/t/HTML-Form-multiple-forms-with-select.pl 2008-05-02 18:06:43.000000000 -0400 @@ -0,0 +1,98 @@ +#!/usr/bin/perl + +# Test for case when multiple forms are on a page with same-named <select> fields. + +use Test::More 'no_plan'; +use FindBin '$Bin'; +use lib "../../perllib"; +use HTML::Form; + +{ + my $test = "the settings of a previous form should not interfere with a latter form (control test with one form)"; + my @forms = HTML::Form->parse( FakeResponse::One->new ); + my $cat_form = $forms[0]; + my @vals = $cat_form->param('age'); + is_deeply(\@vals,[''], $test); +} +{ + my $test = "the settings of a previous form should not interfere with a latter form (test with two forms)"; + my @forms = HTML::Form->parse( FakeResponse::TwoForms->new ); + my $cat_form = $forms[1]; + + my @vals = $cat_form->param('age'); + is_deeply(\@vals,[''], $test); +} + +#### +package FakeResponse::One; +sub new { + bless {}, shift; +} +sub base { + return "http://foo.com" +} +sub decoded_content { + my $html = qq{ + <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> + <html xmlns="http://www.w3.org/1999/xhtml"> + <head> + <title></title> + </head> + <body> + + <form name="search_cats"> + <select name="age" onChange="jumpTo(this)" class="sap-form-item"> + <option value="" selected="selected">Any</option> + <option value="young">Young</option> + <option value="adult">Adult</option> + <option value="senior">Senior</option> + <option value="puppy">Puppy </option> + </select> + </form> + </body></html> + }; + return \$html; +} + +##### +package FakeResponse::TwoForms; +sub new { + bless {}, shift; +} +sub base { + return "http://foo.com" +} +sub decoded_content { + my $html = qq{ + <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> + <html xmlns="http://www.w3.org/1999/xhtml"> + <head> + <title></title> + </head> + <body> + <form name="search_dogs" > + <select name="age" onChange="jumpTo(this)" class="sap-form-item"> + <option value="" selected="selected">Any</option> + <option value="young">Young</option> + <option value="adult">Adult</option> + <option value="senior">Senior</option> + <option value="puppy">Puppy </option> + </select> + </form> + + + <form name="search_cats"> + <select name="age" onChange="jumpTo(this)" class="sap-form-item"> + <option value="" selected="selected">Any</option> + <option value="young">Young</option> + <option value="adult">Adult</option> + <option value="senior">Senior</option> + <option value="puppy">Puppy </option> + </select> + </form> + </body></html> + }; + return \$html; +}
Subject: HTML-Form-croak-dont-die.patch
Fri May 2 17:45:09 EDT 2008 mark@summersault.com * Patch HTML::Form: better diagnostics when HTML::TokeParser creation fails --- old/lib/HTML/Form.pm 2008-05-02 18:06:24.000000000 -0400 +++ new/lib/HTML/Form.pm 2008-05-02 18:06:27.000000000 -0400 @@ -112,7 +112,8 @@ my %opt = @_; require HTML::TokeParser; - my $p = HTML::TokeParser->new(ref($html) ? $html->decoded_content(ref => 1) : \$html); + my $p = HTML::TokeParser->new(ref($html) ? $html->decoded_content(ref => 1) : \$html) + || Carp::croak("failed to create HTML::TokeParser object: $!"); eval { # optimization $p->report_tags(qw(form input textarea select optgroup option keygen label button));
Subject: PATCH: better diagnostics when HTML::TokeParser constructer fails
Download (untitled) / with headers
text/plain 352b
I forgot to mention my last submission included a "bonus patch" that provides better diagnostics when the HTML::TokeParser constructor fails. I'm not sure how this would be triggered normally, but I triggered it while writing a test. Without this patch, the code fails rather poorly with an error about calling "get_tag" on undefined value. Mark
Download (untitled) / with headers
text/plain 542b
Thanks. I've now applied a simpler version of your patch (see below) together with the test and the constructor check. Still considering what to do about the incompatibility you describe in RT#18993. --- a/lib/HTML/Form.pm +++ b/lib/HTML/Form.pm @@ -150,6 +150,7 @@ sub parse $action, $attr->{'enctype'}); $f->{attr} = $attr; + %openselect = (); push(@forms, $f); my(%labels, $current_label); while (my $t = $p->get_tag) {


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.