File Coverage

blib/lib/Test/Selenium/Remote/Driver.pm

Criterion	Covered	Total	%
statement	183	224	81.7
branch	58	122	47.5
condition	32	69	46.3
subroutine	26	27	96.3
pod	16	19	84.2
total	315	461	68.3

package Test::Selenium::Remote::Driver;
$Test::Selenium::Remote::Driver::VERSION = '1.49';
# ABSTRACT: Useful testing subclass for Selenium::Remote::Driver

use Moo;
use Test::Selenium::Remote::WebElement;
use Test::LongString;
use IO::Socket;
use Sub::Install;
use Try::Tiny;

extends 'Selenium::Remote::Driver';

# move_mouse_to_location_ok # TODO # move_to_ok # TODO
has func_list => (
    is      => 'lazy',
    builder => sub {
        return [
            'alert_text_is',                  'alert_text_isnt',
            'alert_text_like',                'alert_text_unlike',
            'current_window_handle_is',       'current_window_handle_isnt',
            'current_window_handle_like',     'current_window_handle_unlike',
            'window_handles_is',              'window_handles_isnt',
            'window_handles_like',            'window_handles_unlike',
            'window_size_is',                 'window_size_isnt',
            'window_size_like',               'window_size_unlike',
            'window_position_is',             'window_position_isnt',
            'window_position_like',           'window_position_unlike',
            'current_url_is',                 'current_url_isnt',
            'current_url_like',               'current_url_unlike',
            'title_is',                       'title_isnt',
            'title_like',                     'title_unlike',
            'active_element_is',              'active_element_isnt',
            'active_element_like',            'active_element_unlike',
            'send_keys_to_active_element_ok', 'send_keys_to_alert_ok',
            'send_keys_to_prompt_ok',         'send_modifier_ok',
            'accept_alert_ok',                'dismiss_alert_ok',
            'get_ok',                         'go_back_ok',
            'go_forward_ok',                  'add_cookie_ok',
            'get_page_source_ok',             'find_element_ok',
            'find_elements_ok',               'find_child_element_ok',
            'find_child_elements_ok',         'find_no_element_ok',
            'compare_elements_ok',            'click_ok',
            'double_click_ok',                'body_like',
        ];
    },
);

=for Pod::Coverage has_args

=cut

