| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Selenium::Remote::RemoteConnection; | 
| 2 |  |  |  |  |  |  | $Selenium::Remote::RemoteConnection::VERSION = '1.47'; | 
| 3 | 15 |  |  | 15 |  | 1289 | use strict; | 
|  | 15 |  |  |  |  | 45 |  | 
|  | 15 |  |  |  |  | 391 |  | 
| 4 | 15 |  |  | 15 |  | 76 | use warnings; | 
|  | 15 |  |  |  |  | 28 |  | 
|  | 15 |  |  |  |  | 370 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 |  |  |  |  |  |  | #ABSTRACT: Connect to a selenium server | 
| 7 |  |  |  |  |  |  |  | 
| 8 | 15 |  |  | 15 |  | 511 | use Moo; | 
|  | 15 |  |  |  |  | 5904 |  | 
|  | 15 |  |  |  |  | 100 |  | 
| 9 | 15 |  |  | 15 |  | 5585 | use Try::Tiny; | 
|  | 15 |  |  |  |  | 33 |  | 
|  | 15 |  |  |  |  | 809 |  | 
| 10 | 15 |  |  | 15 |  | 7068 | use LWP::UserAgent; | 
|  | 15 |  |  |  |  | 408500 |  | 
|  | 15 |  |  |  |  | 462 |  | 
| 11 | 15 |  |  | 15 |  | 111 | use HTTP::Headers; | 
|  | 15 |  |  |  |  | 32 |  | 
|  | 15 |  |  |  |  | 313 |  | 
| 12 | 15 |  |  | 15 |  | 70 | use HTTP::Request; | 
|  | 15 |  |  |  |  | 36 |  | 
|  | 15 |  |  |  |  | 348 |  | 
| 13 | 15 |  |  | 15 |  | 70 | use Carp qw(croak); | 
|  | 15 |  |  |  |  | 28 |  | 
|  | 15 |  |  |  |  | 761 |  | 
| 14 | 15 |  |  | 15 |  | 6051 | use JSON; | 
|  | 15 |  |  |  |  | 92776 |  | 
|  | 15 |  |  |  |  | 95 |  | 
| 15 | 15 |  |  | 15 |  | 9062 | use Data::Dumper; | 
|  | 15 |  |  |  |  | 70674 |  | 
|  | 15 |  |  |  |  | 864 |  | 
| 16 | 15 |  |  | 15 |  | 6370 | use Selenium::Remote::ErrorHandler; | 
|  | 15 |  |  |  |  | 47 |  | 
|  | 15 |  |  |  |  | 453 |  | 
| 17 | 15 |  |  | 15 |  | 120 | use Scalar::Util qw{looks_like_number}; | 
|  | 15 |  |  |  |  | 29 |  | 
|  | 15 |  |  |  |  | 15650 |  | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | has 'remote_server_addr' => ( is => 'rw', ); | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | has 'port' => ( is => 'rw', ); | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | has 'debug' => ( | 
| 24 |  |  |  |  |  |  | is      => 'rw', | 
| 25 |  |  |  |  |  |  | default => sub { 0 } | 
| 26 |  |  |  |  |  |  | ); | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | has 'ua' => ( | 
| 29 |  |  |  |  |  |  | is      => 'lazy', | 
| 30 | 1 |  |  | 1 |  | 19 | builder => sub { return LWP::UserAgent->new; } | 
| 31 |  |  |  |  |  |  | ); | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | has 'error_handler' => ( | 
| 34 |  |  |  |  |  |  | is      => 'lazy', | 
| 35 | 4 |  |  | 4 |  | 70 | builder => sub { return Selenium::Remote::ErrorHandler->new; } | 
| 36 |  |  |  |  |  |  | ); | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | with 'Selenium::Remote::Driver::CanSetWebdriverContext'; | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | sub check_status { | 
| 42 | 10 |  |  | 10 | 1 | 95 | my $self = shift; | 
| 43 | 10 |  |  |  |  | 16 | my $status; | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | try { | 
| 46 | 10 |  |  | 10 |  | 479 | $status = $self->request( { method => 'GET', url => 'status' } ); | 
| 47 |  |  |  |  |  |  | } | 
| 48 |  |  |  |  |  |  | catch { | 
| 49 | 0 |  |  | 0 |  | 0 | croak "Could not connect to SeleniumWebDriver: $_"; | 
| 50 | 10 |  |  |  |  | 70 | }; | 
| 51 |  |  |  |  |  |  |  | 
| 52 | 10 |  | 50 |  |  | 178 | my $cmdOut = $status->{cmd_status} || ''; | 
| 53 | 10 | 100 |  |  |  | 32 | if ( $cmdOut ne 'OK' ) { | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | # Could be grid, see if we can talk to it | 
| 56 | 1 |  |  |  |  | 2 | $status = undef; | 
| 57 | 1 |  |  |  |  | 5 | $status = | 
| 58 |  |  |  |  |  |  | $self->request( { method => 'GET', url => 'grid/api/hub/status' } ); | 
| 59 |  |  |  |  |  |  | } | 
| 60 |  |  |  |  |  |  |  | 
| 61 | 10 | 100 |  |  |  | 40 | unless ( $cmdOut eq 'OK' ) { | 
| 62 | 1 |  |  |  |  | 130 | croak "Selenium server did not return proper status"; | 
| 63 |  |  |  |  |  |  | } | 
| 64 |  |  |  |  |  |  | } | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | sub request { | 
| 68 | 30 |  |  | 30 | 1 | 809 | my ( $self, $resource, $params, $dont_process_response ) = @_; | 
| 69 | 30 |  |  |  |  | 47 | my $method             = $resource->{method}; | 
| 70 | 30 |  |  |  |  | 54 | my $url                = $resource->{url}; | 
| 71 | 30 |  | 100 |  |  | 94 | my $no_content_success = $resource->{no_content_success} // 0; | 
| 72 |  |  |  |  |  |  |  | 
| 73 | 30 |  |  |  |  | 79 | my $content = ''; | 
| 74 | 30 |  |  |  |  | 80 | my $fullurl = ''; | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | # Construct full url. | 
| 77 | 30 | 100 |  |  |  | 147 | if ( $url =~ m/^http/g ) { | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 78 | 3 |  |  |  |  | 5 | $fullurl = $url; | 
| 79 |  |  |  |  |  |  | } | 
| 80 |  |  |  |  |  |  | elsif ( $url =~ m/^\// ) { | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | # This is used when we get a 302 Redirect with a Location header. | 
| 83 | 1 |  |  |  |  | 13 | $fullurl = | 
| 84 |  |  |  |  |  |  | "http://" . $self->remote_server_addr . ":" . $self->port . $url; | 
| 85 |  |  |  |  |  |  | } | 
| 86 |  |  |  |  |  |  | elsif ( $url =~ m/grid/g ) { | 
| 87 | 2 |  |  |  |  | 14 | $fullurl = | 
| 88 |  |  |  |  |  |  | "http://" . $self->remote_server_addr . ":" . $self->port . "/$url"; | 
| 89 |  |  |  |  |  |  | } | 
| 90 |  |  |  |  |  |  | else { | 
| 91 | 24 |  |  |  |  | 470 | $fullurl = | 
| 92 |  |  |  |  |  |  | "http://" | 
| 93 |  |  |  |  |  |  | . $self->remote_server_addr . ":" | 
| 94 |  |  |  |  |  |  | . $self->port | 
| 95 |  |  |  |  |  |  | . $self->wd_context_prefix . "/$url"; | 
| 96 |  |  |  |  |  |  | } | 
| 97 |  |  |  |  |  |  |  | 
| 98 | 30 | 100 | 66 |  |  | 306 | if ( ( defined $params ) && $params ne '' ) { | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | #WebDriver 3 shims | 
| 101 | 16 | 100 |  |  |  | 46 | if ( $resource->{payload} ) { | 
| 102 | 1 |  |  |  |  | 2 | foreach my $key ( keys( %{ $resource->{payload} } ) ) { | 
|  | 1 |  |  |  |  | 4 |  | 
| 103 | 1 |  |  |  |  | 35 | $params->{$key} = $resource->{payload}->{$key}; | 
| 104 |  |  |  |  |  |  | } | 
| 105 |  |  |  |  |  |  | } | 
| 106 |  |  |  |  |  |  |  | 
| 107 | 16 |  |  |  |  | 108 | my $json = JSON->new; | 
| 108 | 16 |  |  |  |  | 87 | $json->allow_blessed; | 
| 109 | 16 |  |  |  |  | 237 | $content = $json->allow_nonref->utf8->encode($params); | 
| 110 |  |  |  |  |  |  | } | 
| 111 |  |  |  |  |  |  |  | 
| 112 | 30 | 50 |  |  |  | 160 | print "REQ: $method, $fullurl, $content\n" if $self->debug; | 
| 113 |  |  |  |  |  |  |  | 
| 114 |  |  |  |  |  |  | # HTTP request | 
| 115 | 30 |  |  |  |  | 125 | my $header = | 
| 116 |  |  |  |  |  |  | HTTP::Headers->new( Content_Type => 'application/json; charset=utf-8' ); | 
| 117 | 30 |  |  |  |  | 1480 | $header->header( 'Accept' => 'application/json' ); | 
| 118 | 30 |  |  |  |  | 1032 | my $request = HTTP::Request->new( $method, $fullurl, $header, $content ); | 
| 119 | 30 |  |  |  |  | 34779 | my $response = $self->ua->request($request); | 
| 120 | 30 | 100 |  |  |  | 55459 | if ($dont_process_response) { | 
| 121 | 1 |  |  |  |  | 6 | return $response; | 
| 122 |  |  |  |  |  |  | } | 
| 123 | 29 |  |  |  |  | 83 | return $self->_process_response( $response, $no_content_success ); | 
| 124 |  |  |  |  |  |  | } | 
| 125 |  |  |  |  |  |  |  | 
| 126 |  |  |  |  |  |  | sub _process_response { | 
| 127 | 230 |  |  | 230 |  | 464 | my ( $self, $response, $no_content_success ) = @_; | 
| 128 | 230 |  |  |  |  | 301 | my $data;    # server response 'value' that'll be returned to the user | 
| 129 | 230 |  |  |  |  | 850 | my $json = JSON->new; | 
| 130 |  |  |  |  |  |  |  | 
| 131 | 230 | 100 |  |  |  | 562 | if ( $response->is_redirect ) { | 
| 132 | 2 |  |  |  |  | 21 | my $redirect = { | 
| 133 |  |  |  |  |  |  | method => 'GET', | 
| 134 |  |  |  |  |  |  | url    => $response->header('location') | 
| 135 |  |  |  |  |  |  | }; | 
| 136 | 2 |  |  |  |  | 72 | return $self->request($redirect); | 
| 137 |  |  |  |  |  |  | } | 
| 138 |  |  |  |  |  |  | else { | 
| 139 | 228 |  |  |  |  | 1651 | my $decoded_json = undef; | 
| 140 | 228 | 100 |  |  |  | 1114 | print "RES: " . $response->decoded_content . "\n\n" if $self->debug; | 
| 141 |  |  |  |  |  |  |  | 
| 142 | 228 | 100 | 66 |  |  | 14898 | if (   ( $response->message ne 'No Content' ) | 
| 143 |  |  |  |  |  |  | && ( $response->content ne '' ) ) | 
| 144 |  |  |  |  |  |  | { | 
| 145 | 217 | 100 |  |  |  | 4761 | if ( $response->content_type !~ m/json/i ) { | 
| 146 | 2 |  |  |  |  | 54 | $data->{'cmd_status'} = 'NOTOK'; | 
| 147 |  |  |  |  |  |  | $data->{'cmd_return'}->{message} = | 
| 148 | 2 |  |  |  |  | 6 | 'Server returned error message ' | 
| 149 |  |  |  |  |  |  | . $response->content | 
| 150 |  |  |  |  |  |  | . ' instead of data'; | 
| 151 | 2 |  |  |  |  | 44 | return $data; | 
| 152 |  |  |  |  |  |  | } | 
| 153 |  |  |  |  |  |  | $decoded_json = | 
| 154 | 215 |  |  |  |  | 7016 | $json->allow_nonref(1)->utf8(1)->decode( $response->content ); | 
| 155 | 215 |  |  |  |  | 13965 | $data->{'sessionId'} = $decoded_json->{'sessionId'}; | 
| 156 |  |  |  |  |  |  | } | 
| 157 |  |  |  |  |  |  |  | 
| 158 | 226 | 100 |  |  |  | 859 | if ( $response->is_error ) { | 
|  |  | 50 |  |  |  |  |  | 
| 159 | 18 |  |  |  |  | 147 | $data->{'cmd_status'} = 'NOTOK'; | 
| 160 | 18 | 100 |  |  |  | 48 | if ( defined $decoded_json ) { | 
| 161 | 17 |  |  |  |  | 395 | $data->{'cmd_return'} = | 
| 162 |  |  |  |  |  |  | $self->error_handler->process_error($decoded_json); | 
| 163 |  |  |  |  |  |  | } | 
| 164 |  |  |  |  |  |  | else { | 
| 165 | 1 |  |  |  |  | 4 | $data->{'cmd_return'} = | 
| 166 |  |  |  |  |  |  | 'Server returned error code ' | 
| 167 |  |  |  |  |  |  | . $response->code | 
| 168 |  |  |  |  |  |  | . ' and no data'; | 
| 169 |  |  |  |  |  |  | } | 
| 170 | 18 |  |  |  |  | 264 | return $data; | 
| 171 |  |  |  |  |  |  | } | 
| 172 |  |  |  |  |  |  | elsif ( $response->is_success ) { | 
| 173 | 208 |  |  |  |  | 2358 | $data->{'cmd_status'} = 'OK'; | 
| 174 | 208 | 100 |  |  |  | 474 | if ( defined $decoded_json ) { | 
| 175 |  |  |  |  |  |  |  | 
| 176 |  |  |  |  |  |  | #XXX MS edge doesn't follow spec here either | 
| 177 | 198 | 0 | 66 |  |  | 986 | if (   looks_like_number( $decoded_json->{status} ) | 
|  |  |  | 33 |  |  |  |  | 
| 178 |  |  |  |  |  |  | && $decoded_json->{status} > 0 | 
| 179 |  |  |  |  |  |  | && $decoded_json->{value}{message} ) | 
| 180 |  |  |  |  |  |  | { | 
| 181 | 0 |  |  |  |  | 0 | $data->{cmd_status} = 'NOT OK'; | 
| 182 | 0 |  |  |  |  | 0 | $data->{cmd_return} = $decoded_json->{value}; | 
| 183 | 0 |  |  |  |  | 0 | return $data; | 
| 184 |  |  |  |  |  |  | } | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  | #XXX shockingly, neither does InternetExplorerDriver | 
| 187 | 198 | 50 | 33 |  |  | 829 | if ( ref $decoded_json eq 'HASH' && $decoded_json->{error} ) { | 
| 188 | 0 |  |  |  |  | 0 | $data->{cmd_status} = 'NOT OK'; | 
| 189 | 0 |  |  |  |  | 0 | $data->{cmd_return} = $decoded_json; | 
| 190 | 0 |  |  |  |  | 0 | return $data; | 
| 191 |  |  |  |  |  |  | } | 
| 192 |  |  |  |  |  |  |  | 
| 193 | 198 | 100 |  |  |  | 374 | if ($no_content_success) { | 
| 194 | 71 |  |  |  |  | 138 | $data->{'cmd_return'} = 1; | 
| 195 |  |  |  |  |  |  | } | 
| 196 |  |  |  |  |  |  | else { | 
| 197 | 127 |  |  |  |  | 234 | $data->{'cmd_return'} = $decoded_json->{'value'}; | 
| 198 | 127 | 50 | 66 |  |  | 370 | if ( ref( $data->{cmd_return} ) eq 'HASH' | 
| 199 |  |  |  |  |  |  | && exists $data->{cmd_return}->{sessionId} ) | 
| 200 |  |  |  |  |  |  | { | 
| 201 | 0 |  |  |  |  | 0 | $data->{sessionId} = $data->{cmd_return}->{sessionId}; | 
| 202 |  |  |  |  |  |  | } | 
| 203 |  |  |  |  |  |  | } | 
| 204 |  |  |  |  |  |  | } | 
| 205 |  |  |  |  |  |  | else { | 
| 206 | 10 |  |  |  |  | 22 | $data->{'cmd_return'} = | 
| 207 |  |  |  |  |  |  | 'Server returned status code ' | 
| 208 |  |  |  |  |  |  | . $response->code | 
| 209 |  |  |  |  |  |  | . ' but no data'; | 
| 210 |  |  |  |  |  |  | } | 
| 211 | 208 |  |  |  |  | 2295 | return $data; | 
| 212 |  |  |  |  |  |  | } | 
| 213 |  |  |  |  |  |  | else { | 
| 214 |  |  |  |  |  |  | # No idea what the server is telling me, must be high | 
| 215 | 0 |  |  |  |  |  | $data->{'cmd_status'} = 'NOTOK'; | 
| 216 | 0 |  |  |  |  |  | $data->{'cmd_return'} = | 
| 217 |  |  |  |  |  |  | 'Server returned status code ' | 
| 218 |  |  |  |  |  |  | . $response->code | 
| 219 |  |  |  |  |  |  | . ' which I don\'t understand'; | 
| 220 | 0 |  |  |  |  |  | return $data; | 
| 221 |  |  |  |  |  |  | } | 
| 222 |  |  |  |  |  |  | } | 
| 223 |  |  |  |  |  |  | } | 
| 224 |  |  |  |  |  |  |  | 
| 225 |  |  |  |  |  |  | 1; | 
| 226 |  |  |  |  |  |  |  | 
| 227 |  |  |  |  |  |  | __END__ |