At Andy's behest, I've added some test (and, in the process, another small error-
catching fix to Mech).
The new patch is enclosed.
Linda
diff -urN /root/.cpan/build/WWW-Mechanize-0.72/MANIFEST WWW-Mechanize-0.72/MANIFEST
--- /root/.cpan/build/WWW-Mechanize-0.72/MANIFEST Mon Jan 5 10:37:15 2004
+++ WWW-Mechanize-0.72/MANIFEST Tue Feb 17 21:24:01 2004
@@ -51,6 +51,8 @@
t/referer.t
t/regex-error.t
t/reload.t
+t/select.html
+t/select.t
t/submit.t
t/tick.html
t/tick.t
diff -urN /root/.cpan/build/WWW-Mechanize-0.72/blib/lib/WWW/Mechanize.pm WWW-Mechanize-0.72/blib/lib/WWW/Mechanize.pm
--- /root/.cpan/build/WWW-Mechanize-0.72/blib/lib/WWW/Mechanize.pm Mon Jan 12 23:36:36 2004
+++ WWW-Mechanize-0.72/blib/lib/WWW/Mechanize.pm Tue Feb 17 21:26:43 2004
@@ -516,6 +516,38 @@
}
}
+=head2 $mech->select($name, $value)
+=head2 $mech->select($name, \@values)
+
+Given the name of a C<select> field, set its value to the value
+specified. If the field is not E<lt>select multipleE<gt> and the
+C<$value> is an array, only the last value will be set. This applies
+to the current form (as set by the C<L<form()>> method or defaulting
+to the first form on the page).
+
+=cut
+
+sub select {
+ my ($self, $name, $value) = @_;
+
+ my $form = $self->{form};
+
+ my $input = $form->find_input($name);
+ if (!$input) {
+ $self->warn( qq{ Input "$name" not found } );
+ return undef;
+ } elsif ($input->type ne 'option') {
+ $self->warn( qq{ Input "$name" is not type "select" } );
+ return undef;
+ }
+
+ if (ref($value) eq "ARRAY") {
+ $form->param($name, $value);
+ } else {
+ $form->value($name => $value);
+ }
+}
+
=head2 $mech->field($name, $value, $number)
Given the name of a field, set its value to the value specified. This
@@ -535,7 +567,11 @@
if ($number > 1) {
$form->find_input($name, undef, $number)->value($value);
} else {
- $form->value($name => $value);
+ if (ref($value) eq "ARRAY") {
+ $form->param($name, $value);
+ } else {
+ $form->value($name => $value);
+ }
}
}
diff -urN /root/.cpan/build/WWW-Mechanize-0.72/lib/WWW/Mechanize.pm WWW-Mechanize-0.72/lib/WWW/Mechanize.pm
--- /root/.cpan/build/WWW-Mechanize-0.72/lib/WWW/Mechanize.pm Mon Jan 12 23:36:36 2004
+++ WWW-Mechanize-0.72/lib/WWW/Mechanize.pm Tue Feb 17 21:26:43 2004
@@ -516,6 +516,38 @@
}
}
+=head2 $mech->select($name, $value)
+=head2 $mech->select($name, \@values)
+
+Given the name of a C<select> field, set its value to the value
+specified. If the field is not E<lt>select multipleE<gt> and the
+C<$value> is an array, only the last value will be set. This applies
+to the current form (as set by the C<L<form()>> method or defaulting
+to the first form on the page).
+
+=cut
+
+sub select {
+ my ($self, $name, $value) = @_;
+
+ my $form = $self->{form};
+
+ my $input = $form->find_input($name);
+ if (!$input) {
+ $self->warn( qq{ Input "$name" not found } );
+ return undef;
+ } elsif ($input->type ne 'option') {
+ $self->warn( qq{ Input "$name" is not type "select" } );
+ return undef;
+ }
+
+ if (ref($value) eq "ARRAY") {
+ $form->param($name, $value);
+ } else {
+ $form->value($name => $value);
+ }
+}
+
=head2 $mech->field($name, $value, $number)
Given the name of a field, set its value to the value specified. This
@@ -535,7 +567,11 @@
if ($number > 1) {
$form->find_input($name, undef, $number)->value($value);
} else {
- $form->value($name => $value);
+ if (ref($value) eq "ARRAY") {
+ $form->param($name, $value);
+ } else {
+ $form->value($name => $value);
+ }
}
}
diff -urN /root/.cpan/build/WWW-Mechanize-0.72/t/select.html WWW-Mechanize-0.72/t/select.html
--- /root/.cpan/build/WWW-Mechanize-0.72/t/select.html Wed Dec 31 19:00:00 1969
+++ WWW-Mechanize-0.72/t/select.html Tue Feb 17 21:22:30 2004
@@ -0,0 +1,22 @@
+<HTML>
+<HEAD>
+ Like a hole
+</HEAD>
+<BODY BGCOLOR="puce">
+<FORM ACTION="/shake-some/">
+<select name="multilist" rows=4 multiple>
+<option value="aaa">aaa</a>
+<option value="bbb">bbb</a>
+<option value="ccc">ccc</a>
+<option value="ddd">ddd</a>
+</select>
+
+<select name="singlelist" rows=4>
+<option value="aaa">aaa</a>
+<option value="bbb">bbb</a>
+<option value="ccc">ccc</a>
+<option value="ddd">ddd</a>
+</select>
+</FORM>
+</BODY>
+</HTML>
diff -urN /root/.cpan/build/WWW-Mechanize-0.72/t/select.t WWW-Mechanize-0.72/t/select.t
--- /root/.cpan/build/WWW-Mechanize-0.72/t/select.t Wed Dec 31 19:00:00 1969
+++ WWW-Mechanize-0.72/t/select.t Tue Feb 17 21:22:42 2004
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use Test::More tests => 7;
+use URI::file;
+
+BEGIN {
+ use_ok( 'WWW::Mechanize' );
+}
+
+my $mech = WWW::Mechanize->new( cookie_jar => undef );
+isa_ok( $mech, 'WWW::Mechanize' );
+
+my $uri = URI::file->new_abs( "t/select.html" )->as_string;
+my $response = $mech->get( $uri );
+ok( $response->is_success, "Fetched $uri" );
+
+my (@send, @return, $form);
+push @send, "bbb";
+push @send, "ccc";
+
+ok($mech->form_number(1), "set form to number 1");
+$form = $mech->current_form();
+
+# multi-select list
+$mech->select("multilist",\@send);
+@return = $form->param("multilist");
+cmp_ok( @return, 'eq', @send, "value is " . join(' ', @send));
+
+# single select list
+
+# push an array of values
+# only the last should be set
+$mech->select("singlelist",\@send);
+@return = $form->param("singlelist");
+push my @singlereturn, pop(@send);
+cmp_ok( @return, 'eq', @singlereturn, "value is " . pop(@send));
+
+# push a single value into a single select
+$mech->select("singlelist","aaa");
+is( $form->param("singlelist"), "aaa", "value is 'aaa'");
RT for rt.cpan.org