View | Details | Raw Unified | Return to bug 14536
Collapse All | Expand All

(-)a/misc/devel/interactiveWebDriverShell.pl (+176 lines)
Line 0 Link Here
1
#!/usr/bin/perl -d
2
3
# Copyright 2015 KohaSuomi
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, see <http://www.gnu.org/licenses>.
18
19
=head1 NAME
20
21
interactiveWebDriverShell.pl
22
23
=head1 SYNOPSIS
24
25
    misc/devel/interactiveWebDriverShell.pl -p mainpage.pl
26
27
Prepares a perl debugger session with the requested PageObject loaded.
28
Then you can easily guide the UserAgent through the web session.
29
30
=cut
31
32
use Modern::Perl;
33
34
use Getopt::Long qw(:config no_ignore_case);
35
use Data::Dumper;
36
37
my ($help, $page, $list, @params, @login);
38
39
GetOptions(
40
    "h|help"        => \$help,
41
    "p|page=s"      => \$page,
42
    "P|params=s{,}" => \@params,
43
    "L|login=s{,}"  => \@login,
44
    "l|list"        => \$list,
45
);
46
47
my $help_msg = <<HELP;
48
49
interactiveWebDriverShell.pl
50
51
    Prepares a perl debugger session with the requested PageObject loaded.
52
    Then you can easily guide the UserAgent through the web session.
53
54
    You should install Term::ReadLine::Gnu for a more pleasant debugging experience.
55
56
    -h --help   This help!
57
58
    -p --page   Which PageObject matching the given page you want to preload?
59
60
    -P --params List of parameters the PageObject must have.
61
62
    -L --login  List of userid and password to automatically login to Koha. Eg:
63
                ./interactiveWebDriverShell.pl -L admin 1234 -p members/moremember.pl -P 12
64
65
    -l --list   Lists available PageObjects and their matching --page -parameter
66
                values.
67
68
EXAMPLE INVOCATIONS:
69
70
./interactiveWebDriverShell.pl -p mainpage.pl -L admin 1234
71
./interactiveWebDriverShell.pl -p members/moremember.pl -P 1 -L admin 1234
72
73
USAGE:
74
75
Start the session from your shell
76
    ..\$ misc/devel/interactiveWebDriverShell.pl -p mainpage.pl
77
or
78
Start the session from your shell with parameters
79
    ..\$ misc/devel/interactiveWebDriverShell.pl -p members/moremember.pl -P 12
80
81
Continue to the breakpoint set in this script
82
    DB<1> c
83
84
The PageObject is bound to variable \$po,
85
and the Selenium::Remote::Driver-implementation to \$d.
86
Then all you need to do is start navigating the web!
87
    DB<2> \$po->isPasswordLoginAvailable()->doPasswordLogin('admin','1234');
88
89
    DB<3> \$ele = \$d->find_element('input[value="Save"]');
90
91
Note! Do not use "my \$ele = 123;" in the debugger session, because that doesn't
92
work as excepted, simply use "\$ele = 123;".
93
94
HELP
95
96
if ($help) {
97
    print $help_msg;
98
    exit;
99
}
100
unless ($page || $list) {
101
    print $help_msg;
102
    exit;
103
}
104
105
my $supportedPageObjects = {
106
    'mainpage.pl' =>
107
    {   package     => "t::lib::Page::Mainpage",
108
        urlEndpoint => "mainpage.pl",
109
        status      => "OK",
110
        params      => "none",
111
    },
112
    "members/moremember.pl" =>
113
    {   package     => "t::lib::Page::Members::Moremember",
114
        urlEndpoint => "members/moremember.pl",
115
        status      => "not implemented",
116
        params      => ["borrowernumber"],
117
    },
118
    "members/member-flags.pl" =>
119
    {   package     => "t::lib::Page::Members::MemberFlags",
120
        urlEndpoint => "members/member-flags.pl",
121
        status      => "not implemented",
122
        params      => ["borrowernumber"],
123
    },
124
};
125
126
listSupportedPageObjects ($supportedPageObjects) if $list;
127
my ($po, $d) = deployPageObject($supportedPageObjects, $page, \@params, \@login) if $page;
128
129
130
131
print "--Debugging--\n";
132
$DB::single = 1; #Breakpoint here
133
$DB::single = 1;
134
135
136
137
sub listSupportedPageObjects {
138
    my ($supportedPageObjects) = @_;
139
    print Data::Dumper::Dumper($supportedPageObjects);
140
    exit;
141
}
142
sub deployPageObject {
143
    my ($supportedPageObjects, $page, $params, $login) = @_;
144
145
    ##Find correct PageObject deployment rules
146
    my $pageObjectMapping = $supportedPageObjects->{$page};
147
    die "No PageObject mapped to --page '$page'. See --list to list available PageObjects.\n" unless $pageObjectMapping;
148
149
    ##Dynamically load package
150
    my $package = $pageObjectMapping->{package};
151
    eval "require $package";
152
153
    ##Fill required parameters
154
    my $poParams = {};
155
    if (ref($pageObjectMapping->{params}) eq 'ARRAY') {
156
        foreach my $paramName (@{$pageObjectMapping->{params}}) {
157
            $poParams->{$paramName} = shift(@$params);
158
            die "Insufficient parameters given, parameter '$paramName' unsatisfied.\n" unless $poParams->{$paramName};
159
        }
160
    }
161
162
    ##Check if the status is OK
163
    die "PageObject status for '$page' is not 'OK'. Current status '".$pageObjectMapping->{status}."'.\nPlease implement the missing PageObject.\n" unless $pageObjectMapping->{status} eq 'OK';
164
165
    ##Create PageObject
166
    my $po = $package->new($poParams);
167
168
    ##Password login if desired
169
    eval {
170
       $po->isPasswordLoginAvailable->doPasswordLogin($login->[0], $login->[1]) if scalar(@$login);
171
    }; if ($@) {
172
        print "Password login unavailable.\n";
173
    }
174
175
    return ($po, $po->getDriver());
176
}
(-)a/t/db_dependent/Koha/Auth.t (+72 lines)
Line 0 Link Here
1
#!/usr/bin/env perl
2
3
# Copyright 2015 Open Source Freedom Fighters
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use Test::More;
23
use Try::Tiny; #Even Selenium::Remote::Driver uses Try::Tiny :)
24
25
use t::lib::Page::Mainpage;
26
27
use t::db_dependent::TestObjects::Borrowers::BorrowerFactory;
28
29
##Setting up the test context
30
my $testContext = {};
31
32
my $password = '1234';
33
my $borrowerFactory = t::db_dependent::TestObjects::Borrowers::BorrowerFactory->new();
34
my $borrowers = $borrowerFactory->createTestGroup([
35
            {firstname  => 'Olli-Antti',
36
             surname    => 'Kivi',
37
             cardnumber => '1A01',
38
             branchcode => 'CPL',
39
             flags      => '1', #superlibrarian, not exactly a very good way of doing permission testing?
40
             userid     => 'mini_admin',
41
             password   => $password,
42
            },
43
        ], undef, $testContext);
