1package Test::WWW::Selenium; 2{ 3 $Test::WWW::Selenium::VERSION = '1.36'; 4} 5# ABSTRACT: Test applications using Selenium Remote Control 6use strict; 7use base qw(WWW::Selenium); 8use Carp qw(croak); 9 10 11use Test::More; 12use Test::Builder; 13 14our $AUTOLOAD; 15 16my $Test = Test::Builder->new; 17$Test->exported_to(__PACKAGE__); 18 19my %comparator = ( 20 is => 'is_eq', 21 isnt => 'isnt_eq', 22 like => 'like', 23 unlike => 'unlike', 24); 25 26# These commands don't require a locator 27# grep item lib/WWW/Selenium.pm | grep sel | grep \(\) | grep get 28my %no_locator = map { $_ => 1 } 29 qw( speed alert confirmation prompt location title 30 body_text all_buttons all_links all_fields 31 mouse_speed all_window_ids all_window_names 32 all_window_titles html_source cookie absolute_location ); 33 34sub no_locator { 35 my $self = shift; 36 my $method = shift; 37 return $no_locator{$method}; 38} 39 40sub AUTOLOAD { 41 my $name = $AUTOLOAD; 42 $name =~ s/.*:://; 43 return if $name eq 'DESTROY'; 44 my $self = $_[0]; 45 46 my $sub; 47 if ($name =~ /(\w+)_(is|isnt|like|unlike)$/i) { 48 my $getter = "get_$1"; 49 my $comparator = $comparator{lc $2}; 50 51 # make a subroutine that will call Test::Builder's test methods 52 # with selenium data from the getter 53 if ($self->no_locator($1)) { 54 $sub = sub { 55 my( $self, $str, $name ) = @_; 56 diag "Test::WWW::Selenium running $getter (@_[1..$#_])" 57 if $self->{verbose}; 58 $name = "$getter, '$str'" 59 if $self->{default_names} and !defined $name; 60 no strict 'refs'; 61 my $rc = $Test->$comparator( $self->$getter, $str, $name ); 62 if (!$rc && $self->error_callback) { 63 &{$self->error_callback}( $name, $self ); 64 } 65 return $rc; 66 }; 67 } 68 else { 69 $sub = sub { 70 my( $self, $locator, $str, $name ) = @_; 71 diag "Test::WWW::Selenium running $getter (@_[1..$#_])" 72 if $self->{verbose}; 73 $name = "$getter, $locator, '$str'" 74 if $self->{default_names} and !defined $name; 75 no strict 'refs'; 76 my $rc = $Test->$comparator( $self->$getter($locator), $str, $name ); 77 if (!$rc && $self->error_callback) { 78 &{$self->error_callback}( $name, $self ); 79 } 80 return $rc; 81 }; 82 } 83 } 84 elsif ($name =~ /(\w+?)_?ok$/i) { 85 my $cmd = $1; 86 87 # make a subroutine for ok() around the selenium command 88 $sub = sub { 89 my( $self, $arg1, $arg2, $name ) = @_; 90 if ($self->{default_names} and !defined $name) { 91 $name = $cmd; 92 $name .= ", $arg1" if defined $arg1; 93 $name .= ", $arg2" if defined $arg2; 94 } 95 diag "Test::WWW::Selenium running $cmd (@_[1..$#_])" 96 if $self->{verbose}; 97 98 local $Test::Builder::Level = $Test::Builder::Level + 1; 99 my $rc = ''; 100 eval { $rc = $self->$cmd( $arg1, $arg2 ) }; 101 die $@ if $@ and $@ =~ /Can't locate object method/; 102 diag($@) if $@; 103 $rc = ok( $rc, $name ); 104 if (!$rc && $self->error_callback) { 105 &{$self->error_callback}( $name, $self ); 106 } 107 return $rc; 108 }; 109 } 110 111 # jump directly to the new subroutine, avoiding an extra frame stack 112 if ($sub) { 113 no strict 'refs'; 114 *{$AUTOLOAD} = $sub; 115 goto &$AUTOLOAD; 116 } 117 else { 118 # try to pass through to WWW::Selenium 119 my $sel = 'WWW::Selenium'; 120 my $sub = "${sel}::${name}"; 121 goto &$sub if exists &$sub; 122 my ($package, $filename, $line) = caller; 123 die qq(Can't locate object method "$name" via package ") 124 . __PACKAGE__ 125 . qq(" (also tried "$sel") at $filename line $line\n); 126 } 127} 128 129sub new { 130 my ($class, %opts) = @_; 131 my $default_names = defined $opts{default_names} ? 132 delete $opts{default_names} : 1; 133 my $error_callback = defined $opts{error_callback} ? 134 delete $opts{error_callback} : undef; 135 my $self = $class->SUPER::new(%opts); 136 $self->{default_names} = $default_names; 137 $self->{error_callback} = $error_callback; 138 $self->start; 139 return $self; 140} 141 142sub error_callback { 143 my ($self, $cb) = @_; 144 if (defined($cb)) { 145 $self->{error_callback} = $cb; 146 } 147 return $self->{error_callback}; 148} 149 150 151sub debug { 152 my $self = shift; 153 require Devel::REPL; 154 my $repl = Devel::REPL->new(prompt => 'Selenium$ '); 155 $repl->load_plugin($_) for qw/History LexEnv Colors Selenium Interrupt/; 156 $repl->selenium($self); 157 $repl->lexical_environment->do($repl->selenium_lex_env); 158 $repl->run; 159} 160 1611; 162 163__END__ 164 165=pod 166 167=head1 NAME 168 169Test::WWW::Selenium - Test applications using Selenium Remote Control 170 171=head1 VERSION 172 173version 1.36 174 175=head1 SYNOPSIS 176 177Test::WWW::Selenium is a subclass of L<WWW::Selenium> that provides 178convenient testing functions. 179 180 use Test::More tests => 5; 181 use Test::WWW::Selenium; 182 183 # Parameters are passed through to WWW::Selenium 184 my $sel = Test::WWW::Selenium->new( host => "localhost", 185 port => 4444, 186 browser => "*firefox", 187 browser_url => "http://www.google.com", 188 default_names => 1, 189 error_callback => sub { ... }, 190 ); 191 192 # use special test wrappers around WWW::Selenium commands: 193 $sel->open_ok("http://www.google.com", undef, "fetched G's site alright"); 194 $sel->type_ok( "q", "hello world"); 195 $sel->click_ok("btnG"); 196 $sel->wait_for_page_to_load_ok(5000); 197 $sel->title_like(qr/Google Search/); 198 $sel->error_callback(sub {...}); 199 200=head1 DESCRIPTION 201 202This module is a L<WWW::Selenium> subclass providing some methods 203useful for writing tests. For each Selenium command (open, click, 204type, ...) there is a corresponding C<< <command>_ok >> method that 205checks the return value (open_ok, click_ok, type_ok). 206 207For each Selenium getter (get_title, ...) there are four autogenerated 208methods (C<< <getter>_is >>, C<< <getter>_isnt >>, C<< <getter>_like >>, 209C<< <getter>_unlike >>) to check the value of the attribute. 210 211By calling the constructor with C<default_names> set to a true value your 212tests will be given a reasonable name should you choose not to provide 213one of your own. The test name should always be the third argument. 214 215=head1 NAME 216 217Test::WWW::Selenium - Test applications using Selenium Remote Control 218 219=head1 REQUIREMENTS 220 221To use this module, you need to have already downloaded and started the 222Selenium Server. (The Selenium Server is a Java application.) 223 224=head1 ADDITIONAL METHODS 225 226Test::WWW::Selenium also provides some other handy testing functions 227that wrap L<WWW::Selenium> commands: 228 229=over 4 230 231=item get_location 232 233Returns the relative location of the current page. Works with 234_is, _like, ... methods. 235 236=item error_callback 237 238Sets the method to use when a corresponding selenium test is called and fails. 239For example if you call text_like(...) and it fails the sub defined in the 240error_callback will be called. This allows you to perform various tasks to 241obtain additional details that occured when obtianing the error. If this is 242set to undef then the callback will not be issued. 243 244=back 245 246=over 4 247 248=item $sel-E<gt>debug() 249 250Starts an interactive shell to pass commands to Selenium. 251 252Commands are run against the selenium object, so you just need to type: 253 254=item eg: click("link=edit") 255 256=back 257 258=head1 AUTHORS 259 260=over 4 261 262=item * 263 264Maintained by: Matt Phillips <mattp@cpan.org>, Luke Closs <lukec@cpan.org> 265 266=item * 267 268Originally by Mattia Barbon <mbarbon@cpan.org> 269 270=back 271 272=head1 CONTRIBUTORS 273 274Dan Dascalescu 275 276Scott McWhirter 277 278=head1 COPYRIGHT AND LICENSE 279 280Copyright (c) 2011 Matt Phillips <mattp@cpan.org> 281 282Copyright (c) 2006 Luke Closs <lukec@cpan.org> 283 284Copyright (c) 2005, 2006 Mattia Barbon <mbarbon@cpan.org> 285 286This program is free software; you can redistribute it and/or 287modify it under the same terms as Perl itself. 288 289=cut 290