File Coverage

lib/Brownie/Node/Mechanize.pm
Criterion Covered Total %
statement 90 100 90.0
branch 33 58 56.9
condition 34 60 56.6
subroutine 29 29 100.0
pod 10 10 100.0
total 196 257 76.2


line stmt bran cond sub pod time code
1             package Brownie::Node::Mechanize;
2              
3 19     19   107 use strict;
  19         37  
  19         917  
4 19     19   98 use warnings;
  19         64  
  19         564  
5 19     19   111 use parent 'Brownie::Node';
  19         50  
  19         165  
6 19     19   1176 use Carp ();
  19         51  
  19         34573  
7              
8             sub _find_outer_link {
9 8     8   101 my $self = shift;
10              
11             my @links = $self->native->look_up(sub {
12 34   66 34   735 return lc($_[0]->tag) eq 'a' && $_[0]->attr('href');
13 8         26 });
14              
15 8 50       157 return @links ? $links[0]->attr('href') : '';
16             }
17              
18             sub _find_select_selector {
19 21     21   41 my $self = shift;
20              
21             my ($select) = $self->native->look_up(sub {
22 105   66 105   2252 return lc($_[0]->tag) eq 'select' && ($_[0]->attr('id') || $_[0]->attr('name'));
23 21         80 });
24              
25 21 50       392 return unless $select;
26              
27 21 50       70 if (my $id = $select->attr('id')) {
    0          
28 21         263 return '#'.$id;
29             }
30             elsif (my $name = $select->attr('name')) {
31 0         0 return '^'.$name;
32             }
33             }
34              
35             sub _is_text_field {
36 88     88   171 my $self = shift;
37 88 100       403 return 1 if $self->tag_name eq 'textarea';
38 84 100 100     1037 return 1 if $self->tag_name eq 'input' && ($self->type =~ /^(?:text|password|file|hidden)$/i || !$self->type);
      66        
39 73         1408 return 0;
40             }
41              
42             sub _is_button {
43 138     138   318 my $self = shift;
44 138 100 66     296 return 1 if $self->tag_name eq 'input' && $self->type =~ /^(?:submit|image)$/i;
45 24 50 33     293 return 1 if $self->tag_name eq 'button' && (!$self->type || $self->type eq 'submit');
      66        
46 8         108 return 0;
47             }
48              
49             sub _is_checkbox {
50 50     50   96 my $self = shift;
51 50   100     192 return $self->tag_name eq 'input' && $self->type eq 'checkbox';
52             }
53              
54             sub _is_radio {
55 35     35   571 my $self = shift;
56 35   66     90 return $self->tag_name eq 'input' && $self->type eq 'radio';
57             }
58              
59             sub _is_option {
60 29     29   343 my $self = shift;
61 29         57 return $self->tag_name eq 'option';
62             }
63              
64             sub _is_in_multiple_select {
65 3     3   59 my $self = shift;
66              
67             return $self->native->look_up(sub {
68 6   66 6   124 return lc($_[0]->tag) eq 'select' && $_[0]->attr('multiple');
69 3         10 });
70             }
71              
72             sub _is_form_control {
73 73     73   154 my $self = shift;
74 73   33     362 return $self->_is_text_field
75             || $self->_is_button
76             || $self->_is_checkbox
77             || $self->_is_radio
78             || $self->_is_option;
79             }
80              
81             sub attr {
82 513     513 1 1015 my ($self, $name) = @_;
83 513   100     1189 return $self->native->attr($name) || '';
84             }
85              
86             sub text {
87 7     7 1 666 my $self = shift;
88 7         275 return $self->native->as_text;
89             }
90              
91             sub tag_name {
92 450     450 1 571 my $self = shift;
93 450         1304 return lc $self->native->tag;
94             }
95              
96 130     130   481 sub _mech { return shift->driver->browser }
97              
98             sub _mech_selector {
99 27     27   38 my $self = shift;
100              
101 27         46 my $selector = '';
102 27 50       119 if (my $id = $self->id) {
    0          
103 27         398 $selector = "#$id";
104             }
105             elsif (my $name = $self->name) {
106 0         0 $selector = "^$name";
107             }
108              
109 27         216 return $selector;
110             }
111              
112 1     1 1 18 sub is_displayed { !shift->is_not_displayed }
113              
114             sub is_not_displayed {
115 4     4 1 11 my $self = shift;
116              
117             my @hidden = $self->native->look_up(sub {
118 12 50 50 12   248 return 1 if lc($_[0]->attr('style') || '') =~ /display\s*:\s*none/;
119 12 100 100     219 return 1 if lc($_[0]->tag) eq 'script' || lc($_[0]->tag) eq 'head';
120 10 100 50     171 return 1 if lc($_[0]->tag) eq 'input' && lc($_[0]->attr('type') || '') eq 'hidden';
      66        
121 9         65 return 0;
122 4         14 });
123              
124 4         78 return scalar(@hidden) > 0;
125             }
126              
127             sub is_selected {
128 4     4 1 8 my $self = shift;
129 4   66     15 return $self->attr('selected') || $self->attr('checked');
130             }
131              
132             *is_checked = \&is_selected;
133              
134             sub set {
135 15     15 1 40 my ($self, $value) = @_;
136              
137 15 50 0     61 if ($self->_is_text_field) {
    0 0        
138 15         382 $self->_mech->field($self->_mech_selector, $value);
139             }
140             elsif ($self->_is_checkbox || $self->_is_radio || $self->_is_option) {
141 0         0 $self->select;
142             }
143             else {
144 0         0 Carp::carp("This element is not a form control.");
145             }
146             }
147              
148             sub select {
149 33     33 1 78 my $self = shift;
150              
151 33 100       173 if ($self->_is_checkbox) {
    100          
    50          
152 6         122 $self->_mech->tick($self->_mech_selector, $self->value);
153 6         16238 $self->native->attr(checked => 'checked');
154             }
155             elsif ($self->_is_radio) {
156 9         135 $self->_mech->set_visible([ radio => $self->value ]);
157 9         23313 $self->native->attr(selected => 'selected');
158             }
159             elsif ($self->_is_option) {
160             # TODO: multiple
161 18         186 my $selector = $self->_find_select_selector;
162 18 50       49 if ($selector) {
163 18         63 $self->_mech->select($selector, $self->value);
164 18         50446 $self->native->attr(selected => 'selected');
165             }
166             }
167             else {
168 0         0 Carp::carp("This element is not selectable.");
169             }
170             }
171              
172             sub unselect {
173 9     9 1 21 my $self = shift;
174              
175 9 100 33     42 if ($self->_is_checkbox) {
    50          
176 6         128 $self->_mech->untick($self->_mech_selector, $self->value);
177 6         21206 $self->native->attr(checked => '');
178             }
179             elsif ($self->_is_option && $self->_is_in_multiple_select) {
180 3         111 my $selector = $self->_find_select_selector;
181 3 50       13 if ($selector) {
182 3         11 $self->_mech->field($selector, undef);
183 3         405 $self->native->attr(selected => '');
184             }
185             }
186             else {
187 0         0 Carp::carp("This element is not selectable.");
188             }
189             }
190              
191             sub click {
192 73     73 1 176 my $self = shift;
193              
194 73 100       413 if ($self->_is_form_control) {
    50          
195 65 50 0     1524 if ($self->_is_button) {
    0          
    0          
196 65 100       1242 my %args = $self->name ? (name => $self->name) : (value => $self->value);
197 65         878 $self->_mech->click_button(%args);
198             }
199             elsif ($self->_is_checkbox || $self->_is_option) {
200 0 0       0 $self->is_checked ? $self->unselect : $self->select;
201             }
202             elsif ($self->_is_radio) {
203 0         0 $self->select;
204             }
205             else {
206 0         0 Carp::carp("This element is not a clickable control.");
207             }
208             }
209             elsif (my $link = $self->_find_outer_link) {
210 8         88 $self->_mech->follow_link(url => $link);
211             }
212             else {
213 0           Carp::carp("This element is not clickable.");
214             }
215             }
216              
217             1;
218              
219             =head1 NAME
220              
221             Brownie::Node::Mechanize - base class of Brownie::Node series
222              
223             =head1 METHODS
224              
225             =over 4
226              
227             =item * C
228              
229             =item * C
230              
231             =item * C
232              
233             =item * C
234              
235             =item * C
236              
237             =item * C
238              
239             =item * C
240              
241             =item * C
242              
243             =item * C
244              
245             =item * C
246              
247             =item * C
248              
249             =item * C
250              
251             =item * C
252              
253             =item * C
254              
255             =item * C
256              
257             =item * C
258              
259             =item * C
260              
261             =item * C
262              
263             =item * C
264              
265             =item * C
266              
267             =item * C
268              
269             =item * C
270              
271             =item * C
272              
273             =back
274              
275             =head1 AUTHOR
276              
277             NAKAGAWA Masaki Emasaki@cpan.orgE
278              
279             =head1 LICENSE
280              
281             This library is free software; you can redistribute it and/or modify
282             it under the same terms as Perl itself.
283              
284             =head1 SEE ALSO
285              
286             L, L, L
287              
288             L, L
289              
290             =cut