File Coverage

blib/lib/Selenium/Remote/Driver.pm
Criterion Covered Total %
statement 409 701 58.3
branch 113 258 43.8
condition 56 134 41.7
subroutine 87 124 70.1
pod 83 85 97.6
total 748 1302 57.4


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