File Coverage

blib/lib/Selenium/Remote/Driver.pm
Criterion Covered Total %
statement 408 700 58.2
branch 113 258 43.8
condition 56 134 41.7
subroutine 87 124 70.1
pod 83 85 97.6
total 747 1301 57.4


line stmt bran cond sub pod time code
1             package Selenium::Remote::Driver;
2             $Selenium::Remote::Driver::VERSION = '1.49';
3 14     14   514339 use strict;
  14         99  
  14         477  
4 14     14   76 use warnings;
  14         30  
  14         389  
5              
6             # ABSTRACT: Perl Client for Selenium Remote Driver
7              
8 14     14   4498 use Moo;
  14         87464  
  14         88  
9 14     14   17123 use Try::Tiny;
  14         8197  
  14         815  
10              
11 14     14   296 use 5.006;
  14         54  
12 14     14   150 use v5.10.0; # Before 5.006, v5.10.0 would not be understood.
  14         45  
13              
14             # See http://perldoc.perl.org/5.10.0/functions/use.html#use-VERSION
15             # and http://www.dagolden.com/index.php/369/version-numbers-should-be-boring/
16             # for details.
17              
18 14     14   92 use Carp;
  14         27  
  14         1025  
19             our @CARP_NOT;
20              
21 14     14   7201 use IO::String;
  14         45447  
  14         495  
22 14     14   9171 use Archive::Zip qw( :ERROR_CODES );
  14         1087227  
  14         2040  
23 14     14   170 use Scalar::Util;
  14         33  
  14         611  
24 14     14   7020 use Selenium::Remote::RemoteConnection;
  14         54  
  14         596  
25 14     14   7016 use Selenium::Remote::Commands;
  14         56  
  14         436  
26 14     14   6763 use Selenium::Remote::Spec;
  14         56  
  14         452  
27 14     14   4929 use Selenium::Remote::WebElement;
  14         59  
  14         402  
28 14     14   6188 use Selenium::Remote::WDKeys;
  14         43  
  14         672  
29 14     14   6788 use File::Spec::Functions ();
  14         12804  
  14         420  
30 14     14   127 use File::Basename qw(basename);
  14         217  
  14         2409  
31 14     14   4832 use Sub::Install ();
  14         16391  
  14         403  
32 14     14   5922 use MIME::Base64 ();
  14         8956  
  14         401  
33 14     14   7278 use Time::HiRes qw(usleep);
  14         20639  
  14         63  
34 14     14   3207 use Clone qw{clone};
  14         41  
  14         1129  
35 14     14   109 use List::Util qw{any};
  14         55  
  14         1219  
36              
37 14         153151 use constant FINDERS => {
38             class => 'class name',
39             class_name => 'class name',
40             css => 'css selector',
41             id => 'id',
42             link => 'link text',
43             link_text => 'link text',
44             name => 'name',
45             partial_link_text => 'partial link text',
46             tag_name => 'tag name',
47             xpath => 'xpath',
48 14     14   108 };
  14         60  