44
45
##Test context set, starting testing:
46
eval { #run in a eval-block so we don't die without tearing down the test context
47
48
    testPasswordLogin();
49
50
};
51
if ($@) { #Catch all leaking errors and gracefully terminate.
52
    warn $@;
53
    tearDown();
54
    exit 1;
55
}
56
57
##All tests done, tear down test context
58
tearDown();
59
done_testing;
60
61
sub tearDown {
62
    t::db_dependent::TestObjects::ObjectFactory->tearDownTestContext($testContext);
63
}
64
65
######################################################
66
    ###  STARTING TEST IMPLEMENTATIONS         ###
67
######################################################
68
69
sub testPasswordLogin {
70
    my $mainpage = t::lib::Page::Mainpage->new();
71
    $mainpage->isPasswordLoginAvailable()->doPasswordLogin($borrowers->{'1A01'}->{userid}, $password)->quit();
72
}
(-)a/t/lib/Page.pm (+178 lines)
Line 0 Link Here
1
package t::lib::Page;
2
3
# Copyright 2015 Open Source Freedom Fighters
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
use Test::More;
22
23
use C4::Context;
24
25
use t::lib::WebDriverFactory;
26
27
use Koha::Exception::BadParameter;
28
29
=head NAME t::lib::Page
30
31
=head SYNOPSIS
32
33
PageObject-pattern parent class. Extend this to implement specific pages shown to our users.
34
35
PageObjects are used to make robust and reusable integration test components to test
36
various front-end features. PageObjects load a Selenium::Remote::Driver implementation,
37
phantomjs by default and use this to do scripted user actions in the browser,
38
eg. clicking HTML-elements, accepting popup dialogs, entering text to input fields.
39
40
PageObjects encapsulate those very low-level operations into clear and easily usable
41
actions or services, like doPasswordLogin().
42
PageObjects also seamlessly deal with navigation from one page to another, eg.
43
    my $mainpage = t::lib::Page::Mainpage->new();
44
    $mainpage->doPasswordLogin('admin', '1234')->gotoPatrons()->
45
               searchPatrons({keywordSearch => "Jane Doe"});
46
47
=head Class variables
48
49
Selenium::Remote::Driver driver, contains the driver implementation used to run these tests
50
t::Page::Common::Header header, the header page component (not implemented)
51
t::Page::Common::Footer footer, the footer page component (not implemented)
52
53
=cut
54
55
our $hostProtocol = 'http';
56
our $hostAddress = 'localhost';
57
our $hostPort = '443';
58
59
sub new {
60
    my ($class, $params) = @_;
61
    $params = _mergeDefaultConfig($params);
62
63
    my $self = {};
64
    bless($self, $class);
65
    unless ($params->{driver}) {
66
        my ($driver) = t::lib::WebDriverFactory::getUserAgentDrivers({phantomjs => $params});
67
        $self->{driver} = $driver;
68
    }
69
    $self->{type}     = $params->{type}; #This parameter is mandatory. _mergeDefaultConfig() dies without it.
70
    $self->{resource} = $params->{resource} || '/';
71
    $self->{resource} .= "?".join('&', @{$params->{getParams}}) if $params->{getParams};
72
    $self->{header}   = $params->{header}   || undef;
73
    $self->{footer}   = $params->{footer}   || undef;
74
75
    $self->{driver}->get( $self->{resource} );
76
    return $self;
77
}
78
79
=head _mergeDefaultConfig
80
81
@THROWS Koha::Exception::BadParameter
82
=cut
83
84
sub _mergeDefaultConfig {
85
    my ($params) = @_;
86
    unless (ref($params) eq 'HASH' && $params->{type}) {
87
        Koha::Exception::BadParameter->throw(error => "t::lib::Page:> When instantiating Page-objects, you must define the 'type'-parameter.");
88
    }
89
90
    my $testServerConfigs = C4::Context->config('testservers');
91
    my $conf = $testServerConfigs->{ $params->{type} };
92
    Koha::Exception::BadParameter->throw(error => "t::lib::Page:> Unknown 'type'-parameter '".$params->{type}."'. Values 'opac', 'staff' and 'rest' are supported.")
93
                unless $conf;
94
    #Merge given $params-config on top of the $KOHA_CONF's testservers-directives
95
    @$conf{keys %$params} = values %$params;
96
    return $conf;
97
}
98
99
=head quit
100
Wrapper for Selenium::Remote::Driver->quit(),
101
Delete the session & close open browsers.
102
103
When ending this browser session, it is polite to quit, or there is a risk of leaving
104
floating test browsers floating around.
105
=cut
106
107
sub quit {
108
    my $self = shift;
109
    $self->getDriver()->quit();
110
}
111
112
=head isPasswordLoginAvailable
113
114
    $page->isPasswordLoginAvailable();
115
116
@RETURN t::lib::Page-object
117
@CROAK if password login is unavailable.
118
=cut
119
120
sub isPasswordLoginAvailable {
121
    my $self = shift;
122
    my $d = $self->getDriver();
123
124
    _getPasswordLoginElements($d);
125
    ok(($d->get_title() =~ /Log in to Koha/), "PasswordLoginAvailable");
126
    return $self;
127
}
128
sub doPasswordLogin {
129
    my ($self, $username, $password) = @_;
130
    my $d = $self->getDriver();
131
132
    my ($submitButton, $useridInput, $passwordInput) = _getPasswordLoginElements($d);
133
    $useridInput->send_keys($username);
134
    $passwordInput->send_keys($password);
135
    $submitButton->click();
136
137
    my $cookies = $d->get_all_cookies();
138
    my @cgisessid = grep {$_->{name} eq 'CGISESSID'} @$cookies;
139
140
    ok(($d->get_title() !~ /Log in to Koha/ && #No longer in the login page
141
        $cgisessid[0]) #Cookie CGISESSID defined!
142
       , "PasswordLoginSucceeded");
143
144
    return $self; #After a succesfull password login, we are directed to the same page we tried to access.
145
}
146
sub _getPasswordLoginElements {
147
    my $d = shift;
148
    my $submitButton  = $d->find_element('#submit');
149
    my $useridInput   = $d->find_element('#userid');
150
    my $passwordInput = $d->find_element('#password');
151
    return ($submitButton, $useridInput, $passwordInput);
152
}
153
154
################################################
155
  ##  INTRODUCING OBJECT ACCESSORS  ##
156
################################################
157
sub setDriver {
158
    my ($self, $driver) = @_;
159
    $self->{driver} = $driver;
160
}
161
sub getDriver {
162
    my ($self) = @_;
163
    return $self->{driver};
164
}
165
166
################################################
167
  ##  INTRODUCING TESTING HELPERS  ##
168
################################################
169
sub debugOutput {
170
    my ($self) = @_;
171
    my $driver = $self->getDriver();
172
173
    print $driver->get_title()."\n";
174
    print $driver->get_all_cookies()."\n";
175
    print $driver->get_page_source()."\n";
176
}
177
178
1; #Make the compiler happy!
(-)a/t/lib/Page/Mainpage.pm (-1 / +45 lines)
Line 0 Link Here
0
- 
1
package t::lib::Page::Mainpage;
2
3
# Copyright 2015 Open Source Freedom Fighters
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use base qw(t::lib::Page);
23
24
=head NAME t::lib::Page::Mainpage
25
26
=head SYNOPSIS
27
28
Mainpage PageObject providing page functionality as a service!
29
30
=cut
31
32
sub new {
33
    my ($class, $params) = @_;
34
    unless (ref($params) eq 'HASH') {
35
        $params = {};
36
    }
37
    $params->{resource} = '/cgi-bin/koha/mainpage.pl';
38
    $params->{type}     = 'staff';
39
    my $self = $class->SUPER::new($params);
40
41
    return $self;
42
}
43
44
45
1; #Make the compiler happy!

Return to bug 14536