File Coverage

blib/lib/Mojo/Transaction/HTTP/Role/Mechanize.pm
Criterion Covered Total %
statement 25 25 100.0
branch 11 12 91.6
condition 7 7 100.0
subroutine 6 6 100.0
pod 2 2 100.0
total 51 52 98.0


line stmt bran cond sub pod time code
1             package Mojo::Transaction::HTTP::Role::Mechanize;
2              
3 1     1   39351 use Mojo::Base -role;
  1         2  
  1         7  
4 1     1   434 use Mojo::UserAgent::Transactor;
  1         3  
  1         9  
5              
6             our $VERSION = '0.06';
7              
8             requires qw{error res};
9              
10             sub extract_forms {
11 14     14 1 956 my $self = shift;
12              
13             my $forms
14 14     14   39 = $self->res->dom->find('form')->each(sub { $_->with_roles('+Form') });
  14         27178  
15              
16 14         3831 return $forms;
17             }
18              
19             sub submit {
20 14     14 1 114314 my ($self, $selector, $overlay) = (shift);
21 14 100 100     95 $overlay = pop if @_ && ref($_[-1]) eq 'HASH';
22 14 100       68 $selector = shift if @_ % 2;
23 14   100     75 $overlay ||= {@_};
24              
25             # cannot continue from error state
26 14 100       66 return if $self->error;
27              
28             # extract form
29 13 100 100 13   276 my $form = $self->extract_forms->grep(sub { $_->at($selector // '') })->first
  13         175  
30             or return;
31              
32 11 100       8059 return unless (my ($method, $target, $type) = $form->target($selector));
33 10         935 $target = $self->req->url->new($target);
34 10 50       820 $target = $target->to_abs($self->req->url) unless $target->is_abs;
35              
36             # values from form
37 10         2357 my $state = $form->val($selector);
38              
39             # merge in new values of form elements
40 10         61 my @keys = grep { exists $overlay->{$_} } keys %$state;
  135         222  
41 10         46 @$state{@keys} = @$overlay{@keys};
42              
43             # build a new transaction ...
44 10         69 return Mojo::UserAgent::Transactor->new->tx(
45             $method => $target,
46             {}, form => $state
47             )->previous($self);
48             }
49              
50             1;
51              
52             =encoding utf8
53              
54             =begin html
55              
56             Build Status - Linux
57             src="https://github.com/kiwiroy/mojo-transaction-http-role-mechanize/workflows/linux/badge.svg" />
58             Build Status - Macos
59             src="https://github.com/kiwiroy/mojo-transaction-http-role-mechanize/workflows/macos/badge.svg" />
60             Build Status - Windows
61             src="https://github.com/kiwiroy/mojo-transaction-http-role-mechanize/workflows/windows/badge.svg" />
62            
63             Kritika Analysis Status
64             src="https://kritika.io/users/kiwiroy/repos/7509235145731088/heads/master/status.svg?type=score%2Bcoverage%2Bdeps" />
65            
66            
67             Coverage Status
68             src="https://coveralls.io/repos/github/kiwiroy/mojo-transaction-http-role-mechanize/badge.svg?branch=master" />
69            
70            
71             CPAN version
72             src="https://badge.fury.io/pl/Mojo-Transaction-HTTP-Role-Mechanize.svg" />
73            
74              
75             =end html
76              
77             =head1 NAME
78              
79             Mojo::Transaction::HTTP::Role::Mechanize - Mechanize Mojo a little
80              
81             =head1 SYNOPSIS
82              
83             use Mojo::UserAgent;
84             use Mojo::Transaction::HTTP::Role::Mechanize;
85              
86             my $ua = Mojo::UserAgent->new;
87             my $tx = $ua->get('/')->with_roles('+Mechanize');
88              
89             # call submit immediately
90             my $submit_tx = $tx->submit('#submit-id', username => 'fry');
91             $ua->start($submit_tx);
92              
93             # first extract form values
94             my $values = $tx->extract_forms->first->val;
95             $submit_tx = $tx->submit('#submit-id', counter => $values->{counter} + 3);
96             $ua->start($submit_tx);
97              
98             =head1 DESCRIPTION
99              
100             L based role to compose a form submission I<"trait"> into
101             L.
102              
103             =head1 METHODS
104              
105             L implements the following method.
106              
107             =head2 extract_forms
108              
109             $collection = $tx->extract_forms;
110              
111             Returns a L of L elements with activated L
112             that contains all the forms of the page.
113              
114             =head2 submit
115              
116             # result using selector
117             $submit_tx = $tx->submit('#id', username => 'fry');
118              
119             # result without selector using default submission
120             $submit_tx = $tx->submit(username => 'fry');
121              
122             # passing hash, rather than list, of values
123             $submit_tx = $tx->submit({username => 'fry'});
124              
125             # passing hash, rather than list, of values and a selector
126             $submit_tx = $tx->submit('#id', {username => 'fry'});
127              
128             Build a new L object with
129             L and the contents of the C
with the
130             C<$id> and merged values. If no selector is given, the first non-disabled
131             button or appropriate input element (of type button, submit, or image)
132             will be used for the submission.
133              
134             =head1 AUTHOR
135              
136             kiwiroy - Roy Storey C
137              
138             tekki - Rolf Stöckli C
139              
140             lindleyw - William Lindley C
141              
142             =head1 LICENSE
143              
144             This library is free software and may be distributed under the same terms as
145             perl itself.
146              
147             =head1 SEE ALSO
148              
149             L, L.
150              
151             =cut