allow action attribute for all_forms_with and form_with

This fixes libwww-perl/HTML-Form#6 without making changes to HTML::Form
at very little extra cost for us.

Author: simbabque

Changes

@@ -1,6 +1,9 @@
 Revision history for WWW::Mechanize
 
 {{$NEXT}}
+    [ENHANCEMENTS]
+    - form_with and all_forms_with() now support the "action" attribute to find
+      forms (GH#349) (Julien Fiegehenn)
 
 2.14      2022-08-15 19:19:24Z
     [FIXED]

lib/WWW/Mechanize.pm

@@ -1784,8 +1784,6 @@ sub form_with_fields {
 
 Searches for forms with arbitrary attribute/value pairs within the E<lt>formE<gt>
 tag.
-(Currently does not work for attribute C<action> due to implementation details
-of L<HTML::Form>.)
 When given more than one pair, all criteria must match.
 Using C<undef> as value means that the attribute in question must not be present.
 
@@ -1796,7 +1794,8 @@ All matching forms (perhaps none) are returned as a list of L<HTML::Form> object
 sub all_forms_with {
     my ( $self, %spec ) = @_;
 
-    my @forms = $self->forms;
+    my $action = delete $spec{action};
+    my @forms = grep { !$action || $_->action eq $action } $self->forms;
     foreach my $attr ( keys %spec ) {
         @forms = grep _equal( $spec{$attr}, $_->attr($attr) ), @forms or return;
     }
@@ -1807,9 +1806,6 @@ sub all_forms_with {
 
 Searches for forms with arbitrary attribute/value pairs within the E<lt>formE<gt>
 tag.
-(Currently does not work for attribute C<action> due to implementation details
-of L<HTML::Form>. Use C<L<< form_action()|/"$mech->form_action( $action )" >>>
-instead.)
 When given more than one pair, all criteria must match.
 Using C<undef> as value means that the attribute in question must not be present.
 

t/form_with_fields.t

@@ -5,7 +5,7 @@ use strict;
 use Test::More 'no_plan';
 use Test::Fatal qw( exception );
 use Test::Warnings ':all';
-use Test::Deep qw( cmp_deeply re );
+use Test::Deep qw( cmp_deeply re array_each code );
 use URI::file ();
 
 BEGIN {
@@ -81,13 +81,31 @@ ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
 
 {
     my @forms = $mech->all_forms_with( name => '3rd_form_ambiguous' );
-    is( scalar @forms, 2 );
+    is( scalar @forms, 2 , 'all_forms_with finds similar forms');
     isa_ok( $forms[0], 'HTML::Form' );
     isa_ok( $forms[1], 'HTML::Form' );
     is($forms[0]->attr('name'), '3rd_form_ambiguous', 'first result of 3rd_form_ambiguous');
     is($forms[1]->attr('name'), '3rd_form_ambiguous', 'second result of 3rd_form_ambiguous');
 }
 
+{
+    my @forms = $mech->all_forms_with( action => 'http://localhost/' );
+    is( scalar @forms, 7, 'all_forms_with action finds all 7 forms' );
+    cmp_deeply(
+        \@forms,
+        array_each(
+            code(
+                # one of the forms is missing the trailing slash, we
+                # should not have it
+                sub {
+                    $_[0]->action eq 'http://localhost/';
+                }
+            )
+        ),
+        '... and all of them have the correct action'
+    );
+}
+
 {
     $mech->get($uri);
     like(

t/local/form.t

@@ -106,6 +106,33 @@ is(
 );
 $mech->quiet(1);
 
+# the server's URL may be in a different form than what the Form actually contains
+my $cli_form_action
+    = ( grep { $_->action =~ m{/google-cli$} } $mech->forms )[0]->action;
+my $form_with_action = $mech->form_with( action => $cli_form_action );
+is(
+    $form_with_action->attr('id'), 'searchbox',
+    'form_with - with with action'
+);
+
+my $formsubmit_form_action
+    = ( grep { $_->action =~ m{/formsubmit$} } $mech->forms )[-1]->action;
+$form_with_action = $mech->form_with(
+    action => $formsubmit_form_action,
+    class  => 'test mf2'
+);
+is(
+    $form_with_action->attr('class'), 'test mf2',
+    'form_with - with action and class'
+);
+
+$form_with_action
+    = $mech->form_with( action => '/does_not_exist', class => 'test' );
+ok(
+    !$form_with_action,
+    'form_with - filters forms when action does not exist'
+);
+
 my $form_id_searchbox = $mech->form_action('google-cli');
 isa_ok( $form_id_searchbox, 'HTML::Form', 'form_action - can select the form' );
 ok( !$mech->form_action('bargle-snark'),