Merge pull request #122 from gempesaw/finish-moo-merge-103

Finish moo transition; resolves #103 and fixes #121.

Changes

@@ -1,11 +1,14 @@
 Revision history for Selenium-Remote-Driver
 
-0.20   4-17-2914
+0.20   4-25-2014
         [DESIRED CAPABILITIES]
         - Add a desired_capabilities option that provides full control over the desiredCapability object
         - Add a new_from_caps constructor to distinguish against the normal new constructor
         - Add a ua option to allow injection of LWP::UserAgent for testing
 
+        [MOO REWRITE]
+        - Completed the Moo restructure (pr #103) with pr #122, fixing a bug in _check_ok (#121).
+
 0.19   4-11-2014
         [FIREFOX PROFILE]
         - Added Selenium::Remote::Driver::Firefox::Profile for managing Firefox profiles.

cpanfile

@@ -14,15 +14,16 @@ requires "JSON" => "0";
 requires "LWP::UserAgent" => "0";
 requires "MIME::Base64" => "0";
 requires "Moo" => "0";
+requires "Moo::Role" => "0";
 requires "Net::Ping" => "0";
 requires "Scalar::Util" => "0";
+requires "Sub::Install" => "0";
 requires "Test::Builder" => "0";
 requires "Test::LongString" => "0";
-requires "Test::More" => "0";
 requires "Try::Tiny" => "0";
 requires "base" => "0";
 requires "constant" => "0";
-requires "parent" => "0";
+requires "namespace::clean" => "0";
 requires "perl" => "5.010";
 requires "strict" => "0";
 requires "warnings" => "0";
@@ -35,6 +36,7 @@ on 'test' => sub {
   requires "Test::LWP::UserAgent" => "0";
   requires "Test::MockObject" => "0";
   requires "Test::MockObject::Extends" => "0";
+  requires "Test::More" => "0";
   requires "Test::Tester" => "0";
 };
 

dist.ini

@@ -1,5 +1,5 @@
 name = Selenium-Remote-Driver
-version = 0.1950
+version = 0.1952
 author = Aditya Ivaturi <ivaturi@gmail.com>
 author = Daniel Gempesaw <gempesaw@gmail.com>
 author = Luke Closs <cpan@5thplane.com>

lib/Selenium/Remote/Driver.pm

@@ -383,19 +383,28 @@ has 'desired_capabilities' => (
     predicate => 'has_desired_capabilities'
 );
 
+has 'testing' => (
+    is => 'rw',
+    default => sub { 0 },
+);
+
 sub BUILD {
     my $self = shift;
 
-    # Connect to remote server & establish a new session
-    if ($self->has_desired_capabilities) {
-        $self->new_desired_session( $self->desired_capabilities );
-    }
-    else {
-        $self->new_session( $self->extra_capabilities );
-    }
+    # disable server connection when testing attribute is on
+    unless ($self->testing) {
 
-    if ( !( defined $self->session_id ) ) {
-        croak "Could not establish a session with the remote server\n";
+        if ($self->has_desired_capabilities) {
+            $self->new_desired_session( $self->desired_capabilities );
+        }
+        else {
+            # Connect to remote server & establish a new session
+            $self->new_session( $self->extra_capabilities );
+        }
+
+        if ( !( defined $self->session_id ) ) {
+            croak "Could not establish a session with the remote server\n";
+        }
     }
 }
 
@@ -409,7 +418,7 @@ sub new_from_caps {
     return $self->new(%args);
 }
 
-sub DESTROY {
+sub DEMOLISH {
     my ($self) = @_;
     return if $$ != $self->pid;
     $self->quit() if ( $self->auto_close && defined $self->session_id );

lib/Test/Selenium/Remote/Driver.pm

@@ -1,140 +1,82 @@
 package Test::Selenium::Remote::Driver;
-
-use strict;
-use warnings;
-use parent  'Selenium::Remote::Driver';
 # ABSTRACT: Useful testing subclass for Selenium::Remote::Driver
 
+use Moo;
 use Test::Selenium::Remote::WebElement;
-use Test::More;
-use Test::Builder;
 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',
+            'compare_elements_ok', 'click_ok', 'double_click_ok',
+            'body_like',
+        ];
+    },
+);
 
-our $AUTOLOAD;
+sub has_args {
+    my $self          = shift;
+    my $fun_name      = shift;
+    my $hash_fun_args = {
+        'find_element'     => 1,
+        'compare_elements' => 2,
+        'get' => 1,
+    };
+    return ( $hash_fun_args->{$fun_name} // 0 );
+}
 
-my $Test = Test::Builder->new;
-$Test->exported_to(__PACKAGE__);
+with 'Test::Selenium::Remote::Role::DoesTesting';
 
-my %comparator = (
-    is       => 'is_eq',
-    isnt     => 'isnt_eq',
-    like     => 'like',
-    unlike   => 'unlike',
+has verbose => (
+    is => 'rw',
 );
-my $comparator_keys = join '|', keys %comparator;
 
-# These commands don't require a locator
-my %no_locator = map { $_ => 1 }
-                qw( alert_text current_window_handle current_url
-                    title page_source body location path);
+has error_callback => (
+    is      => 'rw',
+    default => sub {
+        sub { }
+    },
+);
 
-sub no_locator {
-    my $self   = shift;
-    my $method = shift;
-    return $no_locator{$method};
-}
 
-sub AUTOLOAD {
-    my $name = $AUTOLOAD;
-    $name =~ s/.*:://;
-    return if $name eq 'DESTROY';
-    my $self = $_[0];
-
-    my $sub;
-    if ($name =~ /(\w+)_($comparator_keys)$/i) {
-        my $getter = "get_$1";
-        my $comparator = $comparator{lc $2};
-
-        # make a subroutine that will call Test::Builder's test methods
-        # with driver data from the getter
-        if ($self->no_locator($1)) {
-            $sub = sub {
-                my( $self, $str, $name ) = @_;
-                diag "Test::Selenium::Remote::Driver running no_locator $getter (@_[1..$#_])"
-                    if $self->{verbose};
-                $name = "$getter, '$str'"
-                    if $self->{default_names} and !defined $name;
-                no strict 'refs';
-                my $rc = $Test->$comparator( $self->$getter, $str, $name );
-                if (!$rc && $self->error_callback) {
-                    &{$self->error_callback}($name);
-                }
-                return $rc;
-            };
-        }
-        else {
-            $sub = sub {
-                my( $self, $locator, $str, $name ) = @_;
-                diag "Test::Selenium::Remote::Driver running with locator $getter (@_[1..$#_])"
-                    if $self->{verbose};
-                $name = "$getter, $locator, '$str'"
-                    if $self->{default_names} and !defined $name;
-                no strict 'refs';
-                no strict 'refs';
-                my $rc = $Test->$comparator( $self->$getter($locator), $str, $name );
-                if (!$rc && $self->error_callback) {
-                    &{$self->error_callback}($name);
+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
                 }
-                return $rc;
-            };
+            );
         }
     }
-    elsif ($name =~ /(\w+?)_?ok$/i) {
-        my $cmd = $1;
-
-        # make a subroutine for ok() around the selenium command
-        # TODO: fix the thing for get_ok, it won't work as its arg get
-        # pop'd in $name (so the call to get has no args => end of game)
-        $sub = sub {
-            my $self = shift;
-            my $name = (@_ > 1 ? pop @_ : $cmd);
-            my ($arg1, $arg2) = @_;
-            if ($self->{default_names} and !defined $name) {
-                $name = $cmd;
-                $name .= ", $arg1" if defined $arg1;
-                $name .= ", $arg2" if defined $arg2;
-            }
-            diag "Test::Selenium::Remote::Driver running _ok $cmd (@_[1..$#_])"
-                    if $self->{verbose};
-
-            local $Test::Builder::Level = $Test::Builder::Level + 1;
-            my $rc = '';
-            eval { $rc = $self->$cmd( $arg1, $arg2 ) };
-            die $@ if $@ and $@ =~ /Can't locate object method/;
-            diag($@) if $@;
-            $rc = ok( $rc, $name );
-            if (!$rc && $self->error_callback) {
-                &{$self->error_callback}($name);
-            }
-            return $rc;
-        };
-    }
-
-    # jump directly to the new subroutine, avoiding an extra frame stack
-    if ($sub) {
-        no strict 'refs';
-        *{$AUTOLOAD} = $sub;
-        goto &$AUTOLOAD;
-    }
-    else {
-        # try to pass through to Selenium::Remote::Driver
-        my $sel = 'Selenium::Remote::Driver';
-        my $sub = "${sel}::${name}";
-        goto &$sub if exists &$sub;
-        my ($package, $filename, $line) = caller;
-        die qq(Can't locate object method "$name" via package ")
-            . __PACKAGE__
-            . qq(" (also tried "$sel") at $filename line $line\n);
-    }
-}
-
-sub error_callback {
-    my ($self, $cb) = @_;
-    if (defined($cb)) {
-        $self->{error_callback} = $cb;
-    }
-    return $self->{error_callback};
 }
 
 =head1 NAME
@@ -170,20 +112,20 @@ See L<Selenium::Driver::Remote> for the meanings of these options.
 
 =cut
 
-sub new {
-    my ($class, %p) = @_;
+sub BUILDARGS {
+    my ( $class, %p ) = @_;
 
-    for my $opt (qw/remote_server_addr port browser_name version platform
-                    javascript auto_close extra_capabilities/) {
+    for my $opt (
+        qw/remote_server_addr port browser_name version platform
+        javascript auto_close extra_capabilities/
+      )
+    {
         $p{$opt} //= $ENV{ 'TWD_' . uc($opt) };
     }
-    $p{browser_name}       //= $ENV{TWD_BROWSER}; # ykwim
-    $p{remote_server_addr} //= $ENV{TWD_HOST};    # ykwim
+    $p{browser_name}       //= $ENV{TWD_BROWSER};                      # ykwim
+    $p{remote_server_addr} //= $ENV{TWD_HOST};                         # ykwim
     $p{webelement_class}   //= 'Test::Selenium::Remote::WebElement';
-
-    my $self = $class->SUPER::new(%p);
-    $self->{verbose} = $p{verbose};
-    return $self;
+    return \%p;
 }
 
 =head2 server_is_running( $host, $port )
@@ -198,13 +140,14 @@ determine the server to check.
 
 sub server_is_running {
     my $class_or_self = shift;
-    my $host = $ENV{TWD_HOST} || shift || 'localhost';
-    my $port = $ENV{TWD_PORT} || shift || 4444;
+    my $host          = $ENV{TWD_HOST} || shift || 'localhost';
+    my $port          = $ENV{TWD_PORT} || shift || 4444;
 
-    return ($host, $port) if IO::Socket::INET->new(
+    return ( $host, $port )
+      if IO::Socket::INET->new(
         PeerAddr => $host,
         PeerPort => $port,
-    );
+      );
     return;
 
 }
@@ -304,11 +247,11 @@ Currently, other finders besides the default are not supported for C<type_ok()>.
 =cut
 
 sub type_element_ok {
-   my $self = shift;
-   my $locator = shift;
-   my $keys = shift;
-   my $desc = shift;
-   return $self->find_element($locator)->send_keys_ok($keys,$desc);
+    my $self    = shift;
+    my $locator = shift;
+    my $keys    = shift;
+    my $desc    = shift;
+    return $self->find_element($locator)->send_keys_ok( $keys, $desc );
 }
 
 
@@ -338,13 +281,17 @@ for C<find_no_element_ok()>.
 =cut
 
 sub find_no_element_ok {
-    my $self = shift;
+    my $self          = shift;
     my $search_target = shift;
-    my $desc = shift;
-
-    local $Test::Builder::Level = $Test::Builder::Level +1;
-    eval { $self->find_element($search_target) };
-    ok((defined $@),$desc);
+    my $desc          = shift;
+    my $rv = 0 ;
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+    try {
+        $self->find_element($search_target)
+    } catch {
+        $rv = 1 if ($_);
+    };
+    return $self->ok($rv == 1,$desc);
 }
 
 =head2 $twd->content_like( $regex [, $desc ] )
@@ -362,22 +309,22 @@ is no description.
 =cut
 
 sub content_like {
-    my $self = shift;
+    my $self  = shift;
     my $regex = shift;
-    my $desc = shift;
+    my $desc  = shift;
 
     local $Test::Builder::Level = $Test::Builder::Level + 1;
 
     my $content = $self->get_page_source();
 
-    if (not ref $regex eq 'ARRAY') {
-        my $desc = qq{Content is like "$regex"} if (not defined $desc);
-        return like_string($content , $regex, $desc );
+    if ( not ref $regex eq 'ARRAY' ) {
+        my $desc = qq{Content is like "$regex"} if ( not defined $desc );
+        return like_string( $content, $regex, $desc );
     }
-    elsif (ref $regex eq 'ARRAY') {
+    elsif ( ref $regex eq 'ARRAY' ) {
         for my $re (@$regex) {
-            my $desc = qq{Content is like "$re"} if (not defined $desc);
-            like_string($content , $re, $desc );
+            my $desc = qq{Content is like "$re"} if ( not defined $desc );
+            like_string( $content, $re, $desc );
         }
     }
 }
@@ -397,22 +344,22 @@ is no description.
 =cut
 
 sub content_unlike {
-    my $self = shift;
+    my $self  = shift;
     my $regex = shift;
-    my $desc = shift;
+    my $desc  = shift;
 
     local $Test::Builder::Level = $Test::Builder::Level + 1;
 
     my $content = $self->get_page_source();
 
-    if (not ref $regex eq 'ARRAY') {
-        my $desc = qq{Content is unlike "$regex"} if (not defined $desc);
-        return unlike_string($content , $regex, $desc );
+    if ( not ref $regex eq 'ARRAY' ) {
+        my $desc = qq{Content is unlike "$regex"} if ( not defined $desc );
+        return unlike_string( $content, $regex, $desc );
     }
-    elsif (ref $regex eq 'ARRAY') {
+    elsif ( ref $regex eq 'ARRAY' ) {
         for my $re (@$regex) {
-            my $desc = qq{Content is unlike "$re"} if (not defined $desc);
-            unlike_string($content , $re, $desc );
+            my $desc = qq{Content is unlike "$re"} if ( not defined $desc );
+            unlike_string( $content, $re, $desc );
         }
     }
 }
@@ -435,22 +382,22 @@ To also match the HTML see, C<< content_unlike() >>.
 =cut
 
 sub body_text_like {
-    my $self = shift;
+    my $self  = shift;
     my $regex = shift;
-    my $desc = shift;
+    my $desc  = shift;
 
     local $Test::Builder::Level = $Test::Builder::Level + 1;
 
     my $text = $self->get_body();
 
-    if (not ref $regex eq 'ARRAY') {
-        my $desc = qq{Text is like "$regex"} if (not defined $desc);
-        return like_string($text , $regex, $desc );
+    if ( not ref $regex eq 'ARRAY' ) {
+        my $desc = qq{Text is like "$regex"} if ( not defined $desc );
+        return like_string( $text, $regex, $desc );
     }
-    elsif (ref $regex eq 'ARRAY') {
+    elsif ( ref $regex eq 'ARRAY' ) {
         for my $re (@$regex) {
-            my $desc = qq{Text is like "$re"} if (not defined $desc);
-            like_string($text , $re, $desc );
+            my $desc = qq{Text is like "$re"} if ( not defined $desc );
+            like_string( $text, $re, $desc );
         }
     }
 }
@@ -473,22 +420,22 @@ To also match the HTML see, C<< content_unlike() >>.
 =cut
 
 sub body_text_unlike {
-    my $self = shift;
+    my $self  = shift;
     my $regex = shift;
-    my $desc = shift;
+    my $desc  = shift;
 
     local $Test::Builder::Level = $Test::Builder::Level + 1;
 
     my $text = $self->get_body();
 
-    if (not ref $regex eq 'ARRAY') {
-        my $desc = qq{Text is unlike "$regex"} if (not defined $desc);
-        return unlike_string($text , $regex, $desc );
+    if ( not ref $regex eq 'ARRAY' ) {
+        my $desc = qq{Text is unlike "$regex"} if ( not defined $desc );
+        return unlike_string( $text, $regex, $desc );
     }
-    elsif (ref $regex eq 'ARRAY') {
+    elsif ( ref $regex eq 'ARRAY' ) {
         for my $re (@$regex) {
-            my $desc = qq{Text is unlike "$re"} if (not defined $desc);
-            unlike_string($text , $re, $desc );
+            my $desc = qq{Text is unlike "$re"} if ( not defined $desc );
+            unlike_string( $text, $re, $desc );
         }
     }
 }
@@ -511,21 +458,21 @@ is no description.
 
 sub content_contains {
     my $self = shift;
-    my $str = shift;
+    my $str  = shift;
     my $desc = shift;
 
     local $Test::Builder::Level = $Test::Builder::Level + 1;
 
     my $content = $self->get_page_source();
 
-    if (not ref $str eq 'ARRAY') {
-        my $desc = qq{Content contains "$str"} if (not defined $desc);
-        return contains_string($content , $str, $desc );
+    if ( not ref $str eq 'ARRAY' ) {
+        my $desc = qq{Content contains "$str"} if ( not defined $desc );
+        return contains_string( $content, $str, $desc );
     }
-    elsif (ref $str eq 'ARRAY') {
+    elsif ( ref $str eq 'ARRAY' ) {
         for my $s (@$str) {
-            my $desc = qq{Content contains "$s"} if (not defined $desc);
-            contains_string($content , $s, $desc );
+            my $desc = qq{Content contains "$s"} if ( not defined $desc );
+            contains_string( $content, $s, $desc );
         }
     }
 }
@@ -546,21 +493,21 @@ is no description.
 
 sub content_lacks {
     my $self = shift;
-    my $str = shift;
+    my $str  = shift;
     my $desc = shift;
 
     local $Test::Builder::Level = $Test::Builder::Level + 1;
 
     my $content = $self->get_page_source();
 
-    if (not ref $str eq 'ARRAY') {
-        my $desc = qq{Content lacks "$str"} if (not defined $desc);
-        return lacks_string($content , $str, $desc );
+    if ( not ref $str eq 'ARRAY' ) {
+        my $desc = qq{Content lacks "$str"} if ( not defined $desc );
+        return lacks_string( $content, $str, $desc );
     }
-    elsif (ref $str eq 'ARRAY') {
+    elsif ( ref $str eq 'ARRAY' ) {
         for my $s (@$str) {
-            my $desc = qq{Content lacks "$s"} if (not defined $desc);
-            lacks_string($content , $s, $desc );
+            my $desc = qq{Content lacks "$s"} if ( not defined $desc );
+            lacks_string( $content, $s, $desc );
         }
     }
 }
@@ -584,21 +531,21 @@ To also match the HTML see, C<< content_uncontains() >>.
 
 sub body_text_contains {
     my $self = shift;
-    my $str = shift;
+    my $str  = shift;
     my $desc = shift;
 
     local $Test::Builder::Level = $Test::Builder::Level + 1;
 
     my $text = $self->get_body();
 
-    if (not ref $str eq 'ARRAY') {
-        my $desc = qq{Text contains "$str"} if (not defined $desc);
-        return contains_string($text , $str, $desc );
+    if ( not ref $str eq 'ARRAY' ) {
+        my $desc = qq{Text contains "$str"} if ( not defined $desc );
+        return contains_string( $text, $str, $desc );
     }
-    elsif (ref $str eq 'ARRAY') {
+    elsif ( ref $str eq 'ARRAY' ) {
         for my $s (@$str) {
-            my $desc = qq{Text contains "$s"} if (not defined $desc);
-            contains_string($text , $s, $desc );
+            my $desc = qq{Text contains "$s"} if ( not defined $desc );
+            contains_string( $text, $s, $desc );
         }
     }
 }
@@ -622,21 +569,21 @@ To also match the HTML see, C<< content_lacks() >>.
 
 sub body_text_lacks {
     my $self = shift;
-    my $str = shift;
+    my $str  = shift;
     my $desc = shift;
 
     local $Test::Builder::Level = $Test::Builder::Level + 1;
 
     my $text = $self->get_body();
 
-    if (not ref $str eq 'ARRAY') {
-        my $desc = qq{Text is lacks "$str"} if (not defined $desc);
-        return lacks_string($text , $str, $desc );
+    if ( not ref $str eq 'ARRAY' ) {
+        my $desc = qq{Text is lacks "$str"} if ( not defined $desc );
+        return lacks_string( $text, $str, $desc );
     }
-    elsif (ref $str eq 'ARRAY') {
+    elsif ( ref $str eq 'ARRAY' ) {
         for my $s (@$str) {
-            my $desc = qq{Text is lacks "$s"} if (not defined $desc);
-            lacks_string($text , $s, $desc );
+            my $desc = qq{Text is lacks "$s"} if ( not defined $desc );
+            lacks_string( $text, $s, $desc );
         }
     }
 }
@@ -648,8 +595,8 @@ sub body_text_lacks {
 =cut
 
 sub element_text_is {
-    my ($self,$search_target,$expected,$desc) = @_;
-    return $self->find_element($search_target)->text_is($expected,$desc);
+    my ( $self, $search_target, $expected, $desc ) = @_;
+    return $self->find_element($search_target)->text_is( $expected, $desc );
 }
 
 =head2 $twd->element_value_is($search_target,$expected_value [,$desc]);
@@ -659,8 +606,8 @@ sub element_text_is {
 =cut
 
 sub element_value_is {
-    my ($self,$search_target,$expected,$desc) = @_;
-    return $self->find_element($search_target)->value_is($expected,$desc);
+    my ( $self, $search_target, $expected, $desc ) = @_;
+    return $self->find_element($search_target)->value_is( $expected, $desc );
 }
 
 =head2 $twd->click_element_ok($search_target [,$desc]);
@@ -672,7 +619,7 @@ Find an element and then click on it.
 =cut
 
 sub click_element_ok {
-    my ($self,$search_target,$desc) = @_;
+    my ( $self, $search_target, $desc ) = @_;
     return $self->find_element($search_target)->click_ok($desc);
 }
 
@@ -685,7 +632,7 @@ Find an element and then clear on it.
 =cut
 
 sub clear_element_ok {
-    my ($self,$search_target,$desc) = @_;
+    my ( $self, $search_target, $desc ) = @_;
     return $self->find_element($search_target)->clear_ok($desc);
 }
 
@@ -698,7 +645,7 @@ Find an element and check to confirm that it is displayed. (visible)
 =cut
 
 sub is_element_displayed_ok {
-    my ($self,$search_target,$desc) = @_;
+    my ( $self, $search_target, $desc ) = @_;
     return $self->find_element($search_target)->is_displayed_ok($desc);
 }
 
@@ -711,7 +658,7 @@ Find an element and check to confirm that it is enabled.
 =cut
 
 sub is_element_enabled_ok {
-    my ($self,$search_target,$desc) = @_;
+    my ( $self, $search_target, $desc ) = @_;
     return $self->find_element($search_target)->is_enabled_ok($desc);
 }
 

lib/Test/Selenium/Remote/Role/DoesTesting.pm

@@ -0,0 +1,108 @@
+package Test::Selenium::Remote::Role::DoesTesting;
+# ABSTRACT: Role to cope with everything that is related to testing (could
+# be reused in both testing classes)
+
+use Moo::Role;
+use Test::Builder;
+use Try::Tiny;
+use namespace::clean;
+
+requires qw(func_list has_args);
+
+has _builder => (
+    is      => 'lazy',
+    builder => sub { return Test::Builder->new() },
+    handles => [qw/is_eq isnt_eq like unlike ok croak/],
+);
+
+
+# main method for non ok tests
+
+sub _check_method {
+    my $self           = shift;
+    my $method         = shift;
+    my $method_to_test = shift;
+    $method = "get_$method";
+    my @args = @_;
+    my $rv;
+    try {
+        my $num_of_args = $self->has_args($method);
+        my @r_args = splice( @args, 0, $num_of_args );
+        $rv = $self->$method(@r_args);
+    }
+    catch {
+        $self->croak($_);
+    };
+
+    return $self->$method_to_test( $rv, @args );
+}
+
+# main method for _ok tests
+
+sub _check_ok {
+    my $self      = shift;
+    my $method      = shift;
+    my @args = @_;
+    my $rv;
+    try {
+        my $num_of_args = $self->has_args($method);
+        my @r_args = splice( @args, 0, $num_of_args );
+        $rv = $self->$method(@r_args);
+    }
+    catch {
+        $self->croak($_);
+    };
+
+    my $test_name = pop @args // $method;
+    return $self->ok( $rv, $test_name);
+}
+
+
+# build the subs with the correct arg set
+
+sub _build_sub {
+    my $self      = shift;
+    my $meth_name = shift;
+    my @func_args;
+    my $comparators = {
+        is     => 'is_eq',
+        isnt   => 'isnt_eq',
+        like   => 'like',
+        unlike => 'unlike',
+    };
+    my @meth_elements = split( '_', $meth_name );
+    my $meth          = '_check_ok';
+    my $meth_comp     = pop @meth_elements;
+    if ( $meth_comp eq 'ok' ) {
+        push @func_args, join( '_', @meth_elements );
+    }
+    else {
+        if ( defined( $comparators->{$meth_comp} ) ) {
+            $meth = '_check_method';
+            push @func_args, join( '_', @meth_elements ),
+              $comparators->{$meth_comp};
+        }
+        else {
+            return sub {
+                my $self = shift;
+                $self->croak("Sub $meth_name could not be defined");
+              }
+        }
+    }
+
+    return sub {
+        my $self = shift;
+        local $Test::Builder::Level = $Test::Builder::Level + 2;
+        $self->$meth( @func_args, @_ );
+    };
+
+}
+
+1;
+
+
+=head1 NAME
+
+Selenium::Remote::Role::DoesTesting - Role implementing the common logic used for testing
+
+=cut

lib/Test/Selenium/Remote/WebElement.pm

@@ -1,181 +1,60 @@
 package Test::Selenium::Remote::WebElement;
-
 # ABSTRACT: A sub-class of L<Selenium::Remote::WebElement>, with several test-specific method additions.
 
-use parent 'Selenium::Remote::WebElement';
 use Moo;
-use Test::Builder;
-use Try::Tiny;
+use Sub::Install;
+extends 'Selenium::Remote::WebElement';
+
+
+# list of test functions to be built
 
-has _builder => (
+has func_list => (
     is      => 'lazy',
-    builder => sub { return Test::Builder->new() },
-    handles => [qw/is_eq isnt_eq like unlike ok croak/],
+    builder => sub {
+        return [
+            'clear_ok',     'click_ok',
+            'send_keys_ok', 'is_displayed_ok',
+            'is_enabled_ok', 'is_selected_ok', 'submit_ok',
+            'text_is',          'text_isnt',      'text_like',  'text_unlike',
+            'attribute_is',     'attribute_isnt', 'attribute_like',
+            'attribute_unlike', 'value_is',       'value_isnt', 'value_like',
+            'value_unlike', 'tag_name_is', 'tag_name_isnt', 'tag_name_like',
+            'tag_name_unlike'
+        ];
+    }
 );
 
+with 'Test::Selenium::Remote::Role::DoesTesting';
+
+# helper so we could specify the num of args a method takes (if any)
+
 sub has_args {
-    my $self = shift;
-    my $fun_name = shift;
+    my $self          = shift;
+    my $fun_name      = shift;
     my $hash_fun_args = {
         'get_attribute' => 1,
     };
-    return ($hash_fun_args->{$fun_name} // 0);
+    return ( $hash_fun_args->{$fun_name} // 0 );
 }
 
 
-sub _check_method {
-    my $self           = shift;
-    my $method         = shift;
-    my $method_to_test = shift;
-    $method = "get_$method";
-    my @args = @_;
-    my $rv;
-    try {
-        my $num_of_args = $self->has_args($method);
-        my @r_args = splice (@args,0,$num_of_args);
-        $rv = $self->$method(@r_args);
-    }
-    catch {
-        $self->croak($_);
-    };
-    # +2 because of the delegation on _builder
-    local $Test::Builder::Level = $Test::Builder::Level + 2;
-    return $self->$method_to_test( $rv, @args );
-}
+# install the test methods into the class namespace
 
-sub _check_ok {
+sub BUILD {
     my $self = shift;
-    my $meth = shift;
-    my $test_name = pop // $meth;
-    my $rv;
-    try {
-        $rv = $self->$meth(@_);
+    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
+                }
+            );
+        }
     }
-    catch {
-        $self->croak($_);
-    };
-
-    # +2 because of the delegation on _builder
-    local $Test::Builder::Level = $Test::Builder::Level + 2;
-    return $self->ok($rv,$test_name,@_);
-}
-
-sub clear_ok {
-    my $self = shift;
-    return $self->_check_ok('clear',@_);
-}
-
-sub click_ok {
-    my $self = shift;
-    return $self->_check_ok('click',@_);
-}
-
-sub submit_ok {
-    my $self = shift;
-    return $self->_check_ok('submit',@_);
-}
-
-sub is_selected_ok {
-    my $self = shift;
-    return $self->_check_ok('is_selected',@_);
-}
-
-sub is_enabled_ok {
-    my $self = shift;
-    return $self->_check_ok('is_enabled',@_);
-}
-
-sub is_displayed_ok {
-    my $self = shift;
-    return $self->_check_ok('is_displayed',@_);
-}
-
-sub send_keys_ok {
-    my $self = shift;
-    return $self->_check_ok('send_keys',@_);
-}
-
-
-
-sub text_is {
-    my $self = shift;
-    return $self->_check_method( 'text', 'is_eq', @_ );
-}
-
-sub text_isnt {
-    my $self = shift;
-    return $self->_check_method( 'text', 'isnt_eq', @_ );
 }
 
-sub text_like {
-    my $self = shift;
-    return $self->_check_method( 'text', 'like', @_ );
-}
-
-sub text_unlike {
-    my $self = shift;
-    return $self->_check_method( 'text', 'unlike', @_ );
-}
-
-sub tag_name_is {
-    my $self = shift;
-    return $self->_check_method( 'tag_name', 'is_eq', @_ );
-}
-
-sub tag_name_isnt {
-    my $self = shift;
-    return $self->_check_method( 'tag_name', 'isnt_eq', @_ );
-}
-
-sub tag_name_like {
-    my $self = shift;
-    return $self->_check_method( 'tag_name', 'like', @_ );
-}
-
-sub tag_name_unlike {
-    my $self = shift;
-    return $self->_check_method( 'tag_name', 'unlike', @_ );
-}
-
-sub value_is {
-    my $self = shift;
-    return $self->_check_method( 'value', 'is_eq', @_ );
-}
-
-sub value_isnt {
-    my $self = shift;
-    return $self->_check_method( 'value', 'isnt_eq', @_ );
-}
-
-sub value_like {
-    my $self = shift;
-    return $self->_check_method( 'value', 'like', @_ );
-}
-
-sub value_unlike {
-    my $self = shift;
-    return $self->_check_method( 'value', 'unlike', @_ );
-}
-
-sub attribute_is {
-    my $self = shift;
-    return $self->_check_method( 'attribute', 'is_eq', @_ );
-}
-
-sub attribute_isnt {
-    my $self = shift;
-    return $self->_check_method( 'attribute', 'isnt_eq', @_ );
-}
-
-sub attribute_like {
-    my $self = shift;
-    return $self->_check_method( 'attribute', 'like', @_ );
-}
-
-sub attribute_unlike {
-    my $self = shift;
-    return $self->_check_method( 'attribute', 'unlike', @_ );
-}
 
 1;
 
@@ -216,10 +95,10 @@ module, as well as the following test-specific methods. All test names are optio
   send_keys_ok($str)
   send_keys_ok($str,$test_name)
 
-  attribute_is($attr_name,$match_str,$test_name); # TODO
-  attribute_isnt($attr_name,$match_str,$test_name); # TODO
-  attribute_like($attr_name,$match_re,$test_name); # TODO
-  attribute_unlike($attr_name,$match_re,$test_name); # TODO
+  attribute_is($attr_name,$match_str,$test_name);
+  attribute_isnt($attr_name,$match_str,$test_name);
+  attribute_like($attr_name,$match_re,$test_name);
+  attribute_unlike($attr_name,$match_re,$test_name);
 
   css_attribute_is($attr_name,$match_str,$test_name); # TODO
   css_attribute_isnt($attr_name,$match_str,$test_name); # TODO

t/Test-Selenium-Remote-Driver.t

@@ -5,105 +5,99 @@ use Test::MockObject;
 use Test::MockObject::Extends;
 use Test::Selenium::Remote::Driver;
 use Selenium::Remote::WebElement;
+use Carp;
 
-# Temporarily override the 'new()' in the parent class, so that it doesn't try to make network connections.
-sub Selenium::Remote::Driver::new {
-    my ( $class, %args ) = @_;
-
-    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',
-        version            => delete $args{version}                   || '',
-        webelement_class   => delete $args{webelement_class}          || "Selenium::Remote::WebElement",
-        default_finder     => delete $args{default_finder}            || 'xpath',
-        session_id         => undef,
-        remote_conn        => undef,
-        auto_close         => 1, # by default we will close remote session on DESTROY
-        pid                => $$
-    };
-    bless $self, $class or die "Can't bless $class: $!";
-}
-
-
-# Start off by faking a bunch of Selenium::Remote::Driver calls succeeding
-my $successful_driver = Test::Selenium::Remote::Driver->new;
-$successful_driver =  Test::MockObject::Extends->new( $successful_driver );
+my $successful_driver = Test::Selenium::Remote::Driver->new( testing => 1 );
+$successful_driver = Test::MockObject::Extends->new($successful_driver);
 
 my $element = Test::Selenium::Remote::WebElement->new(
-    id => '1342835311100',
+    id     => '1342835311100',
     parent => $successful_driver,
 );
 
 
 # find_element_ok
 {
-    $successful_driver->mock('find_element', sub { $element } );
+    $successful_driver->mock( 'find_element', sub {$element} );
     check_tests(
-      sub {
-          my $rc = $successful_driver->find_element_ok('q', 'find_element_ok works');
-          is($rc,1,'returns true');
-      },
-      [
-          {
-            ok => 1,
-            name => "find_element_ok works",
-            diag => "",
-          },
-          {
-            ok => 1,
-            name => "returns true",
-            diag => "",
-          },
-      ]
+        sub {
+            my $rc = $successful_driver->find_element_ok( 'q',
+                'find_element_ok works' );
+            is( $rc, 1, 'returns true' );
+        },
+        [   {   ok   => 1,
+                name => "find_element_ok works",
+                diag => "",
+            },
+            {   ok   => 1,
+                name => "returns true",
+                diag => "",
+            },
+        ]
     );
 
-    $successful_driver->mock('find_element', sub { 0 } );
+    $successful_driver->mock( 'find_element', sub {0} );
     check_tests(
-      sub {
-          my $rc = $successful_driver->find_element_ok('q', 'find_element_ok works, falsey test');
-          is($rc,0,'returns false');
-      },
-      [
-          {
-            ok => 0,
-            name => "find_element_ok works, falsey test",
-            diag => "",
-          },
-          {
-            ok => 1,
-            name => "returns false",
-            diag => "",
-          },
-      ]
+        sub {
+            my $rc = $successful_driver->find_element_ok( 'q',
+                'find_element_ok works, falsey test' );
+            is( $rc, 0, 'returns false' );
+        },
+        [   {   ok   => 0,
+                name => "find_element_ok works, falsey test",
+                diag => "",
+            },
+            {   ok   => 1,
+                name => "returns false",
+                diag => "",
+            },
+        ]
     );
 }
 
 # find_no_element_ok
 {
-    $successful_driver->mock('find_element', sub { die } );
+    $successful_driver->mock( 'find_element', sub { die $_[1] } );
     check_tests(
-      sub {
-          my $rc = $successful_driver->find_no_element_ok('BOOM', 'find_no_element_ok works, expecting to find nothing.');
-          is($rc,1,'returns true');
-      },
-      [
-          {
-            ok => 1,
-            name => "find_no_element_ok works, expecting to find nothing.",
-            diag => "",
-          },
-          {
-            ok => 1,
-            name => "returns true",
-            diag => "",
-          },
-      ]
+        sub {
+            my $rc = $successful_driver->find_no_element_ok( 'BOOM',
+                'find_no_element_ok works, expecting to find nothing.' );
+            is( $rc, 1, 'returns true' );
+        },
+        [   {   ok   => 1,
+                name => "find_no_element_ok works, expecting to find nothing.",
+                diag => "",
+            },
+            {   ok   => 1,
+                name => "returns true",
+                diag => "",
+            },
+        ]
     );
 
-}
+    $successful_driver->mock( 'find_element', sub {$element} );
+    check_tests(
+        sub {
+            my $rc =
+              $successful_driver->find_no_element_ok( 'q',
+                'find_no_element_ok works, expecting a false value if a element exists'
+              );
+            is( $rc, 0, 'returns false' );
+        },
+        [   {   ok => 0,
+                name =>
+                  "find_no_element_ok works, expecting a false value if a element exists",
+                diag => "",
+            },
+            {   ok   => 1,
+                name => "returns false",
+                diag => "",
+            },
+        ]
+    );
 
 
+}
+
 
 done_testing();