├── README.pod
├── t
    ├── 00_compile.t
    ├── driver
    │   ├── mechanize
    │   │   ├── browser.t
    │   │   ├── scripting.t
    │   │   ├── headers.t
    │   │   ├── pages.t
    │   │   └── navigation.t
    │   └── selenium_server
    │   │   ├── browser.t
    │   │   ├── headers.t
    │   │   ├── scripting.t
    │   │   ├── navigation.t
    │   │   └── pages.t
    ├── session
    │   ├── external_server.t
    │   ├── create_server.t
    │   ├── mechanize
    │   │   ├── attach_file.t
    │   │   ├── click_link.t
    │   │   ├── choose.t
    │   │   ├── click_button.t
    │   │   ├── fill_in.t
    │   │   ├── check.t
    │   │   └── select.t
    │   └── selenium_server
    │   │   ├── attach_file.t
    │   │   ├── click_link.t
    │   │   ├── choose.t
    │   │   ├── click_button.t
    │   │   ├── fill_in.t
    │   │   ├── check.t
    │   │   └── select.t
    ├── dsl.t
    └── node
    │   ├── mechanize
    │       ├── accessor.t
    │       ├── state.t
    │       └── finder.t
    │   └── selenium_server
    │       ├── accessor.t
    │       ├── state.t
    │       └── finder.t
├── xt
    ├── perlcriticrc
    ├── 01_pod.t
    ├── 02_podcoverage.t
    ├── 04_perlcritic.t
    └── 03_podspell.t
├── .shipit
├── lib
    ├── Brownie
    │   ├── Helpers.pm
    │   ├── Node
    │   │   ├── SeleniumServer.pm
    │   │   └── Mechanize.pm
    │   ├── DSL.pm
    │   ├── Driver
    │   │   ├── Mechanize.pm
    │   │   └── SeleniumServer.pm
    │   ├── Driver.pm
    │   ├── Node.pm
    │   ├── XPath.pm
    │   └── Session.pm
    └── Brownie.pm
├── .gitignore
├── MANIFEST.SKIP
├── eg
    └── google.pl
├── Makefile.PL
└── Changes


/README.pod:
--------------------------------------------------------------------------------
1 | lib/Brownie.pm


--------------------------------------------------------------------------------
/t/00_compile.t:
--------------------------------------------------------------------------------
1 | use Test::UseAllModules;
2 | BEGIN { all_uses_ok(); }
3 | 


--------------------------------------------------------------------------------
/xt/perlcriticrc:
--------------------------------------------------------------------------------
1 | [TestingAndDebugging::ProhibitNoStrict]
2 | allow=refs
3 | 


--------------------------------------------------------------------------------
/.shipit:
--------------------------------------------------------------------------------
1 | steps = FindVersion, ChangeVersion, CheckChangeLog, Manifest, DistTest, Commit, Tag, MakeDist, UploadCPAN, DistClean
2 | git.tagpattern = %v
3 | git.push_to = origin
4 | 


--------------------------------------------------------------------------------
/lib/Brownie/Helpers.pm:
--------------------------------------------------------------------------------
 1 | package Brownie::Helpers;
 2 | 
 3 | use warnings;
 4 | use utf8;
 5 | use Carp ();
 6 | 
 7 | sub not_implemented { Carp::croak('Not implemented') }
 8 | 
 9 | 1;
10 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
 1 | Build
 2 | _build
 3 | Makefile
 4 | Makefile.old
 5 | MANIFEST
 6 | MANIFEST.bak
 7 | META.*
 8 | MYMETA.*
 9 | blib
10 | cover_db
11 | cover_db_view
12 | inc
13 | nytprof
14 | nytprof.out
15 | pm_to_blib
16 | tmon.out
17 | 


--------------------------------------------------------------------------------
/xt/01_pod.t:
--------------------------------------------------------------------------------
1 | use Test::More;
2 | eval "use Test::Pod 1.00";
3 | plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
4 | plan skip_all => "set TEST_POD or TEST_ALL to enable this test"
5 |     unless $ENV{TEST_POD} or $ENV{TEST_ALL};
6 | all_pod_files_ok();
7 | 


--------------------------------------------------------------------------------
/xt/02_podcoverage.t:
--------------------------------------------------------------------------------
1 | use Test::More;
2 | eval "use Test::Pod::Coverage 1.04";
3 | plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
4 | plan skip_all => "set TEST_POD or TEST_ALL to enable this test"
5 |     unless $ENV{TEST_POD} or $ENV{TEST_ALL};
6 | all_pod_coverage_ok();
7 | 


--------------------------------------------------------------------------------
/t/driver/mechanize/browser.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Driver::Mechanize;
 5 | 
 6 | my $driver = Brownie::Driver::Mechanize->new;
 7 | 
 8 | subtest 'Browser' => sub {
 9 |     ok $driver->browser;
10 |     isa_ok $driver->browser => 'WWW::Mechanize';
11 | };
12 | 
13 | done_testing;
14 | 


--------------------------------------------------------------------------------
/t/driver/selenium_server/browser.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Driver::SeleniumServer;
 5 | 
 6 | my $driver = Brownie::Driver::SeleniumServer->new;
 7 | 
 8 | subtest 'Browser' => sub {
 9 |     ok $driver->browser;
10 |     isa_ok $driver->browser => 'Selenium::Remote::Driver';
11 | };
12 | 
13 | done_testing;
14 | 


--------------------------------------------------------------------------------
/MANIFEST.SKIP:
--------------------------------------------------------------------------------
 1 | \bRCS\b
 2 | \bCVS\b
 3 | ,v$
 4 | \.svn/
 5 | \.git/
 6 | ~$
 7 | ^#
 8 | ^MANIFEST\.
 9 | ^Makefile$
10 | ^Build$
11 | \.old$
12 | ^blib/
13 | ^pm_to_blib
14 | ^_build
15 | ^MakeMaker-\d
16 | \.gz$
17 | ^cover_db
18 | ^nytprof
19 | ^tmon\.out
20 | ^tools/
21 | ^author/
22 | ^MYMETA\.
23 | \.cvsignore
24 | \.gitignore
25 | \.shipit
26 | \._
27 | \.DS_Store
28 | 


--------------------------------------------------------------------------------
/xt/04_perlcritic.t:
--------------------------------------------------------------------------------
 1 | use Test::More;
 2 | eval {
 3 |     require Test::Perl::Critic;
 4 |     Test::Perl::Critic->import(-profile => 'xt/perlcriticrc');
 5 | };
 6 | plan skip_all => "Test::Perl::Critic is not installed." if $@;
 7 | plan skip_all => "set TEST_CRITIC or TEST_ALL to enable this test"
 8 |     unless $ENV{TEST_CRITIC} or $ENV{TEST_ALL};
 9 | all_critic_ok('lib');
10 | 


--------------------------------------------------------------------------------
/eg/google.pl:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env perl
 2 | 
 3 | use strict;
 4 | use warnings;
 5 | use FindBin;
 6 | use lib "$FindBin::Bin/../lib";
 7 | use Test::More;
 8 | use Brownie::Session;
 9 | 
10 | my $bs = Brownie::Session->new(driver => 'Mechanize', app_host => 'http://www.google.com');
11 | $bs->visit('/webhp');
12 | 
13 | like $bs->title => qr/Google/;
14 | 
15 | $bs->fill_in('q' => "Brownie\n"); # enable auto-search
16 | sleep 3;
17 | 
18 | like $bs->title => qr/Brownie/i;
19 | 
20 | done_testing;
21 | 


--------------------------------------------------------------------------------
/t/driver/selenium_server/headers.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Exception;
 5 | use Brownie::Driver::SeleniumServer;
 6 | 
 7 | my $driver = Brownie::Driver::SeleniumServer->new;
 8 | 
 9 | subtest 'Headers' => sub {
10 |     subtest 'status_code' => sub {
11 |         dies_ok { $driver->status_code } 'not supported status_code()';
12 |     };
13 | 
14 |     subtest 'response_headers' => sub {
15 |         dies_ok { $driver->response_headers } 'not supported response_headers()';
16 |     };
17 | };
18 | 
19 | done_testing;
20 | 


--------------------------------------------------------------------------------
/t/driver/mechanize/scripting.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Exception;
 5 | use Brownie::Driver::Mechanize;
 6 | 
 7 | my $driver = Brownie::Driver::Mechanize->new;
 8 | 
 9 | subtest 'Scripting' => sub {
10 |     subtest 'execute_script' => sub {
11 |         dies_ok { $driver->execute_script("document.title='execute_script'") } 'not supported execute_script()';
12 |     };
13 | 
14 |     subtest 'evaluate_script' => sub {
15 |         dies_ok { $driver->evaluate_script('1 + 2') } 'not supported evaluate_script()';
16 |     };
17 | };
18 | 
19 | done_testing;
20 | 


--------------------------------------------------------------------------------
/t/session/external_server.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | use Test::Fake::HTTPD;
 6 | 
 7 | subtest 'use external app' => sub {
 8 |     my $httpd = Test::Fake::HTTPD->new(timeout => 30);
 9 |     $httpd->run(sub {
10 |         return [ 200, [ 'Content-Type' => 'text/html' ], [ 'OK' ] ];
11 |     });
12 | 
13 |     my $bs = Brownie::Session->new(app_host => $httpd->endpoint);
14 |     ok $bs->app_host;
15 |     is $bs->app_host => $httpd->endpoint;
16 | 
17 |     $bs->visit('/');
18 |     is $bs->current_url => $bs->app_host . '/';
19 |     is $bs->status_code => 200;
20 |     is $bs->body        => 'OK';
21 | };
22 | 
23 | done_testing;
24 | 


--------------------------------------------------------------------------------
/t/driver/mechanize/headers.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Fake::HTTPD;
 5 | use Brownie::Driver::Mechanize;
 6 | 
 7 | my $driver = Brownie::Driver::Mechanize->new;
 8 | 
 9 | my $body = '<html><body>ok</body></html>';
10 | 
11 | my $httpd = Test::Fake::HTTPD->new(timeout => 30);
12 | $httpd->run(sub { [ 200, [ 'Content-Type' => 'text/html; charset=utf-8' ], [ $body ] ] });
13 | 
14 | subtest 'Headers' => sub {
15 |     $driver->visit($httpd->endpoint);
16 | 
17 |     subtest 'status_code' => sub {
18 |         is $driver->status_code => '200';
19 |     };
20 | 
21 |     subtest 'response_headers' => sub {
22 |         my $headers = $driver->response_headers;
23 |         isa_ok $headers => 'HTTP::Headers';
24 | 
25 |         my $ct = $headers->header('Content-Type');
26 |         like $ct => qr!text/html!i;
27 |         like $ct => qr/charset=utf-8/i;
28 |     };
29 | };
30 | 
31 | done_testing;
32 | 


--------------------------------------------------------------------------------
/xt/03_podspell.t:
--------------------------------------------------------------------------------
 1 | use Test::More;
 2 | use Config ();
 3 | use File::Spec ();
 4 | eval "use Test::Spelling";
 5 | plan skip_all => "Test::Spelling is not installed." if $@;
 6 | plan skip_all => "set TEST_POD or TEST_ALL to enable this test"
 7 |     unless $ENV{TEST_POD} or $ENV{TEST_ALL};
 8 | 
 9 | my $spell;
10 | for my $path (split /$Config::Config{path_sep}/ => $ENV{PATH}) {
11 |     -x File::Spec->catfile($path => 'spell')  and $spell = 'spell',       last;
12 |     -x File::Spec->catfile($path => 'ispell') and $spell = 'ispell -l',   last;
13 |     -x File::Spec->catfile($path => 'aspell') and $spell = 'aspell list', last;
14 | }
15 | plan skip_all => "spell/ispell/aspell are not installed." unless $spell;
16 | 
17 | add_stopwords(map { split /[\s\:\-]/ } <DATA>);
18 | set_spell_cmd($spell) if $spell;
19 | local $ENV{LANG} = 'C';
20 | all_pod_files_spelling_ok('lib');
21 | __DATA__
22 | NAKAGAWA Masaki
23 | masaki@cpan.org
24 | Brownie
25 | 


--------------------------------------------------------------------------------
/t/driver/selenium_server/scripting.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Exception;
 5 | use Test::Fake::HTTPD;
 6 | use Brownie::Driver::SeleniumServer;
 7 | 
 8 | my $driver = Brownie::Driver::SeleniumServer->new;
 9 | 
10 | my $body = <<__HTTPD__;
11 | <html><body>ok</body></html>
12 | __HTTPD__
13 | 
14 | my $httpd = Test::Fake::HTTPD->new(timeout => 30);
15 | $httpd->run(sub { [ 200, [ 'Content-Type' => 'text/html' ], [ $body ] ] });
16 | 
17 | subtest 'Scripting' => sub {
18 |     $driver->visit($httpd->endpoint);
19 | 
20 |     subtest 'execute_script' => sub {
21 |         lives_ok { $driver->execute_script("document.title='execute_script'") };
22 |         is $driver->title => 'execute_script';
23 |     };
24 | 
25 |     subtest 'evaluate_script' => sub {
26 |         my $got;
27 |         lives_ok { $got = $driver->evaluate_script('1 + 2') };
28 |         is $got => 3;
29 |     };
30 | };
31 | 
32 | done_testing;
33 | 


--------------------------------------------------------------------------------
/Makefile.PL:
--------------------------------------------------------------------------------
 1 | use inc::Module::Install;
 2 | 
 3 | name 'Brownie';
 4 | license 'perl';
 5 | all_from 'lib/Brownie.pm';
 6 | 
 7 | requires 'parent';
 8 | requires 'Class::Load';
 9 | requires 'Sub::Install';
10 | requires 'Scalar::Util' => 1.14;
11 | requires 'URI';
12 | requires 'HTML::Selector::XPath';
13 | requires 'Plack::Runner';
14 | requires 'Test::TCP';
15 | # Mechanize
16 | requires 'WWW::Mechanize';
17 | requires 'HTML::TreeBuilder::XPath';
18 | # SeleniumServer
19 | requires 'Selenium::Remote::Driver';
20 | requires 'Selenium::Server';
21 | requires 'File::Slurp';
22 | requires 'MIME::Base64';
23 | 
24 | tests 't/*.t t/*/*.t t/*/mechanize/*.t';
25 | test_requires 'Test::More' => 0.98;
26 | test_requires 'Test::UseAllModules';
27 | test_requires 'Test::Fake::HTTPD' => 0.03;
28 | test_requires 'Test::Mock::Guard';
29 | test_requires 'Test::Exception';
30 | test_requires 'File::Temp';
31 | test_requires 'URI::QueryParam';
32 | 
33 | recursive_author_tests 'xt';
34 | auto_set_repository;
35 | 
36 | WriteAll;
37 | 


--------------------------------------------------------------------------------
/t/driver/mechanize/pages.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Fake::HTTPD;
 5 | use Test::Exception;
 6 | use Brownie::Driver::Mechanize;
 7 | 
 8 | my $driver = Brownie::Driver::Mechanize->new;
 9 | 
10 | my $body = <<__HTTPD__;
11 | <html>
12 |   <head><title>test title</title></head>
13 |   <body>Hello Brownie</body>
14 | </html>
15 | __HTTPD__
16 | 
17 | my $httpd = Test::Fake::HTTPD->new(timeout => 30);
18 | $httpd->run(sub { [ 200, [ 'Content-Type' => 'text/html' ], [ $body ] ] });
19 | 
20 | subtest 'Pages' => sub {
21 |     $driver->visit($httpd->endpoint);
22 | 
23 |     subtest 'title' => sub {
24 |         is $driver->title => 'test title';
25 |     };
26 | 
27 |     subtest 'source' => sub {
28 |         my $data = $driver->source;
29 |         like $data => qr!<html>!s;
30 |         like $data => qr!</html>!s;
31 |         like $data => qr!Hello Brownie!;
32 |     };
33 | 
34 |     subtest 'screenshot' => sub {
35 |         dies_ok { $driver->screenshot };
36 |     };
37 | };
38 | 
39 | 
40 | done_testing;
41 | 


--------------------------------------------------------------------------------
/t/session/create_server.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | use File::Temp;
 6 | 
 7 | subtest 'spawn PSGI from app sub' => sub {
 8 |     my $app = sub { [ 201, [ 'Content-Type' => 'text/html' ], [ 'Created' ] ] };
 9 | 
10 |     my $bs = Brownie::Session->new(app => $app);
11 |     ok $bs->app_host;
12 |     like $bs->app_host => qr/localhost/;
13 | 
14 |     $bs->visit('/');
15 |     is $bs->current_url => $bs->app_host . '/';
16 |     is $bs->status_code => 201;
17 |     is $bs->body        => 'Created';
18 | };
19 | 
20 | subtest 'spawn PSGI from file' => sub {
21 |     my $fh = File::Temp->new(UNLINK => 1);
22 |     print $fh "sub { [ 202, [ 'Content-Type' => 'text/html' ], [ 'Accepted' ] ] };";
23 |     close $fh;
24 | 
25 |     my $bs = Brownie::Session->new(app => $fh->filename);
26 |     ok $bs->app_host;
27 |     like $bs->app_host => qr/localhost/;
28 | 
29 |     $bs->visit('/');
30 |     is $bs->current_url => $bs->app_host . '/';
31 |     is $bs->status_code => 202;
32 |     is $bs->body        => 'Accepted';
33 | };
34 | 
35 | done_testing;
36 | 


--------------------------------------------------------------------------------
/Changes:
--------------------------------------------------------------------------------
 1 | Revision history for Perl extension Brownie
 2 | 
 3 | 0.09
 4 |         - use Selenium::Server, instead of Align::SeleniumRC (ikasam_a)
 5 |         - experimental Brownie::DSL (Cside)
 6 |         - can use external selenium server permanently (Cside)
 7 | 
 8 | 0.08
 9 |         - support Selenium RemoteWebDriver (selenium-server) driver
10 |         - fixed syntax error on Session.pm
11 | 
12 | 0.07
13 |         - added missing dependency
14 | 
15 | 0.06
16 |         - remove Selenium (Remote / Selenium-Server) driver
17 |         - support Mechanize driver
18 |         - support local app w/ Plack::Runner
19 | 
20 | 0.05
21 |         - does not call clear() if file attachment field
22 |         - support input[not(@type)] as text field
23 | 
24 | 0.04
25 |         - added status_code() and response_headers() to driver I/F
26 |         - tests based on shared examples
27 | 
28 | 0.03
29 |         - refresh current_node every time
30 | 
31 | 0.02
32 |         - add eg/google.pl
33 |         - joining XPath
34 |         - use selenium driver native find_element()
35 | 
36 | 0.01
37 |         - original version
38 |         - implements selenium driver
39 | 


--------------------------------------------------------------------------------
/t/driver/mechanize/navigation.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Fake::HTTPD;
 5 | use Test::Exception;
 6 | use Brownie::Driver::Mechanize;
 7 | 
 8 | my $driver = Brownie::Driver::Mechanize->new;
 9 | 
10 | my $body = <<__HTTPD__;
11 | <html><body>ok</body></html>
12 | __HTTPD__
13 | 
14 | my $httpd = Test::Fake::HTTPD->new(timeout => 30);
15 | $httpd->run(sub { [ 200, [ 'Content-Type' => 'text/html' ], [ $body ] ] });
16 | 
17 | my $base_url  = $httpd->endpoint;
18 | my $other_url = $base_url->clone;
19 | $other_url->path('/foo/bar');
20 | 
21 | subtest 'Navigation' => sub {
22 |     subtest 'visit' => sub {
23 |         lives_ok { $driver->visit($base_url) };
24 |     };
25 | 
26 |     subtest 'current_url' => sub {
27 |         for my $url ($base_url, $other_url) {
28 |             $driver->visit($url);
29 |             is $driver->current_url => $url;
30 |         }
31 |     };
32 | 
33 |     subtest 'current_path' => sub {
34 |         for my $url ($base_url, $other_url) {
35 |             $driver->visit($url);
36 |             is $driver->current_path => $url->path;
37 |         }
38 |     };
39 | };
40 | 
41 | done_testing;
42 | 


--------------------------------------------------------------------------------
/t/driver/selenium_server/navigation.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Fake::HTTPD;
 5 | use Test::Exception;
 6 | use Brownie::Driver::SeleniumServer;
 7 | 
 8 | my $driver = Brownie::Driver::SeleniumServer->new;
 9 | 
10 | my $body = <<__HTTPD__;
11 | <html><body>ok</body></html>
12 | __HTTPD__
13 | 
14 | my $httpd = Test::Fake::HTTPD->new(timeout => 30);
15 | $httpd->run(sub { [ 200, [ 'Content-Type' => 'text/html' ], [ $body ] ] });
16 | 
17 | my $base_url  = $httpd->endpoint;
18 | 
19 | subtest 'Navigation' => sub {
20 |     my @path = qw(
21 |         /foo/bar
22 |         /baz/quux
23 |     );
24 | 
25 |     subtest 'visit' => sub {
26 |         lives_ok { $driver->visit($base_url) };
27 |     };
28 | 
29 |     subtest 'current_url' => sub {
30 |         for my $path (@path) {
31 |             my $url = $base_url . $path;
32 |             $driver->visit($url);
33 |             is $driver->current_url => $url;
34 |         }
35 |     };
36 | 
37 |     subtest 'current_path' => sub {
38 |         for my $path (@path) {
39 |             my $url = $base_url . $path;
40 |             $driver->visit($url);
41 |             is $driver->current_path => $path;
42 |         }
43 |     };
44 | };
45 | 
46 | done_testing;
47 | 


--------------------------------------------------------------------------------
/t/driver/selenium_server/pages.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Fake::HTTPD;
 5 | use Test::Exception;
 6 | use File::Temp;
 7 | use Brownie::Driver::SeleniumServer;
 8 | 
 9 | my $driver = Brownie::Driver::SeleniumServer->new;
10 | 
11 | my $body = <<__HTTPD__;
12 | <html>
13 |   <head><title>test title</title></head>
14 |   <body>Hello Brownie</body>
15 | </html>
16 | __HTTPD__
17 | 
18 | my $httpd = Test::Fake::HTTPD->new(timeout => 30);
19 | $httpd->run(sub { [ 200, [ 'Content-Type' => 'text/html' ], [ $body ] ] });
20 | 
21 | subtest 'Pages' => sub {
22 |     $driver->visit($httpd->endpoint);
23 | 
24 |     subtest 'title' => sub {
25 |         is $driver->title => 'test title';
26 |     };
27 | 
28 |     subtest 'source' => sub {
29 |         my $data = $driver->source;
30 |         like $data => qr!<html!s;
31 |         like $data => qr!</html>!s;
32 |         like $data => qr!Hello Brownie!;
33 |     };
34 | 
35 |     subtest 'screenshot' => sub {
36 |         my $path = File::Temp->new(UNLINK => 1, suffix => '.png')->filename;
37 |         ok ! -e $path;
38 | 
39 |         $driver->screenshot($path);
40 |         ok -e $path && -s _ && -B _;
41 | 
42 |         unlink $path;
43 |     };
44 | };
45 | 
46 | 
47 | done_testing;
48 | 


--------------------------------------------------------------------------------
/t/dsl.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Mock::Guard;
 5 | use Brownie::DSL;
 6 | 
 7 | sub reset_test {
 8 |     Brownie->reset_sessions;
 9 |     $Brownie::Driver  = 'Mechanize';
10 |     $Brownie::AppHost = undef;
11 | }
12 | 
13 | my $guard = mock_guard('Brownie::Driver::SeleniumServer', +{
14 |     new => sub { bless +{}, shift },
15 | });
16 | 
17 | subtest 'DSL methods' => sub {
18 |     for my $method (@Brownie::DSL::DslMethods) {
19 |         can_ok __PACKAGE__, $method;
20 |     }
21 | };
22 | 
23 | subtest 'page is a Brownie::Session object' => sub {
24 |     isa_ok page, 'Brownie::Session';
25 |     reset_test;
26 | };
27 | 
28 | subtest 'driver' => sub {
29 |     isa_ok page->driver, 'Brownie::Driver::Mechanize';
30 |     reset_test;
31 | 
32 |     Brownie->driver('SeleniumServer');
33 |     isa_ok page->driver, 'Brownie::Driver::SeleniumServer';
34 |     reset_test;
35 | };
36 | 
37 | subtest 'app host' => sub {
38 |     ok ! page->app_host;
39 |     reset_test;
40 | 
41 |     Brownie->app_host('http://example.com');
42 |     is page->app_host, 'http://example.com';
43 |     reset_test;
44 | };
45 | 
46 | subtest 'app' => sub {
47 |     ok ! page->server;
48 |     reset_test;
49 | 
50 |     Brownie->app(sub { [ 200, [ 'Content-Type' => 'text/html' ], [ 'App' ] ] });
51 |     ok page->server;
52 |     reset_test;
53 | };
54 | 
55 | done_testing;
56 | 


--------------------------------------------------------------------------------
/t/session/mechanize/attach_file.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | use File::Spec;
 6 | 
 7 | my $app = sub {
 8 |     my $body = <<__HTTPD__;
 9 | <html>
10 |   <head>
11 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
12 |     <title>test</title>
13 |   </head>
14 |   <body>
15 |     <form action="/form" method="get">
16 |       <input type="submit" id="submit" name="submit" value="submit"/>
17 | 
18 |       <p>
19 |         <label for="file1">File1 Label</label>
20 |         <input type="file" id="file1" name="file1" value=""/>
21 |       </p>
22 |       <p>
23 |         <label>File2 Label<input type="file" id="file2" name="file2" value=""/></label>
24 |       </p>
25 |     </form>
26 |   </body>
27 | </html>
28 | __HTTPD__
29 | 
30 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
31 | };
32 | 
33 | my $bs = Brownie::Session->new(driver => 'Mechanize', app => $app);
34 | 
35 | subtest 'attach_file' => sub {
36 |     my $file_path = File::Spec->rel2abs($0);
37 | 
38 |     for (
39 |         ['file1',       'file1'],
40 |         ['File1 Label', 'file1'],
41 |         ['File2 Label', 'file2'],
42 |     ) {
43 |         my ($locator, $id) = @$_;
44 |         $bs->visit('/');
45 | 
46 |         ok $bs->attach_file($locator, $file_path);
47 |         # XXX: should check whether file is uploaded
48 |     }
49 | };
50 | 
51 | done_testing;
52 | 


--------------------------------------------------------------------------------
/t/session/selenium_server/attach_file.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | use File::Spec;
 6 | 
 7 | my $app = sub {
 8 |     my $body = <<__HTTPD__;
 9 | <html>
10 |   <head>
11 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
12 |     <title>test</title>
13 |   </head>
14 |   <body>
15 |     <form action="/form" method="get">
16 |       <input type="submit" id="submit" name="submit" value="submit"/>
17 | 
18 |       <p>
19 |         <label for="file1">File1 Label</label>
20 |         <input type="file" id="file1" name="file1" value=""/>
21 |       </p>
22 |       <p>
23 |         <label>File2 Label<input type="file" id="file2" name="file2" value=""/></label>
24 |       </p>
25 |     </form>
26 |   </body>
27 | </html>
28 | __HTTPD__
29 | 
30 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
31 | };
32 | 
33 | my $bs = Brownie::Session->new(driver => 'Mechanize', app => $app);
34 | 
35 | subtest 'attach_file' => sub {
36 |     my $file_path = File::Spec->rel2abs($0);
37 | 
38 |     for (
39 |         ['file1',       'file1'],
40 |         ['File1 Label', 'file1'],
41 |         ['File2 Label', 'file2'],
42 |     ) {
43 |         my ($locator, $id) = @$_;
44 |         $bs->visit('/');
45 | 
46 |         ok $bs->attach_file($locator, $file_path);
47 |         # XXX: should check whether file is uploaded
48 |     }
49 | };
50 | 
51 | done_testing;
52 | 


--------------------------------------------------------------------------------
/t/node/mechanize/accessor.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Fake::HTTPD;
 5 | use Test::Exception;
 6 | use Brownie::Driver::Mechanize;
 7 | use Brownie::Node::Mechanize;
 8 | 
 9 | my $driver = Brownie::Driver::Mechanize->new;
10 | 
11 | my $body = <<__HTTPD__;
12 | <html>
13 |   <head><title>test title</title></head>
14 |   <body>
15 |     <h1 id="title" title="heading">Heading 1</h1>
16 |     <form>
17 |       <input type="text" name="text" id="text" value="text value"/>
18 |     </form>
19 |   </body>
20 | </html>
21 | __HTTPD__
22 | 
23 | my $httpd = Test::Fake::HTTPD->new(timeout => 30);
24 | $httpd->run(sub { [ 200, [ 'Content-Type' => 'text/html; charset=utf-8' ], [ $body ] ] });
25 | 
26 | my $base_url = $httpd->endpoint;
27 | 
28 | subtest 'Accessor' => sub {
29 |     $driver->visit($base_url);
30 |     my $doc = $driver->find('/html');
31 | 
32 |     subtest 'text element' => sub {
33 |         my $elem = $doc->find('h1');
34 | 
35 |         is $elem->tag_name      => 'h1';
36 |         is $elem->text          => 'Heading 1';
37 |         is $elem->id            => 'title';
38 |         is $elem->attr('title') => 'heading';
39 |     };
40 | 
41 |     subtest 'control element' => sub {
42 |         my $elem = $doc->find('#text');
43 | 
44 |         is $elem->tag_name => 'input';
45 |         is $elem->id       => 'text';
46 |         is $elem->type     => 'text';
47 |         is $elem->name     => 'text';
48 |         is $elem->value    => 'text value';
49 |     };
50 | };
51 | 
52 | done_testing;
53 | 


--------------------------------------------------------------------------------
/t/node/selenium_server/accessor.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Fake::HTTPD;
 5 | use Test::Exception;
 6 | use Brownie::Driver::SeleniumServer;
 7 | use Brownie::Node::SeleniumServer;
 8 | 
 9 | my $driver = Brownie::Driver::SeleniumServer->new;
10 | 
11 | my $body = <<__HTTPD__;
12 | <html>
13 |   <head><title>test title</title></head>
14 |   <body>
15 |     <h1 id="title" title="heading">Heading 1</h1>
16 |     <form>
17 |       <input type="text" name="text" id="text" value="text value"/>
18 |     </form>
19 |   </body>
20 | </html>
21 | __HTTPD__
22 | 
23 | my $httpd = Test::Fake::HTTPD->new(timeout => 30);
24 | $httpd->run(sub { [ 200, [ 'Content-Type' => 'text/html; charset=utf-8' ], [ $body ] ] });
25 | 
26 | my $base_url = $httpd->endpoint;
27 | 
28 | subtest 'Accessor' => sub {
29 |     $driver->visit($base_url);
30 |     my $doc = $driver->find('/html');
31 | 
32 |     subtest 'text element' => sub {
33 |         my $elem = $doc->find('h1');
34 | 
35 |         is $elem->tag_name      => 'h1';
36 |         is $elem->text          => 'Heading 1';
37 |         is $elem->id            => 'title';
38 |         is $elem->attr('title') => 'heading';
39 |     };
40 | 
41 |     subtest 'control element' => sub {
42 |         my $elem = $doc->find('#text');
43 | 
44 |         is $elem->tag_name => 'input';
45 |         is $elem->id       => 'text';
46 |         is $elem->type     => 'text';
47 |         is $elem->name     => 'text';
48 |         is $elem->value    => 'text value';
49 |     };
50 | };
51 | 
52 | done_testing;
53 | 


--------------------------------------------------------------------------------
/t/session/mechanize/click_link.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | 
 6 | my $app = sub {
 7 |     my $body = <<__HTTPD__;
 8 | <html>
 9 |   <head>
10 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
11 |     <title>test</title>
12 |   </head>
13 |   <body>
14 |     <p id="navigation">
15 |       <a href="/id" id="link_id">Link</a>
16 |       <a href="/xpath">Link</a>
17 |       <a href="/text">Text of Link</a>
18 |       <a href="/title" title="Title of Link">Link</a>
19 |       <a href="/img/alt"><img src="" alt="Alt of Image"/></a>
20 |     </p>
21 |   </body>
22 | </html>
23 | __HTTPD__
24 | 
25 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
26 | };
27 | 
28 | my $bs = Brownie::Session->new(driver => 'Mechanize', app => $app);
29 | 
30 | my @endpoints = (
31 |     ['link_id',       '/id'],
32 |     ['Text of Link',  '/text'],
33 |     ['Title of Link', '/title'],
34 |     ['Alt of Image',  '/img/alt'],
35 | );
36 | 
37 | subtest 'click_link' => sub {
38 |     for (@endpoints) {
39 |         my ($locator, $path) = @$_;
40 |         $bs->visit('/');
41 | 
42 |         is $bs->current_path => '/';
43 |         ok $bs->click_link($locator);
44 |         is $bs->current_path => $path;
45 |     }
46 | };
47 | 
48 | subtest 'click_link_or_button' => sub {
49 |     for (@endpoints) {
50 |         my ($locator, $path) = @$_;
51 |         $bs->visit('/');
52 | 
53 |         is $bs->current_path => '/';
54 |         ok $bs->click_link_or_button($locator);
55 |         is $bs->current_path => $path;
56 |     }
57 | };
58 | 
59 | done_testing;
60 | 


--------------------------------------------------------------------------------
/t/session/selenium_server/click_link.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | 
 6 | my $app = sub {
 7 |     my $body = <<__HTTPD__;
 8 | <html>
 9 |   <head>
10 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
11 |     <title>test</title>
12 |   </head>
13 |   <body>
14 |     <p id="navigation">
15 |       <a href="/id" id="link_id">Link</a>
16 |       <a href="/xpath">Link</a>
17 |       <a href="/text">Text of Link</a>
18 |       <a href="/title" title="Title of Link">Link</a>
19 |       <a href="/img/alt"><img src="" alt="Alt of Image"/></a>
20 |     </p>
21 |   </body>
22 | </html>
23 | __HTTPD__
24 | 
25 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
26 | };
27 | 
28 | my $bs = Brownie::Session->new(driver => 'SeleniumServer', app => $app);
29 | 
30 | my @endpoints = (
31 |     ['link_id',       '/id'],
32 |     ['Text of Link',  '/text'],
33 |     ['Title of Link', '/title'],
34 |     ['Alt of Image',  '/img/alt'],
35 | );
36 | 
37 | subtest 'click_link' => sub {
38 |     for (@endpoints) {
39 |         my ($locator, $path) = @$_;
40 |         $bs->visit('/');
41 | 
42 |         is $bs->current_path => '/';
43 |         ok $bs->click_link($locator);
44 |         is $bs->current_path => $path;
45 |     }
46 | };
47 | 
48 | subtest 'click_link_or_button' => sub {
49 |     for (@endpoints) {
50 |         my ($locator, $path) = @$_;
51 |         $bs->visit('/');
52 | 
53 |         is $bs->current_path => '/';
54 |         ok $bs->click_link_or_button($locator);
55 |         is $bs->current_path => $path;
56 |     }
57 | };
58 | 
59 | done_testing;
60 | 


--------------------------------------------------------------------------------
/t/node/mechanize/state.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Fake::HTTPD;
 5 | use Test::Exception;
 6 | use Brownie::Driver::Mechanize;
 7 | use Brownie::Node::Mechanize;
 8 | 
 9 | my $driver = Brownie::Driver::Mechanize->new;
10 | 
11 | my $body = <<__HTTPD__;
12 | <html>
13 |   <head>
14 |     <title>test title</title>
15 |   </head>
16 |   <body>
17 |     <script type="text/javascript">var num = 1 + 1;</script>
18 |     <h1>Heading 1</h1>
19 |     <form>
20 |       <input type="hidden" name="hidden" id="hidden" value="value"/>
21 | 
22 |       <input type="checkbox" name="check" id="check1" value="check1" checked="checked"/>
23 |       <input type="checkbox" name="check" id="check2" value="check2"/>
24 | 
25 |       <input type="radio" name="radio" id="radio1" value="radio1" checked="checked"/>
26 |       <input type="radio" name="radio" id="radio2" value="radio2"/>
27 |    </form>
28 |   </body>
29 | </html>
30 | __HTTPD__
31 | 
32 | my $httpd = Test::Fake::HTTPD->new(timeout => 30);
33 | $httpd->run(sub { [ 200, [ 'Content-Type' => 'text/html; charset=utf-8' ], [ $body ] ] });
34 | 
35 | my $base_url = $httpd->endpoint;
36 | 
37 | subtest 'State' => sub {
38 |     $driver->visit($base_url);
39 |     my $doc = $driver->find('/html');
40 | 
41 |     subtest 'visibility' => sub {
42 |         ok $doc->find('h1')->is_displayed;
43 | 
44 |         ok $doc->find('head')->is_not_displayed;
45 |         ok $doc->find('script')->is_not_displayed;
46 |         ok $doc->find('#hidden')->is_not_displayed;
47 |     };
48 | 
49 |     subtest 'selection' => sub {
50 |         ok $doc->find('#check1')->is_checked;
51 |         ok $doc->find('#radio1')->is_checked;
52 | 
53 |         ok $doc->find('#check2')->is_not_checked;
54 |         ok $doc->find('#radio2')->is_not_checked;
55 |     };
56 | };
57 | 
58 | done_testing;
59 | 


--------------------------------------------------------------------------------
/t/node/selenium_server/state.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Fake::HTTPD;
 5 | use Test::Exception;
 6 | use Brownie::Driver::SeleniumServer;
 7 | use Brownie::Node::SeleniumServer;
 8 | 
 9 | my $driver = Brownie::Driver::SeleniumServer->new;
10 | 
11 | my $body = <<__HTTPD__;
12 | <html>
13 |   <head>
14 |     <title>test title</title>
15 |   </head>
16 |   <body>
17 |     <script type="text/javascript">var num = 1 + 1;</script>
18 |     <h1>Heading 1</h1>
19 |     <form>
20 |       <input type="hidden" name="hidden" id="hidden" value="value"/>
21 | 
22 |       <input type="checkbox" name="check" id="check1" value="check1" checked="checked"/>
23 |       <input type="checkbox" name="check" id="check2" value="check2"/>
24 | 
25 |       <input type="radio" name="radio" id="radio1" value="radio1" checked="checked"/>
26 |       <input type="radio" name="radio" id="radio2" value="radio2"/>
27 |    </form>
28 |   </body>
29 | </html>
30 | __HTTPD__
31 | 
32 | my $httpd = Test::Fake::HTTPD->new(timeout => 30);
33 | $httpd->run(sub { [ 200, [ 'Content-Type' => 'text/html; charset=utf-8' ], [ $body ] ] });
34 | 
35 | my $base_url = $httpd->endpoint;
36 | 
37 | subtest 'State' => sub {
38 |     $driver->visit($base_url);
39 |     my $doc = $driver->find('/html');
40 | 
41 |     subtest 'visibility' => sub {
42 |         ok $doc->find('h1')->is_displayed;
43 | 
44 |         ok $doc->find('head')->is_not_displayed;
45 |         ok $doc->find('script')->is_not_displayed;
46 |         ok $doc->find('#hidden')->is_not_displayed;
47 |     };
48 | 
49 |     subtest 'selection' => sub {
50 |         ok $doc->find('#check1')->is_checked;
51 |         ok $doc->find('#radio1')->is_checked;
52 | 
53 |         ok $doc->find('#check2')->is_not_checked;
54 |         ok $doc->find('#radio2')->is_not_checked;
55 |     };
56 | };
57 | 
58 | done_testing;
59 | 


--------------------------------------------------------------------------------
/t/session/mechanize/choose.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | use URI::QueryParam;
 6 | 
 7 | my $app = sub {
 8 |     my $body = <<__HTTPD__;
 9 | <html>
10 |   <head>
11 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
12 |     <title>test</title>
13 |   </head>
14 |   <body>
15 |     <form action="/form" method="get">
16 |       <input type="submit" id="submit" name="submit" value="submit"/>
17 | 
18 |       <p>
19 |         <input type="radio" id="radio1" name="radio" value="Radio1 Value"/>
20 |         <label for="radio1">Radio1 Label</label>
21 |       </p>
22 |       <p>
23 |         <label>
24 |           <input type="radio" id="radio2" name="radio" value="Radio2 Value" checked="checked"/>
25 |           Radio2 Label
26 |         </label>
27 |       </p>
28 |       <p>
29 |         <label>
30 |           <input type="radio" id="radio3" name="radio" value="Radio3 Value"/>
31 |           Radio3 Label
32 |         </label>
33 |       </p>
34 |     </form>
35 |   </body>
36 | </html>
37 | __HTTPD__
38 | 
39 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
40 | };
41 | 
42 | my $bs = Brownie::Session->new(driver => 'Mechanize', app => $app);
43 | 
44 | subtest 'choose' => sub {
45 |     for (
46 |         [ 'Radio1 Value' => [ 'radio1', 'Radio1 Label', 'Radio1 Value' ] ],
47 |         [ 'Radio2 Value' => [ 'radio2', 'Radio2 Label', 'Radio2 Value' ] ],
48 |         [ 'Radio3 Value' => [ 'radio3', 'Radio3 Label', 'Radio3 Value' ] ],
49 |     ) {
50 |         my ($value, $locators) = @$_;
51 | 
52 |         for my $locator (@$locators) {
53 |             $bs->visit('/');
54 | 
55 |             ok $bs->choose($locator);
56 |             $bs->click_button('submit');
57 |             is $bs->current_url->query_param('radio') => $value;
58 |         }
59 |     }
60 | };
61 | 
62 | done_testing;
63 | 


--------------------------------------------------------------------------------
/t/session/selenium_server/choose.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | use URI::QueryParam;
 6 | 
 7 | my $app = sub {
 8 |     my $body = <<__HTTPD__;
 9 | <html>
10 |   <head>
11 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
12 |     <title>test</title>
13 |   </head>
14 |   <body>
15 |     <form action="/form" method="get">
16 |       <input type="submit" id="submit" name="submit" value="submit"/>
17 | 
18 |       <p>
19 |         <input type="radio" id="radio1" name="radio" value="Radio1 Value"/>
20 |         <label for="radio1">Radio1 Label</label>
21 |       </p>
22 |       <p>
23 |         <label>
24 |           <input type="radio" id="radio2" name="radio" value="Radio2 Value" checked="checked"/>
25 |           Radio2 Label
26 |         </label>
27 |       </p>
28 |       <p>
29 |         <label>
30 |           <input type="radio" id="radio3" name="radio" value="Radio3 Value"/>
31 |           Radio3 Label
32 |         </label>
33 |       </p>
34 |     </form>
35 |   </body>
36 | </html>
37 | __HTTPD__
38 | 
39 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
40 | };
41 | 
42 | my $bs = Brownie::Session->new(driver => 'SeleniumServer', app => $app);
43 | 
44 | subtest 'choose' => sub {
45 |     for (
46 |         [ 'Radio1 Value' => [ 'radio1', 'Radio1 Label', 'Radio1 Value' ] ],
47 |         [ 'Radio2 Value' => [ 'radio2', 'Radio2 Label', 'Radio2 Value' ] ],
48 |         [ 'Radio3 Value' => [ 'radio3', 'Radio3 Label', 'Radio3 Value' ] ],
49 |     ) {
50 |         my ($value, $locators) = @$_;
51 | 
52 |         for my $locator (@$locators) {
53 |             $bs->visit('/');
54 | 
55 |             ok $bs->choose($locator);
56 |             $bs->click_button('submit');
57 |             is $bs->current_url->query_param('radio') => $value;
58 |         }
59 |     }
60 | };
61 | 
62 | done_testing;
63 | 


--------------------------------------------------------------------------------
/t/session/mechanize/click_button.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | 
 6 | my $app = sub {
 7 |     my $body = <<__HTTPD__;
 8 | <html>
 9 |   <head>
10 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
11 |     <title>test</title>
12 |   </head>
13 |   <body>
14 |     <form action="/form" method="get">
15 |       <input type="submit" id="input_submit" title="Input Submit Title" value="Input Submit Value"/>
16 |       <input type="image" id="input_image" title="Input Image Title" alt="Input Image Alt" value="Input Image Value"/>
17 |       <button type="submit" id="button_submit" title="Button Submit Title" value="Button Submit Value">Button Submit</button>
18 |       <input type="button" id="input_button" title="Input Button Title" value="Input Button Value" onclick="javascript:location.href='/js'"/>
19 |       <button type="button" id="button_button" title="Button Button Title" value="Button Button Value" onclick="javascript:location.href='/js'">Button Button</button>
20 |     </form>
21 |   </body>
22 | </html>
23 | __HTTPD__
24 | 
25 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
26 | };
27 | 
28 | my $bs = Brownie::Session->new(driver => 'Mechanize', app => $app);
29 | 
30 | my @buttons = (
31 |     'input_submit',
32 |     'Input Submit Title',
33 |     'Input Submit Value',
34 |     'button_submit',
35 |     'Button Submit Title',
36 |     'Button Submit Value',
37 |     'Button Submit',
38 | );
39 | 
40 | subtest 'click_button' => sub {
41 |     for my $locator (@buttons) {
42 |         $bs->visit('/');
43 | 
44 |         is $bs->current_path => '/';
45 |         ok $bs->click_button($locator);
46 |         is $bs->current_path => '/form';
47 |     }
48 | };
49 | 
50 | subtest 'click_button' => sub {
51 |     for my $locator (@buttons) {
52 |         $bs->visit('/');
53 | 
54 |         is $bs->current_path => '/';
55 |         ok $bs->click_link_or_button($locator);
56 |         is $bs->current_path => '/form';
57 |     }
58 | };
59 | 
60 | done_testing;
61 | 


--------------------------------------------------------------------------------
/t/session/selenium_server/click_button.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | 
 6 | my $app = sub {
 7 |     my $body = <<__HTTPD__;
 8 | <html>
 9 |   <head>
10 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
11 |     <title>test</title>
12 |   </head>
13 |   <body>
14 |     <form action="/form" method="get">
15 |       <input type="submit" id="input_submit" title="Input Submit Title" value="Input Submit Value"/>
16 |       <input type="image" id="input_image" title="Input Image Title" alt="Input Image Alt" value="Input Image Value"/>
17 |       <button type="submit" id="button_submit" title="Button Submit Title" value="Button Submit Value">Button Submit</button>
18 |       <input type="button" id="input_button" title="Input Button Title" value="Input Button Value" onclick="javascript:location.href='/js'"/>
19 |       <button type="button" id="button_button" title="Button Button Title" value="Button Button Value" onclick="javascript:location.href='/js'">Button Button</button>
20 |     </form>
21 |   </body>
22 | </html>
23 | __HTTPD__
24 | 
25 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
26 | };
27 | 
28 | my $bs = Brownie::Session->new(driver => 'SeleniumServer', app => $app);
29 | 
30 | my @buttons = (
31 |     'input_submit',
32 |     'Input Submit Title',
33 |     'Input Submit Value',
34 |     'button_submit',
35 |     'Button Submit Title',
36 |     'Button Submit Value',
37 |     'Button Submit',
38 | );
39 | 
40 | subtest 'click_button' => sub {
41 |     for my $locator (@buttons) {
42 |         $bs->visit('/');
43 | 
44 |         is $bs->current_path => '/';
45 |         ok $bs->click_button($locator);
46 |         is $bs->current_path => '/form';
47 |     }
48 | };
49 | 
50 | subtest 'click_button' => sub {
51 |     for my $locator (@buttons) {
52 |         $bs->visit('/');
53 | 
54 |         is $bs->current_path => '/';
55 |         ok $bs->click_link_or_button($locator);
56 |         is $bs->current_path => '/form';
57 |     }
58 | };
59 | 
60 | done_testing;
61 | 


--------------------------------------------------------------------------------
/t/session/mechanize/fill_in.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | 
 6 | my $app = sub {
 7 |     my $body = <<__HTTPD__;
 8 | <html>
 9 |   <head>
10 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
11 |     <title>test</title>
12 |   </head>
13 |   <body>
14 |     <form action="/form" method="get">
15 |       <input type="submit" id="submit" name="submit" value="submit"/>
16 | 
17 |       <!-- text field -->
18 |       <p>
19 |         <label for="text1">Text1 Label</label>
20 |         <input type="text" id="text1" name="text1" value="Text1 Value" title="Text1 Title"/>
21 |         <label for="text2">Text2 Label</label>
22 |         <input             id="text2" name="text2" value="Text2 Value" />
23 |       </p>
24 |       <!-- textarea -->
25 |       <p>
26 |         <label for="textarea1">Textarea1 Label</label>
27 |         <textarea id="textarea1" name="textarea1">Textarea1 Text</textarea>
28 |         <label>Textarea2 Label<textarea id="textarea2" name="textarea2">Textarea2 Text</textarea></label>
29 |       </p>
30 |       <!-- password -->
31 |       <p>
32 |         <label for="password1">Password1 Label</label>
33 |         <input type="password" id="password1" name="password1" value=""/>
34 |       </p>
35 |       <!-- hidden -->
36 |       <input type="hidden" id="hidden1" name="hidden1" value="Hidden1 Value"/>
37 |     </form>
38 |   </body>
39 | </html>
40 | __HTTPD__
41 | 
42 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
43 | };
44 | 
45 | my $bs = Brownie::Session->new(driver => 'Mechanize', app => $app);
46 | 
47 | subtest 'fill_in' => sub {
48 |     for my $locator (
49 |         'text1',     'Text1 Label',     'Text1 Title',
50 |         'text2',     'Text2 Label',
51 |         'password1', 'Password1 Label',
52 |         'textarea1', 'Textarea1 Label',
53 |         'textarea2', 'Textarea2 Label',
54 |         'hidden1',
55 |     ) {
56 |         $bs->visit('/');
57 |         my $value = time . $$;
58 | 
59 |         unlike $bs->current_url => qr/$value/;
60 | 
61 |         ok $bs->fill_in($locator, $value);
62 |         $bs->click_button('submit');
63 | 
64 |         like $bs->current_url => qr/$value/;
65 |     }
66 | };
67 | 
68 | done_testing;
69 | 


--------------------------------------------------------------------------------
/t/session/selenium_server/fill_in.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | 
 6 | my $app = sub {
 7 |     my $body = <<__HTTPD__;
 8 | <html>
 9 |   <head>
10 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
11 |     <title>test</title>
12 |   </head>
13 |   <body>
14 |     <form action="/form" method="get">
15 |       <input type="submit" id="submit" name="submit" value="submit"/>
16 | 
17 |       <!-- text field -->
18 |       <p>
19 |         <label for="text1">Text1 Label</label>
20 |         <input type="text" id="text1" name="text1" value="Text1 Value" title="Text1 Title"/>
21 |         <label for="text2">Text2 Label</label>
22 |         <input             id="text2" name="text2" value="Text2 Value" />
23 |       </p>
24 |       <!-- textarea -->
25 |       <p>
26 |         <label for="textarea1">Textarea1 Label</label>
27 |         <textarea id="textarea1" name="textarea1">Textarea1 Text</textarea>
28 |         <label>Textarea2 Label<textarea id="textarea2" name="textarea2">Textarea2 Text</textarea></label>
29 |       </p>
30 |       <!-- password -->
31 |       <p>
32 |         <label for="password1">Password1 Label</label>
33 |         <input type="password" id="password1" name="password1" value=""/>
34 |       </p>
35 |       <!-- hidden -->
36 |       <input type="hidden" id="hidden1" name="hidden1" value="Hidden1 Value"/>
37 |     </form>
38 |   </body>
39 | </html>
40 | __HTTPD__
41 | 
42 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
43 | };
44 | 
45 | my $bs = Brownie::Session->new(driver => 'SeleniumServer', app => $app);
46 | 
47 | subtest 'fill_in' => sub {
48 |     for my $locator (
49 |         'text1',     'Text1 Label',     'Text1 Title',
50 |         'text2',     'Text2 Label',
51 |         'password1', 'Password1 Label',
52 |         'textarea1', 'Textarea1 Label',
53 |         'textarea2', 'Textarea2 Label',
54 |         # XXX: selenium can not interact hidden element. 'hidden1',
55 |     ) {
56 |         $bs->visit('/');
57 |         my $value = time . $$;
58 | 
59 |         unlike $bs->current_url => qr/$value/;
60 | 
61 |         ok $bs->fill_in($locator, $value);
62 |         $bs->click_button('submit');
63 | 
64 |         like $bs->current_url => qr/$value/;
65 |     }
66 | };
67 | 
68 | done_testing;
69 | 


--------------------------------------------------------------------------------
/t/session/mechanize/check.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | use URI::QueryParam;
 6 | 
 7 | my $app = sub {
 8 |     my $body = <<__HTTPD__;
 9 | <html>
10 |   <head>
11 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
12 |     <title>test</title>
13 |   </head>
14 |   <body>
15 |     <form action="/form" method="get">
16 |       <input type="submit" id="submit" name="submit" value="submit"/>
17 | 
18 |       <p>
19 |         <input type="checkbox" id="checkbox1" name="checkbox1" value="Checkbox1 Value" checked=""/>
20 |         <label for="checkbox1">Checkbox1 Label</label>
21 |       </p>
22 |       <p>
23 |         <label>
24 |           <input type="checkbox" id="checkbox2" name="checkbox2" value="Checkbox2 Value" checked=""/>
25 |           Checkbox2 Label
26 |         </label>
27 |       </p>
28 | 
29 |       <p>
30 |         <input type="checkbox" id="checkbox3" name="checkbox3" value="Checkbox3 Value" checked="checked"/>
31 |         <label for="checkbox3">Checkbox3 Label</label>
32 |       </p>
33 |       <p>
34 |         <label>
35 |           <input type="checkbox" id="checkbox4" name="checkbox4" value="Checkbox4 Value" checked="checked"/>
36 |           Checkbox4 Label
37 |         </label>
38 |       </p>
39 |     </form>
40 |   </body>
41 | </html>
42 | __HTTPD__
43 | 
44 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
45 | };
46 | 
47 | my $bs = Brownie::Session->new(driver => 'Mechanize', app => $app);
48 | 
49 | subtest 'check' => sub {
50 |     for (
51 |         [ checkbox1 => [ 'checkbox1', 'Checkbox1 Label', 'Checkbox1 Value' ] ],
52 |         [ checkbox2 => [ 'checkbox2', 'Checkbox2 Label', 'Checkbox2 Value' ] ],
53 |     ) {
54 |         my ($id, $locators) = @$_;
55 | 
56 |         for my $locator (@$locators) {
57 |             $bs->visit('/');
58 | 
59 |             ok $bs->check($locator);
60 |             $bs->click_button('submit');
61 |             ok $bs->current_url->query_param($id);
62 |         }
63 |     }
64 | };
65 | 
66 | subtest 'uncheck' => sub {
67 |     for (
68 |         [ checkbox3 => [ 'checkbox3', 'Checkbox3 Label', 'Checkbox3 Value' ] ],
69 |         [ checkbox4 => [ 'checkbox4', 'Checkbox4 Label', 'Checkbox4 Value' ] ],
70 |     ) {
71 |         my ($id, $locators) = @$_;
72 | 
73 |         for my $locator (@$locators) {
74 |             $bs->visit('/');
75 | 
76 |             ok $bs->uncheck($locator);
77 |             $bs->click_button('submit');
78 |             ok not $bs->current_url->query_param($id);
79 |         }
80 |     }
81 | };
82 | 
83 | done_testing;
84 | 


--------------------------------------------------------------------------------
/t/session/selenium_server/check.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | use URI::QueryParam;
 6 | 
 7 | my $app = sub {
 8 |     my $body = <<__HTTPD__;
 9 | <html>
10 |   <head>
11 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
12 |     <title>test</title>
13 |   </head>
14 |   <body>
15 |     <form action="/form" method="get">
16 |       <input type="submit" id="submit" name="submit" value="submit"/>
17 | 
18 |       <p>
19 |         <input type="checkbox" id="checkbox1" name="checkbox1" value="Checkbox1 Value" checked=""/>
20 |         <label for="checkbox1">Checkbox1 Label</label>
21 |       </p>
22 |       <p>
23 |         <label>
24 |           <input type="checkbox" id="checkbox2" name="checkbox2" value="Checkbox2 Value" checked=""/>
25 |           Checkbox2 Label
26 |         </label>
27 |       </p>
28 | 
29 |       <p>
30 |         <input type="checkbox" id="checkbox3" name="checkbox3" value="Checkbox3 Value" checked="checked"/>
31 |         <label for="checkbox3">Checkbox3 Label</label>
32 |       </p>
33 |       <p>
34 |         <label>
35 |           <input type="checkbox" id="checkbox4" name="checkbox4" value="Checkbox4 Value" checked="checked"/>
36 |           Checkbox4 Label
37 |         </label>
38 |       </p>
39 |     </form>
40 |   </body>
41 | </html>
42 | __HTTPD__
43 | 
44 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
45 | };
46 | 
47 | my $bs = Brownie::Session->new(driver => 'SeleniumServer', app => $app);
48 | 
49 | subtest 'check' => sub {
50 |     for (
51 |         [ checkbox1 => [ 'checkbox1', 'Checkbox1 Label', 'Checkbox1 Value' ] ],
52 |         [ checkbox2 => [ 'checkbox2', 'Checkbox2 Label', 'Checkbox2 Value' ] ],
53 |     ) {
54 |         my ($id, $locators) = @$_;
55 | 
56 |         for my $locator (@$locators) {
57 |             $bs->visit('/');
58 | 
59 |             ok $bs->check($locator);
60 |             $bs->click_button('submit');
61 |             ok $bs->current_url->query_param($id);
62 |         }
63 |     }
64 | };
65 | 
66 | subtest 'uncheck' => sub {
67 |     for (
68 |         [ checkbox3 => [ 'checkbox3', 'Checkbox3 Label', 'Checkbox3 Value' ] ],
69 |         [ checkbox4 => [ 'checkbox4', 'Checkbox4 Label', 'Checkbox4 Value' ] ],
70 |     ) {
71 |         my ($id, $locators) = @$_;
72 | 
73 |         for my $locator (@$locators) {
74 |             $bs->visit('/');
75 | 
76 |             ok $bs->uncheck($locator);
77 |             $bs->click_button('submit');
78 |             ok not $bs->current_url->query_param($id);
79 |         }
80 |     }
81 | };
82 | 
83 | done_testing;
84 | 


--------------------------------------------------------------------------------
/t/node/mechanize/finder.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Fake::HTTPD;
 5 | use Test::Exception;
 6 | use Brownie::Driver::Mechanize;
 7 | use Brownie::Node::Mechanize;
 8 | 
 9 | my $driver = Brownie::Driver::Mechanize->new;
10 | 
11 | my $body = <<__HTTPD__;
12 | <html>
13 |   <head><title>test title</title></head>
14 |   <body>
15 |     <ul>
16 |       <li>li 1</li>
17 |       <li class="even">li 2</li>
18 |       <li>li 3</li>
19 |       <li class="even">li 4</li>
20 |       <li>li 5</li>
21 |     </ul>
22 | 
23 |     <p>outer paragraph</p>
24 |     <div id="parent">
25 |       <p>inner paragraph</p>
26 |     </div>
27 |   </body>
28 | </html>
29 | __HTTPD__
30 | 
31 | my $httpd = Test::Fake::HTTPD->new(timeout => 30);
32 | $httpd->run(sub { [ 200, [ 'Content-Type' => 'text/html; charset=utf-8' ], [ $body ] ] });
33 | 
34 | my $base_url = $httpd->endpoint;
35 | 
36 | subtest 'Finder' => sub {
37 |     $driver->visit($base_url);
38 |     my $doc = $driver->find('/html');
39 | 
40 |     subtest 'using XPath' => sub {
41 |         subtest 'all' => sub {
42 |             is scalar($doc->all('//li'))                => 5;
43 |             is scalar($doc->all('//li[@class="even"]')) => 2;
44 | 
45 |             subtest 'empty when not exist locator' => sub {
46 |                 lives_ok {
47 |                     my @elems = $doc->all('//span[@class="noexist"]');
48 |                     is scalar(@elems) => 0;
49 |                 };
50 |             };
51 |         };
52 | 
53 |         subtest 'find' => sub {
54 |             is $doc->find('//li')->text                => 'li 1';
55 |             is $doc->find('//li[@class="even"]')->text => 'li 2';
56 | 
57 |             subtest 'child element' => sub {
58 |                 my $base = $doc->find('//div[@id="parent"]');
59 |                 my $child = $base->find('//p');
60 |                 is $child->text => 'inner paragraph';
61 |             };
62 |         };
63 |     };
64 | 
65 |     subtest 'using CSS Selector' => sub {
66 |         subtest 'all' => sub {
67 |             is scalar($doc->all('li'))      => 5;
68 |             is scalar($doc->all('li.even')) => 2;
69 | 
70 |             subtest 'empty when not exist locator' => sub {
71 |                 lives_ok {
72 |                     my @elems = $doc->all('span.noexist');
73 |                     is scalar(@elems) => 0;
74 |                 };
75 |             };
76 |         };
77 | 
78 |         subtest 'find' => sub {
79 |             is $doc->find('li')->text      => 'li 1';
80 |             is $doc->find('li.even')->text => 'li 2';
81 | 
82 |             subtest 'child element' => sub {
83 |                 my $base = $doc->find('#parent');
84 |                 my $child = $base->find('p');
85 |                 is $child->text => 'inner paragraph';
86 |             };
87 |         };
88 |     };
89 | };
90 | 
91 | done_testing;
92 | 


--------------------------------------------------------------------------------
/lib/Brownie/Node/SeleniumServer.pm:
--------------------------------------------------------------------------------
  1 | package Brownie::Node::SeleniumServer;
  2 | 
  3 | use strict;
  4 | use warnings;
  5 | use parent 'Brownie::Node';
  6 | 
  7 | sub attr {
  8 |     my ($self, $name) = @_;
  9 |     return $self->native->get_attribute($name);
 10 | }
 11 | 
 12 | sub value {
 13 |     my $self = shift;
 14 |     return $self->native->get_value;
 15 | }
 16 | 
 17 | sub text {
 18 |     my $self = shift;
 19 |     return $self->native->get_text;
 20 | }
 21 | 
 22 | sub tag_name {
 23 |     my $self = shift;
 24 |     return lc $self->native->get_tag_name;
 25 | }
 26 | 
 27 | sub is_displayed {
 28 |     my $self = shift;
 29 |     return $self->native->is_displayed;
 30 | }
 31 | 
 32 | sub is_selected {
 33 |     my $self = shift;
 34 |     return $self->native->is_selected;
 35 | }
 36 | 
 37 | sub is_checked {
 38 |     my $self = shift;
 39 |     return $self->native->is_selected;
 40 | }
 41 | 
 42 | sub set {
 43 |     my ($self, $value) = @_;
 44 | 
 45 |     if ($self->tag_name eq 'input' and $self->type =~ /(?:checkbox|radio)/) {
 46 |         $self->select;
 47 |     }
 48 |     elsif ($self->tag_name eq 'input' or $self->tag_name eq 'textarea') {
 49 |         $self->native->clear if $self->type ne 'file';
 50 |         $self->native->send_keys($value);
 51 |     }
 52 | }
 53 | 
 54 | sub select {
 55 |     my $self = shift;
 56 |     $self->click unless $self->is_selected;
 57 | }
 58 | 
 59 | sub unselect {
 60 |     my $self = shift;
 61 |     # TODO: check if multiple select options
 62 |     $self->click if $self->is_selected;
 63 | }
 64 | 
 65 | sub click {
 66 |     my $self = shift;
 67 |     $self->native->click;
 68 | }
 69 | 
 70 | 1;
 71 | 
 72 | =head1 NAME
 73 | 
 74 | Brownie::Node::SeleniumServer
 75 | 
 76 | =head1 METHODS
 77 | 
 78 | =over 4
 79 | 
 80 | =item * C<new(%args)>
 81 | 
 82 | =item * C<driver>
 83 | 
 84 | =item * C<native>
 85 | 
 86 | =item * C<attr($name)>
 87 | 
 88 | =item * C<id>
 89 | 
 90 | =item * C<name>
 91 | 
 92 | =item * C<type>
 93 | 
 94 | =item * C<value>
 95 | 
 96 | =item * C<text>
 97 | 
 98 | =item * C<tag_name>
 99 | 
100 | =item * C<is_displayed>
101 | 
102 | =item * C<is_checked>
103 | 
104 | =item * C<is_selected>
105 | 
106 | =item * C<is_not_displayed>
107 | 
108 | =item * C<is_not_checked>
109 | 
110 | =item * C<is_not_selected>
111 | 
112 | =item * C<set($value)>
113 | 
114 | =item * C<select>
115 | 
116 | =item * C<unselect>
117 | 
118 | =item * C<click>
119 | 
120 | =item * C<find($locator)>
121 | 
122 | =item * C<all($locator)>
123 | 
124 | =back
125 | 
126 | =head1 AUTHOR
127 | 
128 | NAKAGAWA Masaki E<lt>masaki@cpan.orgE<gt>
129 | 
130 | =head1 LICENSE
131 | 
132 | This library is free software; you can redistribute it and/or modify
133 | it under the same terms as Perl itself.
134 | 
135 | =head1 SEE ALSO
136 | 
137 | L<Brownie::Node>, L<Selenium::Remote::WebElement>
138 | 
139 | =cut
140 | 


--------------------------------------------------------------------------------
/t/node/selenium_server/finder.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Fake::HTTPD;
 5 | use Test::Exception;
 6 | use Brownie::Driver::SeleniumServer;
 7 | use Brownie::Node::SeleniumServer;
 8 | 
 9 | my $driver = Brownie::Driver::SeleniumServer->new;
10 | 
11 | my $body = <<__HTTPD__;
12 | <html>
13 |   <head><title>test title</title></head>
14 |   <body>
15 |     <ul>
16 |       <li>li 1</li>
17 |       <li class="even">li 2</li>
18 |       <li>li 3</li>
19 |       <li class="even">li 4</li>
20 |       <li>li 5</li>
21 |     </ul>
22 | 
23 |     <p>outer paragraph</p>
24 |     <div id="parent">
25 |       <p>inner paragraph</p>
26 |     </div>
27 |   </body>
28 | </html>
29 | __HTTPD__
30 | 
31 | my $httpd = Test::Fake::HTTPD->new(timeout => 30);
32 | $httpd->run(sub { [ 200, [ 'Content-Type' => 'text/html; charset=utf-8' ], [ $body ] ] });
33 | 
34 | my $base_url = $httpd->endpoint;
35 | 
36 | subtest 'Finder' => sub {
37 |     $driver->visit($base_url);
38 |     my $doc = $driver->find('/html');
39 | 
40 |     subtest 'using XPath' => sub {
41 |         subtest 'all' => sub {
42 |             is scalar($doc->all('//li'))                => 5;
43 |             is scalar($doc->all('//li[@class="even"]')) => 2;
44 | 
45 |             subtest 'empty when not exist locator' => sub {
46 |                 lives_ok {
47 |                     my @elems = $doc->all('//span[@class="noexist"]');
48 |                     is scalar(@elems) => 0;
49 |                 };
50 |             };
51 |         };
52 | 
53 |         subtest 'find' => sub {
54 |             is $doc->find('//li')->text                => 'li 1';
55 |             is $doc->find('//li[@class="even"]')->text => 'li 2';
56 | 
57 |             subtest 'child element' => sub {
58 |                 my $base = $doc->find('//div[@id="parent"]');
59 |                 my $child = $base->find('//p');
60 |                 is $child->text => 'inner paragraph';
61 |             };
62 |         };
63 |     };
64 | 
65 |     subtest 'using CSS Selector' => sub {
66 |         subtest 'all' => sub {
67 |             is scalar($doc->all('li'))      => 5;
68 |             is scalar($doc->all('li.even')) => 2;
69 | 
70 |             subtest 'empty when not exist locator' => sub {
71 |                 lives_ok {
72 |                     my @elems = $doc->all('span.noexist');
73 |                     is scalar(@elems) => 0;
74 |                 };
75 |             };
76 |         };
77 | 
78 |         subtest 'find' => sub {
79 |             is $doc->find('li')->text      => 'li 1';
80 |             is $doc->find('li.even')->text => 'li 2';
81 | 
82 |             subtest 'child element' => sub {
83 |                 my $base = $doc->find('#parent');
84 |                 my $child = $base->find('p');
85 |                 is $child->text => 'inner paragraph';
86 |             };
87 |         };
88 |     };
89 | };
90 | 
91 | done_testing;
92 | 


--------------------------------------------------------------------------------
/t/session/selenium_server/select.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Brownie::Session;
 5 | use URI::QueryParam;
 6 | 
 7 | my $app = sub {
 8 |     my $body = <<__HTTPD__;
 9 | <html>
10 |   <head>
11 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
12 |     <title>test</title>
13 |   </head>
14 |   <body>
15 |     <form action="/form" method="get">
16 |       <input type="submit" id="submit" name="submit" value="submit"/>
17 | 
18 |       <select id="single" name="single">
19 |         <option value="Option1 Value" id="option1"                    >Option1 Text</option>
20 |         <option value="Option2 Value" id="option2" selected="selected">Option2 Text</option>
21 |         <option value="Option3 Value" id="option3"                    >Option3 Text</option>
22 |       </select>
23 | 
24 |       <select id="multiple" name="multiple" multiple="multiple">
25 |         <option value="Option4 Value" id="option4"                    >Option4 Text</option>
26 |         <option value="Option5 Value" id="option5"                    >Option5 Text</option>
27 |         <option value="Option6 Value" id="option6" selected="selected">Option6 Text</option>
28 |       </select>
29 |     </form>
30 |   </body>
31 | </html>
32 | __HTTPD__
33 | 
34 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
35 | };
36 | 
37 | my $bs = Brownie::Session->new(driver => 'SeleniumServer', app => $app);
38 | 
39 | subtest 'select' => sub {
40 |     subtest 'single' => sub {
41 |         for (
42 |             [ 'Option1 Value' => [ 'option1', 'Option1 Value', 'Option1 Text' ] ],
43 |             [ 'Option2 Value' => [ 'option2', 'Option2 Value', 'Option2 Text' ] ],
44 |             [ 'Option3 Value' => [ 'option3', 'Option3 Value', 'Option3 Text' ] ],
45 |         ) {
46 |             my ($value, $locators) = @$_;
47 | 
48 |             for my $locator (@$locators) {
49 |                 $bs->visit('/');
50 | 
51 |                 ok $bs->select($locator);
52 |                 $bs->click_button('submit');
53 |                 is $bs->current_url->query_param('single') => $value;
54 |             }
55 |         }
56 |     };
57 | 
58 |     subtest 'multiple' => sub {
59 |         for (
60 |             [ 'Option4 Value' => [ 'option4', 'Option4 Value', 'Option4 Text' ] ],
61 |             [ 'Option5 Value' => [ 'option5', 'Option5 Value', 'Option5 Text' ] ],
62 |         ) {
63 |             my ($value, $locators) = @$_;
64 | 
65 |             for my $locator (@$locators) {
66 |                 $bs->visit('/');
67 | 
68 |                 ok $bs->select($locator);
69 |                 $bs->click_button('submit');
70 | 
71 |                 ok my @params = $bs->current_url->query_param('multiple');
72 |                 is scalar(@params) => 2;
73 |                 is $params[0]  => $value;
74 |                 is $params[-1] => 'Option6 Value';
75 |             }
76 |         }
77 |     };
78 | };
79 | 
80 | subtest 'unselect' => sub {
81 |     for (
82 |         'option6',
83 |         'Option6 Value',
84 |         'Option6 Text',
85 |     ) {
86 |         $bs->visit('/');
87 | 
88 |         $bs->select('option5');
89 |         ok $bs->unselect($_);
90 |         $bs->click_button('submit');
91 | 
92 |         my @params = $bs->current_url->query_param('multiple');
93 |         is scalar(@params) => 1;
94 |         is $params[0] => 'Option5 Value';
95 |     }
96 | };
97 | 
98 | done_testing;
99 | 


--------------------------------------------------------------------------------
/t/session/mechanize/select.t:
--------------------------------------------------------------------------------
  1 | use strict;
  2 | use warnings;
  3 | use Test::More;
  4 | use Brownie::Session;
  5 | use URI::QueryParam;
  6 | 
  7 | my $app = sub {
  8 |     my $body = <<__HTTPD__;
  9 | <html>
 10 |   <head>
 11 |     <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
 12 |     <title>test</title>
 13 |   </head>
 14 |   <body>
 15 |     <form action="/form" method="get">
 16 |       <input type="submit" id="submit" name="submit" value="submit"/>
 17 | 
 18 |       <select id="single" name="single">
 19 |         <option value="Option1 Value" id="option1"                    >Option1 Text</option>
 20 |         <option value="Option2 Value" id="option2" selected="selected">Option2 Text</option>
 21 |         <option value="Option3 Value" id="option3"                    >Option3 Text</option>
 22 |       </select>
 23 | 
 24 |       <select id="multiple" name="multiple" multiple="multiple">
 25 |         <option value="Option4 Value" id="option4"                    >Option4 Text</option>
 26 |         <option value="Option5 Value" id="option5"                    >Option5 Text</option>
 27 |         <option value="Option6 Value" id="option6" selected="selected">Option6 Text</option>
 28 |       </select>
 29 |     </form>
 30 |   </body>
 31 | </html>
 32 | __HTTPD__
 33 | 
 34 |     [ 200, [ 'Content-Type' => 'text/html;charset=utf-8' ], [$body] ];
 35 | };
 36 | 
 37 | my $bs = Brownie::Session->new(driver => 'Mechanize', app => $app);
 38 | 
 39 | subtest 'select' => sub {
 40 |     subtest 'single' => sub {
 41 |         for (
 42 |             [ 'Option1 Value' => [ 'option1', 'Option1 Value', 'Option1 Text' ] ],
 43 |             [ 'Option2 Value' => [ 'option2', 'Option2 Value', 'Option2 Text' ] ],
 44 |             [ 'Option3 Value' => [ 'option3', 'Option3 Value', 'Option3 Text' ] ],
 45 |         ) {
 46 |             my ($value, $locators) = @$_;
 47 | 
 48 |             for my $locator (@$locators) {
 49 |                 $bs->visit('/');
 50 | 
 51 |                 ok $bs->select($locator);
 52 |                 $bs->click_button('submit');
 53 |                 is $bs->current_url->query_param('single') => $value;
 54 |             }
 55 |         }
 56 |     };
 57 | 
 58 |     subtest 'multiple' => sub {
 59 |         for (
 60 |             [ 'Option4 Value' => [ 'option4', 'Option4 Value', 'Option4 Text' ] ],
 61 |             [ 'Option5 Value' => [ 'option5', 'Option5 Value', 'Option5 Text' ] ],
 62 |         ) {
 63 |             my ($value, $locators) = @$_;
 64 | 
 65 |             for my $locator (@$locators) {
 66 |                 $bs->visit('/');
 67 | 
 68 |                 ok $bs->select($locator);
 69 |                 $bs->click_button('submit');
 70 | 
 71 |                 ok my @params = $bs->current_url->query_param('multiple');
 72 |                 is scalar(@params) => 2;
 73 |                 is $params[0]  => $value;
 74 |                 is $params[-1] => 'Option6 Value';
 75 |             }
 76 |         }
 77 |     };
 78 | };
 79 | 
 80 | TODO: {
 81 |     local $TODO = 'not implemented collect unselect';
 82 | 
 83 |     subtest 'unselect' => sub {
 84 |         for (
 85 |             'option6',
 86 |             'Option6 Value',
 87 |             'Option6 Text',
 88 |         ) {
 89 |             $bs->visit('/');
 90 | 
 91 |             $bs->select('option5');
 92 |             ok $bs->unselect($_);
 93 |             $bs->click_button('submit');
 94 | 
 95 |             my @params = $bs->current_url->query_param('multiple');
 96 |             is scalar(@params) => 1;
 97 |             is $params[0] => 'Option5 Value';
 98 |         }
 99 |     };
100 | }
101 | 
102 | done_testing;
103 | 


--------------------------------------------------------------------------------
/lib/Brownie/DSL.pm:
--------------------------------------------------------------------------------
  1 | package Brownie::DSL;
  2 | 
  3 | use strict;
  4 | use warnings;
  5 | use Sub::Install;
  6 | use Brownie;
  7 | 
  8 | our @DriverMethods = qw(
  9 |     current_url
 10 |     current_path
 11 |     status_code
 12 |     response_headers
 13 |     title
 14 |     source
 15 |     screenshot
 16 |     execute_script
 17 |     evaluate_script
 18 |     body
 19 |     visit
 20 |     current_node
 21 |     document
 22 |     find
 23 |     first
 24 |     all
 25 |     click_link
 26 |     click_button
 27 |     click_link_or_button
 28 |     fill_in
 29 |     choose
 30 |     check
 31 |     uncheck
 32 |     select
 33 |     unselect
 34 |     attach_file
 35 | );
 36 | our @SessionMethods = qw(
 37 |     page
 38 | );
 39 | our @DslMethods = (@DriverMethods, @SessionMethods);
 40 | 
 41 | sub page { Brownie->current_session }
 42 | 
 43 | sub import {
 44 |     my $class  = shift;
 45 |     my $caller = caller;
 46 | 
 47 |     for my $method (@DriverMethods) {
 48 |         Sub::Install::install_sub({
 49 |           code => sub { page->$method(@_) },
 50 |           into => $caller,
 51 |           as   => $method,
 52 |         });
 53 |     }
 54 |     for my $method (@SessionMethods) {
 55 |         Sub::Install::install_sub({
 56 |           code => \&$method,
 57 |           into => $caller,
 58 |           as   => $method,
 59 |         });
 60 |     }
 61 | }
 62 | 
 63 | 1;
 64 | 
 65 | =head1 NAME
 66 | 
 67 | Brownie::DSL - provides DSL-Style interface to use browser session
 68 | 
 69 | =head1 SYNOPSIS
 70 | 
 71 |   use Brownie::DSL;
 72 | 
 73 |   # external server
 74 |   Brownie->driver('Mechanize');
 75 |   Brownie->app_host('http://app.example.com:5000');
 76 | 
 77 |   # PSGI app
 78 |   Brownie->driver('Mechanize');
 79 |   Brownie->app(sub { ...(PSGI app)... });
 80 | 
 81 |   # psgi file
 82 |   Brownie->driver('Mechanize');
 83 |   Brownie->app('app.psgi');
 84 | 
 85 |   visit('/');
 86 |   is title, 'Some Title';
 87 | 
 88 |   fill_in('User Name' => 'brownie');
 89 |   fill_in('Email Address' => 'brownie@example.com');
 90 |   click_button('Login');
 91 |   like source, qr/Welcome (.+)/;
 92 | 
 93 |   fill_in(q => 'Brownie');
 94 |   lick_link_or_button('Search');
 95 |   like title, qr/Search result of Brownie/i;
 96 | 
 97 |   done_testing;
 98 | 
 99 | =head1 CLASS METHODS
100 | 
101 | =over 4
102 | 
103 | =item * C<driver>: loadable driver name or config
104 | 
105 | =item * C<app_host>: external target application
106 | 
107 | =item * C<app>: PSGI application
108 | 
109 | =back
110 | 
111 | =head1 FUNCTIONS
112 | 
113 | =over 4
114 | 
115 | =item * C<page>
116 | 
117 | Shortcut to accessing the current session.
118 | 
119 | =item * C<visit($url)>
120 | 
121 | =item * C<current_url>
122 | 
123 | =item * C<current_path>
124 | 
125 | =item * C<title>
126 | 
127 | =item * C<source>
128 | 
129 | =item * C<screenshot($filename)>
130 | 
131 | =item * C<click_link($locator)>
132 | 
133 | =item * C<click_button($locator)>
134 | 
135 | =item * C<click_on($locator)>
136 | 
137 | =item * C<fill_in($locator, $value)>
138 | 
139 | =item * C<choose($locator)>
140 | 
141 | =item * C<check($locator)>
142 | 
143 | =item * C<uncheck($locator)>
144 | 
145 | =item * C<select($locator)>
146 | 
147 | =item * C<unselect($locator)>
148 | 
149 | =item * C<attach_file($locator, $filename)>
150 | 
151 | =item * C<execute_script($javascript)>
152 | 
153 | =item * C<evaluate_script($javascript)>
154 | 
155 | =item * C<find($locator)>
156 | 
157 | =item * C<all($locator)>
158 | 
159 | =back
160 | 
161 | =head1 AUTHOR
162 | 
163 | NAKAGAWA Masaki E<lt>masaki@cpan.orgE<gt>
164 | 
165 | =head1 LICENSE
166 | 
167 | This library is free software; you can redistribute it and/or modify
168 | it under the same terms as Perl itself.
169 | 
170 | =head1 SEE ALSO
171 | 
172 | L<Brownie::Session>
173 | 
174 | =cut
175 | 


--------------------------------------------------------------------------------
/lib/Brownie/Driver/Mechanize.pm:
--------------------------------------------------------------------------------
  1 | package Brownie::Driver::Mechanize;
  2 | 
  3 | use strict;
  4 | use warnings;
  5 | use parent 'Brownie::Driver';
  6 | use WWW::Mechanize;
  7 | use HTML::TreeBuilder::XPath;
  8 | use constant HAS_LIBXML => eval { require HTML::TreeBuilder::LibXML; 1 };
  9 | use Scalar::Util qw(blessed);
 10 | 
 11 | use Brownie;
 12 | use Brownie::XPath;
 13 | use Brownie::Node::Mechanize;
 14 | 
 15 | our $NodeClass = 'Brownie::Node::Mechanize';
 16 | 
 17 | sub DESTROY {
 18 |     my $self = shift;
 19 |     delete $self->{browser};
 20 | }
 21 | 
 22 | sub browser {
 23 |     my $self = shift;
 24 | 
 25 |     $self->{browser} ||= WWW::Mechanize->new(
 26 |         agent       => "Brownie/${Brownie::VERSION}",
 27 |         cookie_jar  => +{},
 28 |         quiet       => 1,
 29 |         stack_depth => 1,
 30 |     );
 31 | 
 32 |     return $self->{browser};
 33 | }
 34 | 
 35 | sub visit {
 36 |     my ($self, $url) = @_;
 37 |     $self->browser->get("$url"); # stringify for URI
 38 | }
 39 | 
 40 | sub current_url {
 41 |     my $self = shift;
 42 |     return $self->browser->uri->clone;
 43 | }
 44 | 
 45 | sub current_path {
 46 |     my $self = shift;
 47 |     return $self->current_url->path;
 48 | }
 49 | 
 50 | sub status_code {
 51 |     my $self = shift;
 52 |     return $self->browser->status;
 53 | }
 54 | 
 55 | sub response_headers {
 56 |     my $self = shift;
 57 |     return $self->browser->res->headers;
 58 | }
 59 | 
 60 | sub title {
 61 |     my $self = shift;
 62 |     return $self->browser->title;
 63 | }
 64 | 
 65 | sub source {
 66 |     my $self = shift;
 67 |     my $content = $self->browser->content;
 68 |     # TODO: consider gzip and deflate
 69 |     return $content;
 70 | }
 71 | 
 72 | sub _root {
 73 |     my $self = shift;
 74 |     my $builder = HAS_LIBXML ? 'HTML::TreeBuilder::LibXML' : 'HTML::TreeBuilder::XPath';
 75 |     my $tree = $builder->new_from_content($self->source);
 76 | }
 77 | 
 78 | sub find {
 79 |     my ($self, $locator, %args) = @_;
 80 | 
 81 |     my @elements = $self->all($locator, %args);
 82 |     return @elements ? shift(@elements) : undef;
 83 | }
 84 | 
 85 | sub all {
 86 |     my ($self, $locator, %args) = @_;
 87 | 
 88 |     my @elements = ();
 89 |     my $xpath = Brownie::XPath::to_xpath($locator);
 90 | 
 91 |     if (my $base = $args{base}) {
 92 |         my $node = (blessed($base) and $base->can('native')) ? $base->native : $base;
 93 |         $xpath = ".$xpath" unless $xpath =~ /^\./;
 94 |         @elements = $node->findnodes($xpath); # abs2rel
 95 |     }
 96 |     else {
 97 |         @elements = $self->_root->findnodes($xpath);
 98 |     }
 99 | 
100 |     return @elements ? map { $NodeClass->new(driver => $self, native => $_) } @elements : ();
101 | }
102 | 
103 | 1;
104 | 
105 | =head1 NAME
106 | 
107 | Brownie::Driver::Mechanize - WWW::Mechanize bridge implementation
108 | 
109 | =head1 SYNOPSIS
110 | 
111 |   my $driver = Brownie::Driver::Mechanize->new;
112 | 
113 |   $driver->visit($url);
114 |   my $title = $driver->title;
115 | 
116 | =head1 METHODS
117 | 
118 | =head2 IMPLEMENTED
119 | 
120 | =over 4
121 | 
122 | =item * C<browser>
123 | 
124 | =item * C<visit($url)>
125 | 
126 | =item * C<current_url>
127 | 
128 | =item * C<current_path>
129 | 
130 | =item * C<status_code>
131 | 
132 | =item * C<response_headers>
133 | 
134 | =item * C<title>
135 | 
136 | =item * C<source>
137 | 
138 | =item * C<find($locator)>
139 | 
140 | =item * C<all($locator)>
141 | 
142 | =back
143 | 
144 | =head2 NOT SUPPORTED
145 | 
146 | =over 4
147 | 
148 | =item * C<screenshot($filename)>
149 | 
150 | =item * C<execute_script($javascript)>
151 | 
152 | =item * C<evaluate_script($javascript)>
153 | 
154 | =back
155 | 
156 | =head1 AUTHOR
157 | 
158 | NAKAGAWA Masaki E<lt>masaki@cpan.orgE<gt>
159 | 
160 | =head1 LICENSE
161 | 
162 | This library is free software; you can redistribute it and/or modify
163 | it under the same terms as Perl itself.
164 | 
165 | =head1 SEE ALSO
166 | 
167 | L<Brownie::Driver>, L<WWW::Mechanize>, L<Brownie::Node::Mechanize>
168 | 
169 | =cut
170 | 


--------------------------------------------------------------------------------
/lib/Brownie/Driver.pm:
--------------------------------------------------------------------------------
  1 | package Brownie::Driver;
  2 | 
  3 | use strict;
  4 | use warnings;
  5 | use Sub::Install;
  6 | 
  7 | use Brownie::Helpers;
  8 | 
  9 | sub new {
 10 |     my ($class, %args) = @_;
 11 |     return bless { %args }, $class;
 12 | }
 13 | 
 14 | for my $method (qw/
 15 |     browser
 16 |     find
 17 |     all
 18 |     visit
 19 |     current_url
 20 |     current_path
 21 |     status_code
 22 |     response_headers
 23 |     title
 24 |     source
 25 |     screenshot
 26 |     execute_script
 27 |     evaluate_script
 28 | /) {
 29 |     next if __PACKAGE__->can($method);
 30 |     Sub::Install::install_sub({
 31 |         code => Brownie::Helpers->can('not_implemented'),
 32 |         as   => $method,
 33 |     });
 34 | }
 35 | 
 36 | 1;
 37 | 
 38 | =head1 NAME
 39 | 
 40 | Brownie::Driver - base class of Brownie::Driver series
 41 | 
 42 | =head1 METHODS
 43 | 
 44 | =over 4
 45 | 
 46 | =item * C<new(%args)>
 47 | 
 48 | Returns a new instance.
 49 | 
 50 |   my $driver = Brownie::Driver->new(%args);
 51 | 
 52 | =item * C<browser>
 53 | 
 54 | Returns a driver specific browser object.
 55 | 
 56 |   my $browser = $driver->browser;
 57 | 
 58 | =item * C<visit($url)>
 59 | 
 60 | Go to $url.
 61 | 
 62 |   $driver->visit('http://example.com/');
 63 | 
 64 | =item * C<current_url>
 65 | 
 66 | Returns current page's URL.
 67 | 
 68 |   my $url = $driver->current_url;
 69 | 
 70 | =item * C<current_path>
 71 | 
 72 | Returns current page's path of URL.
 73 | 
 74 |   my $path = $driver->current_path;
 75 | 
 76 | =item * C<status_code>
 77 | 
 78 | Returns last request's HTTP status code.
 79 | 
 80 |   my $code = $driver->status_code;
 81 | 
 82 | =item * C<response_headers>
 83 | 
 84 | Returns last request's HTTP response headers L<HTTP::Headers>.
 85 | 
 86 |   my $headers = $driver->response_headers;
 87 | 
 88 | =item * C<title>
 89 | 
 90 | Returns current page's <title> text.
 91 | 
 92 |   my $title = $driver->title;
 93 | 
 94 | =item * C<source>
 95 | 
 96 | Returns current page's HTML source.
 97 | 
 98 |   my $source = $driver->source;
 99 | 
100 | =item * C<document>
101 | 
102 | Returns current page's HTML root element.
103 | 
104 |   my $element = $driver->document;
105 | 
106 | =item * C<screenshot($filename)>
107 | 
108 | Takes current page's screenshot and saves to $filename as PNG.
109 | 
110 |   $driver->screenshot($filename);
111 | 
112 | =item * C<execute_script($javascript)>
113 | 
114 | Executes snippet of JavaScript into current page.
115 | 
116 |   $driver->execute_script('$("body").empty()');
117 | 
118 | =item * C<evaluate_script($javascript)>
119 | 
120 | Executes snipptes and returns result.
121 | 
122 |   my $result = $driver->evaluate_script('1 + 2');
123 | 
124 | If specified DOM element, it returns WebElement object.
125 | 
126 |   my $node = $driver->evaluate_script('document.getElementById("foo")');
127 | 
128 | =item * C<find($locator, %args)>
129 | 
130 | Find an element on the page, and return L<Brownie::Node> object.
131 | 
132 |   my $element = $driver->find($locator, %args)
133 | 
134 | C<$locator> is string of "CSS Selector" (e.g. "#id") or "XPath" (e.g. "//a[1]").
135 | 
136 | C<%args> are:
137 | 
138 | =over 8
139 | 
140 | =item * C<-base>: Brownie::Node object where you want to start finding
141 | 
142 |   my $parent = $driver->find('#where_to_parent');
143 |   my $child  = $driver->find('a', base => $parent);
144 | 
145 | =back
146 | 
147 | =item * C<all($locator, %args)>
148 | 
149 | Find all elements on the page, and return L<Brownie::Node> object list.
150 | 
151 |   my @elements = $driver->all($locator, %args)
152 | 
153 | C<$locator> is string of "CSS Selector" (e.g. "#id") or "XPath" (e.g. "//a[1]").
154 | 
155 | C<%args> are:
156 | 
157 | =over 8
158 | 
159 | =item * C<-base>: Brownie::Node object where you want to start finding
160 | 
161 |   my $parent   = $driver->find('#where_to_parent');
162 |   my @children = $driver->all('li', base => $parent);
163 | 
164 | =back
165 | 
166 | =back
167 | 
168 | =head1 AUTHOR
169 | 
170 | NAKAGAWA Masaki E<lt>masaki@cpan.orgE<gt>
171 | 
172 | =head1 LICENSE
173 | 
174 | This library is free software; you can redistribute it and/or modify
175 | it under the same terms as Perl itself.
176 | 
177 | =head1 SEE ALSO
178 | 
179 | L<Brownie::Node>, L<Brownie::Session>
180 | 
181 | =cut
182 | 


--------------------------------------------------------------------------------
/lib/Brownie.pm:
--------------------------------------------------------------------------------
  1 | package Brownie;
  2 | 
  3 | use 5.008001;
  4 | use strict;
  5 | use warnings;
  6 | use Brownie::Session;
  7 | use Sub::Install;
  8 | 
  9 | our $VERSION = '0.09';
 10 | 
 11 | my %container;
 12 | for my $accessor (qw{
 13 |     driver
 14 |     app_host
 15 |     app
 16 | }) {
 17 |     Sub::Install::install_sub({
 18 |         code => sub {
 19 |             my ($class, $args) = @_;
 20 |             return $container{$accessor} unless @_ > 1;
 21 |             $container{$accessor} = $args;
 22 |         },
 23 |         as   => $accessor,
 24 |     });
 25 | }
 26 | 
 27 | my %session;
 28 | sub current_session {
 29 |     my $class = shift;
 30 |     # TODO: changable session
 31 |     $session{default} ||= Brownie::Session->new(
 32 |         app      => Brownie->app,
 33 |         app_host => Brownie->app_host,
 34 |         driver   => Brownie->driver,
 35 |     );
 36 | }
 37 | 
 38 | sub reset_sessions {
 39 |     my $class = shift;
 40 |     undef %session;
 41 | }
 42 | 
 43 | END { __PACKAGE__->reset_sessions }
 44 | 
 45 | 1;
 46 | 
 47 | =head1 NAME
 48 | 
 49 | Brownie - Browser integration framework inspired by Capybara
 50 | 
 51 | =head1 SYNOPSIS
 52 | 
 53 | =head2 OO-Style
 54 | 
 55 |   use Test::More;
 56 |   use Brownie::Session;
 57 | 
 58 |   # external server
 59 |   my $session = Brownie::Session->new(
 60 |       driver   => 'Mechanize',
 61 |       app_host => 'http://app.example.com:5000',
 62 |   );
 63 | 
 64 |   # PSGI app
 65 |   my $session = Brownie::Session->new(
 66 |       driver => 'Mechanize',
 67 |       app    => sub { ...(PSGI app)... },
 68 |   );
 69 | 
 70 |   # PSGI file
 71 |   my $session = Brownie::Session->new(
 72 |       driver => 'Mechanize',
 73 |       app    => 'app.psgi',
 74 |   );
 75 | 
 76 |   $session->visit('/');
 77 |   is $session->title => 'Some Title';
 78 | 
 79 |   $session->fill_in('User Name' => 'brownie');
 80 |   $session->fill_in('Email Address' => 'brownie@example.com');
 81 |   $session->click_button('Login');
 82 |   like $session->source => qr/Welcome (.+)/;
 83 | 
 84 |   $session->fill_in(q => 'Brownie');
 85 |   $session->click_link_or_button('Search');
 86 |   like $session->title => qr/Search result of Brownie/i;
 87 | 
 88 |   done_testing;
 89 | 
 90 | =head2 DSL-Style
 91 | 
 92 |   use Brownie::DSL;
 93 | 
 94 |   # external server
 95 |   Brownie->driver('Mechanize');
 96 |   Brownie->app_host('http://app.example.com:5000');
 97 | 
 98 |   # PSGI app
 99 |   Brownie->driver('Mechanize');
100 |   Brownie->app(sub { ...(PSGI app)... });
101 | 
102 |   # psgi file
103 |   Brownie->driver('Mechanize');
104 |   Brownie->app('app.psgi');
105 | 
106 |   visit('/');
107 |   is page->title, 'Some Title';
108 | 
109 |   fill_in('User Name' => 'brownie');
110 |   fill_in('Email Address' => 'brownie@example.com');
111 |   click_button('Login');
112 |   like page->source => qr/Welcome (.+)/;
113 | 
114 |   fill_in(q => 'Brownie');
115 |   click_link_or_button('Search');
116 |   like page->title => qr/Search result of Brownie/i;
117 | 
118 |   done_testing;
119 | 
120 | =head1 DESCRIPTION
121 | 
122 | Brownie is browser integration framework. It is inspired by Capybara (Ruby).
123 | 
124 | =head1 VOCABULARY
125 | 
126 | =over 4
127 | 
128 | =item * C<visit($url)>
129 | 
130 | =item * C<current_url>
131 | 
132 | =item * C<current_path>
133 | 
134 | =item * C<title>
135 | 
136 | =item * C<source>
137 | 
138 | =item * C<screenshot($filename)>
139 | 
140 | =item * C<click_link($locator)>
141 | 
142 | =item * C<click_button($locator)>
143 | 
144 | =item * C<click_on($locator)>
145 | 
146 | =item * C<fill_in($locator, $value)>
147 | 
148 | =item * C<choose($locator)>
149 | 
150 | =item * C<check($locator)>
151 | 
152 | =item * C<uncheck($locator)>
153 | 
154 | =item * C<select($locator)>
155 | 
156 | =item * C<unselect($locator)>
157 | 
158 | =item * C<attach_file($locator, $filename)>
159 | 
160 | =item * C<execute_script($javascript)>
161 | 
162 | =item * C<evaluate_script($javascript)>
163 | 
164 | =item * C<find($locator)>
165 | 
166 | =item * C<all($locator)>
167 | 
168 | =back
169 | 
170 | =head1 AUTHOR
171 | 
172 | NAKAGAWA Masaki E<lt>masaki@cpan.orgE<gt>
173 | 
174 | =head1 LICENSE
175 | 
176 | This library is free software; you can redistribute it and/or modify
177 | it under the same terms as Perl itself.
178 | 
179 | =head1 SEE ALSO
180 | 
181 | L<Brownie::Session>
182 | 
183 | L<Capybara|http://github.com/jnicklas/capybara>
184 | 
185 | =cut
186 | 


--------------------------------------------------------------------------------
/lib/Brownie/Node.pm:
--------------------------------------------------------------------------------
  1 | package Brownie::Node;
  2 | 
  3 | use strict;
  4 | use warnings;
  5 | use Sub::Install;
  6 | 
  7 | use Brownie::Helpers;
  8 | 
  9 | sub new {
 10 |     my ($class, %args) = @_;
 11 |     return bless { %args }, $class;
 12 | }
 13 | 
 14 | sub driver { shift->{driver} }
 15 | sub native { shift->{native} }
 16 | 
 17 | our @Accessor = qw(attr text tag_name id name value type);
 18 | our @Finder   = qw(find all first);
 19 | our @State    = qw(is_displayed is_not_displayed is_selected is_not_selected is_checked is_not_checked);
 20 | our @Action   = qw(click set select unselect);
 21 | 
 22 | sub id    { shift->attr('id')    }
 23 | sub name  { shift->attr('name')  }
 24 | sub type  { shift->attr('type')  }
 25 | sub value { shift->attr('value') }
 26 | 
 27 | sub find {
 28 |     my ($self, $locator) = @_;
 29 |     return $self->driver->find($locator, base => $self);
 30 | }
 31 | *first = \&find;
 32 | 
 33 | sub all {
 34 |     my ($self, $locator) = @_;
 35 |     my @children = $self->driver->all($locator, base => $self);
 36 |     return @children ? @children : ();
 37 | }
 38 | 
 39 | sub is_not_displayed { !shift->is_displayed }
 40 | sub is_not_selected  { !shift->is_selected  }
 41 | sub is_not_checked   { !shift->is_checked   }
 42 | 
 43 | our @Method = (@Accessor, @Finder, @State, @Action);
 44 | for (@Method) {
 45 |     next if __PACKAGE__->can($_);
 46 |     Sub::Install::install_sub({
 47 |         code => Brownie::Helpers->can('not_implemented'),
 48 |         as   => $_,
 49 |     });
 50 | }
 51 | 
 52 | 1;
 53 | 
 54 | =head1 NAME
 55 | 
 56 | Brownie::Node - base class of Brownie::Node series
 57 | 
 58 | =head1 METHODS
 59 | 
 60 | =over 4
 61 | 
 62 | =item * C<new(%args)>
 63 | 
 64 | Returns a new instance.
 65 | 
 66 |   my $node = Brownie::Node->new(%args);
 67 | 
 68 | C<%args> are:
 69 | 
 70 | =over 8
 71 | 
 72 | =item * C<driver>: parent Brownie::Driver instance
 73 | 
 74 | =item * C<native>: native driver specific node representation instance
 75 | 
 76 | =back
 77 | 
 78 | =item * C<driver>
 79 | 
 80 | Returns a driver instance.
 81 | 
 82 |   my $driver = $node->driver;
 83 | 
 84 | =item * C<native>
 85 | 
 86 | Returns a native node instance.
 87 | 
 88 |   my $native = $node->native;
 89 | 
 90 | =item * C<attr($name)>
 91 | 
 92 | Returns an attribute value.
 93 | 
 94 |   my $title = $node->attr('title');
 95 | 
 96 | =item * C<value>
 97 | 
 98 | Returns the value of element.
 99 | 
100 |   my $value = $node->value;
101 | 
102 | =item * C<text>
103 | 
104 | Returns a child node text. (= innerText)
105 | 
106 |   my $text = $node->text;
107 | 
108 | =item * C<tag_name>
109 | 
110 | Returns a tag name.
111 | 
112 |   my $tag_name = $node->tag_name;
113 | 
114 | =item * C<is_displayed>, C<is_not_displayed>
115 | 
116 | Whether this element is displayed, or not.
117 | 
118 |   if ($node->is_displayed) {
119 |       print "this node is visible";
120 |   }
121 | 
122 |   if ($node->is_not_displayed) {
123 |       warn "this node is not visible";
124 |   }
125 | 
126 | =item * C<is_checked>, C<is_not_checked>
127 | 
128 | Whether this element is checked, or not. (checkbox)
129 | 
130 |   if ($checkbox->is_checked) {
131 |       print "marked";
132 |   }
133 | 
134 |   if ($checkbox->is_not_checked) {
135 |       warn "unmarked...";
136 |   }
137 | 
138 | =item * C<is_selected>, C<is_not_selected>
139 | 
140 | Whether this element is selected, or not. (radio, option)
141 | 
142 |   if ($radio->is_selected) {
143 |       print "this radio button is selcted";
144 |   }
145 | 
146 |   if ($option->is_not_selected) {
147 |       warn "this option element is not selected";
148 |   }
149 | 
150 | =item * C<set($value)>
151 | 
152 | Sets value to this element. (input, textarea)
153 | 
154 |   $input->set($value);
155 |   $textarea->set($text);
156 | 
157 | =item * C<select>
158 | 
159 | Select this element (option, radio)
160 | 
161 |   $option->select;
162 |   $radio->select;
163 | 
164 | =item * C<unselect>
165 | 
166 | Unselect this element (options - multiple select)
167 | 
168 |   $option->unselect;
169 | 
170 | =item * C<click>
171 | 
172 | Clicks this element.
173 | 
174 |   $link->click;
175 |   $button->click;
176 | 
177 | =item * C<find($locator)>
178 | 
179 | Finds and returns an located element under this.
180 | 
181 |   my $element = $node->find($locator); # search under $node
182 | 
183 | =item * C<all($locator)>
184 | 
185 | Finds and returns located elements under this.
186 | 
187 |   my @elements = $node->all($locator); # search under $node
188 | 
189 | =back
190 | 
191 | =head1 AUTHOR
192 | 
193 | NAKAGAWA Masaki E<lt>masaki@cpan.orgE<gt>
194 | 
195 | =head1 LICENSE
196 | 
197 | This library is free software; you can redistribute it and/or modify
198 | it under the same terms as Perl itself.
199 | 
200 | =head1 SEE ALSO
201 | 
202 | L<Brownie::Driver>
203 | 
204 | =cut
205 | 


