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.50';
3 26     26   1732264 use strict;
  26         56  
  26         3015  
4 26     26   145 use warnings;
  26         57  
  26         1733  
5              
6             # ABSTRACT: Perl Client for Selenium Remote Driver
7              
8 26     26   5043 use Moo;
  26         79347  
  26         171  
9 26     26   32371 use Try::Tiny;
  26         27120  
  26         1778  
10              
11 26     26   472 use 5.006;
  26         93  
12 26     26   359 use v5.10.0; # Before 5.006, v5.10.0 would not be understood.
  26         118  
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 26     26   211 use Carp;
  26         55  
  26         2673  
19             our @CARP_NOT;
20              
21 26     26   14217 use IO::String;
  26         97375  
  26         1318  
22 26     26   12189 use Archive::Zip qw( :ERROR_CODES );
  26         1708516  
  26         3870  
23 26     26   231 use Scalar::Util;
  26         76  
  26         1268  
24 26     26   14115 use Selenium::Remote::RemoteConnection;
  26         145  
  26         1264  
25 26     26   14813 use Selenium::Remote::Commands;
  26         93  
  26         1140  
26 26     26   14612 use Selenium::Remote::Spec;
  26         99  
  26         1073  
27 26     26   11578 use Selenium::Remote::WebElement;
  26         86  
  26         908  
28 26     26   14310 use Selenium::Remote::WDKeys;
  26         131  
  26         1534  
29 26     26   12421 use File::Spec::Functions ();
  26         21713  
  26         999  
30 26     26   176 use File::Basename qw(basename);
  26         45  
  26         1841  
31 26     26   9469 use Sub::Install ();
  26         40060  
  26         664  
32 26     26   8736 use MIME::Base64 ();
  26         13655  
  26         966  
33 26     26   166 use Time::HiRes qw(usleep);
  26         51  
  26         373  
34 26     26   2938 use Clone qw{clone};
  26         57  
  26         1371  
35 26     26   189 use List::Util qw{any};
  26         83  
  26         2263  