49              
50             our $FORCE_WD2 = 0;
51             our $FORCE_WD3 = 0;
52             our %CURRENT_ACTION_CHAIN = ( actions => [] );
53              
54              
55              
56              
57             has 'remote_server_addr' => (
58             is => 'rw',
59             coerce => sub { ( defined( $_[0] ) ? $_[0] : 'localhost' ) },
60             default => sub { 'localhost' },
61             predicate => 1
62             );
63              
64             has 'browser_name' => (
65             is => 'rw',
66             coerce => sub { ( defined( $_[0] ) ? $_[0] : 'firefox' ) },
67             default => sub { 'firefox' },
68             );
69              
70             has 'base_url' => (
71             is => 'lazy',
72             coerce => sub {
73             my $base_url = shift;
74             $base_url =~ s|/$||;
75             return $base_url;
76             },
77             predicate => 'has_base_url',
78             );
79              
80             has 'platform' => (
81             is => 'rw',
82             coerce => sub { ( defined( $_[0] ) ? $_[0] : 'ANY' ) },
83             default => sub { 'ANY' },
84             );
85              
86             has 'port' => (
87             is => 'rw',
88             coerce => sub { ( defined( $_[0] ) ? $_[0] : '4444' ) },
89             default => sub { '4444' },
90             predicate => 1
91             );
92              
93             has 'version' => (
94             is => 'rw',
95             default => sub { '' },
96             );
97              
98             has 'webelement_class' => (
99             is => 'rw',
100             default => sub { 'Selenium::Remote::WebElement' },
101             );
102              
103             has 'default_finder' => (
104             is => 'rw',
105             coerce => sub { __PACKAGE__->FINDERS->{ $_[0] } },
106             default => sub { 'xpath' },
107             );
108              
109             has 'session_id' => (
110             is => 'rw',
111             default => sub { undef },
112             );
113              
114             has 'remote_conn' => (
115             is => 'lazy',
116             builder => sub {
117 11     11   115 my $self = shift;
118 11         198 return Selenium::Remote::RemoteConnection->new(
119             remote_server_addr => $self->remote_server_addr,
120             port => $self->port,
121             ua => $self->ua,
122             wd_context_prefix => $self->wd_context_prefix
123             );
124             },
125             );
126              
127             has 'error_handler' => (
128             is => 'rw',
129             coerce => sub {
130             my ($maybe_coderef) = @_;
131              
132             if ( ref($maybe_coderef) eq 'CODE' ) {
133             return $maybe_coderef;
134             }
135             else {
136             croak 'The error handler must be a code ref.';
137             }
138             },
139             clearer => 1,
140             predicate => 1
141             );
142              
143             has 'ua' => (
144             is => 'lazy',
145 3     3   170 builder => sub { return LWP::UserAgent->new }
146             );
147              
148             has 'commands' => (
149             is => 'lazy',
150             builder => sub {
151 24     24   592 return Selenium::Remote::Commands->new;
152             },
153             );
154              
155             has 'commands_v3' => (
156             is => 'lazy',
157             builder => sub {
158 29     29   744 return Selenium::Remote::Spec->new;
159             },
160             );
161              
162             has 'auto_close' => (
163             is => 'rw',
164             coerce => sub { ( defined( $_[0] ) ? $_[0] : 1 ) },
165             default => sub { 1 },
166             );
167              
168             has 'pid' => (
169             is => 'lazy',
170 35     35   635 builder => sub { return $$ }
171             );
172              
173             has 'javascript' => (
174             is => 'rw',
175             coerce => sub { $_[0] ? JSON::true : JSON::false },
176             default => sub { return JSON::true }
177             );
178              
179             has 'accept_ssl_certs' => (
180             is => 'rw',
181             coerce => sub { $_[0] ? JSON::true : JSON::false },
182             default => sub { return JSON::true }
183             );
184              
185             has 'proxy' => (
186             is => 'rw',
187             coerce => sub {
188             my $proxy = $_[0];
189             if ( $proxy->{proxyType} =~ /^pac$/i ) {
190             if ( not defined $proxy->{proxyAutoconfigUrl} ) {
191             croak "proxyAutoconfigUrl not provided\n";
192             }
193             elsif ( not( $proxy->{proxyAutoconfigUrl} =~ /^(http|file)/g ) ) {
194             croak
195             "proxyAutoconfigUrl should be of format http:// or file://";
196             }
197              
198             if ( $proxy->{proxyAutoconfigUrl} =~ /^file/ ) {
199             my $pac_url = $proxy->{proxyAutoconfigUrl};
200             my $file = $pac_url;
201             $file =~ s{^file://}{};
202              
203             if ( !-e $file ) {
204             warn "proxyAutoConfigUrl file does not exist: '$pac_url'";
205             }
206             }
207             }
208             $proxy;
209             },
210             );
211              
212             has 'extra_capabilities' => (
213             is => 'rw',
214             default => sub { {} }
215             );
216              
217             has 'firefox_profile' => (
218             is => 'rw',
219             coerce => sub {
220             my $profile = shift;
221             unless ( Scalar::Util::blessed($profile)
222             && $profile->isa('Selenium::Firefox::Profile') )
223             {
224             croak "firefox_profile should be a Selenium::Firefox::Profile\n";
225             }
226              
227             return $profile;
228             },
229             predicate => 'has_firefox_profile',
230             clearer => 1
231             );
232              
233             has debug => (
234             is => 'lazy',
235             default => sub { 0 },
236             );
237              
238             has 'desired_capabilities' => (
239             is => 'lazy',
240             predicate => 'has_desired_capabilities'
241             );
242              
243             has 'inner_window_size' => (
244             is => 'lazy',
245             predicate => 1,
246             coerce => sub {
247             my $size = shift;
248              
249             croak "inner_window_size must have two elements: [ height, width ]"
250             unless scalar @$size == 2;
251              
252             foreach my $dim (@$size) {
253             croak 'inner_window_size only accepts integers, not: ' . $dim
254             unless Scalar::Util::looks_like_number($dim);
255             }
256              
257             return $size;
258             },
259              
260             );
261              
262             # At the time of writing, Geckodriver uses a different endpoint than
263             # the java bindings for executing synchronous and asynchronous
264             # scripts. As a matter of fact, Geckodriver does conform to the W3C
265             # spec, but as are bound to support both while the java bindings
266             # transition to full spec support, we need some way to handle the
267             # difference.
268              
269             has '_execute_script_suffix' => (
270             is => 'lazy',
271             default => ''
272             );
273              
274             with 'Selenium::Remote::Finders';
275             with 'Selenium::Remote::Driver::CanSetWebdriverContext';
276              
277             sub BUILD {
278 32     32 0 263 my $self = shift;
279              
280 32 100       219 if ( !( defined $self->session_id ) ) {
281 31 100       171 if ( $self->has_desired_capabilities ) {
282 5         88 $self->new_desired_session( $self->desired_capabilities );
283             }
284             else {
285             # Connect to remote server & establish a new session
286 26         185 $self->new_session( $self->extra_capabilities );
287             }
288             }
289              
290 30 50       277 if ( !( defined $self->session_id ) ) {
    50          
291 0         0 croak "Could not establish a session with the remote server\n";
292             }
293             elsif ( $self->has_inner_window_size ) {
294 0         0 my $size = $self->inner_window_size;
295 0         0 $self->set_inner_window_size(@$size);
296             }
297              
298             #Set debug if needed
299 30 50       734 $self->debug_on() if $self->debug;
300              
301             # Setup non-croaking, parameter versions of finders
302 30         66 foreach my $by ( keys %{ $self->FINDERS } ) {
  30         250  
303 300         5355 my $finder_name = 'find_element_by_' . $by;
304              
305             # In case we get instantiated multiple times, we don't want to
306             # install into the name space every time.
307 300 100       1681 unless ( $self->can($finder_name) ) {
308 110         376 my $find_sub = $self->_build_find_by($by);
309              
310 110         572 Sub::Install::install_sub(
311             {
312             code => $find_sub,
313             into => __PACKAGE__,
314             as => $finder_name,
315             }
316             );
317             }
318             }
319             }
320              
321             sub new_from_caps {
322 4     4 1 12108 my ( $self, %args ) = @_;
323              
324 4 100       21 if ( not exists $args{desired_capabilities} ) {
325 2         8 $args{desired_capabilities} = {};
326             }
327              
328 4         114 return $self->new(%args);
329             }
330              
331             sub DEMOLISH {
332 38     38 0 35611 my ( $self, $in_global_destruction ) = @_;
333 38 50       750 return if $$ != $self->pid;
334 38 50       160 return if $in_global_destruction;
335 38 100 100     693 $self->quit() if ( $self->auto_close && defined $self->session_id );
336             }
337              
338             # We install an 'around' because we can catch more exceptions this way
339             # than simply wrapping the explicit croaks in _execute_command.
340             # @args should be fed to the handler to provide context
341             # return_value could be assigned from the handler if we want to allow the
342             # error_handler to handle the errors
343              
344             around '_execute_command' => sub {
345             my $orig = shift;
346             my $self = shift;
347              
348             # copy @_ because it gets lost in the way
349             my @args = @_;
350             my $return_value;
351             try {
352             $return_value = $orig->( $self, @args );
353             }
354             catch {
355             if ( $self->has_error_handler ) {
356             $return_value = $self->error_handler->( $self, $_, @args );
357             }
358             else {
359             croak $_;
360             }
361             };
362             return $return_value;
363             };
364              
365             # This is an internal method used the Driver & is not supposed to be used by
366             # end user. This method is used by Driver to set up all the parameters
367             # (url & JSON), send commands & receive processed response from the server.
368             sub _execute_command {
369             my ( $self, $res, $params ) = @_;
370             $res->{'session_id'} = $self->session_id;
371              
372             print "Prepping $res->{command}\n" if $self->{debug};
373              
374             #webdriver 3 shims
375             return $self->{capabilities}
376             if $res->{command} eq 'getCapabilities' && $self->{capabilities};
377             $res->{ms} = $params->{ms} if $params->{ms};
378             $res->{type} = $params->{type} if $params->{type};
379             $res->{text} = $params->{text} if $params->{text};
380             $res->{using} = $params->{using} if $params->{using};
381             $res->{value} = $params->{value} if $params->{value};
382              
383             print "Executing $res->{command}\n" if $self->{debug};
384             my $resource =
385             $self->{is_wd3}
386             ? $self->commands_v3->get_params($res)
387             : $self->commands->get_params($res);
388              
389             #Fall-back to legacy if wd3 command doesn't exist
390             if ( !$resource && $self->{is_wd3} ) {
391             print "Falling back to legacy selenium method for $res->{command}\n"
392             if $self->{debug};
393             $resource = $self->commands->get_params($res);
394             }
395              
396             #XXX InternetExplorerDriver quirks
397             if ( $self->{is_wd3} && $self->browser_name eq 'internet explorer' ) {
398             delete $params->{ms};
399             delete $params->{type};
400             delete $resource->{payload}->{type};
401             my $oldvalue = delete $params->{'page load'};
402             $params->{pageLoad} = $oldvalue if $oldvalue;
403             }
404              
405             if ($resource) {
406             $params = {} unless $params;
407             my $resp = $self->remote_conn->request( $resource, $params );
408              
409             #In general, the parse_response for v3 is better, which is why we use it *even if* we are falling back.
410             return $self->commands_v3->parse_response( $res, $resp )
411             if $self->{is_wd3};
412             return $self->commands->parse_response( $res, $resp );
413             }
414             else {
415             #Tell the use about the offending setting.
416             croak "Couldn't retrieve command settings properly ".$res->{command}."\n";
417             }
418             }
419              
420              
421             sub new_session {
422 22     22 1 69 my ( $self, $extra_capabilities ) = @_;
423 22   50     129 $extra_capabilities ||= {};
424              
425 22   50     468 my $args = {
426             'desiredCapabilities' => {
427             'browserName' => $self->browser_name,
428             'platform' => $self->platform,
429             'javascriptEnabled' => $self->javascript,
430             'version' => $self->version // '',
431             'acceptSslCerts' => $self->accept_ssl_certs,
432             %$extra_capabilities,
433             },
434             };
435 22 100       1997 $args->{'extra_capabilities'} = \%$extra_capabilities unless $FORCE_WD2;
436              
437 22 100       438 if ( defined $self->proxy ) {
438 2         44 $args->{desiredCapabilities}->{proxy} = $self->proxy;
439             }
440              
441 22 50 66     388 if ( $args->{desiredCapabilities}->{browserName} =~ /firefox/i
442             && $self->has_firefox_profile )
443             {
444             $args->{desiredCapabilities}->{firefox_profile} =
445 0         0 $self->firefox_profile->_encode;
446             }
447              
448 22         104 $self->_request_new_session($args);
449             }
450              
451              
452             sub new_desired_session {
453 5     5 1 53 my ( $self, $caps ) = @_;
454              
455 5         32 $self->_request_new_session(
456             {
457             desiredCapabilities => $caps
458             }
459             );
460             }
461              
462             sub _request_new_session {
463 29     29   2878 my ( $self, $args ) = @_;
464              
465             #XXX UGLY shim for webdriver3
466             $args->{capabilities}->{alwaysMatch} =
467 29         609 clone( $args->{desiredCapabilities} );
468 29         666 my $cmap = $self->commands_v3->get_caps_map();
469 29         799 my $caps = $self->commands_v3->get_caps();
470 29         96 foreach my $cap ( keys( %{ $args->{capabilities}->{alwaysMatch} } ) ) {
  29         201  
471              
472             #Handle browser specific capabilities
473 136 100 66     1067 if ( exists( $args->{desiredCapabilities}->{browserName} )
474             && $cap eq 'extra_capabilities' )
475             {
476              
477 2 100       8 if (
478             exists $args->{capabilities}->{alwaysMatch}
479             ->{'moz:firefoxOptions'}->{args} )
480             {
481             $args->{capabilities}->{alwaysMatch}->{$cap}->{args} =
482             $args->{capabilities}->{alwaysMatch}->{'moz:firefoxOptions'}
483 1         5 ->{args};
484             }
485             $args->{capabilities}->{alwaysMatch}->{'moz:firefoxOptions'} =
486             $args->{capabilities}->{alwaysMatch}->{$cap}
487 2 100       8 if $args->{desiredCapabilities}->{browserName} eq 'firefox';
488              
489             #XXX the chrome documentation is lies, you can't do this yet
490             #$args->{capabilities}->{alwaysMatch}->{'goog:chromeOptions'} = $args->{capabilities}->{alwaysMatch}->{$cap} if $args->{desiredCapabilities}->{browserName} eq 'chrome';
491             #Does not appear there are any MSIE based options, so let's just let that be
492             }
493 136 100 66     640 if ( exists( $args->{desiredCapabilities}->{browserName} )
      100        
494             && $args->{desiredCapabilities}->{browserName} eq 'firefox'
495             && $cap eq 'firefox_profile' )
496             {
497 2 100       11 if (
498             ref $args->{capabilities}->{alwaysMatch}->{$cap} eq
499             'Selenium::Firefox::Profile' )
500             {
501             #XXX not sure if I need to keep a ref to the File::Temp::Tempdir object to prevent reaping
502             $args->{capabilities}->{alwaysMatch}->{'moz:firefoxOptions'}
503             ->{args} = [
504             '-profile',
505             $args->{capabilities}->{alwaysMatch}->{$cap}->{profile_dir}
506             ->dirname()
507 1         6 ];
508             }
509             }
510 136         382 foreach my $newkey ( keys(%$cmap) ) {
511 467 100       929 if ( $newkey eq $cap ) {
512 103 100       275 last if $cmap->{$newkey} eq $cap;
513             $args->{capabilities}->{alwaysMatch}->{ $cmap->{$newkey} } =
514 72         248 $args->{capabilities}->{alwaysMatch}->{$cap};
515 72         166 delete $args->{capabilities}->{alwaysMatch}->{$cap};
516 72         204 last;
517             }
518             }
519             delete $args->{capabilities}->{alwaysMatch}->{$cap}
520 136 100   1295   647 if !any { $_ eq $cap } @$caps;
  1295         2096  
521             }
522             delete $args->{desiredCapabilities}
523 29 50       124 if $FORCE_WD3; #XXX fork working-around busted fallback in firefox
524             delete $args->{capabilities}
525 29 100       158 if $FORCE_WD2; #XXX 'secret' feature to help the legacy unit tests to work
526              
527             #Delete compatibility layer when using drivers directly
528 29 50 66     580 if ( $self->isa('Selenium::Firefox') || $self->isa('Selenium::Chrome') || $self->isa('Selenium::Edge') ) {
      66        
529 2 0 33     8 if ( exists $args->{capabilities}
530             && exists $args->{capabilities}->{alwaysMatch} )
531             {
532 0         0 delete $args->{capabilities}->{alwaysMatch}->{browserName};
533 0         0 delete $args->{capabilities}->{alwaysMatch}->{browserVersion};
534 0         0 delete $args->{capabilities}->{alwaysMatch}->{platformName};
535             }
536             }
537              
538             #Fix broken out of the box chrome because they hate the maintainers of their interfaces
539 29 50       168 if ( $self->isa('Selenium::Chrome') ) {
540 0 0       0 if ( exists $args->{desiredCapabilities} ) {
541 0   0     0 $args->{desiredCapabilities}{'goog:chromeOptions'}{args} //= [];
542 0         0 push(@{$args->{desiredCapabilities}{'goog:chromeOptions'}{args}}, qw{no-sandbox disable-dev-shm-usage});
  0         0  
543             }
544             }
545              
546             # Get actual status
547 29         794 $self->remote_conn->check_status();
548              
549             # command => 'newSession' to fool the tests of commands implemented
550             # TODO: rewrite the testing better, this is so fragile.
551 28         646 my $resource_new_session = {
552             method => $self->commands->get_method('newSession'),
553             url => $self->commands->get_url('newSession'),
554             no_content_success =>
555             $self->commands->get_no_content_success('newSession'),
556             };
557 28         724 my $rc = $self->remote_conn;
558 28         321 my $resp = $rc->request( $resource_new_session, $args, );
559              
560 28 50 33     219 if ( $resp->{cmd_status} && $resp->{cmd_status} eq 'NOT OK' ) {
561 0         0 croak "Could not obtain new session: ". $resp->{cmd_return}{message};
562             }
563              
564 28 100 66     213 if ( ( defined $resp->{'sessionId'} ) && $resp->{'sessionId'} ne '' ) {
565 27         137 $self->session_id( $resp->{'sessionId'} );
566             }
567             else {
568 1         3 my $error = 'Could not create new session';
569              
570 1 50       5 if ( ref $resp->{cmd_return} eq 'HASH' ) {
571 1         12 $error .= ': ' . $resp->{cmd_return}->{message};
572             }
573             else {
574 0         0 $error .= ': ' . $resp->{cmd_return};
575             }
576 1         196 croak $error;
577             }
578              
579             #Webdriver 3 - best guess that this is 'whats goin on'
580 27 100 100     138 if ( ref $resp->{cmd_return} eq 'HASH'
581             && $resp->{cmd_return}->{capabilities} )
582             {
583 2         5 $self->{is_wd3} = 1;
584 2         6 $self->{emulate_jsonwire} = 1;
585 2         5 $self->{capabilities} = $resp->{cmd_return}->{capabilities};
586             }
587              
588             #XXX chromedriver DOES NOT FOLLOW SPEC!
589 27 100 100     146 if ( ref $resp->{cmd_return} eq 'HASH' && $resp->{cmd_return}->{chrome} ) {
590 1 50       5 if ( defined $resp->{cmd_return}->{setWindowRect} )
591             { #XXX i'm inferring we are wd3 based on the presence of this
592 0         0 $self->{is_wd3} = 1;
593 0         0 $self->{emulate_jsonwire} = 1;
594 0         0 $self->{capabilities} = $resp->{cmd_return};
595             }
596             }
597              
598             #XXX unsurprisingly, neither does microsoft
599 27 50 100     324 if ( ref $resp->{cmd_return} eq 'HASH'
      66        
600             && $resp->{cmd_return}->{pageLoadStrategy}
601             && $self->browser_name eq 'MicrosoftEdge' )
602             {
603 0         0 $self->{is_wd3} = 1;
604 0         0 $self->{emulate_jsonwire} = 1;
605 0         0 $self->{capabilities} = $resp->{cmd_return};
606             }
607              
608 27         289 return ( $args, $resp );
609             }
610              
611              
612             sub is_webdriver_3 {
613 0     0 1 0 my $self = shift;
614 0         0 return $self->{is_wd3};
615             }
616              
617              
618             sub debug_on {
619 1     1 1 596 my ($self) = @_;
620 1         3 $self->{debug} = 1;
621 1         27 $self->remote_conn->debug(1);
622             }
623              
624              
625             sub debug_off {
626 0     0 1 0 my ($self) = @_;
627 0         0 $self->{debug} = 0;
628 0         0 $self->remote_conn->debug(0);
629             }
630              
631              
632             sub get_sessions {
633 0     0 1 0 my ($self) = @_;
634 0         0 my $res = { 'command' => 'getSessions' };
635 0         0 return $self->_execute_command($res);
636             }
637              
638              
639             sub status {
640 1     1 1 681 my ($self) = @_;
641 1         6 my $res = { 'command' => 'status' };
642 1         27 return $self->_execute_command($res);
643             }
644              
645              
646             sub get_alert_text {
647 6     6 1 39 my ($self) = @_;
648 6         19 my $res = { 'command' => 'getAlertText' };
649 6         145 return $self->_execute_command($res);
650             }
651              
652              
653             sub send_keys_to_active_element {
654 0     0 1 0 my ( $self, @strings ) = @_;
655              
656 0 0 0     0 if ( $self->{is_wd3}
657 0         0 && !( grep { $self->browser_name eq $_ } qw{MicrosoftEdge} ) )
658             {
659 0         0 @strings = map { split( '', $_ ) } @strings;
  0         0  
660             my @acts = map {
661 0         0 (
662             {
663 0         0 type => 'keyDown',
664             value => $_,
665             },
666             {
667             type => 'keyUp',
668             value => $_,
669             }
670             )
671             } @strings;
672              
673 0         0 my $action = {
674             actions => [
675             {
676             id => 'key',
677             type => 'key',
678             actions => \@acts,
679             }
680             ]
681             };
682 0         0 return $self->general_action(%$action);
683             }
684              
685 0         0 my $res = { 'command' => 'sendKeysToActiveElement' };
686 0         0 my $params = { 'value' => \@strings, };
687 0         0 return $self->_execute_command( $res, $params );
688             }
689              
690              
691             sub send_keys_to_alert {
692 0     0 1 0 return shift->send_keys_to_prompt(@_);
693             }
694              
695              
696             sub send_keys_to_prompt {
697 1     1 1 4 my ( $self, $keys ) = @_;
698 1         5 my $res = { 'command' => 'sendKeysToPrompt' };
699 1         4 my $params = { 'text' => $keys };
700 1         30 return $self->_execute_command( $res, $params );
701             }
702              
703              
704             sub accept_alert {
705 6     6 1 977 my ($self) = @_;
706 6         20 my $res = { 'command' => 'acceptAlert' };
707 6         182 return $self->_execute_command($res);
708             }
709              
710              
711             sub dismiss_alert {
712 3     3 1 8 my ($self) = @_;
713 3         11 my $res = { 'command' => 'dismissAlert' };
714 3         78 return $self->_execute_command($res);
715             }
716              
717              
718             sub general_action {
719 0     0 1 0 my ( $self, %action ) = @_;
720              
721 0         0 _queue_action(%action);
722 0         0 my $res = { 'command' => 'generalAction' };
723 0         0 my $out = $self->_execute_command( $res, \%CURRENT_ACTION_CHAIN );
724 0         0 %CURRENT_ACTION_CHAIN = ( actions => [] );
725 0         0 return $out;
726             }
727              
728             sub _queue_action {
729 0     0   0 my (%action) = @_;
730 0 0       0 if ( ref $action{actions} eq 'ARRAY' ) {
731 0         0 foreach my $live_action ( @{ $action{actions} } ) {
  0         0  
732 0         0 my $existing_action;
733 0         0 foreach my $global_action ( @{ $CURRENT_ACTION_CHAIN{actions} } ) {
  0         0  
734 0 0       0 if ( $global_action->{id} eq $live_action->{id} ) {
735 0         0 $existing_action = $global_action;
736 0         0 last;
737             }
738             }
739 0 0       0 if ($existing_action) {
740             push(
741 0         0 @{ $existing_action->{actions} },
742 0         0 @{ $live_action->{actions} }
  0         0  
743             );
744             }
745             else {
746 0         0 push( @{ $CURRENT_ACTION_CHAIN{actions} }, $live_action );
  0         0  
747             }
748             }
749             }
750             }
751              
752              
753             sub release_general_action {
754 0     0 1 0 my ($self) = @_;
755 0         0 my $res = { 'command' => 'releaseGeneralAction' };
756 0         0 %CURRENT_ACTION_CHAIN = ( actions => [] );
757 0         0 return $self->_execute_command($res);
758             }
759              
760              
761             sub mouse_move_to_location {
762 0     0 1 0 my ( $self, %params ) = @_;
763 0 0       0 $params{element} = $params{element}{id} if exists $params{element};
764              
765 0 0 0     0 if ( $self->{is_wd3}
766 0         0 && !( grep { $self->browser_name eq $_ } qw{MicrosoftEdge} ) )
767             {
768 0         0 my $origin = $params{element};
769             my $move_action = {
770             type => "pointerMove",
771             duration => 0,
772             x => $params{xoffset} // 0,
773 0   0     0 y => $params{yoffset} // 0,
      0        
774             };
775             $move_action->{origin} =
776 0 0       0 { 'element-6066-11e4-a52e-4f735466cecf' => $origin }
777             if $origin;
778              
779 0         0 _queue_action(
780             actions => [
781             {
782             type => "pointer",
783             id => 'mouse',
784             "parameters" => { "pointerType" => "mouse" },
785             actions => [$move_action],
786             }
787             ]
788             );
789 0         0 return 1;
790             }
791              
792 0         0 my $res = { 'command' => 'mouseMoveToLocation' };
793 0         0 return $self->_execute_command( $res, \%params );
794             }
795              
796              
797             sub move_to {
798 0     0 1 0 return shift->mouse_move_to_location(@_);
799             }
800              
801              
802             sub get_capabilities {
803 1     1 1 1347 my $self = shift;
804 1         5 my $res = { 'command' => 'getCapabilities' };
805 1         29 return $self->_execute_command($res);
806             }
807              
808              
809             sub get_timeouts {
810 0     0 1 0 my $self = shift;
811 0         0 my $res = { 'command' => 'getTimeouts' };
812 0         0 return $self->_execute_command( $res, {} );
813             }
814              
815              
816             sub set_timeout {
817 1     1 1 405 my ( $self, $type, $ms ) = @_;
818 1 50       6 if ( not defined $type ) {
819 0         0 croak "Expecting type";
820             }
821 1         5 $ms = _coerce_timeout_ms($ms);
822 0 0 0     0 $type = 'pageLoad'
823             if $type eq 'page load'
824             && $self->browser_name ne
825             'MicrosoftEdge'; #XXX SHIM they changed the WC3 standard mid stream
826              
827 0         0 my $res = { 'command' => 'setTimeout' };
828 0         0 my $params = { $type => $ms };
829              
830             #XXX edge still follows earlier versions of the WC3 standard
831 0 0       0 if ( $self->browser_name eq 'MicrosoftEdge' ) {
832 0         0 $params->{ms} = $ms;
833 0         0 $params->{type} = $type;
834             }
835 0         0 return $self->_execute_command( $res, $params );
836             }
837              
838              
839             sub set_async_script_timeout {
840 1     1 1 396 my ( $self, $ms ) = @_;
841              
842 1 50       6 return $self->set_timeout( 'script', $ms ) if $self->{is_wd3};
843              
844 1         3 $ms = _coerce_timeout_ms($ms);
845 0         0 my $res = { 'command' => 'setAsyncScriptTimeout' };
846 0         0 my $params = { 'ms' => $ms };
847 0         0 return $self->_execute_command( $res, $params );
848             }
849              
850              
851             sub set_implicit_wait_timeout {
852 3     3 1 1012 my ( $self, $ms ) = @_;
853 3 50       11 return $self->set_timeout( 'implicit', $ms ) if $self->{is_wd3};
854              
855 3         12 $ms = _coerce_timeout_ms($ms);
856 2         8 my $res = { 'command' => 'setImplicitWaitTimeout' };
857 2         6 my $params = { 'ms' => $ms };
858 2         57 return $self->_execute_command( $res, $params );
859             }
860              
861              
862             sub pause {
863 1     1 1 13 my $self = shift;
864 1   50     9 my $timeout = ( shift // 1000 ) * 1000;
865 1         1000507 usleep($timeout);
866             }
867              
868              
869             sub close {
870 0     0 1 0 my $self = shift;
871 0         0 my $res = { 'command' => 'close' };
872 0         0 $self->_execute_command($res);
873             }
874              
875              
876             sub quit {
877 27     27 1 4593 my $self = shift;
878 27         97 my $res = { 'command' => 'quit' };
879 27         561 $self->_execute_command($res);
880 27         496 $self->session_id(undef);
881             }
882              
883              
884             sub get_current_window_handle {
885 0     0 1 0 my $self = shift;
886 0         0 my $res = { 'command' => 'getCurrentWindowHandle' };
887 0         0 return $self->_execute_command($res);
888             }
889              
890              
891             sub get_window_handles {
892 2     2 1 1553 my $self = shift;
893 2         8 my $res = { 'command' => 'getWindowHandles' };
894 2         54 return $self->_execute_command($res);
895             }
896              
897              
898             sub get_window_size {
899 0     0 1 0 my ( $self, $window ) = @_;
900 0 0       0 $window = ( defined $window ) ? $window : 'current';
901 0         0 my $res = { 'command' => 'getWindowSize', 'window_handle' => $window };
902             $res = { 'command' => 'getWindowRect', handle => $window }
903 0 0       0 if $self->{is_wd3};
904 0         0 return $self->_execute_command($res);
905             }
906              
907              
908             sub get_window_position {
909 0     0 1 0 my ( $self, $window ) = @_;
910 0 0       0 $window = ( defined $window ) ? $window : 'current';
911 0         0 my $res = { 'command' => 'getWindowPosition', 'window_handle' => $window };
912             $res = { 'command' => 'getWindowRect', handle => $window }
913 0 0       0 if $self->{is_wd3};
914 0         0 return $self->_execute_command($res);
915             }
916              
917              
918             sub get_current_url {
919 2     2 1 602 my $self = shift;
920 2         9 my $res = { 'command' => 'getCurrentUrl' };
921 2         50 return $self->_execute_command($res);
922             }
923              
924              
925             sub navigate {
926 0     0 1 0 my ( $self, $url ) = @_;
927 0         0 $self->get($url);
928             }
929              
930              
931             sub get {
932 28     28 1 10054 my ( $self, $url ) = @_;
933              
934 28 100 100     178 if ( $self->has_base_url && $url !~ m|://| ) {
935 5         18 $url =~ s|^/||;
936 5         91 $url = $self->base_url . "/" . $url;
937             }
938              
939 28         134 my $res = { 'command' => 'get' };
940 28         89 my $params = { 'url' => $url };
941 28         647 return $self->_execute_command( $res, $params );
942             }
943              
944              
945             sub get_title {
946 14     14 1 1902 my $self = shift;
947 14         53 my $res = { 'command' => 'getTitle' };
948 14         362 return $self->_execute_command($res);
949             }
950              
951              
952             sub go_back {
953 2     2 1 762 my $self = shift;
954 2         6 my $res = { 'command' => 'goBack' };
955 2         50 return $self->_execute_command($res);
956             }
957              
958              
959             sub go_forward {
960 1     1 1 627 my $self = shift;
961 1         4 my $res = { 'command' => 'goForward' };
962 1         28 return $self->_execute_command($res);
963             }
964              
965              
966             sub refresh {
967 1     1 1 559 my $self = shift;
968 1         5 my $res = { 'command' => 'refresh' };
969 1         27 return $self->_execute_command($res);
970             }
971              
972              
973             sub has_javascript {
974 10     10 1 23 my $self = shift;
975 10         230 return int( $self->javascript );
976             }
977              
978              
979             sub execute_async_script {
980 2     2 1 2610 my ( $self, $script, @args ) = @_;
981 2 50       9 if ( $self->has_javascript ) {
982 2 50       34 if ( not defined $script ) {
983 0         0 croak 'No script provided';
984             }
985 2         41 my $res =
986             { 'command' => 'executeAsyncScript' . $self->_execute_script_suffix };
987              
988             # Check the args array if the elem obj is provided & replace it with
989             # JSON representation
990 2         27 for ( my $i = 0 ; $i < @args ; $i++ ) {
991 2 100 66     21 if ( Scalar::Util::blessed( $args[$i] )
992             and $args[$i]->isa('Selenium::Remote::WebElement') )
993             {
994 1 50       4 if ( $self->{is_wd3} ) {
995             $args[$i] =
996             { 'element-6066-11e4-a52e-4f735466cecf' =>
997 0         0 ( $args[$i] )->{id} };
998             }
999             else {
1000 1         6 $args[$i] = { 'ELEMENT' => ( $args[$i] )->{id} };
1001             }
1002             }
1003             }
1004              
1005 2         9 my $params = { 'script' => $script, 'args' => \@args };
1006 2         45 my $ret = $self->_execute_command( $res, $params );
1007              
1008             # replace any ELEMENTS with WebElement
1009 2 50 33     57 if ( ref($ret)
      33        
1010             and ( ref($ret) eq 'HASH' )
1011             and $self->_looks_like_element($ret) )
1012             {
1013 2         57 $ret = $self->webelement_class->new(
1014             id => $ret,
1015             driver => $self
1016             );
1017             }
1018 2         27 return $ret;
1019             }
1020             else {
1021 0         0 croak 'Javascript is not enabled on remote driver instance.';
1022             }
1023             }
1024              
1025              
1026             sub execute_script {
1027 8     8 1 1367 my ( $self, $script, @args ) = @_;
1028 8 50       42 if ( $self->has_javascript ) {
1029 8 50       137 if ( not defined $script ) {
1030 0         0 croak 'No script provided';
1031             }
1032 8         151 my $res =
1033             { 'command' => 'executeScript' . $self->_execute_script_suffix };
1034              
1035             # Check the args array if the elem obj is provided & replace it with
1036             # JSON representation
1037 8         120 for ( my $i = 0 ; $i < @args ; $i++ ) {
1038 2 100 66     20 if ( Scalar::Util::blessed( $args[$i] )
1039             and $args[$i]->isa('Selenium::Remote::WebElement') )
1040             {
1041 1 50       6 if ( $self->{is_wd3} ) {
1042             $args[$i] =
1043             { 'element-6066-11e4-a52e-4f735466cecf' =>
1044 0         0 ( $args[$i] )->{id} };
1045             }
1046             else {
1047 1         6 $args[$i] = { 'ELEMENT' => ( $args[$i] )->{id} };
1048             }
1049             }
1050             }
1051              
1052 8         38 my $params = { 'script' => $script, 'args' => [@args] };
1053 8         163 my $ret = $self->_execute_command( $res, $params );
1054              
1055 8         46 return $self->_convert_to_webelement($ret);
1056             }
1057             else {
1058 0         0 croak 'Javascript is not enabled on remote driver instance.';
1059             }
1060             }
1061              
1062             # _looks_like_element
1063             # An internal method to check if a return value might be an element
1064              
1065             sub _looks_like_element {
1066 5     5   15 my ( $self, $maybe_element ) = @_;
1067              
1068             return (
1069             exists $maybe_element->{ELEMENT}
1070 5   33     25 or exists $maybe_element->{'element-6066-11e4-a52e-4f735466cecf'}
1071             );
1072             }
1073              
1074             # _convert_to_webelement
1075             # An internal method used to traverse a data structure
1076             # and convert any ELEMENTS with WebElements
1077              
1078             sub _convert_to_webelement {
1079 9     9   28 my ( $self, $ret ) = @_;
1080              
1081 9 100 100     58 if ( ref($ret) and ( ref($ret) eq 'HASH' ) ) {
1082 3 50       15 if ( $self->_looks_like_element($ret) ) {
1083              
1084             # replace an ELEMENT with WebElement
1085 3         72 return $self->webelement_class->new(
1086             id => $ret,
1087             driver => $self
1088             );
1089             }
1090              
1091 0         0 my %hash;
1092 0         0 foreach my $key ( keys %$ret ) {
1093 0         0 $hash{$key} = $self->_convert_to_webelement( $ret->{$key} );
1094             }
1095 0         0 return \%hash;
1096             }
1097              
1098 6 100 66     33 if ( ref($ret) and ( ref($ret) eq 'ARRAY' ) ) {
1099 1         5 my @array = map { $self->_convert_to_webelement($_) } @$ret;
  1         7  
1100 1         26 return \@array;
1101             }
1102              
1103 5         28 return $ret;
1104             }
1105              
1106              
1107             sub screenshot {
1108 0     0 1 0 my ($self, $params) = @_;
1109 0   0     0 $params //= { full => 0 };
1110              
1111 0 0 0     0 croak "Full page screenshot only supported on geckodriver" if $params->{full} && ( $self->{browser_name} ne 'firefox' );
1112              
1113 0 0       0 my $res = { 'command' => $params->{'full'} == 1 ? 'mozScreenshotFull' : 'screenshot' };
1114 0         0 return $self->_execute_command($res);
1115             }
1116              
1117              
1118             sub capture_screenshot {
1119 0     0 1 0 my ( $self, $filename, $params ) = @_;
1120 0 0       0 croak '$filename is required' unless $filename;
1121              
1122 0         0 open( my $fh, '>', $filename );
1123 0         0 binmode $fh;
1124 0         0 print $fh MIME::Base64::decode_base64( $self->screenshot($params) );
1125 0         0 CORE::close $fh;
1126 0         0 return 1;
1127             }
1128              
1129              
1130             #TODO emulate behavior on wd3?
1131             #grep { eval { Selenium::Remote::Driver->new( browser => $_ ) } } (qw{firefox MicrosoftEdge chrome opera safari htmlunit iphone phantomjs},'internet_explorer');
1132             #might do the trick
1133             sub available_engines {
1134 1     1 1 831 my ($self) = @_;
1135 1         5 my $res = { 'command' => 'availableEngines' };
1136 1         29 return $self->_execute_command($res);
1137             }
1138              
1139              
1140             sub switch_to_frame {
1141 1     1 1 9 my ( $self, $id ) = @_;
1142              
1143 1         6 my $json_null = JSON::null;
1144 1         7 my $params;
1145 1 50       5 $id = ( defined $id ) ? $id : $json_null;
1146              
1147 1         3 my $res = { 'command' => 'switchToFrame' };
1148              
1149 1 50       9 if ( ref $id eq $self->webelement_class ) {
1150 0 0       0 if ( $self->{is_wd3} ) {
1151             $params =
1152             { 'id' =>
1153 0         0 { 'element-6066-11e4-a52e-4f735466cecf' => $id->{'id'} } };
1154             }
1155             else {
1156 0         0 $params = { 'id' => { 'ELEMENT' => $id->{'id'} } };
1157             }
1158             }
1159             else {
1160 1         4 $params = { 'id' => $id };
1161             }
1162 1         23 return $self->_execute_command( $res, $params );
1163             }
1164              
1165              
1166             sub switch_to_parent_frame {
1167 0     0 1 0 my ($self) = @_;
1168 0         0 my $res = { 'command' => 'switchToParentFrame' };
1169 0         0 return $self->_execute_command($res);
1170             }
1171              
1172              
1173             sub switch_to_window {
1174 4     4 1 2827 my ( $self, $name ) = @_;
1175 4 50       19 if ( not defined $name ) {
1176 0         0 return 'Window name not provided';
1177             }
1178 4         12 my $res = { 'command' => 'switchToWindow' };
1179 4         13 my $params = { 'name' => $name, 'handle' => $name };
1180 4         103 return $self->_execute_command( $res, $params );
1181             }
1182              
1183              
1184             sub set_window_position {
1185 0     0 1 0 my ( $self, $x, $y, $window ) = @_;
1186 0 0       0 $window = ( defined $window ) ? $window : 'current';
1187 0 0 0     0 if ( not defined $x and not defined $y ) {
1188 0         0 croak "X & Y co-ordinates are required";
1189             }
1190 0 0       0 croak qq{Error: In set_window_size, argument x "$x" isn't numeric}
1191             unless Scalar::Util::looks_like_number($x);
1192 0 0       0 croak qq{Error: In set_window_size, argument y "$y" isn't numeric}
1193             unless Scalar::Util::looks_like_number($y);
1194 0         0 $x +=
1195             0; # convert to numeric if a string, otherwise they'll be sent as strings
1196 0         0 $y += 0;
1197 0         0 my $res = { 'command' => 'setWindowPosition', 'window_handle' => $window };
1198 0         0 my $params = { 'x' => $x, 'y' => $y };
1199 0 0       0 if ( $self->{is_wd3} ) {
1200 0         0 $res = { 'command' => 'setWindowRect', handle => $window };
1201             }
1202 0         0 my $ret = $self->_execute_command( $res, $params );
1203 0 0       0 return $ret ? 1 : 0;
1204             }
1205              
1206              
1207             sub set_window_size {
1208 0     0 1 0 my ( $self, $height, $width, $window ) = @_;
1209 0 0       0 $window = ( defined $window ) ? $window : 'current';
1210 0 0 0     0 if ( not defined $height and not defined $width ) {
1211 0         0 croak "height & width of browser are required";
1212             }
1213 0 0       0 croak qq{Error: In set_window_size, argument height "$height" isn't numeric}
1214             unless Scalar::Util::looks_like_number($height);
1215 0 0       0 croak qq{Error: In set_window_size, argument width "$width" isn't numeric}
1216             unless Scalar::Util::looks_like_number($width);
1217 0         0 $height +=
1218             0; # convert to numeric if a string, otherwise they'll be sent as strings
1219 0         0 $width += 0;
1220 0         0 my $res = { 'command' => 'setWindowSize', 'window_handle' => $window };
1221 0         0 my $params = { 'height' => $height, 'width' => $width };
1222 0 0       0 if ( $self->{is_wd3} ) {
1223 0         0 $res = { 'command' => 'setWindowRect', handle => $window };
1224             }
1225 0         0 my $ret = $self->_execute_command( $res, $params );
1226 0 0       0 return $ret ? 1 : 0;
1227             }
1228              
1229              
1230             sub maximize_window {
1231 0     0 1 0 my ( $self, $window ) = @_;
1232              
1233 0 0       0 $window = ( defined $window ) ? $window : 'current';
1234 0         0 my $res = { 'command' => 'maximizeWindow', 'window_handle' => $window };
1235 0         0 my $ret = $self->_execute_command($res);
1236 0 0       0 return $ret ? 1 : 0;
1237             }
1238              
1239              
1240             sub minimize_window {
1241 0     0 1 0 my ( $self, $window ) = @_;
1242 0 0       0 $window = ( defined $window ) ? $window : 'current';
1243 0         0 my $res = { 'command' => 'minimizeWindow', 'window_handle' => $window };
1244 0         0 my $ret = $self->_execute_command($res);
1245 0 0       0 return $ret ? 1 : 0;
1246             }
1247              
1248              
1249             sub fullscreen_window {
1250 0     0 1 0 my ( $self, $window ) = @_;
1251 0 0       0 $window = ( defined $window ) ? $window : 'current';
1252 0         0 my $res = { 'command' => 'fullscreenWindow', 'window_handle' => $window };
1253 0         0 my $ret = $self->_execute_command($res);
1254 0 0       0 return $ret ? 1 : 0;
1255             }
1256              
1257              
1258             sub get_all_cookies {
1259 4     4 1 964 my ($self) = @_;
1260 4         14 my $res = { 'command' => 'getAllCookies' };
1261 4         101 return $self->_execute_command($res);
1262             }
1263              
1264              
1265             sub add_cookie {
1266 1     1 1 26 my ( $self, $name, $value, $path, $domain, $secure, $httponly, $expiry ) =
1267             @_;
1268              
1269 1 50 33     9 if ( ( not defined $name )
1270             || ( not defined $value ) )
1271             {
1272 0         0 croak "Missing parameters";
1273             }
1274              
1275 1         6 my $res = { 'command' => 'addCookie' };
1276 1         8 my $json_false = JSON::false;
1277 1         9 my $json_true = JSON::true;
1278 1 50 33     8 $secure = ( defined $secure && $secure ) ? $json_true : $json_false;
1279              
1280 1         6 my $params = {
1281             'cookie' => {
1282             'name' => $name,
1283             'value' => $value,
1284             'path' => $path,
1285             'secure' => $secure,
1286             }
1287             };
1288 1 50       4 $params->{cookie}->{domain} = $domain if $domain;
1289 1 50       4 $params->{cookie}->{'httponly'} = $httponly if $httponly;
1290 1 50       3 $params->{cookie}->{'expiry'} = $expiry if $expiry;
1291              
1292 1         21 return $self->_execute_command( $res, $params );
1293             }
1294              
1295              
1296             sub delete_all_cookies {
1297 2     2 1 1188 my ($self) = @_;
1298 2         8 my $res = { 'command' => 'deleteAllCookies' };
1299 2         54 return $self->_execute_command($res);
1300             }
1301              
1302              
1303             sub get_cookie_named {
1304 0     0 1 0 my ( $self, $cookie_name ) = @_;
1305 0         0 my $res = { 'command' => 'getCookieNamed', 'name' => $cookie_name };
1306 0         0 return $self->_execute_command($res);
1307             }
1308              
1309              
1310             sub delete_cookie_named {
1311 1     1 1 1182 my ( $self, $cookie_name ) = @_;
1312 1 50       5 if ( not defined $cookie_name ) {
1313 0         0 croak "Cookie name not provided";
1314             }
1315 1         5 my $res = { 'command' => 'deleteCookieNamed', 'name' => $cookie_name };
1316 1         27 return $self->_execute_command($res);
1317             }
1318              
1319              
1320             sub get_page_source {
1321 13     13 1 3780 my ($self) = @_;
1322 13         35 my $res = { 'command' => 'getPageSource' };
1323 13         342 return $self->_execute_command($res);
1324             }
1325              
1326              
1327             sub find_element {
1328 67     67 1 5682 my ( $self, $query, $method ) = @_;
1329 67 50       196 if ( not defined $query ) {
1330 0         0 croak 'Search string to find element not provided.';
1331             }
1332              
1333 67         183 my $res = { 'command' => 'findElement' };
1334 67         185 my $params = $self->_build_find_params( $method, $query );
1335 67         138 my $ret_data = eval { $self->_execute_command( $res, $params ); };
  67         1787  
1336 67 100       773 if ($@) {
1337 12 100       85 if ( $@ =~
1338             /(An element could not be located on the page using the given search parameters)/
1339             )
1340             {
1341             # give details on what element wasn't found
1342 11         58 $@ = "$1: $query,$params->{using}";
1343 11         40 local @CARP_NOT = ( "Selenium::Remote::Driver", @CARP_NOT );
1344 11         850 croak $@;
1345             }
1346             else {
1347             # re throw if the exception wasn't what we expected
1348 1         17 die $@;
1349             }
1350             }
1351 55         1200 return $self->webelement_class->new(
1352             id => $ret_data,
1353             driver => $self
1354             );
1355             }
1356              
1357              
1358             sub find_elements {
1359 6     6 1 1483 my ( $self, $query, $method ) = @_;
1360 6 50       19 if ( not defined $query ) {
1361 0         0 croak 'Search string to find element not provided.';
1362             }
1363              
1364 6         18 my $res = { 'command' => 'findElements' };
1365 6         17 my $params = $self->_build_find_params( $method, $query );
1366 6         12 my $ret_data = eval { $self->_execute_command( $res, $params ); };
  6         137  
1367 6 50       20 if ($@) {
1368 0 0       0 if ( $@ =~
1369             /(An element could not be located on the page using the given search parameters)/
1370             )
1371             {
1372             # give details on what element wasn't found
1373 0         0 $@ = "$1: $query,$params->{using}";
1374 0         0 local @CARP_NOT = ( "Selenium::Remote::Driver", @CARP_NOT );
1375 0         0 croak $@;
1376             }
1377             else {
1378             # re throw if the exception wasn't what we expected
1379 0         0 die $@;
1380             }
1381             }
1382 6         14 my $elem_obj_arr = [];
1383 6         36 foreach (@$ret_data) {
1384 6         137 push(
1385             @$elem_obj_arr,
1386             $self->webelement_class->new(
1387             id => $_,
1388             driver => $self
1389             )
1390             );
1391             }
1392 4 100       41 return wantarray ? @{$elem_obj_arr} : $elem_obj_arr;
  1         7  
1393             }
1394              
1395              
1396             sub find_child_element {
1397 4     4 1 45 my ( $self, $elem, $query, $method ) = @_;
1398 4 100 66     26 if ( ( not defined $elem ) || ( not defined $query ) ) {
1399 1         96 croak "Missing parameters";
1400             }
1401 3         13 my $res = { 'command' => 'findChildElement', 'id' => $elem->{id} };
1402 3         10 my $params = $self->_build_find_params( $method, $query );
1403 3         8 my $ret_data = eval { $self->_execute_command( $res, $params ); };
  3         65  
1404 3 50       16 if ($@) {
1405 0 0       0 if ( $@ =~
1406             /(An element could not be located on the page using the given search parameters)/
1407             )
1408             {
1409             # give details on what element wasn't found
1410 0         0 $@ = "$1: $query,$params->{using}";
1411 0         0 local @CARP_NOT = ( "Selenium::Remote::Driver", @CARP_NOT );
1412 0         0 croak $@;
1413             }
1414             else {
1415             # re throw if the exception wasn't what we expected
1416 0         0 die $@;
1417             }
1418             }
1419 3         79 return $self->webelement_class->new(
1420             id => $ret_data,
1421             driver => $self
1422             );
1423             }
1424              
1425              
1426             sub find_child_elements {
1427 2     2 1 706 my ( $self, $elem, $query, $method ) = @_;
1428 2 50 33     29 if ( ( not defined $elem ) || ( not defined $query ) ) {
1429 0         0 croak "Missing parameters";
1430             }
1431              
1432 2         10 my $res = { 'command' => 'findChildElements', 'id' => $elem->{id} };
1433 2         9 my $params = $self->_build_find_params( $method, $query );
1434 2         16 my $ret_data = eval { $self->_execute_command( $res, $params ); };
  2         50  
1435 2 50       8 if ($@) {
1436 0 0       0 if ( $@ =~
1437             /(An element could not be located on the page using the given search parameters)/
1438             )
1439             {
1440             # give details on what element wasn't found
1441 0         0 $@ = "$1: $query,$params->{using}";
1442 0         0 local @CARP_NOT = ( "Selenium::Remote::Driver", @CARP_NOT );
1443 0         0 croak $@;
1444             }
1445             else {
1446             # re throw if the exception wasn't what we expected
1447 0         0 die $@;
1448             }
1449             }
1450 2         7 my $elem_obj_arr = [];
1451 2         6 my $i = 0;
1452 2         7 foreach (@$ret_data) {
1453 6         114 $elem_obj_arr->[$i] = $self->webelement_class->new(
1454             id => $_,
1455             driver => $self
1456             );
1457 6         38 $i++;
1458             }
1459 2 50       15 return wantarray ? @{$elem_obj_arr} : $elem_obj_arr;
  0         0  
1460             }
1461              
1462              
1463             sub _build_find_params {
1464 78     78   169 my ( $self, $method, $query ) = @_;
1465              
1466 78         198 my $using = $self->_build_using($method);
1467              
1468             # geckodriver doesn't accept name as a valid selector
1469 78 50 33     587 if ( $self->isa('Selenium::Firefox') && $using eq 'name' ) {
1470             return {
1471 0         0 using => 'css selector',
1472             value => qq{[name="$query"]}
1473             };
1474             }
1475             else {
1476             return {
1477 78         319 using => $using,
1478             value => $query
1479             };
1480             }
1481             }
1482              
1483             sub _build_using {
1484 78     78   162 my ( $self, $method ) = @_;
1485              
1486 78 100       185 if ($method) {
1487 69 50       253 if ( $self->FINDERS->{$method} ) {
1488 69         240 return $self->FINDERS->{$method};
1489             }
1490             else {
1491             croak 'Bad method, expected: '
1492 0         0 . join( ', ', keys %{ $self->FINDERS } )
  0         0  
1493             . ", got $method";
1494             }
1495             }
1496             else {
1497 9         208 return $self->default_finder;
1498             }
1499             }
1500              
1501             sub get_active_element {
1502 1     1 1 1067 my ($self) = @_;
1503 1         4 my $res = { 'command' => 'getActiveElement' };
1504 1         2 my $ret_data = eval { $self->_execute_command($res) };
  1         28  
1505 1 50       12 if ($@) {
1506 0         0 croak $@;
1507             }
1508             else {
1509 1         23 return $self->webelement_class->new(
1510             id => $ret_data,
1511             driver => $self
1512             );
1513             }
1514             }
1515              
1516              
1517             sub cache_status {
1518 0     0 1 0 my ($self) = @_;
1519 0         0 my $res = { 'command' => 'cacheStatus' };
1520 0         0 return $self->_execute_command($res);
1521             }
1522              
1523              
1524             sub set_geolocation {
1525 1     1 1 791 my ( $self, %params ) = @_;
1526 1         6 my $res = { 'command' => 'setGeolocation' };
1527 1         29 return $self->_execute_command( $res, \%params );
1528             }
1529              
1530              
1531             sub get_geolocation {
1532 0     0 1 0 my ($self) = @_;
1533 0         0 my $res = { 'command' => 'getGeolocation' };
1534 0         0 return $self->_execute_command($res);
1535             }
1536              
1537              
1538             sub get_log {
1539 4     4 1 1463 my ( $self, $type ) = @_;
1540 4         13 my $res = { 'command' => 'getLog' };
1541 4         115 return $self->_execute_command( $res, { type => $type } );
1542             }
1543              
1544              
1545             sub get_log_types {
1546 1     1 1 8 my ($self) = @_;
1547 1         4 my $res = { 'command' => 'getLogTypes' };
1548 1         23 return $self->_execute_command($res);
1549             }
1550              
1551              
1552             sub set_orientation {
1553 0     0 1 0 my ( $self, $orientation ) = @_;
1554 0         0 my $res = { 'command' => 'setOrientation' };
1555 0         0 return $self->_execute_command( $res, { orientation => $orientation } );
1556             }
1557              
1558              
1559             sub get_orientation {
1560 0     0 1 0 my ($self) = @_;
1561 0         0 my $res = { 'command' => 'getOrientation' };
1562 0         0 return $self->_execute_command($res);
1563             }
1564              
1565              
1566             sub send_modifier {
1567 1     1 1 22 my ( $self, $modifier, $isdown ) = @_;
1568 1 50       11 if ( $isdown =~ /(down|up)/ ) {
1569 1 50       6 $isdown = $isdown =~ /down/ ? 1 : 0;
1570             }
1571              
1572 1 50 33     5 if ( $self->{is_wd3}
1573 0         0 && !( grep { $self->browser_name eq $_ } qw{MicrosoftEdge} ) )
1574             {
1575             my $acts = [
1576             {
1577             type => $isdown ? 'keyDown' : 'keyUp',
1578 0 0       0 value => KEYS->{ lc($modifier) },
1579             },
1580             ];
1581              
1582 0         0 my $action = {
1583             actions => [
1584             {
1585             id => 'key',
1586             type => 'key',
1587             actions => $acts,
1588             }
1589             ]
1590             };
1591 0         0 _queue_action(%$action);
1592 0         0 return 1;
1593             }
1594              
1595 1         4 my $res = { 'command' => 'sendModifier' };
1596 1         5 my $params = {
1597             value => $modifier,
1598             isdown => $isdown
1599             };
1600 1         23 return $self->_execute_command( $res, $params );
1601             }
1602              
1603              
1604             sub compare_elements {
1605 0     0 1 0 my ( $self, $elem1, $elem2 ) = @_;
1606             my $res = {
1607             'command' => 'elementEquals',
1608             'id' => $elem1->{id},
1609             'other' => $elem2->{id}
1610 0         0 };
1611 0         0 return $self->_execute_command($res);
1612             }
1613              
1614              
1615             sub click {
1616 0     0 1 0 my ( $self, $button, $append ) = @_;
1617 0         0 $button = _get_button($button);
1618              
1619 0         0 my $res = { 'command' => 'click' };
1620 0         0 my $params = { 'button' => $button };
1621              
1622 0 0 0     0 if ( $self->{is_wd3}
1623 0         0 && !( grep { $self->browser_name eq $_ } qw{MicrosoftEdge} ) )
1624             {
1625 0         0 $params = {
1626             actions => [
1627             {
1628             type => "pointer",
1629             id => 'mouse',
1630             parameters => { "pointerType" => "mouse" },
1631             actions => [
1632             {
1633             type => "pointerDown",
1634             duration => 0,
1635             button => $button,
1636             },
1637             {
1638             type => "pointerUp",
1639             duration => 0,
1640             button => $button,
1641             },
1642             ],
1643             }
1644             ],
1645             };
1646 0 0       0 if ($append) {
1647 0         0 _queue_action(%$params);
1648 0         0 return 1;
1649             }
1650 0         0 return $self->general_action(%$params);
1651             }
1652              
1653 0         0 return $self->_execute_command( $res, $params );
1654             }
1655              
1656             sub _get_button {
1657 0     0   0 my $button = shift;
1658 0         0 my $button_enum = { LEFT => 0, MIDDLE => 1, RIGHT => 2 };
1659 0 0 0     0 if ( defined $button && $button =~ /(LEFT|MIDDLE|RIGHT)/i ) {
1660 0         0 return $button_enum->{ uc $1 };
1661             }
1662 0 0 0     0 if ( defined $button && $button =~ /(0|1|2)/ ) {
1663             #Handle user error sending in "1"
1664 0         0 return int($1);
1665             }
1666 0         0 return 0;
1667             }
1668              
1669              
1670             sub double_click {
1671 0     0 1 0 my ( $self, $button ) = @_;
1672              
1673 0         0 $button = _get_button($button);
1674              
1675 0 0 0     0 if ( $self->{is_wd3}
1676 0         0 && !( grep { $self->browser_name eq $_ } qw{MicrosoftEdge} ) )
1677             {
1678 0         0 $self->click( $button, 1 );
1679 0         0 $self->click( $button, 1 );
1680 0         0 return $self->general_action();
1681             }
1682              
1683 0         0 my $res = { 'command' => 'doubleClick' };
1684 0         0 return $self->_execute_command($res);
1685             }
1686              
1687              
1688             sub button_down {
1689 0     0 1 0 my ($self) = @_;
1690              
1691 0 0 0     0 if ( $self->{is_wd3}
1692 0         0 && !( grep { $self->browser_name eq $_ } qw{MicrosoftEdge} ) )
1693             {
1694 0         0 my $params = {
1695             actions => [
1696             {
1697             type => "pointer",
1698             id => 'mouse',
1699             parameters => { "pointerType" => "mouse" },
1700             actions => [
1701             {
1702             type => "pointerDown",
1703             duration => 0,
1704             button => 0,
1705             },
1706             ],
1707             }
1708             ],
1709             };
1710 0         0 _queue_action(%$params);
1711 0         0 return 1;
1712             }
1713              
1714 0         0 my $res = { 'command' => 'buttonDown' };
1715 0         0 return $self->_execute_command($res);
1716             }
1717              
1718              
1719             sub button_up {
1720 0     0 1 0 my ($self) = @_;
1721              
1722 0 0 0     0 if ( $self->{is_wd3}
1723 0         0 && !( grep { $self->browser_name eq $_ } qw{MicrosoftEdge} ) )
1724             {
1725 0         0 my $params = {
1726             actions => [
1727             {
1728             type => "pointer",
1729             id => 'mouse',
1730             parameters => { "pointerType" => "mouse" },
1731             actions => [
1732             {
1733             type => "pointerUp",
1734             duration => 0,
1735             button => 0,
1736             },
1737             ],
1738             }
1739             ],
1740             };
1741 0         0 _queue_action(%$params);
1742 0         0 return 1;
1743             }
1744              
1745 0         0 my $res = { 'command' => 'buttonUp' };
1746 0         0 return $self->_execute_command($res);
1747             }
1748              
1749              
1750             # this method duplicates upload() method in the
1751             # org.openqa.selenium.remote.RemoteWebElement java class.
1752              
1753             sub upload_file {
1754 5     5 1 1142 my ( $self, $filename, $raw_content ) = @_;
1755              
1756 5         10 my $params;
1757 5 100       15 if ( defined $raw_content ) {
1758              
1759             #If no processing is passed, send the argument raw
1760 1         6 $params = { file => $raw_content };
1761             }
1762             else {
1763             #Otherwise, zip/base64 it.
1764 4         11 $params = $self->_prepare_file($filename);
1765             }
1766              
1767 4         87 my $res = { 'command' => 'uploadFile' }; # /session/:SessionId/file
1768 4         115 my $ret = $self->_execute_command( $res, $params );
1769              
1770 3         51 return $ret;
1771             }
1772              
1773             sub _prepare_file {
1774 4     4   11 my ( $self, $filename ) = @_;
1775              
1776 4 100       189 if ( not -r $filename ) { croak "upload_file: no such file: $filename"; }
  1         184  
1777 3         11 my $string = ""; # buffer
1778 3         21 my $zip = Archive::Zip->new();
1779 3         293 $zip->addFile( $filename, basename($filename) );
1780 3 50       1273 if ( $zip->writeToFileHandle( IO::String->new($string) ) != AZ_OK ) {
1781 0         0 die 'zip failed';
1782             }
1783              
1784 3         6416 return { file => MIME::Base64::encode_base64( $string, '' ) };
1785             }
1786              
1787              
1788             sub get_text {
1789 14     14 1 25 my $self = shift;
1790 14         46 return $self->find_element(@_)->get_text();
1791             }
1792              
1793              
1794             sub get_body {
1795 13     13 1 29 my $self = shift;
1796 13         40 return $self->get_text( '//body', 'xpath' );
1797             }
1798              
1799              
1800             sub get_path {
1801 0     0 1 0 my $self = shift;
1802 0         0 my $location = $self->get_current_url;
1803 0         0 $location =~ s/\?.*//; # strip of query params
1804 0         0 $location =~ s/#.*//; # strip of anchors
1805 0         0 $location =~ s#^https?://[^/]+##; # strip off host
1806 0         0 return $location;
1807             }
1808              
1809              
1810             sub get_user_agent {
1811 1     1 1 81 my $self = shift;
1812 1         7 return $self->execute_script('return window.navigator.userAgent;');
1813             }
1814              
1815              
1816             sub set_inner_window_size {
1817 0     0 1 0 my $self = shift;
1818 0         0 my $height = shift;
1819 0         0 my $width = shift;
1820 0         0 my $location = $self->get_current_url;
1821              
1822 0         0 $self->execute_script( 'window.open("' . $location . '", "_blank")' );
1823 0         0 $self->close;
1824 0         0 my @handles = @{ $self->get_window_handles };
  0         0  
1825 0         0 $self->switch_to_window( pop @handles );
1826              
1827 0         0 my @resize = (
1828             'window.innerHeight = ' . $height,
1829             'window.innerWidth = ' . $width,
1830             'return 1'
1831             );
1832              
1833 0 0       0 return $self->execute_script( join( ';', @resize ) ) ? 1 : 0;
1834             }
1835              
1836              
1837             sub get_local_storage_item {
1838 2     2 1 13 my ( $self, $key ) = @_;
1839 2         6 my $res = { 'command' => 'getLocalStorageItem' };
1840 2         8 my $params = { 'key' => $key };
1841 2         51 return $self->_execute_command( $res, $params );
1842             }
1843              
1844              
1845             sub delete_local_storage_item {
1846 1     1 1 339 my ( $self, $key ) = @_;
1847 1         8 my $res = { 'command' => 'deleteLocalStorageItem' };
1848 1         7 my $params = { 'key' => $key };
1849 1         28 return $self->_execute_command( $res, $params );
1850             }
1851              
1852             sub _coerce_timeout_ms {
1853 7     7   1369 my ($ms) = @_;
1854              
1855 7 100       21 if ( defined $ms ) {
1856 6         17 return _coerce_number($ms);
1857             }
1858             else {
1859 1         91 croak 'Expecting a timeout in ms';
1860             }
1861             }
1862              
1863             sub _coerce_number {
1864 7     7   422 my ($maybe_number) = @_;
1865              
1866 7 100       32 if ( Scalar::Util::looks_like_number($maybe_number) ) {
1867 2         7 return $maybe_number + 0;
1868             }
1869             else {
1870 5         514 croak "Expecting a number, not: $maybe_number";
1871             }
1872             }
1873              
1874             1;
1875              
1876             __END__