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