libtest-www-selenium-perl 1.36-1 / usr / share / perl5 / Test / WWW / Selenium.pm

package Test::WWW::Selenium;
{
  $Test::WWW::Selenium::VERSION = '1.36';
}
# ABSTRACT: Test applications using Selenium Remote Control
use strict;
use base qw(WWW::Selenium);
use Carp qw(croak);


use Test::More;
use Test::Builder;

our $AUTOLOAD;

my $Test = Test::Builder->new;
$Test->exported_to(__PACKAGE__);

my %comparator = (
    is       => 'is_eq',
    isnt     => 'isnt_eq',
    like     => 'like',
    unlike   => 'unlike',
);

# These commands don't require a locator
# grep item lib/WWW/Selenium.pm | grep sel | grep \(\) | grep get
my %no_locator = map { $_ => 1 }
                qw( speed alert confirmation prompt location title
                    body_text all_buttons all_links all_fields
                    mouse_speed all_window_ids all_window_names
                    all_window_titles html_source cookie absolute_location );

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+)_(is|isnt|like|unlike)$/i) {
        my $getter = "get_$1";
        my $comparator = $comparator{lc $2};

        # make a subroutine that will call Test::Builder's test methods
        # with selenium data from the getter
        if ($self->no_locator($1)) {
            $sub = sub {
                my( $self, $str, $name ) = @_;
                diag "Test::WWW::Selenium running $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, $self );
                }
                return $rc;
            };
        }
        else {
            $sub = sub {
                my( $self, $locator, $str, $name ) = @_;
                diag "Test::WWW::Selenium running $getter (@_[1..$#_])"
                    if $self->{verbose};
                $name = "$getter, $locator, '$str'"
                    if $self->{default_names} and !defined $name;
                no strict 'refs';
                my $rc = $Test->$comparator( $self->$getter($locator), $str, $name );
                if (!$rc && $self->error_callback) {
                    &{$self->error_callback}( $name, $self );
                }
		return $rc;
            };
        }
    }
    elsif ($name =~ /(\w+?)_?ok$/i) {
        my $cmd = $1;

        # make a subroutine for ok() around the selenium command
        $sub = sub {
            my( $self, $arg1, $arg2, $name ) = @_;
            if ($self->{default_names} and !defined $name) {
                $name = $cmd;
                $name .= ", $arg1" if defined $arg1;
                $name .= ", $arg2" if defined $arg2;
            }
            diag "Test::WWW::Selenium running $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, $self );
            }
            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 WWW::Selenium
        my $sel = 'WWW::Selenium';
        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 new {
    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};
}


sub debug {
    my $self = shift;
    require Devel::REPL;
    my $repl = Devel::REPL->new(prompt => 'Selenium$ ');
    $repl->load_plugin($_) for qw/History LexEnv Colors Selenium Interrupt/;
    $repl->selenium($self);
    $repl->lexical_environment->do($repl->selenium_lex_env);
    $repl->run;
}

1;

__END__

=pod

=head1 NAME

Test::WWW::Selenium - Test applications using Selenium Remote Control

=head1 VERSION

version 1.36

=head1 SYNOPSIS

Test::WWW::Selenium is a subclass of L<WWW::Selenium> that provides
convenient testing functions.

    use Test::More tests => 5;
    use Test::WWW::Selenium;

    # Parameters are passed through to WWW::Selenium
    my $sel = Test::WWW::Selenium->new( host => "localhost",
                                        port => 4444,
                                        browser => "*firefox",
                                        browser_url => "http://www.google.com",
                                        default_names => 1,
                                        error_callback => sub { ... },
                                      );

    # use special test wrappers around WWW::Selenium commands:
    $sel->open_ok("http://www.google.com", undef, "fetched G's site alright");
    $sel->type_ok( "q", "hello world");
    $sel->click_ok("btnG");
    $sel->wait_for_page_to_load_ok(5000);
    $sel->title_like(qr/Google Search/);
    $sel->error_callback(sub {...});

=head1 DESCRIPTION

This module is a L<WWW::Selenium> subclass providing some methods
useful for writing tests. For each Selenium command (open, click,
type, ...) there is a corresponding C<< <command>_ok >> method that
checks the return value (open_ok, click_ok, type_ok).

For each Selenium getter (get_title, ...) there are four autogenerated
methods (C<< <getter>_is >>, C<< <getter>_isnt >>, C<< <getter>_like >>,
C<< <getter>_unlike >>) to check the value of the attribute.

By calling the constructor with C<default_names> set to a true value your
tests will be given a reasonable name should you choose not to provide
one of your own.  The test name should always be the third argument.

=head1 NAME

Test::WWW::Selenium - Test applications using Selenium Remote Control

=head1 REQUIREMENTS

To use this module, you need to have already downloaded and started the
Selenium Server.  (The Selenium Server is a Java application.)

=head1 ADDITIONAL METHODS

Test::WWW::Selenium also provides some other handy testing functions
that wrap L<WWW::Selenium> commands:

=over 4

=item get_location

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

=over 4

=item $sel-E<gt>debug()

Starts an interactive shell to pass commands to Selenium.

Commands are run against the selenium object, so you just need to type:

=item eg: click("link=edit")

=back

=head1 AUTHORS

=over 4

=item *

Maintained by: Matt Phillips <mattp@cpan.org>, Luke Closs <lukec@cpan.org>

=item *

Originally by Mattia Barbon <mbarbon@cpan.org>

=back

=head1 CONTRIBUTORS

Dan Dascalescu

Scott McWhirter

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2011 Matt Phillips <mattp@cpan.org>

Copyright (c) 2006 Luke Closs <lukec@cpan.org>

Copyright (c) 2005, 2006 Mattia Barbon <mbarbon@cpan.org>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut