r49593 - in /trunk/libtest-www-selenium-perl: Changes META.yml debian/changelog lib/Test/WWW/Selenium.pm t/test-selenium.t

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Thu Dec 31 04:43:40 UTC 2009


Author: jawnsy-guest
Date: Thu Dec 31 04:43:34 2009
New Revision: 49593

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=49593
Log:
builds clean, dch -r

Modified:
    trunk/libtest-www-selenium-perl/Changes
    trunk/libtest-www-selenium-perl/META.yml
    trunk/libtest-www-selenium-perl/debian/changelog
    trunk/libtest-www-selenium-perl/lib/Test/WWW/Selenium.pm
    trunk/libtest-www-selenium-perl/t/test-selenium.t

Modified: trunk/libtest-www-selenium-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-selenium-perl/Changes?rev=49593&op=diff
==============================================================================
--- trunk/libtest-www-selenium-perl/Changes (original)
+++ trunk/libtest-www-selenium-perl/Changes Thu Dec 31 04:43:34 2009
@@ -1,6 +1,10 @@
 Revision history for Perl extension Test::WWW::Selenium.
 
-1.20 - Not yet released
+1.21 - Wed Dec 30 14:58:07 PST 2009
+  - Add error_callback() patch from Derek Wueppelmann
+
+1.20 - Mon Nov  2 22:13:47 PST 2009
+  - Refactor timeout code so the UserAgent timeout is always long enough
   - Make set_timeout() also set the UserAgent timeout.
 
 1.19 - Thu Sep 24 19:27:51 PDT 2009

Modified: trunk/libtest-www-selenium-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-selenium-perl/META.yml?rev=49593&op=diff
==============================================================================
--- trunk/libtest-www-selenium-perl/META.yml (original)
+++ trunk/libtest-www-selenium-perl/META.yml Thu Dec 31 04:43:34 2009
@@ -26,4 +26,4 @@
   URI::Escape: 1.31
 resources:
   license: http://dev.perl.org/licenses/
-version: 1.20
+version: 1.21

Modified: trunk/libtest-www-selenium-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-selenium-perl/debian/changelog?rev=49593&op=diff
==============================================================================
--- trunk/libtest-www-selenium-perl/debian/changelog (original)
+++ trunk/libtest-www-selenium-perl/debian/changelog Thu Dec 31 04:43:34 2009
@@ -1,3 +1,9 @@
+libtest-www-selenium-perl (1.21-1) unstable; urgency=low
+
+  * New upstream release
+
+ -- Jonathan Yu <jawnsy at cpan.org>  Wed, 30 Dec 2009 23:45:33 -0500
+
 libtest-www-selenium-perl (1.20-1) unstable; urgency=low
 
   * New upstream release

Modified: trunk/libtest-www-selenium-perl/lib/Test/WWW/Selenium.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-selenium-perl/lib/Test/WWW/Selenium.pm?rev=49593&op=diff
==============================================================================
--- trunk/libtest-www-selenium-perl/lib/Test/WWW/Selenium.pm (original)
+++ trunk/libtest-www-selenium-perl/lib/Test/WWW/Selenium.pm Thu Dec 31 04:43:34 2009
@@ -4,7 +4,7 @@
 use base qw(WWW::Selenium);
 use Carp qw(croak);
 
-our $VERSION = '1.20';
+our $VERSION = '1.21';
 
 =head1 NAME
 
@@ -24,6 +24,7 @@
                                         browser => "*firefox",
                                         browser_url => "http://www.google.com",
                                         default_names => 1,
+                                        error_callback => sub { ... },
                                       );
 
     # use special test wrappers around WWW::Selenium commands:
@@ -32,6 +33,7 @@
     $sel->click_ok("btnG");
     $sel->wait_for_page_to_load_ok(5000);
     $sel->title_like(qr/Google Search/);
+    $sel->error_callback(sub {...});
 
 =head1 REQUIREMENTS
 
@@ -64,6 +66,14 @@
 
 Returns the relative location of the current page.  Works with
 _is, _like, ... methods.
+
+=item error_callback
+
+Sets the method to use when a corresponding selenium test is called and fails.
+For example if you call text_like(...) and it fails the sub defined in the 
+error_callback will be called. This allows you to perform various tasks to
+obtain additional details that occured when obtianing the error. If this is 
+set to undef then the callback will not be issued.
 
 =back
 
@@ -119,7 +129,11 @@
                 $name = "$getter, '$str'" 
                     if $self->{default_names} and !defined $name;
                 no strict 'refs';
-                return $Test->$comparator( $self->$getter, $str, $name );
+                my $rc = $Test->$comparator( $self->$getter, $str, $name );
+                if (!$rc && $self->error_callback) {
+                    &{$self->error_callback}($name);
+                }
+                return $rc;
             };
         }
         else {
@@ -130,7 +144,11 @@
                 $name = "$getter, $locator, '$str'" 
                     if $self->{default_names} and !defined $name;
                 no strict 'refs';
-                return $Test->$comparator( $self->$getter($locator), $str, $name );
+                my $rc = $Test->$comparator( $self->$getter($locator), $str, $name );
+                if (!$rc && $self->error_callback) {
+                    &{$self->error_callback}($name);
+                }
+		return $rc;
             };
         }
     }
@@ -153,7 +171,11 @@
             eval { $rc = $self->$cmd( $arg1, $arg2 ) };
             die $@ if $@ and $@ =~ /Can't locate object method/;
             diag($@) if $@;
-            return ok( $rc, $name );
+            $rc = ok( $rc, $name );
+            if (!$rc && $self->error_callback) {
+                &{$self->error_callback}($name);
+            }
+            return $rc;
         };
     }
 
@@ -179,12 +201,23 @@
     my ($class, %opts) = @_;
     my $default_names = defined $opts{default_names} ? 
                             delete $opts{default_names} : 1;
+    my $error_callback = defined $opts{error_callback} ?
+	                    delete $opts{error_callback} : undef;
     my $self = $class->SUPER::new(%opts);
     $self->{default_names} = $default_names;
+    $self->{error_callback} = $error_callback;
     $self->start;
     return $self;
 }
 
+sub error_callback {
+    my ($self, $cb) = @_;
+    if (defined($cb)) {
+        $self->{error_callback} = $cb;
+    }
+    return $self->{error_callback};
+}
+
 1;
 
 __END__

Modified: trunk/libtest-www-selenium-perl/t/test-selenium.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-selenium-perl/t/test-selenium.t?rev=49593&op=diff
==============================================================================
--- trunk/libtest-www-selenium-perl/t/test-selenium.t (original)
+++ trunk/libtest-www-selenium-perl/t/test-selenium.t Thu Dec 31 04:43:34 2009
@@ -4,7 +4,7 @@
 use Test::More;
 use Test::Exception;
 use Test::Mock::LWP;
-use Test::Builder::Tester tests => 46;
+use Test::Builder::Tester tests => 62;
 Test::Builder::Tester::color(1);
 
 BEGIN {
@@ -223,6 +223,78 @@
     }
 }
 
+Error_callback: {
+    my $foo = 0;
+    $Mock_resp->mock('content' => sub { 'OK,SESSION_ID' });
+    my $sel = Test::WWW::Selenium->new(
+        browser_url => 'http://foo.com',
+        error_callback => sub { $foo++ },
+    );
+    $sel->open;
+    is_pass: {
+        $Mock_resp->mock('content' => sub { 'OK,foo' });
+        test_out('ok 1 - bar');
+        $sel->text_is('id', 'foo', 'bar');
+        test_test('is pass');
+        is $foo, 0, 'callback not called';
+    }
+    is_fail: {
+        $Mock_resp->mock('content' => sub { 'OK,baz' });
+        test_out('not ok 1 - bar');
+        test_fail(+1);
+        $sel->text_is('id', 'foo', 'bar');
+        test_test(skip_err => 1, title => 'is fail');
+        is $foo, 1, 'callback called';
+    }
+    isnt_pass: {
+        $Mock_resp->mock('content' => sub { 'OK,baz' });
+        test_out('ok 1 - bar');
+        $sel->text_isnt('id', 'foo', 'bar');
+        test_test('isnt pass');
+        is $foo, 1, 'callback not called';
+    }
+    isnt_fail: {
+        $Mock_resp->mock('content' => sub { 'OK,foo' });
+        test_out('not ok 1 - bar');
+        test_fail(+1);
+        $sel->text_isnt('id', 'foo', 'bar');
+        test_test(skip_err => 1, title => 'isnt fail');
+        is $foo, 2, 'callback called';
+    }
+    like_pass: {
+        $Mock_resp->mock('content' => sub { 'OK,foo' });
+        test_out('ok 1 - bar');
+        $sel->text_like('id', qr/foo/, 'bar');
+        test_test('like pass');
+        is $foo, 2, 'callback not called';
+    }
+    like_fail: {
+        $Mock_resp->mock('content' => sub { 'OK,baz' });
+        test_out('not ok 1 - bar');
+        test_fail(+1);
+        $sel->text_like('id', qr/foo/, 'bar');
+        test_test(skip_err => 1, title => 'like fail');
+        is $foo, 3, 'callback called';
+    }
+    unlike_pass: {
+        $Mock_resp->mock('content' => sub { 'OK,baz' });
+        test_out('ok 1 - bar');
+        $sel->text_unlike('id', qr/foo/, 'bar');
+        test_test('unlike pass');
+        is $foo, 3, 'callback not called';
+    }
+    unlike_fail: {
+        $Mock_resp->mock('content' => sub { 'OK,foo' });
+        test_out('not ok 1 - bar');
+        test_fail(+1);
+        $sel->text_unlike('id', qr/foo/, 'bar');
+        test_test(skip_err => 1, title => 'unlike fail');
+        is $foo, 4, 'callback called';
+    }
+    # for $sel DESTROY
+    $Mock_resp->mock('content' => sub { 'OK' });
+}
+
 exit;
 
 




More information about the Pkg-perl-cvs-commits mailing list