--------------------------------------------------------------------------------
/lib/Brownie/XPath.pm:
--------------------------------------------------------------------------------
  1 | package Brownie::XPath;
  2 | 
  3 | use strict;
  4 | use warnings;
  5 | use HTML::Selector::XPath ();
  6 | 
  7 | sub to_xpath {
  8 |     my $locator = shift;
  9 |     # taken from Web::Scraper
 10 |     return $locator =~ m!^(?:/|id\()!
 11 |         ? $locator # XPath
 12 |         : HTML::Selector::XPath::selector_to_xpath($locator); # CSS to XPath
 13 | }
 14 | 
 15 | sub to_link {
 16 |     my $locator = shift;
 17 |     return join '|', map { sprintf $_, $locator } (
 18 |         q!//a[@id='%s']!,
 19 |         q!//a[@name='%s']!,
 20 |         q!//a[@title='%s']!,
 21 |         q!//a[text()[contains(.,'%s')]]!,
 22 |         q!//a//img[@alt='%s']!,
 23 |     );
 24 | }
 25 | 
 26 | sub to_button {
 27 |     my $locator = shift;
 28 |     return join '|', map { sprintf $_, $locator } (
 29 |         q!//input[(@type='submit' or @type='button' or @type='image') and @id='%s']!,
 30 |         q!//input[(@type='submit' or @type='button' or @type='image') and @name='%s']!,
 31 |         q!//input[(@type='submit' or @type='button' or @type='image') and @title='%s']!,
 32 |         q!//input[(@type='submit' or @type='button' or @type='image') and @value='%s']!,
 33 |         q!//input[@type='image' and @alt='%s']!,
 34 |         q!//button[@id='%s']!,
 35 |         q!//button[@name='%s']!,
 36 |         q!//button[@title='%s']!,
 37 |         q!//button[@value='%s']!,
 38 |         q!//button[text()[contains(.,'%s')]]!,
 39 |     );
 40 | }
 41 | 
 42 | sub to_link_or_button {
 43 |     my $locator = shift;
 44 |     return join '|', map { sprintf $_, $locator } (
 45 |         q!//a[@id='%s']!,
 46 |         q!//a[@name='%s']!,
 47 |         q!//a[@title='%s']!,
 48 |         q!//a[text()[contains(.,'%s')]]!,
 49 |         q!//a//img[@alt='%s']!,
 50 |         q!//input[(@type='submit' or @type='button' or @type='image') and @id='%s']!,
 51 |         q!//input[(@type='submit' or @type='button' or @type='image') and @name='%s']!,
 52 |         q!//input[(@type='submit' or @type='button' or @type='image') and @title='%s']!,
 53 |         q!//input[(@type='submit' or @type='button' or @type='image') and @value='%s']!,
 54 |         q!//input[@type='image' and @alt='%s']!,
 55 |         q!//button[@id='%s']!,
 56 |         q!//button[@name='%s']!,
 57 |         q!//button[@title='%s']!,
 58 |         q!//button[@value='%s']!,
 59 |         q!//button[text()[contains(.,'%s')]]!,
 60 |     );
 61 | }
 62 | 
 63 | sub to_text_field {
 64 |     my $locator = shift;
 65 |     return join '|', map { sprintf $_, $locator } (
 66 |         q!//input[(@type='text' or @type='password' or @type='hidden' or not(@type)) and @id='%s']!,
 67 |         q!//input[(@type='text' or @type='password' or @type='hidden' or not(@type)) and @name='%s']!,
 68 |         q!//input[(@type='text' or @type='password' or @type='hidden' or not(@type)) and @title='%s']!,
 69 |         q!//input[(@type='text' or @type='password' or @type='hidden' or not(@type)) and @value='%s']!,
 70 |         q!//input[(@type='text' or @type='password' or @type='hidden' or not(@type)) and @id=//label[text()[contains(.,'%s')]]/@for]!,
 71 |         q!//label[text()[contains(.,'%s')]]//input[(@type='text' or @type='password' or @type='hidden' or not(@type))]!,
 72 |         q!//textarea[@id='%s']!,
 73 |         q!//textarea[@name='%s']!,
 74 |         q!//textarea[@title='%s']!,
 75 |         q!//textarea[@id=//label[text()[contains(.,'%s')]]/@for]!,
 76 |         q!//label[text()[contains(.,'%s')]]//textarea!,
 77 |     );
 78 | }
 79 | 
 80 | sub to_radio {
 81 |     my $locator = shift;
 82 |     return join '|', map { sprintf $_, $locator } (
 83 |         q!//input[@type='radio' and @id='%s']!,
 84 |         q!//input[@type='radio' and @name='%s']!,
 85 |         q!//input[@type='radio' and @title='%s']!,
 86 |         q!//input[@type='radio' and @value='%s']!,
 87 |         q!//input[@type='radio' and @id=//label[text()[contains(.,'%s')]]/@for]!,
 88 |         q!//label[text()[contains(.,'%s')]]//input[@type='radio']!,
 89 |     );
 90 | }
 91 | 
 92 | sub to_checkbox {
 93 |     my $locator = shift;
 94 |     return join '|', map { sprintf $_, $locator } (
 95 |         q!//input[@type='checkbox' and @id='%s']!,
 96 |         q!//input[@type='checkbox' and @name='%s']!,
 97 |         q!//input[@type='checkbox' and @title='%s']!,
 98 |         q!//input[@type='checkbox' and @value='%s']!,
 99 |         q!//input[@type='checkbox' and @id=//label[text()[contains(.,'%s')]]/@for]!,
100 |         q!//label[text()[contains(.,'%s')]]//input[@type='checkbox']!,
101 |     );
102 | }
103 | 
104 | sub to_option {
105 |     my $locator = shift;
106 |     return join '|', map { sprintf $_, $locator } (
107 |         q!//option[@id='%s']!,
108 |         q!//option[@name='%s']!,
109 |         q!//option[@title='%s']!,
110 |         q!//option[@value='%s']!,
111 |         q!//option[text()[contains(.,'%s')]]!,
112 |     );
113 | }
114 | 
115 | sub to_file_field {
116 |     my $locator = shift;
117 |     return join '|', map { sprintf $_, $locator } (
118 |         q!//input[@type='file' and @id='%s']!,
119 |         q!//input[@type='file' and @name='%s']!,
120 |         q!//input[@type='file' and @title='%s']!,
121 |         q!//input[@type='file' and @id=//label[text()[contains(.,'%s')]]/@for]!,
122 |         q!//label[text()[contains(.,'%s')]]//input[@type='file']!,
123 |     );
124 | }
125 | 
126 | 1;
127 | 
128 | =head1 NAME
129 | 
130 | Brownie::XPath
131 | 
132 | =head1 AUTHOR
133 | 
134 | NAKAGAWA Masaki E<lt>masaki@cpan.orgE<gt>
135 | 
136 | =head1 LICENSE
137 | 
138 | This library is free software; you can redistribute it and/or modify
139 | it under the same terms as Perl itself.
140 | 
141 | =head1 SEE ALSO
142 | 
143 | L<Brownie::Session>
144 | 
145 | =cut
146 | 


--------------------------------------------------------------------------------
/lib/Brownie/Driver/SeleniumServer.pm:
--------------------------------------------------------------------------------
  1 | package Brownie::Driver::SeleniumServer;
  2 | 
  3 | use strict;
  4 | use warnings;
  5 | use parent 'Brownie::Driver';
  6 | use Selenium::Remote::Driver;
  7 | use Selenium::Server;
  8 | use Scalar::Util qw(blessed);
  9 | use URI;
 10 | use File::Slurp qw(write_file);
 11 | use MIME::Base64 qw(decode_base64);
 12 | 
 13 | use Brownie::XPath;
 14 | use Brownie::Node::SeleniumServer;
 15 | 
 16 | our $NodeClass = 'Brownie::Node::SeleniumServer';
 17 | 
 18 | sub new {
 19 |     my ($class, %args) = @_;
 20 | 
 21 |     if ($ENV{SELENIUM_REMOTE_SERVER_HOST} && $ENV{SELENIUM_REMOTE_SERVER_PORT}) {
 22 |        $args{server_host} = $ENV{SELENIUM_REMOTE_SERVER_HOST};
 23 |        $args{server_port} = $ENV{SELENIUM_REMOTE_SERVER_PORT};
 24 |     }
 25 |     else {
 26 |         my $server = $class->_create_selenium_server(%args);
 27 |         if ($server) {
 28 |             $args{server}      = $server;
 29 |             $args{server_host} = $server->host;
 30 |             $args{server_port} = $server->port,
 31 |         }
 32 |     }
 33 | 
 34 |     $args{browser_name} ||= ($ENV{SELENIUM_BROWSER_NAME} || 'firefox');
 35 | 
 36 |     return $class->SUPER::new(%args);
 37 | }
 38 | 
 39 | sub _create_selenium_server {
 40 |     my ($class, %args) = @_;
 41 | 
 42 |     my $server = Selenium::Server->new;
 43 |     $server->start if $server;
 44 | 
 45 |     $server;
 46 | }
 47 | 
 48 | sub DESTROY {
 49 |     my $self = shift;
 50 | 
 51 |     delete $self->{browser};
 52 | 
 53 |     if ($self->{server}) {
 54 |         $self->{server}->stop;
 55 |         delete $self->{server};
 56 |     }
 57 | }
 58 | 
 59 | sub server_host  { shift->{server_host}  }
 60 | sub server_port  { shift->{server_port}  }
 61 | sub browser_name { shift->{browser_name} }
 62 | 
 63 | sub browser {
 64 |     my $self = shift;
 65 | 
 66 |     $self->{browser} ||= Selenium::Remote::Driver->new(
 67 |         remote_server_addr => $self->server_host,
 68 |         port               => $self->server_port,
 69 |         browser_name       => $self->browser_name,
 70 |     );
 71 | 
 72 |     return $self->{browser};
 73 | }
 74 | 
 75 | sub visit {
 76 |     my ($self, $url) = @_;
 77 |     $self->browser->get("$url"); # stringify for URI
 78 | }
 79 | 
 80 | sub current_url {
 81 |     my $self = shift;
 82 |     return URI->new($self->browser->get_current_url);
 83 | }
 84 | 
 85 | sub current_path {
 86 |     my $self = shift;
 87 |     return $self->current_url->path;
 88 | }
 89 | 
 90 | sub title {
 91 |     my $self = shift;
 92 |     return $self->browser->get_title;
 93 | }
 94 | 
 95 | sub source {
 96 |     my $self = shift;
 97 |     return $self->browser->get_page_source;
 98 | }
 99 | 
100 | sub screenshot {
101 |     my ($self, $file) = @_;
102 |     my $image = decode_base64($self->browser->screenshot);
103 |     write_file($file, { binmode => ':raw' }, $image);
104 | }
105 | 
106 | sub find {
107 |     my ($self, $locator, %args) = @_;
108 | 
109 |     my $element;
110 |     my $xpath = Brownie::XPath::to_xpath($locator);
111 | 
112 |     if (my $base = $args{base}) {
113 |         my $node = (blessed($base) and $base->can('native')) ? $base->native : $base;
114 |         $xpath = ".$xpath" unless $xpath =~ /^\./;
115 |         $element = eval { $self->browser->find_child_element($node, $xpath) }; # abs2rel
116 |     }
117 |     else {
118 |         $element = eval { $self->browser->find_element($xpath) };
119 |     }
120 | 
121 |     return $element ? $NodeClass->new(driver => $self, native => $element) : undef;
122 | }
123 | 
124 | sub all {
125 |     my ($self, $locator, %args) = @_;
126 | 
127 |     my @elements = ();
128 |     my $xpath = Brownie::XPath::to_xpath($locator);
129 | 
130 |     if (my $base = $args{base}) {
131 |         my $node = (blessed($base) and $base->can('native')) ? $base->native : $base;
132 |         $xpath = ".$xpath" unless $xpath =~ /^\./;
133 |         @elements = eval { $self->browser->find_child_elements($node, $xpath) }; # abs2rel
134 |     }
135 |     else {
136 |         @elements = eval { $self->browser->find_elements($xpath) };
137 |     }
138 | 
139 |     return @elements ? map { $NodeClass->new(driver => $self, native => $_) } @elements : ();
140 | }
141 | 
142 | sub execute_script {
143 |     my ($self, $script) = @_;
144 |     $self->browser->execute_script($script);
145 | }
146 | 
147 | sub evaluate_script {
148 |     my ($self, $script) = @_;
149 |     return $self->browser->execute_script("return $script");
150 | }
151 | 
152 | 1;
153 | 
154 | =head1 NAME
155 | 
156 | Brownie::Driver::SeleniumServer - Selenium RemoteWebDriver bridge
157 | 
158 | =head1 SYNOPSIS
159 | 
160 |   # use default browser (firefox)
161 |   my $driver = Brownie::Driver::SeleniumServer->new;
162 | 
163 |   # specify browser
164 |   my $driver = Brownie::Driver::SeleniumServer->new(browser_name => 'chrome');
165 | 
166 |   $driver->visit($url);
167 |   my $title = $driver->title;
168 | 
169 | =head1 METHODS
170 | 
171 | =head2 IMPLEMENTED
172 | 
173 | =over 4
174 | 
175 | =item * C<new( %args )>
176 | 
177 |   my $driver = Brownie::Driver::SeleniumServer->new(%args);
178 | 
179 | C<%args> are:
180 | 
181 |   * browser_name: selenium-server's browser name (default: "firefox")
182 | 
183 | You can also set selenium-server parameters using C<%ENV>:
184 | 
185 |   * SELENIUM_BROWSER_NAME
186 | 
187 | =item * C<browser>
188 | 
189 | =item * C<visit($url)>
190 | 
191 | =item * C<current_url>
192 | 
193 | =item * C<current_path>
194 | 
195 | =item * C<title>
196 | 
197 | =item * C<source>
198 | 
199 | =item * C<screenshot($filename)>
200 | 
201 | =item * C<execute_script($javascript)>
202 | 
203 | =item * C<evaluate_script($javascript)>
204 | 
205 | =item * C<find($locator)>
206 | 
207 | =item * C<all($locator)>
208 | 
209 | =back
210 | 
211 | =head2 NOT SUPPORTED
212 | 
213 | =over 4
214 | 
215 | =item * C<status_code>
216 | 
217 | =item * C<response_headers>
218 | 
219 | =back
220 | 
221 | =head1 TIPS
222 | 
223 | =head2 Use external selenium server
224 | 
225 | If you secify "SELENIUM_REMOTE_SERVER_HOST" and "SELENIUM_REMOTE_SERVER_PORT" enviromnent valiables, Brownie uses its server for selenium server.  By this, you can quicken the execution of your tests.
226 | 
227 | =head1 AUTHOR
228 | 
229 | NAKAGAWA Masaki E<lt>masaki@cpan.orgE<gt>
230 | 
231 | =head1 LICENSE
232 | 
233 | This library is free software; you can redistribute it and/or modify
234 | it under the same terms as Perl itself.
235 | 
236 | =head1 SEE ALSO
237 | 
238 | L<Brownie::Driver>, L<Selenium::Remote::Driver>, L<Brownie::Node::SeleniumServer>
239 | 
240 | L<http://code.google.com/p/selenium/wiki/RemoteWebDriver>
241 | 
242 | L<http://code.google.com/p/selenium/wiki/RemoteWebDriverServer>
243 | 
244 | =cut
245 | 


--------------------------------------------------------------------------------
/lib/Brownie/Node/Mechanize.pm:
--------------------------------------------------------------------------------
  1 | package Brownie::Node::Mechanize;
  2 | 
  3 | use strict;
  4 | use warnings;
  5 | use parent 'Brownie::Node';
  6 | use Carp ();
  7 | 
  8 | sub _find_outer_link {
  9 |     my $self = shift;
 10 | 
 11 |     my @links = $self->native->look_up(sub {
 12 |         return lc($_[0]->tag) eq 'a' && $_[0]->attr('href');
 13 |     });
 14 | 
 15 |     return @links ? $links[0]->attr('href') : '';
 16 | }
 17 | 
 18 | sub _find_select_selector {
 19 |     my $self = shift;
 20 | 
 21 |     my ($select) = $self->native->look_up(sub {
 22 |         return lc($_[0]->tag) eq 'select' && ($_[0]->attr('id') || $_[0]->attr('name'));
 23 |     });
 24 | 
 25 |     return unless $select;
 26 | 
 27 |     if (my $id = $select->attr('id')) {
 28 |         return '#'.$id;
 29 |     }
 30 |     elsif (my $name = $select->attr('name')) {
 31 |         return '^'.$name;
 32 |     }
 33 | }
 34 | 
 35 | sub _is_text_field {
 36 |     my $self = shift;
 37 |     return 1 if $self->tag_name eq 'textarea';
 38 |     return 1 if $self->tag_name eq 'input' && ($self->type =~ /^(?:text|password|file|hidden)$/i || !$self->type);
 39 |     return 0;
 40 | }
 41 | 
 42 | sub _is_button {
 43 |     my $self = shift;
 44 |     return 1 if $self->tag_name eq 'input'  && $self->type =~ /^(?:submit|image)$/i;
 45 |     return 1 if $self->tag_name eq 'button' && (!$self->type || $self->type eq 'submit');
 46 |     return 0;
 47 | }
 48 | 
 49 | sub _is_checkbox {
 50 |     my $self = shift;
 51 |     return $self->tag_name eq 'input' && $self->type eq 'checkbox';
 52 | }
 53 | 
 54 | sub _is_radio {
 55 |     my $self = shift;
 56 |     return $self->tag_name eq 'input' && $self->type eq 'radio';
 57 | }
 58 | 
 59 | sub _is_option {
 60 |     my $self = shift;
 61 |     return $self->tag_name eq 'option';
 62 | }
 63 | 
 64 | sub _is_in_multiple_select {
 65 |     my $self = shift;
 66 | 
 67 |     return $self->native->look_up(sub {
 68 |         return lc($_[0]->tag) eq 'select' && $_[0]->attr('multiple');
 69 |     });
 70 | }
 71 | 
 72 | sub _is_form_control {
 73 |     my $self = shift;
 74 |     return $self->_is_text_field
 75 |         || $self->_is_button
 76 |         || $self->_is_checkbox
 77 |         || $self->_is_radio
 78 |         || $self->_is_option;
 79 | }
 80 | 
 81 | sub attr {
 82 |     my ($self, $name) = @_;
 83 |     return $self->native->attr($name) || '';
 84 | }
 85 | 
 86 | sub text {
 87 |     my $self = shift;
 88 |     return $self->native->as_text;
 89 | }
 90 | 
 91 | sub tag_name {
 92 |     my $self = shift;
 93 |     return lc $self->native->tag;
 94 | }
 95 | 
 96 | sub _mech { return shift->driver->browser }
 97 | 
 98 | sub _mech_selector {
 99 |     my $self = shift;
100 | 
101 |     my $selector = '';
102 |     if (my $id = $self->id) {
103 |         $selector = "#$id";
104 |     }
105 |     elsif (my $name = $self->name) {
106 |         $selector = "^$name";
107 |     }
108 | 
109 |     return $selector;
110 | }
111 | 
112 | sub is_displayed { !shift->is_not_displayed }
113 | 
114 | sub is_not_displayed {
115 |     my $self = shift;
116 | 
117 |     my @hidden = $self->native->look_up(sub {
118 |         return 1 if lc($_[0]->attr('style') || '') =~ /display\s*:\s*none/;
119 |         return 1 if lc($_[0]->tag) eq 'script' || lc($_[0]->tag) eq 'head';
120 |         return 1 if lc($_[0]->tag) eq 'input' && lc($_[0]->attr('type') || '') eq 'hidden';
121 |         return 0;
122 |     });
123 | 
124 |     return scalar(@hidden) > 0;
125 | }
126 | 
127 | sub is_selected {
128 |     my $self = shift;
129 |     return $self->attr('selected') || $self->attr('checked');
130 | }
131 | 
132 | *is_checked = \&is_selected;
133 | 
134 | sub set {
135 |     my ($self, $value) = @_;
136 | 
137 |     if ($self->_is_text_field) {
138 |         $self->_mech->field($self->_mech_selector, $value);
139 |     }
140 |     elsif ($self->_is_checkbox || $self->_is_radio || $self->_is_option) {
141 |         $self->select;
142 |     }
143 |     else {
144 |         Carp::carp("This element is not a form control.");
145 |     }
146 | }
147 | 
148 | sub select {
149 |     my $self = shift;
150 | 
151 |     if ($self->_is_checkbox) {
152 |         $self->_mech->tick($self->_mech_selector, $self->value);
153 |         $self->native->attr(checked => 'checked');
154 |     }
155 |     elsif ($self->_is_radio) {
156 |         $self->_mech->set_visible([ radio => $self->value ]);
157 |         $self->native->attr(selected => 'selected');
158 |     }
159 |     elsif ($self->_is_option) {
160 |         # TODO: multiple
161 |         my $selector = $self->_find_select_selector;
162 |         if ($selector) {
163 |             $self->_mech->select($selector, $self->value);
164 |             $self->native->attr(selected => 'selected');
165 |         }
166 |     }
167 |     else {
168 |         Carp::carp("This element is not selectable.");
169 |     }
170 | }
171 | 
172 | sub unselect {
173 |     my $self = shift;
174 | 
175 |     if ($self->_is_checkbox) {
176 |         $self->_mech->untick($self->_mech_selector, $self->value);
177 |         $self->native->attr(checked => '');
178 |     }
179 |     elsif ($self->_is_option && $self->_is_in_multiple_select) {
180 |         my $selector = $self->_find_select_selector;
181 |         if ($selector) {
182 |             $self->_mech->field($selector, undef);
183 |             $self->native->attr(selected => '');
184 |         }
185 |     }
186 |     else {
187 |         Carp::carp("This element is not selectable.");
188 |     }
189 | }
190 | 
191 | sub click {
192 |     my $self = shift;
193 | 
194 |     if ($self->_is_form_control) {
195 |         if ($self->_is_button) {
196 |             my %args = $self->name ? (name => $self->name) : (value => $self->value);
197 |             $self->_mech->click_button(%args);
198 |         }
199 |         elsif ($self->_is_checkbox || $self->_is_option) {
200 |             $self->is_checked ? $self->unselect : $self->select;
201 |         }
202 |         elsif ($self->_is_radio) {
203 |             $self->select;
204 |         }
205 |         else {
206 |             Carp::carp("This element is not a clickable control.");
207 |         }
208 |     }
209 |     elsif (my $link = $self->_find_outer_link) {
210 |         $self->_mech->follow_link(url => $link);
211 |     }
212 |     else {
213 |         Carp::carp("This element is not clickable.");
214 |     }
215 | }
216 | 
217 | 1;
218 | 
219 | =head1 NAME
220 | 
221 | Brownie::Node::Mechanize - base class of Brownie::Node series
222 | 
223 | =head1 METHODS
224 | 
225 | =over 4
226 | 
227 | =item * C<new(%args)>
228 | 
229 | =item * C<driver>
230 | 
231 | =item * C<native>
232 | 
233 | =item * C<attr($name)>
234 | 
235 | =item * C<id>
236 | 
237 | =item * C<name>
238 | 
239 | =item * C<type>
240 | 
241 | =item * C<value>
242 | 
243 | =item * C<text>
244 | 
245 | =item * C<tag_name>
246 | 
247 | =item * C<is_displayed>
248 | 
249 | =item * C<is_checked>
250 | 
251 | =item * C<is_selected>
252 | 
253 | =item * C<is_not_displayed>
254 | 
255 | =item * C<is_not_checked>
256 | 
257 | =item * C<is_not_selected>
258 | 
259 | =item * C<set($value)>
260 | 
261 | =item * C<select>
262 | 
263 | =item * C<unselect>
264 | 
265 | =item * C<click>
266 | 
267 | =item * C<find($locator)>
268 | 
269 | =item * C<first($locator)>
270 | 
271 | =item * C<all($locator)>
272 | 
273 | =back
274 | 
275 | =head1 AUTHOR
276 | 
277 | NAKAGAWA Masaki E<lt>masaki@cpan.orgE<gt>
278 | 
279 | =head1 LICENSE
280 | 
281 | This library is free software; you can redistribute it and/or modify
282 | it under the same terms as Perl itself.
283 | 
284 | =head1 SEE ALSO
285 | 
286 | L<Brownie::Node>, L<Brownie::Driver>, L<Brownie::Driver::Mechanize>
287 | 
288 | L<HTML::Element>, L<WWW::Mechanize>
289 | 
290 | =cut
291 | 


--------------------------------------------------------------------------------
/lib/Brownie/Session.pm:
--------------------------------------------------------------------------------
  1 | package Brownie::Session;
  2 | 
  3 | use strict;
  4 | use warnings;
  5 | use Carp ();
  6 | use Class::Load;
  7 | use Sub::Install;
  8 | use Plack::Runner;
  9 | use Test::TCP;
 10 | 
 11 | use Brownie::Driver;
 12 | use Brownie::Node;
 13 | use Brownie::XPath;
 14 | 
 15 | sub new {
 16 |     my ($class, %args) = @_;
 17 | 
 18 |     my $self = +{
 19 |         scopes   => [],
 20 |         driver   => $class->_create_driver($args{driver}),
 21 |         app_host => $args{app_host},
 22 |     };
 23 | 
 24 |     if ($args{app}) {
 25 |         my $server = $class->_create_server($args{app});
 26 |         if ($server) {
 27 |             $self->{server}   = $server;
 28 |             $self->{app_host} = 'http://localhost:' . $server->port;
 29 |         }
 30 |     }
 31 | 
 32 |     return bless $self => $class;
 33 | }
 34 | 
 35 | sub DESTROY {
 36 |     my $self = shift;
 37 |     delete $self->{driver} if exists $self->{driver};
 38 |     delete $self->{server} if exists $self->{server};
 39 | }
 40 | 
 41 | sub _create_driver {
 42 |     my ($class, $opts) = @_;
 43 | 
 44 |     $opts ||= { name => 'Mechanize' };
 45 |     $opts = { name => $opts } unless ref $opts;
 46 | 
 47 |     my $klass = $opts->{class} || 'Brownie::Driver::' . $opts->{name};
 48 |     Class::Load::load_class($klass);
 49 | 
 50 |     return $klass->new(%{ $opts->{args} || {} });
 51 | }
 52 | 
 53 | sub _create_server {
 54 |     my ($class, $app, %args) = @_;
 55 |     return unless $app;
 56 | 
 57 |     my $server = Test::TCP->new(
 58 |         code => sub {
 59 |             my $port = shift;
 60 | 
 61 |             my $r = Plack::Runner->new(app => $app);
 62 |             $r->parse_options('--port' => $port, '--env' => 'test');
 63 |             $r->set_options(%args);
 64 |             $r->run;
 65 |         },
 66 |     );
 67 | }
 68 | 
 69 | sub driver   { shift->{driver} }
 70 | sub server   { shift->{server} }
 71 | sub app_host { shift->{app_host} }
 72 | 
 73 | for my $method (qw/
 74 |     current_url
 75 |     current_path
 76 |     status_code
 77 |     response_headers
 78 |     title
 79 |     source
 80 |     screenshot
 81 |     execute_script
 82 |     evaluate_script
 83 | /) {
 84 |     Sub::Install::install_sub({
 85 |         code => sub { shift->driver->$method(@_) },
 86 |         as   => $method,
 87 |     });
 88 | }
 89 | 
 90 | *body = \&source;
 91 | 
 92 | sub visit {
 93 |     my ($self, $url) = @_;
 94 | 
 95 |     if ($self->app_host && $url !~ /^http/) {
 96 |         $url = $self->app_host . $url;
 97 |     }
 98 | 
 99 |     $self->driver->visit($url);
100 | }
101 | 
102 | sub current_node {
103 |     my $self = shift;
104 |     if (@{$self->{scopes}}) {
105 |         return $self->{scopes}->[-1];
106 |     }
107 |     else {
108 |         return $self->document;
109 |     }
110 | }
111 | 
112 | sub document { shift->driver->find('/html') }
113 | 
114 | sub find  { $_[0]->current_node->find($_[1])  }
115 | sub first { $_[0]->current_node->first($_[1]) }
116 | sub all   { $_[0]->current_node->all($_[1])   }
117 | 
118 | sub _do_safe_action {
119 |     my $code = shift;
120 |     my $ret = eval { $code->(); 1 } || 0;
121 |     Carp::carp($@) if $@;
122 |     return $ret;
123 | }
124 | 
125 | sub click_link {
126 |     my ($self, $locator) = @_;
127 |     my $xpath = Brownie::XPath::to_link($locator);
128 |     _do_safe_action(sub { $self->find($xpath)->click });
129 | }
130 | 
131 | sub click_button {
132 |     my ($self, $locator) = @_;
133 |     my $xpath = Brownie::XPath::to_button($locator);
134 |     _do_safe_action(sub { $self->find($xpath)->click });
135 | }
136 | 
137 | sub click_link_or_button {
138 |     my ($self, $locator) = @_;
139 |     my $xpath = Brownie::XPath::to_link_or_button($locator);
140 |     _do_safe_action(sub { $self->find($xpath)->click });
141 | }
142 | *click_on = \&click_link_or_button;
143 | 
144 | sub fill_in {
145 |     my ($self, $locator, $value) = @_;
146 |     my $xpath = Brownie::XPath::to_text_field($locator);
147 |     _do_safe_action(sub { $self->find($xpath)->set($value) });
148 | }
149 | 
150 | sub choose {
151 |     my ($self, $locator) = @_;
152 |     my $xpath = Brownie::XPath::to_radio($locator);
153 |     _do_safe_action(sub { $self->find($xpath)->select });
154 | }
155 | 
156 | sub check {
157 |     my ($self, $locator) = @_;
158 |     my $xpath = Brownie::XPath::to_checkbox($locator);
159 |     _do_safe_action(sub { $self->find($xpath)->select });
160 | }
161 | 
162 | sub uncheck {
163 |     my ($self, $locator) = @_;
164 |     my $xpath = Brownie::XPath::to_checkbox($locator);
165 |     _do_safe_action(sub { $self->find($xpath)->unselect });
166 | }
167 | 
168 | sub select {
169 |     my ($self, $locator) = @_;
170 |     my $xpath = Brownie::XPath::to_option($locator);
171 |     _do_safe_action(sub { $self->find($xpath)->select });
172 | }
173 | 
174 | sub unselect {
175 |     my ($self, $locator) = @_;
176 |     my $xpath = Brownie::XPath::to_option($locator);
177 |     _do_safe_action(sub { $self->find($xpath)->unselect });
178 | }
179 | 
180 | sub attach_file {
181 |     my ($self, $locator, $filename) = @_;
182 |     my $xpath = Brownie::XPath::to_file_field($locator);
183 |     _do_safe_action(sub { $self->find($xpath)->set($filename) });
184 | }
185 | 
186 | 1;
187 | 
188 | =head1 NAME
189 | 
190 | Brownie::Session - browser session class
191 | 
192 | =head1 SYNOPSIS
193 | 
194 |   use Test::More;
195 |   use Brownie::Session;
196 | 
197 |   # external server
198 |   my $session = Brownie::Session->new(
199 |       driver   => 'Mechanize',
200 |       app_host => 'http://app.example.com:5000',
201 |   );
202 | 
203 |   # PSGI app
204 |   my $session = Brownie::Session->new(
205 |       driver => 'Mechanize',
206 |       app    => sub { ...(PSGI app)... },
207 |   );
208 | 
209 |   # PSGI file
210 |   my $session = Brownie::Session->new(
211 |       driver => 'Mechanize',
212 |       app    => 'app.psgi',
213 |   );
214 | 
215 |   $session->visit('/');
216 |   is $session->title => 'Some Title';
217 | 
218 |   $session->fill_in('User Name' => 'brownie');
219 |   $session->fill_in('Email Address' => 'brownie@example.com');
220 |   $session->click_button('Login');
221 |   like $session->source => qr/Welcome (.+)/;
222 | 
223 |   $session->fill_in(q => 'Brownie');
224 |   $session->click_link_or_button('Search');
225 |   like $session->title => qr/Search result of Brownie/i;
226 | 
227 |   done_testing;
228 | 
229 | =head1 METHODS
230 | 
231 | =over 4
232 | 
233 | =item * C<new(%args)>
234 | 
235 |   my $session = Brownie::Session->new(%args);
236 | 
237 | C<%args> are:
238 | 
239 | =over 8
240 | 
241 | =item * C<driver>: loadable driver name or config
242 | 
243 | =item * C<app_host>: external target application
244 | 
245 | =item * C<app>: PSGI application
246 | 
247 | =back
248 | 
249 | =back
250 | 
251 | =head2 Driver Delegation
252 | 
253 | =over 4
254 | 
255 | =item * C<visit($url)>
256 | 
257 | Go to $url.
258 | 
259 |   $session->visit('http://example.com/');
260 | 
261 | =item * C<current_url>
262 | 
263 | Returns current page's URL.
264 | 
265 |   my $url = $session->current_url;
266 | 
267 | =item * C<current_path>
268 | 
269 | Returns current page's path of URL.
270 | 
271 |   my $path = $session->current_path;
272 | 
273 | =item * C<title>
274 | 
275 | Returns current page's <title> text.
276 | 
277 |   my $title = $session->title;
278 | 
279 | =item * C<source>
280 | 
281 | Returns current page's HTML source.
282 | 
283 |   my $source = $session->source;
284 | 
285 | =item * C<screenshot($filename)>
286 | 
287 | Takes current page's screenshot and saves to $filename as PNG.
288 | 
289 |   $session->screenshot($filename);
290 | 
291 | =item * C<execute_script($javascript)>
292 | 
293 | Executes snippet of JavaScript into current page.
294 | 
295 |   $session->execute_script('$("body").empty()');
296 | 
297 | =item * C<evaluate_script($javascript)>
298 | 
299 | Executes snipptes and returns result.
300 | 
301 |   my $result = $session->evaluate_script('1 + 2');
302 | 
303 | If specified DOM element, it returns WebElement object.
304 | 
305 |   my $node = $session->evaluate_script('document.getElementById("foo")');
306 | 
307 | =back
308 | 
309 | =head2 Node Action
310 | 
311 | =over 4
312 | 
313 | =item * C<click_link($locator)>
314 | 
315 | Finds and clicks specified link.
316 | 
317 |   $session->click_link($locator);
318 | 
319 | C<$locator>: id or text of link
320 | 
321 | =item * C<click_button($locator)>
322 | 
323 | Finds and clicks specified buttons.
324 | 
325 |   $session->click_button($locator);
326 | 
327 | C<$locator>: id or value of button
328 | 
329 | =item * C<click_on($locator)>
330 | 
331 | Finds and clicks specified links or buttons.
332 | 
333 |   $session->click_on($locator);
334 | 
335 | It combines C<click_link> and C<click_button>.
336 | 
337 | =item * C<fill_in($locator, $value)>
338 | 
339 | Sets a value to located field (input or textarea).
340 | 
341 |   $session->fill_in($locator, $value);
342 | 
343 | =item * C<choose($locator)>
344 | 
345 | Selects a radio button.
346 | 
347 |   $session->choose($locator);
348 | 
349 | =item * C<check($locator)>
350 | 
351 | Sets a checkbox to "checked"
352 | 
353 |   $session->check($locator);
354 | 
355 | =item * C<uncheck($locator)>
356 | 
357 | Unsets a checkbox from "checked"
358 | 
359 |   $session->check($locator);
360 | 
361 | =item * C<select($locator)>
362 | 
363 | Selects an option.
364 | 
365 |   $session->select($locator);
366 | 
367 | =item * C<unselect($locator)>
368 | 
369 | Unselects an option in multiple select.
370 | 
371 |   $session->unselect($locator);
372 | 
373 | =item * C<attach_file($locator, $filename)>
374 | 
375 | Sets a path to file upload field.
376 | 
377 |   $session->attach_file($locator, $filename);
378 | 
379 | =back
380 | 
381 | =head1 AUTHOR
382 | 
383 | NAKAGAWA Masaki E<lt>masaki@cpan.orgE<gt>
384 | 
385 | =head1 LICENSE
386 | 
387 | This library is free software; you can redistribute it and/or modify
388 | it under the same terms as Perl itself.
389 | 
390 | =head1 SEE ALSO
391 | 
392 | L<Brownie::Driver>, L<Brownie::Node>
393 | 
394 | =cut
395 | 


--------------------------------------------------------------------------------