sub has_args {
    my $self          = shift;
    my $fun_name      = shift;
    my $hash_fun_args = {
        'find_element'        => 2,
        'find_no_element'     => 2,
        'find_child_element'  => 3,
        'find_child_elements' => 3,
        'find_element'        => 2,
        'find_elements'       => 2,
        'compare_elements'    => 2,
        'get'                 => 1,
    };
    return ( $hash_fun_args->{$fun_name} // 0 );
}

with 'Test::Selenium::Remote::Role::DoesTesting';

=for Pod::Coverage BUILD

=cut

sub BUILD {
    my $self = shift;
    foreach my $method_name ( @{ $self->func_list } ) {
        unless ( defined( __PACKAGE__->can($method_name) ) ) {
            my $sub = $self->_build_sub($method_name);
            Sub::Install::install_sub(
                {
                    code => $sub,
                    into => __PACKAGE__,
                    as   => $method_name
                }
            );
        }
    }
}

=head1 NAME

Test::Selenium::Remote::Driver - add testing methods to L

=head1 DESCRIPTION

A subclass of L which provides useful testing
methods.

This is an I addition to the Selenium::Remote::Driver
distribution. Some interfaces may change.

=head1 Methods

=head2 new ( %opts )

This will create a new Test::Selenium::Remote::Driver object, which subclasses
L.  This subclass provides useful testing
functions. It is modeled on L.

Environment vars can be used to specify options to pass to
L. ENV vars are prefixed with C.
( After the old fork name, "Test::WebDriver" ). The explicity passed
options have precedence. ENV vars take only effect when they are
actually set. This important e.g. for the option C, which
is turned on per default in L.

Set the Selenium server address with C<$TWD_HOST> and C<$TWD_PORT>.

Pick which browser is used using the  C<$TWD_BROWSER>, C<$TWD_VERSION>,
C<$TWD_PLATFORM>, C<$TWD_JAVASCRIPT>, C<$TWD_EXTRA_CAPABILITIES>.

C<$TWD_BROWSER> is actually an alias for C<$TWD_BROWSER_NAME>.
C<$TWD_HOST> is actually an alias for C<$TWD_REMOTE_SERVER_ADDR>.
The aliases habe lower precedence than the original values.

See L for the meanings of these options.

=for Pod::Coverage BUILDARGS

=cut

sub BUILDARGS {
    my ( undef, %p ) = @_;

    OPT:
    for my $opt (
        qw/remote_server_addr port browser_name version platform
        javascript auto_close extra_capabilities/
      )
    {
        my $env_var_name = 'TWD_' . uc($opt);

        next OPT unless exists $ENV{$env_var_name};

        $p{$opt} //= $ENV{$env_var_name};
    }
    $p{browser_name}       //= $ENV{TWD_BROWSER} if exists $ENV{TWD_BROWSER};  # ykwim
    $p{remote_server_addr} //= $ENV{TWD_HOST}    if exists $ENV{TWD_HOST};     # ykwim
    $p{webelement_class}   //= 'Test::Selenium::Remote::WebElement';
    return \%p;
}

=head2 verbose

Enable/disable debugging output, or view the status of verbosity.

=cut

has verbose => ( is => 'rw', );

=head2 server_is_running( $host, $port )

Returns true if a Selenium server is running.  The host and port
parameters are optional, and they default to C.

The environment vars C and C can also be used to
determine which server should be checked.

=cut

sub server_is_running {
    my $host = $ENV{TWD_HOST} || shift || 'localhost';
    my $port = $ENV{TWD_PORT} || shift || 4444;

    return ( $host, $port )
      if IO::Socket::INET->new(
        PeerAddr => $host,
        PeerPort => $port,
      );
    return;
}

=head2 error_handler

As for L, this class also supports adding an
optional C attribute during instantiation :

    my $test_driver = Test::Selenium::Remote::Driver->new(
        error_handler => sub { print $_[1]; croak 'goodbye'; }
    );

Additionally, you can set and/or clear it at any time on an
already-instantiated driver:

    # later, change the error handler to something else
    $driver->error_handler( sub { print $_[1]; croak 'hello'; } );

    # stop handling errors manually and use the default S:R:D behavior
    # (we will croak about the exception)
    $driver->clear_error_handler;

Your error handler will receive two arguments,
The first argument is the C<$driver> object itself.
Due to some specificities of this class, the second argument passed to the
handler can be:

=over

=item the error message from the Webdriver

This is the case when the error message is raised by a WebDriver failure

=item "Failed to find ..."

This message is raised when the Webdriver call is successful but the failure
occurs on the test performed aftwerwards. This is the case for functions like
C, C, C, C,
C, C, C, C.

=back

If you set your own handler, you should not rely that much on the message returned.
You should also remember that you are entirely responsible for handling exceptions,
which means that should the error handler be called, it means that the test you are
doing has failed, so you should croak.

You should also call fail() in your handler, in case the function called raised a
webdriver error, because, as exceptions are not caught anymore when you specify a
handler, the function will not fail anymore, which translates to a 'ok' in your TAP
output if you do not handle it properly.

=head1 Testing Methods

The following testing methods are available.
For more documentation, see the related methods in L.
(And feel free to submit a patch to flesh out the documentation for these here).
Defaults for optional arguments B be the same as for their analogues in
L.

    alert_text_is
    alert_text_isnt
    alert_text_like
    alert_text_unlike

    current_window_handle_is
    current_window_handle_isnt
    current_window_handle_like
    current_window_handle_unlike

    window_handles_is
    window_handles_isnt
    window_handles_like
    window_handles_unlike

    window_size_is
    window_size_isnt
    window_size_like
    window_size_unlike

    window_position_is
    window_position_isnt
    window_position_like
    window_position_unlike

    current_url_is
    current_url_isnt
    current_url_like
    current_url_unlike

    title_is
    title_isnt
    title_like
    title_unlike


    active_element_is
    active_element_isnt
    active_element_like
    active_element_unlike

    # Basically the same as 'content_like()', but content_like() supports multiple regex's.
    page_source_is
    page_source_isnt
    page_source_like
    page_source_unlike

    send_keys_to_active_element_ok
    send_keys_to_alert_ok
    send_keys_to_prompt_ok
    send_modifier_ok

    accept_alert_ok
    dismiss_alert_ok

    move_mouse_to_location_ok # TODO
    move_to_ok # TODO

    get_ok
    go_back_ok
    go_forward_ok
    add_cookie_ok
    get_page_source_ok

    find_element_ok($search_target)
    find_element_ok($search_target)

    find_elements_ok
    find_child_element_ok
    find_child_elements_ok

    compare_elements_ok

    click_ok
    double_click_ok

=cut

# function composing a find_element with locator with a webelement test

sub _find_element_with_action {
    my $self   = shift;
    my $method = shift;
    my ( $locator, $locator_strategy, $params, $desc ) = @_;
    $locator_strategy //= 'xpath';

    # case 4 args
    if ($desc) {
        $self->croak('Invalid locator strategy')
          unless ( $self->FINDERS->{$locator_strategy} );
    }
    else {
        if ($params) {

            # means that we called it the 'old way' (no locator strategy)
            if ( !defined( $self->FINDERS->{$locator_strategy} ) ) {
                $desc   = $params;
                $params = $locator_strategy;
                $locator_strategy =
                  $self->_get_finder_key( $self->default_finder );
            }
        }
        else {
            # means it was called with no locator strategy and no desc
            if ($locator_strategy) {
                if ( !defined( $self->FINDERS->{$locator_strategy} ) ) {
                    $params = $locator_strategy;
                    $locator_strategy =
                      $self->_get_finder_key( $self->default_finder );
                }
            }
            else {
                $self->croak('Not enough arguments');
            }
        }
    }
    unless ($desc) {
        $desc = $method;
        $desc .= "'" . join( " ", ( $params // '' ) ) . "'";
    }
    my $element;
    eval { $element = $self->find_element( $locator, $locator_strategy ); };
    if ($@) {
        print "# Error: $@\n";
        return 0;
    }
    return $element->$method( $params, $desc );
}

=head2 $twd->type_element_ok($search_target [,$locator], $keys, [, $desc ]);

   $twd->type_element_ok( $search_target [,$locator], $keys [, $desc ] );

Use L to resolve the C<$search_target>
to a web element and an optional locator, and then type C<$keys> into it, providing an optional test
label.

=cut

sub type_element_ok {
    my $self   = shift;
    my $method = 'send_keys_ok';
    return $self->_find_element_with_action( $method, @_ );
}

=head2 $twd->element_text_is($search_target[,$finder],$expected_text [,$desc]);

    $twd->element_text_is($search_target[,$finder],$expected_text [,$desc]);

=cut

sub element_text_is {
    my $self   = shift;
    my $method = 'text_is';
    return $self->_find_element_with_action( $method, @_ );
}

=head2 $twd->element_value_is($search_target[,$finder],$expected_value [,$desc]);

    $twd->element_value_is($search_target[,$finder],$expected_value [,$desc]);

=cut

sub element_value_is {
    my $self   = shift;
    my $method = 'value_is';
    return $self->_find_element_with_action( $method, @_ );
}

=head2 $twd->click_element_ok($search_target [,$finder ,$desc]);

    $twd->click_element_ok($search_target [,$finder ,$desc]);

Find an element and then click on it.

=cut

sub click_element_ok {
    my $self   = shift;
    my $method = 'click_ok';
    return $self->_find_element_with_action( $method, @_ );
}

=head2 $twd->clear_element_ok($search_target [,$finder ,$desc]);

    $twd->clear_element_ok($search_target [,$finder ,$desc]);

Find an element and then clear on it.

=cut

sub clear_element_ok {
    my $self   = shift;
    my $method = 'clear_ok';
    return $self->_find_element_with_action( $method, @_ );
}

=head2 $twd->is_element_displayed_ok($search_target [,$finder ,$desc]);

    $twd->is_element_displayed_ok($search_target [,$finder ,$desc]);

Find an element and check to confirm that it is displayed. (visible)

=cut

sub is_element_displayed_ok {
    my $self   = shift;
    my $method = 'is_displayed_ok';
    return $self->_find_element_with_action( $method, @_ );
}

=head2 $twd->is_element_enabled_ok($search_target [,$finder ,$desc]);

    $twd->is_element_enabled_ok($search_target [,$finder ,$desc]);

Find an element and check to confirm that it is enabled.

=cut

sub is_element_enabled_ok {
    my $self   = shift;
    my $method = 'is_enabled_ok';
    return $self->_find_element_with_action( $method, @_ );
}

=head2 $twd->find_element_ok($search_target [,$finder, $desc ]);

   $twd->find_element_ok( $search_target [,$finder, $desc ] );

Returns true if C<$search_target> is successfully found on the page. C<$search_target>
is passed to L using a finder or the C
if none passed.
See there for more details on the format for C.

=head2 $twd->find_no_element_ok($search_target [,$finder, $desc ]);

   $twd->find_no_element_ok( $search_target [,$finder, $desc ] );

Returns true if C<$search_target> is I found on the page. C<$search_target>
is passed to L using a finder or the
C if none passed. See there for more details on the format for C.

=head2 $twd->content_like( $regex [, $desc ] )

   $twd->content_like( $regex [, $desc ] )
   $twd->content_like( [$regex_1, $regex_2] [, $desc ] )

Tells if the content of the page matches I<$regex>. If an arrayref of regex's
are provided, one 'test' is run for each regex against the content of the
current page.

A default description of 'Content is like "$regex"' will be provided if there
is no description.

=cut

sub content_like {
    my $self  = shift;
    my $regex = shift;
    my $desc  = shift;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $content = $self->get_page_source();
    my $ret;

    if ( not ref $regex eq 'ARRAY' ) {
        $desc = qq{Content is like "$regex"} if ( not defined $desc );
        $ret = like_string( $content, $regex, $desc );
        if ( !$ret && $self->has_error_handler ) {
            $self->error_handler->( $self, "Failed to find $regex" );
        }
        return $ret;
    }
    elsif ( ref $regex eq 'ARRAY' ) {
        for my $re (@$regex) {
            $desc = qq{Content is like "$re"} if ( not defined $desc );
            $ret = like_string( $content, $re, $desc );
            if ( !$ret && $self->has_error_handler ) {
                $self->error_handler->( $self, "Failed to find $re" );
            }
        }
    }
}

=head2 $twd->content_unlike( $regex [, $desc ] )

   $twd->content_unlike( $regex [, $desc ] )
   $twd->content_unlike( [$regex_1, $regex_2] [, $desc ] )

Tells if the content of the page does NOT match I<$regex>. If an arrayref of regex's
are provided, one 'test' is run for each regex against the content of the
current page.

A default description of 'Content is unlike "$regex"' will be provided if there
is no description.

=cut

sub content_unlike {
    my $self  = shift;
    my $regex = shift;
    my $desc  = shift;
    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $content = $self->get_page_source();
    my $ret;

    if ( not ref $regex eq 'ARRAY' ) {
        $desc = qq{Content is unlike "$regex"} if ( not defined $desc );
        $ret = unlike_string( $content, $regex, $desc );
        if ( !$ret && $self->has_error_handler ) {
            $self->error_handler->( $self, "Failed to find $regex" );
        }
    }
    elsif ( ref $regex eq 'ARRAY' ) {
        for my $re (@$regex) {
            $desc = qq{Content is unlike "$re"} if ( not defined $desc );
            $ret = unlike_string( $content, $re, $desc );
            if ( !$ret && $self->has_error_handler ) {
                $self->error_handler->( $self, "Failed to find $re" );
            }
        }
    }
}

=head2 $twd->body_text_like( $regex [, $desc ] )

   $twd->body_text_like( $regex [, $desc ] )
   $twd->body_text_like( [$regex_1, $regex_2] [, $desc ] )

Tells if the text of the page (as returned by C<< get_body() >>)  matches
I<$regex>. If an arrayref of regex's are provided, one 'test' is run for each
regex against the text of the current page.

A default description of 'Text is like "$regex"' will be provided if there
is no description.

To also match the HTML, see C<< content_unlike() >>.

=cut

sub body_text_like {
    my $self  = shift;
    my $regex = shift;
    my $desc  = shift;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $text = $self->get_body();
    my $ret;

    if ( not ref $regex eq 'ARRAY' ) {
        $desc = qq{Text is like "$regex"} if ( not defined $desc );
        $ret = like_string( $text, $regex, $desc );
        if ( !$ret && $self->has_error_handler ) {
            $self->error_handler->( $self, "Failed to find $regex" );
        }
        return $ret;
    }
    elsif ( ref $regex eq 'ARRAY' ) {
        for my $re (@$regex) {
            $desc = qq{Text is like "$re"} if ( not defined $desc );
            $ret = like_string( $text, $re, $desc );
            if ( !$ret && $self->has_error_handler ) {
                $self->error_handler->( $self, "Failed to find $re" );
            }
        }
    }
}

=head2 $twd->body_text_unlike( $regex [, $desc ] )

   $twd->body_text_unlike( $regex [, $desc ] )
   $twd->body_text_unlike( [$regex_1, $regex_2] [, $desc ] )

Tells if the text of the page (as returned by C<< get_body() >>)
does NOT match I<$regex>. If an arrayref of regex's
are provided, one 'test' is run for each regex against the text of the
current page.

A default description of 'Text is unlike "$regex"' will be provided if there
is no description.

To also match the HTML, see C<< content_unlike() >>.

=cut

sub body_text_unlike {
    my $self  = shift;
    my $regex = shift;
    my $desc  = shift;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $text = $self->get_body();
    my $ret;

    if ( not ref $regex eq 'ARRAY' ) {
        $desc = qq{Text is unlike "$regex"} if ( not defined $desc );
        $ret = unlike_string( $text, $regex, $desc );
        if ( !$ret && $self->has_error_handler ) {
            $self->error_handler->( $self, "Failed to find $regex" );
        }
        return $ret;

    }
    elsif ( ref $regex eq 'ARRAY' ) {
        for my $re (@$regex) {
            $desc = qq{Text is unlike "$re"} if ( not defined $desc );
            $ret = unlike_string( $text, $re, $desc );
            if ( !$ret && $self->has_error_handler ) {
                $self->error_handler->( $self, "Failed to find $re" );
            }
        }
    }
}

#####

=head2 $twd->content_contains( $str [, $desc ] )

   $twd->content_contains( $str [, $desc ] )
   $twd->content_contains( [$str_1, $str_2] [, $desc ] )

Tells if the content of the page contains I<$str>. If an arrayref of strings
are provided, one 'test' is run for each string against the content of the
current page.

A default description of 'Content contains "$str"' will be provided if there
is no description.

=cut

sub content_contains {
    my $self = shift;
    my $str  = shift;
    my $desc = shift;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $content = $self->get_page_source();
    my $ret;

    if ( not ref $str eq 'ARRAY' ) {
        $desc = qq{Content contains "$str"} if ( not defined $desc );
        $ret = contains_string( $content, $str, $desc );
        if ( !$ret && $self->has_error_handler ) {
            $self->error_handler->( $self, "Failed to find $str" );
        }
        return $ret;
    }
    elsif ( ref $str eq 'ARRAY' ) {
        for my $s (@$str) {
            $desc = qq{Content contains "$s"} if ( not defined $desc );
            $ret = contains_string( $content, $s, $desc );

            if ( !$ret && $self->has_error_handler ) {
                $self->error_handler->( $self, "Failed to find $s" );
            }
        }
    }
}

=head2 $twd->content_lacks( $str [, $desc ] )

   $twd->content_lacks( $str [, $desc ] )
   $twd->content_lacks( [$str_1, $str_2] [, $desc ] )

Tells if the content of the page does NOT contain I<$str>. If an arrayref of strings
are provided, one 'test' is run for each string against the content of the
current page.

A default description of 'Content lacks "$str"' will be provided if there
is no description.

=cut

sub content_lacks {
    my $self = shift;
    my $str  = shift;
    my $desc = shift;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $content = $self->get_page_source();
    my $ret;

    if ( not ref $str eq 'ARRAY' ) {
        $desc = qq{Content lacks "$str"} if ( not defined $desc );
        $ret = lacks_string( $content, $str, $desc );
        if ( !$ret && $self->has_error_handler ) {
            $self->error_handler->( $self, "Failed to find $str" );
        }
        return $ret;
    }
    elsif ( ref $str eq 'ARRAY' ) {
        for my $s (@$str) {
            $desc = qq{Content lacks "$s"} if ( not defined $desc );
            $ret = lacks_string( $content, $s, $desc );
            if ( !$ret && $self->has_error_handler ) {
                $self->error_handler->( $self, "Failed to find $s" );
            }
        }
    }
}

=head2 $twd->body_text_contains( $str [, $desc ] )

   $twd->body_text_contains( $str [, $desc ] )
   $twd->body_text_contains( [$str_1, $str_2] [, $desc ] )

Tells if the text of the page (as returned by C<< get_body() >>) contains
I<$str>. If an arrayref of strings are provided, one 'test' is run for each
string against the text of the current page.

A default description of 'Text contains "$str"' will be provided if there
is no description.

To also match the HTML, see C<< content_lacks() >>.

=cut

sub body_text_contains {
    my $self = shift;
    my $str  = shift;
    my $desc = shift;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $text = $self->get_body();
    my $ret;

    if ( not ref $str eq 'ARRAY' ) {
        $desc = qq{Text contains "$str"} if ( not defined $desc );
        $ret = contains_string( $text, $str, $desc );
        if ( !$ret && $self->has_error_handler ) {
            $self->error_handler->( $self, "Failed to find $str" );
        }
        return $ret;
    }
    elsif ( ref $str eq 'ARRAY' ) {
        for my $s (@$str) {
            $desc = qq{Text contains "$s"} if ( not defined $desc );
            $ret = contains_string( $text, $s, $desc );
            if ( !$ret && $self->has_error_handler ) {
                $self->error_handler->( $self, "Failed to find $s" );
            }
        }
    }
}

=head2 $twd->body_text_lacks( $str [, $desc ] )

   $twd->body_text_lacks( $str [, $desc ] )
   $twd->body_text_lacks( [$str_1, $str_2] [, $desc ] )

Tells if the text of the page (as returned by C<< get_body() >>)
does NOT contain I<$str>. If an arrayref of strings
are provided, one 'test' is run for each string against the content of the
current page.

A default description of 'Text lacks "$str"' will be provided if there
is no description.

To also match the HTML, see C<< content_lacks() >>.

=cut

sub body_text_lacks {
    my $self = shift;
    my $str  = shift;
    my $desc = shift;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $text = $self->get_body();
    my $ret;

    if ( not ref $str eq 'ARRAY' ) {
        $desc = qq{Text lacks "$str"} if ( not defined $desc );
        $ret = lacks_string( $text, $str, $desc );
        if ( !$ret && $self->has_error_handler ) {
            $self->error_handler->( $self, "Failed to find $str" );
        }
        return $ret;
    }
    elsif ( ref $str eq 'ARRAY' ) {
        for my $s (@$str) {
            $desc = qq{Text lacks "$s"} if ( not defined $desc );
            $ret = lacks_string( $text, $s, $desc );
            if ( !$ret && $self->has_error_handler ) {
                $self->error_handler->( $self, "Failed to find $s" );
            }
        }
    }
}

1;

__END__