| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303 |
- package Selenium::Remote::Driver;
- use strict;
- use warnings;
- use Data::Dumper;
- use Carp qw(croak);
- use Selenium::Remote::RemoteConnection;
- use Selenium::Remote::Commands;
- use Selenium::Remote::ErrorHandler;
- =head1 NAME
- Selenium::Remote::Driver - Perl Client for Selenium Remote Driver
- =cut
- =head1 SYNOPSIS
- use Selenium::Remote::Driver;
-
- my $driver = new Selenium::Remote::Driver;
- $driver->get("http://www.google.com");
- print $driver->get_title();
- $driver->quit();
- =cut
- =head1 DESCRIPTION
- Selenium is a test tool that allows you to write
- automated web application UI tests in any programming language against
- any HTTP website using any mainstream JavaScript-enabled browser. This module is
- an implementation of the Perl Bindings (client) for the Remote driver that
- Selenium provides. You can find bindings for other languages at this location:
- L<http://code.google.com/p/selenium/>
- This module sends commands directly to the Server using simple HTTP requests.
- Using this module together with the Selenium Server, you can automatically
- control any supported browser.
- To use this module, you need to have already downloaded and started
- the Selenium Server. (The Selenium Server is a Java application.)
- =cut
- sub new {
- my ($class, %args) = @_;
- my $commands = new Selenium::Remote::Commands;
- # Set the defaults if user doesn't send any
- my $self = {
- remote_server_addr => delete $args{remote_server_addr} || 'localhost',
- browser_name => delete $args{browser_name} || 'firefox',
- platform => delete $args{platform} || 'ANY',
- port => delete $args{port} || '4444',
- javascript => delete $args{javascript} || JSON::true,
- version => delete $args{version} || '',
- session_id => undef,
- remote_conn => undef,
- error_handler => undef,
- commands => $commands,
- };
- bless $self, $class or die "Can't bless $class: $!";
-
- $self->{error_handler} = new Selenium::Remote::ErrorHandler;
- # Connect to remote server & establish a new session
- $self->{remote_conn} =
- new Selenium::Remote::RemoteConnection($self->{remote_server_addr},
- $self->{port});
- $self->new_session();
- if (!(defined $self->{session_id})) {
- croak "Could not establish a session with the remote server\n";
- }
- return $self;
- }
- # When a command is processed by the remote server & a result is sent back, it
- # also includes other relevant info. We strip those & just return the value we're
- # interested in. And if there is an error, ErrorHandler will handle it.
- sub _get_command_result {
- my ($self, @args) = @_;
- my $resp = $self->{remote_conn}->request(@args);
- if (defined $resp->{'status'} && $resp->{'status'} != 0) {
- $self->{error_handler}->process_error($resp);
- }
- elsif (defined $resp->{'value'}) {
- return $resp->{'value'};
- }
- else {
- # If there is no value or status assume success
- return 1;
- }
- }
- sub new_session {
- my $self = shift;
- my $args = { 'desiredCapabilities' => {
- 'browserName' => $self->{browser_name},
- 'platform' => $self->{platform},
- 'javascriptEnabled' => $self->{javascript},
- 'version' => $self->{version},
- }
- };
- my $resp =
- $self->{remote_conn}->request(
- $self->{commands}->{'newSession'}->{'method'},
- $self->{commands}->{'newSession'}->{'url'},
- $args,
- );
- if ((defined $resp->{'sessionId'}) && $resp->{'sessionId'} ne '') {
- $self->{session_id} = $resp->{'sessionId'};
- }
- else {
- croak "Could not create new session";
- }
- }
- sub get_capabilities {
- my $self = shift;
- my $command = 'getCapabilities';
- my $args = { 'session_id' => $self->{'session_id'}, };
- my $data = $self->{commands}->getParams($command, $args);
-
- if ($data) {
- return $self->_get_command_result($data->{'method'}, $data->{'url'});
- }
- else {
- croak "Couldn't retrieve command $command settings\n";
- }
- }
- sub quit {
- my $self = shift;
- my $args = { 'session_id' => $self->{'session_id'}, };
- my $data = $self->{commands}->getParams('quit', $args);
- if ($data) {
- $self->{remote_conn}->request($data->{'method'}, $data->{'url'});
- }
- else {
- croak "Couldn't retrieve command settings properly\n";
- }
- }
- sub get_current_window_handle {
- my $self = shift;
- my $command = 'getCurrentWindowHandle';
- my $args = { 'session_id' => $self->{'session_id'}, };
- my $data = $self->{commands}->getParams($command, $args);
-
- if ($data) {
- return $self->_get_command_result($data->{'method'}, $data->{'url'});
- }
- else {
- croak "Couldn't retrieve command $command settings\n";
- }
- }
- sub get_window_handles {
- my $self = shift;
- my $command = 'getWindowHandles';
- my $args = { 'session_id' => $self->{'session_id'}, };
- my $data = $self->{commands}->getParams($command, $args);
-
- if ($data) {
- return $self->_get_command_result($data->{'method'}, $data->{'url'});
- }
- else {
- croak "Couldn't retrieve command $command settings\n";
- }
- }
- sub get_current_url {
- my $self = shift;
- my $command = 'getCurrentUrl';
- my $args = { 'session_id' => $self->{'session_id'}, };
- my $data = $self->{commands}->getParams($command, $args);
-
- if ($data) {
- return $self->_get_command_result($data->{'method'}, $data->{'url'});
- }
- else {
- croak "Couldn't retrieve command $command settings\n";
- }
- }
- sub navigate {
- my ($self, $url) = @_;
- $self->get($url);
- }
- sub get {
- my ($self, $url) = @_;
- my $command = 'get';
- my $args = { 'session_id' => $self->{'session_id'}, };
- my $data = $self->{commands}->getParams($command, $args);
- my $params = {'url' => $url};
- if ($data) {
- $self->{remote_conn}->request($data->{'method'}, $data->{'url'}, $params);
- }
- else {
- croak "Couldn't retrieve command $command settings\n";
- }
- }
- sub get_title {
- my $self = shift;
- my $command = 'getTitle';
- my $args = { 'session_id' => $self->{'session_id'}, };
- my $data = $self->{commands}->getParams($command, $args);
- if ($data) {
- return $self->_get_command_result($data->{'method'}, $data->{'url'});
- }
- else {
- croak "Couldn't retrieve command $command settings\n";
- }
- }
- sub go_back {
- my $self = shift;
- my $command = 'goBack';
- my $args = { 'session_id' => $self->{'session_id'}, };
- my $data = $self->{commands}->getParams($command, $args);
- if ($data) {
- $self->{remote_conn}->request($data->{'method'}, $data->{'url'});
- }
- else {
- croak "Couldn't retrieve command $command settings\n";
- }
- }
- sub go_forward {
- my $self = shift;
- my $command = 'goForward';
- my $args = { 'session_id' => $self->{'session_id'}, };
- my $data = $self->{commands}->getParams($command, $args);
- if ($data) {
- $self->{remote_conn}->request($data->{'method'}, $data->{'url'});
- }
- else {
- croak "Couldn't retrieve command $command settings\n";
- }
- }
- sub refresh {
- my $self = shift;
- my $command = 'goForward';
- my $args = { 'session_id' => $self->{'session_id'}, };
- my $data = $self->{commands}->getParams($command, $args);
- if ($data) {
- $self->{remote_conn}->request($data->{'method'}, $data->{'url'});
- }
- else {
- croak "Couldn't retrieve command $command settings\n";
- }
- }
- 1;
- __END__
- =head1 SEE ALSO
- For more information about Selenium , visit the website at
- L<http://code.google.com/p/selenium/>.
- =head1 BUGS
- The Selenium issue tracking system is available online at
- L<http://code.google.com/p/selenium/issues/list>.
- =head1 AUTHOR
- Perl Bindings for Remote Driver by Aditya Ivaturi <ivaturi@gmail.com>
- =head1 LICENSE
- Copyright (c) 2010 Juniper Networks, Inc
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
- http://www.apache.org/licenses/LICENSE-2.0
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
|