File Coverage

blib/lib/Test/Mojo/Role/SubmitForm.pm
Criterion Covered Total %
statement 48 52 92.3
branch 28 30 93.3
condition 12 14 85.7
subroutine 6 6 100.0
pod 1 1 100.0
total 95 103 92.2


line stmt bran cond sub pod time code
1             package Test::Mojo::Role::SubmitForm;
2              
3 1     1   107922 use Mojo::Base -base;
  1         3  
  1         7  
4 1     1   190 use Role::Tiny;
  1         2  
  1         7  
5 1     1   199 use Carp qw/croak/;
  1         3  
  1         1053  
6              
7             our $VERSION = '1.004004'; # VERSION
8              
9             sub click_ok {
10 16     16 1 376673 my ( $self, $selector_or_dom, $extra_params ) = @_;
11 16   100     157 $extra_params ||= {};
12              
13 16 100 66     46 my $el = eval { $selector_or_dom->isa('Mojo::DOM') }
  16         227  
14             ? $selector_or_dom
15             : $self->tx->res->dom->at($selector_or_dom)
16             || croak 'Test::Mojo::Role::SubmitForm::click_ok()'
17             . " Did not find element matching selector $selector_or_dom";
18 15 100       127945 unless ( $el->tag eq 'form' ) {
19 7 50       149 if (length $el->{name}) {
20 7 100 50     160 if ( ($el->{type}//'') eq 'image' ) {
21 2         38 $extra_params->{ $el->{name} . '.x' } = 1;
22 2         37 $extra_params->{ $el->{name} . '.y' } = 1;
23             }
24             else {
25 5         99 $extra_params->{ $el->{name} } = $el->val;
26             }
27             }
28              
29 7         362 $el = $el->ancestors('form')->first;
30             }
31              
32 15         3353 for ( sort keys %$extra_params ) {
33 19 100       129 next unless ref $extra_params->{$_} eq 'CODE';
34 5         23 ( my $name = $_ ) =~ s/"/\\"/g;
35 5         33 $extra_params->{$_} = $extra_params->{$_}->(
36             $self->_gather_vals( $el->find(qq{[name="$name"]})->each )
37             );
38             }
39              
40 15         85 my %form = (
41             $self->_get_controls($el),
42             %$extra_params,
43             );
44 15         85 for (keys %form) {
45 82 100       224 delete $form{$_} unless defined $form{$_}
46             }
47              
48 15 50       73 if ( $ENV{MOJO_SUBMITFORM_DEBUG} ) {
49 0         0 warn "\n########## SUBMITTING FORM ##########\n";
50 0         0 require Mojo::Util;
51 0         0 warn Mojo::Util::dumper(\%form);
52 0         0 warn "########## END FORM ##########\n\n";
53             }
54              
55             my $tx = $self->ua->build_tx(
56 15 100 100     86 $el->{method}||'GET' => defined $el->{action} && $el->{action} ne '' ? $el->{action} : $self->tx->req->url
      100        
57             => form => \%form,
58             );
59              
60 15         17444 $self->request_ok( $tx );
61             }
62              
63             sub _gather_vals {
64 123     123   13180 my ( $self, @els ) = @_;
65 123         205 my @vals;
66 123         238 for ( @els ) {
67 125 100       322 next if $_
68             ->matches('[type=radio]:not(:checked), [type=checkbox]:not(:checked)');
69              
70 109 100       44394 defined( my $val = $_->val ) or next;
71 104 100       40745 push @vals, ref $val ? @$val : $val;
72             }
73 123 100       8743 return @vals == 1 ? $vals[0] : @vals ? \@vals : undef;
    100          
74             }
75              
76             sub _get_controls {
77 15     15   44 my ( $self, $form ) = @_;
78              
79 15         84 my @els = $form->find(
80             'input:not([type=button]):not([type=submit]):not([type=image]):not([disabled]),' .
81             'select:not([disabled]),' .
82             'textarea:not([disabled])'
83             )->each;
84              
85             # remove controls defined in templates
86 15         56631 @els = grep { $_->ancestors('template')->size() == 0 } @els;
  133         41105  
87              
88 15         2713 my %controls;
89 15         63 for ( @els ) {
90 118 100       1721 defined(my $vals = $self->_gather_vals( $_ )) or next;
91 98 100       174 push @{ $controls{$_->{name}} }, ref $vals ? @$vals : $vals;
  98         232  
92             }
93 15   100     273 $#$_ or $_= $_->[0] for values %controls; # chage 1-el arrayrefs to strings
94              
95 15         224 return %controls;
96             }
97              
98             q|
99             The fantastic element that explains the appeal of games to
100             many developers is neither the fire-breathing monsters nor the
101             milky-skinned, semi-clad sirens; it is the experience of
102             carrying out a task from start to finish without any change
103             in the user requirements.
104             |;
105              
106             __END__