36              
37 26         322935 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 26     26   201 };
  26         54  
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   148 my $self = shift;
118 11         287 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   141 builder => sub { return LWP::UserAgent->new }
146             );
147              
148             has 'commands' => (
149             is => 'lazy',
150             builder => sub {
151 24     24   542 return Selenium::Remote::Commands->new;
152             },
153             );
154              
155             has 'commands_v3' => (
156             is => 'lazy',
157             builder => sub {
158 29     29   663 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   765 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 197 my $self = shift;
279              
280 32 100       188 if ( !( defined $self->session_id ) ) {
281 31 100       249 if ( $self->has_desired_capabilities ) {
282 5         98 $self->new_desired_session( $self->desired_capabilities );
283             }
284             else {
285             # Connect to remote server & establish a new session
286 26         170 $self->new_session( $self->extra_capabilities );
287             }
288             }
289              
290 30 50       273 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       777 $self->debug_on() if $self->debug;
300              
301             # Setup non-croaking, parameter versions of finders
302 30         54 foreach my $by ( keys %{ $self->FINDERS } ) {
  30         221  
303 300         4577 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       1415 unless ( $self->can($finder_name) ) {
308 110         324 my $find_sub = $self->_build_find_by($by);
309              
310 110         440 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 10912 my ( $self, %args ) = @_;
323              
324 4 100       19 if ( not exists $args{desired_capabilities} ) {
325 2         8 $args{desired_capabilities} = {};
326             }
327              
328 4         119 return $self->new(%args);
329             }
330              
331             sub DEMOLISH {
332 38     38 0 45946 my ( $self, $in_global_destruction ) = @_;
333 38 50       756 return if $$ != $self->pid;
334 38 50       134 return if $in_global_destruction;
335 38 100 100     904 $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 92 my ( $self, $extra_capabilities ) = @_;
423 22   50     109 $extra_capabilities ||= {};
424              
425 22   50     449 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       1608 $args->{'extra_capabilities'} = \%$extra_capabilities unless $FORCE_WD2;
436              
437 22 100       365 if ( defined $self->proxy ) {
438 2         62 $args->{desiredCapabilities}->{proxy} = $self->proxy;
439             }
440              
441 22 50 66     314 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         93 $self->_request_new_session($args);
449             }
450              
451              
452             sub new_desired_session {
453 5     5 1 51 my ( $self, $caps ) = @_;
454              
455 5         27 $self->_request_new_session(
456             {
457             desiredCapabilities => $caps
458             }
459             );
460             }
461              
462             sub _request_new_session {
463 29     29   2170 my ( $self, $args ) = @_;
464              
465             #XXX UGLY shim for webdriver3
466             $args->{capabilities}->{alwaysMatch} =
467 29         682 clone( $args->{desiredCapabilities} );
468 29         578 my $cmap = $self->commands_v3->get_caps_map();
469 29         453 my $caps = $self->commands_v3->get_caps();
470 29         76 foreach my $cap ( keys( %{ $args->{capabilities}->{alwaysMatch} } ) ) {
  29         136  
471              
472             #Handle browser specific capabilities
473 136 100 66     892 if ( exists( $args->{desiredCapabilities}->{browserName} )
474             && $cap eq 'extra_capabilities' )
475             {
476              
477 2 100       6 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         46 ->{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     657 if ( exists( $args->{desiredCapabilities}->{browserName} )
      100        
494             && $args->{desiredCapabilities}->{browserName} eq 'firefox'
495             && $cap eq 'firefox_profile' )
496             {
497 2 100       7 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         5 ];
508             }
509             }
510 136         266 foreach my $newkey ( keys(%$cmap) ) {
511 480 100       703 if ( $newkey eq $cap ) {
512 103 100       195 last if $cmap->{$newkey} eq $cap;
513             $args->{capabilities}->{alwaysMatch}->{ $cmap->{$newkey} } =
514 72         191 $args->{capabilities}->{alwaysMatch}->{$cap};
515 72         108 delete $args->{capabilities}->{alwaysMatch}->{$cap};
516 72         143 last;
517             }
518             }
519             delete $args->{capabilities}->{alwaysMatch}->{$cap}
520 136 100   1295   481 if !any { $_ eq $cap } @$caps;
  1295         1713  
521             }
522             delete $args->{desiredCapabilities}
523 29 50       95 if $FORCE_WD3; #XXX fork working-around busted fallback in firefox
524             delete $args->{capabilities}
525 29 100       144 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     459 if ( $self->isa('Selenium::Firefox') || $self->isa('Selenium::Chrome') || $self->isa('Selenium::Edge') ) {
      66        
529 2 0 33     6 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       116 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         653 $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         656 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         626 my $rc = $self->remote_conn;
558 28         242 my $resp = $rc->request( $resource_new_session, $args, );
559              
560 28 50 33     206 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     152 if ( ( defined $resp->{'sessionId'} ) && $resp->{'sessionId'} ne '' ) {
565 27         126 $self->session_id( $resp->{'sessionId'} );
566             }
567             else {
568 1         4 my $error = 'Could not create new session';
569              
570 1 50       6 if ( ref $resp->{cmd_return} eq 'HASH' ) {
571 1         4 $error .= ': ' . $resp->{cmd_return}->{message};
572             }
573             else {
574 0         0 $error .= ': ' . $resp->{cmd_return};
575             }
576 1         289 croak $error;
577             }
578              
579             #Webdriver 3 - best guess that this is 'whats goin on'
580 27 100 100     112 if ( ref $resp->{cmd_return} eq 'HASH'
581             && $resp->{cmd_return}->{capabilities} )
582             {
583 2         3 $self->{is_wd3} = 1;
584 2         3 $self->{emulate_jsonwire} = 1;
585 2         4 $self->{capabilities} = $resp->{cmd_return}->{capabilities};
586             }
587              
588             #XXX chromedriver DOES NOT FOLLOW SPEC!
589 27 100 100     109 if ( ref $resp->{cmd_return} eq 'HASH' && $resp->{cmd_return}->{chrome} ) {
590 1 50       4 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     387 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         271 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 617 my ($self) = @_;
620 1         3 $self->{debug} = 1;
621 1         22 $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 706 my ($self) = @_;
641 1         3 my $res = { 'command' => 'status' };
642 1         26 return $self->_execute_command($res);
643             }
644              
645              
646             sub get_alert_text {
647 6     6 1 37 my ($self) = @_;
648 6         16 my $res = { 'command' => 'getAlertText' };
649 6         131 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         4 my $res = { 'command' => 'sendKeysToPrompt' };
699 1         3 my $params = { 'text' => $keys };
700 1         27 return $self->_execute_command( $res, $params );
701             }
702              
703              
704             sub accept_alert {
705 6     6 1 769 my ($self) = @_;
706 6         16 my $res = { 'command' => 'acceptAlert' };
707 6         131 return $self->_execute_command($res);
708             }
709              
710              
711             sub dismiss_alert {
712 3     3 1 8 my ($self) = @_;
713 3         10 my $res = { 'command' => 'dismissAlert' };
714 3         70 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 1186 my $self = shift;
804 1         4 my $res = { 'command' => 'getCapabilities' };
805 1         37 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 386 my ( $self, $type, $ms ) = @_;
818 1 50       5 if ( not defined $type ) {
819 0         0 croak "Expecting type";
820             }
821 1         4 $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 321 my ( $self, $ms ) = @_;
841              
842 1 50       5 return $self->set_timeout( 'script', $ms ) if $self->{is_wd3};
843              
844 1         4 $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 1005 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         6 my $res = { 'command' => 'setImplicitWaitTimeout' };
857 2         4 my $params = { 'ms' => $ms };
858 2         52 return $self->_execute_command( $res, $params );
859             }
860              
861              
862             sub pause {
863 1     1 1 9 my $self = shift;
864 1   50     7 my $timeout = ( shift // 1000 ) * 1000;
865 1         1001772 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 4281 my $self = shift;
878 27         93 my $res = { 'command' => 'quit' };
879 27         614 $self->_execute_command($res);
880 27         541 $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 1646 my $self = shift;
893 2         5 my $res = { 'command' => 'getWindowHandles' };
894 2         52 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 743 my $self = shift;
920 2         8 my $res = { 'command' => 'getCurrentUrl' };
921 2         40 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 11235 my ( $self, $url ) = @_;
933              
934 28 100 100     185 if ( $self->has_base_url && $url !~ m|://| ) {
935 5         11 $url =~ s|^/||;
936 5         81 $url = $self->base_url . "/" . $url;
937             }
938              
939 28         140 my $res = { 'command' => 'get' };
940 28         81 my $params = { 'url' => $url };
941 28         758 return $self->_execute_command( $res, $params );
942             }
943              
944              
945             sub get_title {
946 14     14 1 3128 my $self = shift;
947 14         41 my $res = { 'command' => 'getTitle' };
948 14         445 return $self->_execute_command($res);
949             }
950              
951              
952             sub go_back {
953 2     2 1 1025 my $self = shift;
954 2         14 my $res = { 'command' => 'goBack' };
955 2         74 return $self->_execute_command($res);
956             }
957              
958              
959             sub go_forward {
960 1     1 1 832 my $self = shift;
961 1         4 my $res = { 'command' => 'goForward' };
962 1         24 return $self->_execute_command($res);
963             }
964              
965              
966             sub refresh {
967 1     1 1 833 my $self = shift;
968 1         3 my $res = { 'command' => 'refresh' };
969 1         27 return $self->_execute_command($res);
970             }
971              
972              
973             sub has_javascript {
974 10     10 1 17 my $self = shift;
975 10         319 return int( $self->javascript );
976             }
977              
978              
979             sub execute_async_script {
980 2     2 1 2829 my ( $self, $script, @args ) = @_;
981 2 50       8 if ( $self->has_javascript ) {
982 2 50       39 if ( not defined $script ) {
983 0         0 croak 'No script provided';
984             }
985 2         47 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         28 for ( my $i = 0 ; $i < @args ; $i++ ) {
991 2 100 66     16 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         7 $args[$i] = { 'ELEMENT' => ( $args[$i] )->{id} };
1001             }
1002             }
1003             }
1004              
1005 2         8 my $params = { 'script' => $script, 'args' => \@args };
1006 2         52 my $ret = $self->_execute_command( $res, $params );
1007              
1008             # replace any ELEMENTS with WebElement
1009 2 50 33     24 if ( ref($ret)
      33        
1010             and ( ref($ret) eq 'HASH' )
1011             and $self->_looks_like_element($ret) )
1012             {
1013 2         60 $ret = $self->webelement_class->new(
1014             id => $ret,
1015             driver => $self
1016             );
1017             }
1018 2         32 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 1316 my ( $self, $script, @args ) = @_;
1028 8 50       32 if ( $self->has_javascript ) {
1029 8 50       133 if ( not defined $script ) {
1030 0         0 croak 'No script provided';
1031             }
1032 8         152 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         89 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       5 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         29 my $params = { 'script' => $script, 'args' => [@args] };
1053 8         146 my $ret = $self->_execute_command( $res, $params );
1054              
1055 8         36 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   16 my ( $self, $maybe_element ) = @_;
1067              
1068             return (
1069             exists $maybe_element->{ELEMENT}
1070 5   33     28 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   25 my ( $self, $ret ) = @_;
1080              
1081 9 100 100     45 if ( ref($ret) and ( ref($ret) eq 'HASH' ) ) {
1082 3 50       53 if ( $self->_looks_like_element($ret) ) {
1083              
1084             # replace an ELEMENT with WebElement
1085 3         90 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     25 if ( ref($ret) and ( ref($ret) eq 'ARRAY' ) ) {
1099 1         4 my @array = map { $self->_convert_to_webelement($_) } @$ret;
  1         7  
1100 1         17 return \@array;
1101             }
1102              
1103 5         29 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 694 my ($self) = @_;
1135 1         4 my $res = { 'command' => 'availableEngines' };
1136 1         26 return $self->_execute_command($res);
1137             }
1138              
1139              
1140             sub switch_to_frame {
1141 1     1 1 9 my ( $self, $id ) = @_;
1142              
1143 1         5 my $json_null = JSON::null;
1144 1         4 my $params;
1145 1 50       3 $id = ( defined $id ) ? $id : $json_null;
1146              
1147 1         4 my $res = { 'command' => 'switchToFrame' };
1148              
1149 1 50       6 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         3 $params = { 'id' => $id };
1161             }
1162 1         18 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 3591 my ( $self, $name ) = @_;
1175 4 50       13 if ( not defined $name ) {
1176 0         0 return 'Window name not provided';
1177             }
1178 4         11 my $res = { 'command' => 'switchToWindow' };
1179 4         12 my $params = { 'name' => $name, 'handle' => $name };
1180 4         118 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 1658 my ($self) = @_;
1260 4         14 my $res = { 'command' => 'getAllCookies' };
1261 4         92 return $self->_execute_command($res);
1262             }
1263              
1264              
1265             sub add_cookie {
1266 1     1 1 15 my ( $self, $name, $value, $path, $domain, $secure, $httponly, $expiry ) =
1267             @_;
1268              
1269 1 50 33     7 if ( ( not defined $name )
1270             || ( not defined $value ) )
1271             {
1272 0         0 croak "Missing parameters";
1273             }
1274              
1275 1         3 my $res = { 'command' => 'addCookie' };
1276 1         5 my $json_false = JSON::false;
1277 1         6 my $json_true = JSON::true;
1278 1 50 33     7 $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       3 $params->{cookie}->{domain} = $domain if $domain;
1289 1 50       4 $params->{cookie}->{'httponly'} = $httponly if $httponly;
1290 1 50       2 $params->{cookie}->{'expiry'} = $expiry if $expiry;
1291              
1292 1         16 return $self->_execute_command( $res, $params );
1293             }
1294              
1295              
1296             sub delete_all_cookies {
1297 2     2 1 1540 my ($self) = @_;
1298 2         131 my $res = { 'command' => 'deleteAllCookies' };
1299 2         65 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 1410 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         25 return $self->_execute_command($res);
1317             }
1318              
1319              
1320             sub get_page_source {
1321 13     13 1 5030 my ($self) = @_;
1322 13         37 my $res = { 'command' => 'getPageSource' };
1323 13         454 return $self->_execute_command($res);
1324             }
1325              
1326              
1327             sub find_element {
1328 67     67 1 6193 my ( $self, $query, $method ) = @_;
1329 67 50       234 if ( not defined $query ) {
1330 0         0 croak 'Search string to find element not provided.';
1331             }
1332              
1333 67         266 my $res = { 'command' => 'findElement' };
1334 67         244 my $params = $self->_build_find_params( $method, $query );
1335 67         123 my $ret_data = eval { $self->_execute_command( $res, $params ); };
  67         2460  
1336 67 100       237 if ($@) {
1337 12 100       101 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         66 $@ = "$1: $query,$params->{using}";
1343 11         44 local @CARP_NOT = ( "Selenium::Remote::Driver", @CARP_NOT );
1344 11         1485 croak $@;
1345             }
1346             else {
1347             # re throw if the exception wasn't what we expected
1348 1         4 die $@;
1349             }
1350             }
1351 55         1513 return $self->webelement_class->new(
1352             id => $ret_data,
1353             driver => $self
1354             );
1355             }
1356              
1357              
1358             sub find_elements {
1359 6     6 1 1755 my ( $self, $query, $method ) = @_;
1360 6 50       14 if ( not defined $query ) {
1361 0         0 croak 'Search string to find element not provided.';
1362             }
1363              
1364 6         14 my $res = { 'command' => 'findElements' };
1365 6         16 my $params = $self->_build_find_params( $method, $query );
1366 6         11 my $ret_data = eval { $self->_execute_command( $res, $params ); };
  6         114  
1367 6 50       16 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         10 my $elem_obj_arr = [];
1383 6         28 foreach (@$ret_data) {
1384 6         97 push(
1385             @$elem_obj_arr,
1386             $self->webelement_class->new(
1387             id => $_,
1388             driver => $self
1389             )
1390             );
1391             }
1392 4 100       33 return wantarray ? @{$elem_obj_arr} : $elem_obj_arr;
  1         6  
1393             }
1394              
1395              
1396             sub find_child_element {
1397 4     4 1 36 my ( $self, $elem, $query, $method ) = @_;
1398 4 100 66     19 if ( ( not defined $elem ) || ( not defined $query ) ) {
1399 1         90 croak "Missing parameters";
1400             }
1401 3         9 my $res = { 'command' => 'findChildElement', 'id' => $elem->{id} };
1402 3         7 my $params = $self->_build_find_params( $method, $query );
1403 3         6 my $ret_data = eval { $self->_execute_command( $res, $params ); };
  3         49  
1404 3 50       10 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         50 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 859 my ( $self, $elem, $query, $method ) = @_;
1428 2 50 33     20 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         4 my $ret_data = eval { $self->_execute_command( $res, $params ); };
  2         49  
1435 2 50       9 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         6 my $elem_obj_arr = [];
1451 2         5 my $i = 0;
1452 2         6 foreach (@$ret_data) {
1453 6         124 $elem_obj_arr->[$i] = $self->webelement_class->new(
1454             id => $_,
1455             driver => $self
1456             );
1457 6         36 $i++;
1458             }
1459 2 50       16 return wantarray ? @{$elem_obj_arr} : $elem_obj_arr;
  0         0  
1460             }
1461              
1462              
1463             sub _build_find_params {
1464 78     78   175 my ( $self, $method, $query ) = @_;
1465              
1466 78         238 my $using = $self->_build_using($method);
1467              
1468             # geckodriver doesn't accept name as a valid selector
1469 78 50 33     731 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         549 using => $using,
1478             value => $query
1479             };
1480             }
1481             }
1482              
1483             sub _build_using {
1484 78     78   168 my ( $self, $method ) = @_;
1485              
1486 78 100       188 if ($method) {
1487 69 50       313 if ( $self->FINDERS->{$method} ) {
1488 69         227 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         196 return $self->default_finder;
1498             }
1499             }
1500              
1501             sub get_active_element {
1502 1     1 1 762 my ($self) = @_;
1503 1         4 my $res = { 'command' => 'getActiveElement' };
1504 1         3 my $ret_data = eval { $self->_execute_command($res) };
  1         43  
1505 1 50       6 if ($@) {
1506 0         0 croak $@;
1507             }
1508             else {
1509 1         37 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 889 my ( $self, %params ) = @_;
1526 1         4 my $res = { 'command' => 'setGeolocation' };
1527 1         26 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 1310 my ( $self, $type ) = @_;
1540 4         10 my $res = { 'command' => 'getLog' };
1541 4         105 return $self->_execute_command( $res, { type => $type } );
1542             }
1543              
1544              
1545             sub get_log_types {
1546 1     1 1 5 my ($self) = @_;
1547 1         4 my $res = { 'command' => 'getLogTypes' };
1548 1         17 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 29 my ( $self, $modifier, $isdown ) = @_;
1568 1 50       10 if ( $isdown =~ /(down|up)/ ) {
1569 1 50       5 $isdown = $isdown =~ /down/ ? 1 : 0;
1570             }
1571              
1572 1 50 33     7 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         35 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 996 my ( $self, $filename, $raw_content ) = @_;
1755              
1756 5         7 my $params;
1757 5 100       11 if ( defined $raw_content ) {
1758              
1759             #If no processing is passed, send the argument raw
1760 1         3 $params = { file => $raw_content };
1761             }
1762             else {
1763             #Otherwise, zip/base64 it.
1764 4         9 $params = $self->_prepare_file($filename);
1765             }
1766              
1767 4         80 my $res = { 'command' => 'uploadFile' }; # /session/:SessionId/file
1768 4         119 my $ret = $self->_execute_command( $res, $params );
1769              
1770 3         39 return $ret;
1771             }
1772              
1773             sub _prepare_file {
1774 4     4   6 my ( $self, $filename ) = @_;
1775              
1776 4 100       123 if ( not -r $filename ) { croak "upload_file: no such file: $filename"; }
  1         153  
1777 3         6 my $string = ""; # buffer
1778 3         18 my $zip = Archive::Zip->new();
1779 3         260 $zip->addFile( $filename, basename($filename) );
1780 3 50       867 if ( $zip->writeToFileHandle( IO::String->new($string) ) != AZ_OK ) {
1781 0         0 die 'zip failed';
1782             }
1783              
1784 3         4844 return { file => MIME::Base64::encode_base64( $string, '' ) };
1785             }
1786              
1787              
1788             sub get_text {
1789 14     14 1 67 my $self = shift;
1790 14         53 return $self->find_element(@_)->get_text();
1791             }
1792              
1793              
1794             sub get_body {
1795 13     13 1 27 my $self = shift;
1796 13         64 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 67 my $self = shift;
1812 1         5 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 8 my ( $self, $key ) = @_;
1839 2         5 my $res = { 'command' => 'getLocalStorageItem' };
1840 2         5 my $params = { 'key' => $key };
1841 2         43 return $self->_execute_command( $res, $params );
1842             }
1843              
1844              
1845             sub delete_local_storage_item {
1846 1     1 1 297 my ( $self, $key ) = @_;
1847 1         4 my $res = { 'command' => 'deleteLocalStorageItem' };
1848 1         3 my $params = { 'key' => $key };
1849 1         25 return $self->_execute_command( $res, $params );
1850             }
1851              
1852             sub _coerce_timeout_ms {
1853 7     7   1171 my ($ms) = @_;
1854              
1855 7 100       16 if ( defined $ms ) {
1856 6         14 return _coerce_number($ms);
1857             }
1858             else {
1859 1         83 croak 'Expecting a timeout in ms';
1860             }
1861             }
1862              
1863             sub _coerce_number {
1864 7     7   355 my ($maybe_number) = @_;
1865              
1866 7 100       21 if ( Scalar::Util::looks_like_number($maybe_number) ) {
1867 2         5 return $maybe_number + 0;
1868             }
1869             else {
1870 5         632 croak "Expecting a number, not: $maybe_number";
1871             }
1872             }
1873              
1874             1;
1875              
1876             __END__