Wed Jun 7 14:36:30 EDT 2006 mark@summersault.com
* Add submit_form_ok() method.
diff -rN -u old-Test-WWW-Mechanize-1.08/Changes new-Test-WWW-Mechanize-1.08/Changes
--- old-Test-WWW-Mechanize-1.08/Changes 2006-06-07 14:36:59.000000000 -0400
+++ new-Test-WWW-Mechanize-1.08/Changes 2006-06-07 14:36:59.000000000 -0400
@@ -1,5 +1,8 @@
Revision history for Test-WWW-Mechanize
+ [ENHANCEMENTS]
+ * Added submit_form_ok() method. Thanks to Mark Stosberg.
+
1.08
[FIXES]
* has_tag_like()'s regex was reversed, so would match when
diff -rN -u old-Test-WWW-Mechanize-1.08/Mechanize.pm new-Test-WWW-Mechanize-1.08/Mechanize.pm
--- old-Test-WWW-Mechanize-1.08/Mechanize.pm 2006-06-07 14:36:59.000000000 -0400
+++ new-Test-WWW-Mechanize-1.08/Mechanize.pm 2006-06-07 14:36:59.000000000 -0400
@@ -665,6 +665,54 @@
return $ok;
}
+=head2 submit_form_ok( \%parms [, $comment] )
+
+Makes a C<submit_form()> call and executes tests on the results.
+The form must be found, and then submitted successfully. Otherwise,
+this test fails.
+
+I<%parms> is a hashref containing the parms to pass to C<submit_form()>.
+Note that the parms to C<submit_form()> are a hash whereas the parms to
+this function are a hashref. You have to call this function like:
+
+ $agent->submit_form_ok( {n=>3}, "looking for 3rd link" );
+
+As with other test functions, C<$comment> is optional. If it is supplied
+then it will display when running the test harness in verbose mode.
+
+Returns true value if the specified link was found and followed
+successfully. The L<HTTP::Response> object returned by submit_form()
+is not available.
+
+=cut
+
+sub submit_form_ok {
+ my $self = shift;
+ my $parms = shift || {};
+ my $comment = shift;
+
+ # return from submit_form() is an HTTP::Response or undef
+ my $response = $self->submit_form( %$parms );
+
+ my $ok;
+ my $error;
+ if ( !$response ) {
+ $error = "No matching form found";
+ } else {
+ if ( !$response->is_success ) {
+ $error = $response->as_string;
+ } else {
+ $ok = 1;
+ }
+ }
+
+ $Test->ok( $ok, $comment );
+ $Test->diag( $error ) if $error;
+
+ return $ok;
+}
+
+
=head2 $agent->stuff_inputs( [\%options] )
XXX Delete this when it winds up in Test::WWW::Mechanize
diff -rN -u old-Test-WWW-Mechanize-1.08/t/submit_form_ok.t new-Test-WWW-Mechanize-1.08/t/submit_form_ok.t
--- old-Test-WWW-Mechanize-1.08/t/submit_form_ok.t 1969-12-31 19:00:00.000000000 -0500
+++ new-Test-WWW-Mechanize-1.08/t/submit_form_ok.t 2006-06-07 14:36:59.000000000 -0400
@@ -0,0 +1,55 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More 'no_plan';
+use Test::Builder::Tester;
+use URI::file;
+
+use constant PORT => 13432;
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+
+my $server=TWMServer->new(PORT);
+my $pid=$server->background;
+ok($pid,'HTTP Server started') or die "Can't start the server";
+
+sub cleanup { kill(9,$pid) };
+$SIG{__DIE__}=\&cleanup;
+
+SUBMIT_GOOD_FORM: {
+ my $mech = Test::WWW::Mechanize->new();
+ isa_ok( $mech,'Test::WWW::Mechanize' );
+
+ $mech->get('
http://localhost:'.PORT.'/form.html');
+ $mech->submit_form_ok( {form_number =>1}, "Submit First Form" );
+}
+
+cleanup();
+
+{
+ package TWMServer;
+ use base 'HTTP::Server::Simple::CGI';
+
+ sub handle_request {
+ my $self=shift;
+ my $cgi=shift;
+
+ my $file=(split('/',$cgi->path_info))[-1]||'index.html';
+ $file=~s/\s+//g;
+
+ if(-r "t/html/$file") {
+ if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
+ print "HTTP/1.0 200 OK\r\n";
+ print "Content-Type: text/html\r\nContent-Length: ",
+ length($response), "\r\n\r\n", $response;
+ return;
+ }
+ }
+
+ print "HTTP/1.0 404 Not Found\r\n\r\n";
+ }
+}
RT for rt.cpan.org