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

(-)a/misc/devel/interactiveWebDriverShell.pl (+190 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
################################################################################
107
  ########## STAFF CONFIGURATIONS ##########
108
################################################################################
109
    'mainpage.pl' =>
110
    {   package     => "t::lib::Page::Mainpage",
111
        urlEndpoint => "mainpage.pl",
112
        status      => "OK",
113
        params      => "none",
114
    },
115
    "members/moremember.pl" =>
116
    {   package     => "t::lib::Page::Members::Moremember",
117
        urlEndpoint => "members/moremember.pl",
118
        status      => "not implemented",
119
        params      => ["borrowernumber"],
120
    },
121
    "members/member-flags.pl" =>
122
    {   package     => "t::lib::Page::Members::MemberFlags",
123
        urlEndpoint => "members/member-flags.pl",
124
        status      => "not implemented",
125
        params      => ["borrowernumber"],
126
    },
127
################################################################################
128
  ########## OPAC CONFIGURATIONS ##########
129
################################################################################
130
    "opac/opac-main.pl" =>
131
    {   package     => "t::lib::Page::Opac::OpacMain",
132
        urlEndpoint => "opac/opac-main.pl",
133
        status      => "OK",
134
    },
135
};
136
################################################################################
137
  ########## END OF PAGE CONFIGURATIONS ##########
138
################################################################################
139
140
listSupportedPageObjects ($supportedPageObjects) if $list;
141
my ($po, $d) = deployPageObject($supportedPageObjects, $page, \@params, \@login) if $page;
142
143
144
145
print "--Debugging--\n";
146
$DB::single = 1; #Breakpoint here
147
$DB::single = 1;
148
149
150
151
sub listSupportedPageObjects {
152
    my ($supportedPageObjects) = @_;
153
    print Data::Dumper::Dumper($supportedPageObjects);
154
    exit;
155
}
156
sub deployPageObject {
157
    my ($supportedPageObjects, $page, $params, $login) = @_;
158
159
    ##Find correct PageObject deployment rules
160
    my $pageObjectMapping = $supportedPageObjects->{$page};
161
    die "No PageObject mapped to --page '$page'. See --list to list available PageObjects.\n" unless $pageObjectMapping;
162
163
    ##Dynamically load package
164
    my $package = $pageObjectMapping->{package};
165
    eval "require $package";
166
167
    ##Fill required parameters
168
    my $poParams = {};
169
    if (ref($pageObjectMapping->{params}) eq 'ARRAY') {
170
        foreach my $paramName (@{$pageObjectMapping->{params}}) {
171
            $poParams->{$paramName} = shift(@$params);
172
            die "Insufficient parameters given, parameter '$paramName' unsatisfied.\n" unless $poParams->{$paramName};
173
        }
174
    }
175
176
    ##Check if the status is OK
177
    die "PageObject status for '$page' is not 'OK'. Current status '".$pageObjectMapping->{status}."'.\nPlease implement the missing PageObject.\n" unless $pageObjectMapping->{status} eq 'OK';
178
179
    ##Create PageObject
180
    my $po = $package->new($poParams);
181
182
    ##Password login if desired
183
    eval {
184
       $po->isPasswordLoginAvailable->doPasswordLogin($login->[0], $login->[1]) if scalar(@$login);
185
    }; if ($@) {
186
        print "Password login unavailable.\n";
187
    }
188
189
    return ($po, $po->getDriver());
190
}
(-)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 (+287 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
use Koha::Exception::SystemCall;
29
30
=head NAME t::lib::Page
31
32
=head SYNOPSIS
33
34
PageObject-pattern parent class. Extend this to implement specific pages shown to our users.
35
36
PageObjects are used to make robust and reusable integration test components to test
37
various front-end features. PageObjects load a Selenium::Remote::Driver implementation,
38
phantomjs by default and use this to do scripted user actions in the browser,
39
eg. clicking HTML-elements, accepting popup dialogs, entering text to input fields.
40
41
PageObjects encapsulate those very low-level operations into clear and easily usable
42
actions or services, like doPasswordLogin().
43
PageObjects also seamlessly deal with navigation from one page to another, eg.
44
    my $mainpage = t::lib::Page::Mainpage->new();
45
    $mainpage->doPasswordLogin('admin', '1234')->gotoPatrons()->
46
               searchPatrons({keywordSearch => "Jane Doe"});
47
48
=head Class variables
49
50
Selenium::Remote::Driver driver, contains the driver implementation used to run these tests
51
t::Page::Common::Header  header, the header page component (not implemented)
52
t::Page::Common::Footer  footer, the footer page component (not implemented)
53
Scalar                   userInteractionDelay, How many milliseconds to wait for javascript
54
                                               to stop processing by default after user actions?
55
56
=head DEBUGGING
57
58
Set Environment value
59
    $ENV{KOHA_PAGEOBJECT_DEBUG} = 1;
60
Before creating the first PageObject to enable debugging.
61
Debugging output is written to /tmp/PageObjectDebug/ by default, but you can change it
62
using the same environment variable
63
    $ENV{KOHA_PAGEOBJECT_DEBUG} = "/tmp/generalDebugging/";
64
65
=cut
66
67
sub new {
68
    my ($class, $params) = @_;
69
    $params = _mergeDefaultConfig($params);
70
71
    my $self = {};
72
    bless($self, $class);
73
    unless ($params->{driver}) {
74
        my ($driver) = t::lib::WebDriverFactory::getUserAgentDrivers({phantomjs => $params});
75
        $self->{driver} = $driver;
76
    }
77
    $self->{type}     = $params->{type}; #This parameter is mandatory. _mergeDefaultConfig() dies without it.
78
    $self->{resource} = $params->{resource} || '/';
79
    $self->{resource} .= "?".join('&', @{$params->{getParams}}) if $params->{getParams};
80
    $self->{header}   = $params->{header}   || undef;
81
    $self->{footer}   = $params->{footer}   || undef;
82
83
    $self->{userInteractionDelay} = $params->{userInteractionDelay} || 500;
84
85
    $self->{driver}->set_window_size(1280, 960);
86
    $self->{driver}->get( $self->{resource} );
87
88
    $self->debugSetEnvironment(); #If debugging is enabled
89
90
    return $self;
91
}
92
93
=head rebrandFromPageObject
94
When we are getting redirected from one page to another we rebrand the existing PageObject
95
as another PageObject to have the new page's services available.
96
=cut
97
98
sub rebrandFromPageObject {
99
    my ($class, $self) = @_;
100
    bless($self, $class);
101
    return $self;
102
}
103
104
=head _mergeDefaultConfig
105
106
@THROWS Koha::Exception::BadParameter
107
=cut
108
109
sub _mergeDefaultConfig {
110
    my ($params) = @_;
111
    unless (ref($params) eq 'HASH' && $params->{type}) {
112
        Koha::Exception::BadParameter->throw(error => "t::lib::Page:> When instantiating Page-objects, you must define the 'type'-parameter.");
113
    }
114
115
    my $testServerConfigs = C4::Context->config('testservers');
116
    my $conf = $testServerConfigs->{ $params->{type} };
117
    Koha::Exception::BadParameter->throw(error => "t::lib::Page:> Unknown 'type'-parameter '".$params->{type}."'. Values 'opac', 'staff' and 'rest' are supported.")
118
                unless $conf;
119
    #Merge given $params-config on top of the $KOHA_CONF's testservers-directives
120
    @$conf{keys %$params} = values %$params;
121
    return $conf;
122
}
123
124
=head quit
125
Wrapper for Selenium::Remote::Driver->quit(),
126
Delete the session & close open browsers.
127
128
When ending this browser session, it is polite to quit, or there is a risk of leaving
129
floating test browsers floating around.
130
=cut
131
132
sub quit {
133
    my ($self) = @_;
134
    $self->getDriver()->quit();
135
}
136
137
=head pause
138
Wrapper for Selenium::Remote::Driver->pause(),
139
=cut
140
141
sub pause {
142
    my ($self, $pauseMillis) = @_;
143
    $self->getDriver()->pause($pauseMillis);
144
    return $self;
145
}
146
147
=head isPasswordLoginAvailable
148
149
    $page->isPasswordLoginAvailable();
150
151
@RETURN t::lib::Page-object
152
@CROAK if password login is unavailable.
153
=cut
154
155
sub isPasswordLoginAvailable {
156
    my $self = shift;
157
    my $d = $self->getDriver();
158
    $self->debugTakeSessionSnapshot();
159
160
    _getPasswordLoginElements($d);
161
    ok(($d->get_title() =~ /Log in to Koha/), "PasswordLogin available");
162
    return $self;
163
}
164
165
sub doPasswordLogin {
166
    my ($self, $username, $password) = @_;
167
    my $d = $self->getDriver();
168
    $self->debugTakeSessionSnapshot();
169
170
    my ($submitButton, $useridInput, $passwordInput) = _getPasswordLoginElements($d);
171
    $useridInput->send_keys($username);
172
    $passwordInput->send_keys($password);
173
    $submitButton->click();
174
    $self->debugTakeSessionSnapshot();
175
176
    my $cookies = $d->get_all_cookies();
177
    my @cgisessid = grep {$_->{name} eq 'CGISESSID'} @$cookies;
178
179
    ok(($d->get_title() !~ /Log in to Koha/ && #No longer in the login page
180
        $d->get_title() !~ /Access denied/ &&
181
        $cgisessid[0]) #Cookie CGISESSID defined!
182
       , "PasswordLogin succeeded");
183
184
    return $self; #After a succesfull password login, we are directed to the same page we tried to access.
185
}
186
187
sub _getPasswordLoginElements {
188
    my $d = shift;
189
    my $submitButton  = $d->find_element('#submit');
190
    my $useridInput   = $d->find_element('#userid');
191
    my $passwordInput = $d->find_element('#password');
192
    return ($submitButton, $useridInput, $passwordInput);
193
}
194
195
sub doPasswordLogout {
196
    my ($self, $username, $password) = @_;
197
    my $d = $self->getDriver();
198
    $self->debugTakeSessionSnapshot();
199
200
    #Click the dropdown menu to make the logout-link visible
201
    my $logged_in_identifierA = $d->find_element('#drop3'); #What a nice and descriptive HTML element name!
202
    $logged_in_identifierA->click();
203
204
    #Logout
205
    my $logoutA = $d->find_element('#logout');
206
    $logoutA->click();
207
208
    ok(($d->get_title() =~ /Log in to Koha/), "PasswordLogout succeeded");
209
    return $self; #After a succesfull password logout, we are still in the same page we did before logout.
210
}
211
212
################################################
213
  ##  INTRODUCING OBJECT ACCESSORS  ##
214
################################################
215
sub setDriver {
216
    my ($self, $driver) = @_;
217
    $self->{driver} = $driver;
218
}
219
sub getDriver {
220
    my ($self) = @_;
221
    return $self->{driver};
222
}
223
224
################################################
225
  ##  INTRODUCING TESTING HELPERS  ##
226
################################################
227
sub debugSetEnvironment {
228
    my ($self) = @_;
229
    if ($ENV{KOHA_PAGEOBJECT_DEBUG}) {
230
        $self->{debugSessionId} = sprintf("%03i",rand(999));
231
        $self->{debugSessionTmpDirectory} = "/tmp/PageObjectDebug/";
232
        $self->{debugSessionTmpDirectory} = $ENV{KOHA_PAGEOBJECT_DEBUG} if (not(ref($ENV{KOHA_PAGEOBJECT_DEBUG})) && length($ENV{KOHA_PAGEOBJECT_DEBUG}) > 1);
233
        my $error = system(("mkdir", "-p", $self->{debugSessionTmpDirectory}));
234
        Koha::Exception::SystemCall->throw(error => "Trying to create a temporary directory for PageObject debugging session '".$self->{debugSessionId}."' failed:\n  $?")
235
                if $error;
236
        $self->{debugInternalCounter} = 1;
237
238
        print "\n\n--Starting PageObject debugging session '".$self->{debugSessionId}."'\n\n";
239
    }
240
}
241
242
sub debugTakeSessionSnapshot {
243
    my ($self) = @_;
244
    if ($ENV{KOHA_PAGEOBJECT_DEBUG}) {
245
        my ($actionIdentifier, $actionFile) = $self->_debugGetSessionIdentifier(2);
246
247
        $self->_debugWriteHTML($actionIdentifier, $actionFile);
248
        $self->_debugWriteScreenshot($actionIdentifier, $actionFile);
249
        $self->{debugInternalCounter}++;
250
    }
251
}
252
253
sub _debugGetSessionIdentifier {
254
    my ($self, $callerDepth) = @_;
255
    $callerDepth = $callerDepth || 2;
256
    ##Create a unique and descriptive identifier for this program state.
257
    my ($package, $filename, $line, $subroutine) = caller($callerDepth); #Get where we are called from
258
    $subroutine = $2 if ($subroutine =~ /(::|->)([^:->]+)$/); #Get the last part of the package, the subroutine name.
259
    my $actionIdentifier = "[session '".$self->{debugSessionId}."', counter '".sprintf("%03i",$self->{debugInternalCounter})."', caller '$subroutine']";
260
    my $actionFile = $self->{debugSessionId}.'_'.sprintf("%03i",$self->{debugInternalCounter}).'_'.$subroutine;
261
    return ($actionIdentifier, $actionFile);
262
}
263
264
sub _debugWriteHTML {
265
    require Data::Dumper;
266
    my ($self, $actionIdentifier, $actionFile) = @_;
267
    my $d = $self->getDriver();
268
269
    ##Write the current Response data
270
    open(my $fh, ">:encoding(UTF-8)", $self->{debugSessionTmpDirectory}.$actionFile.'.html')
271
                or die "Trying to open a filehandle for PageObject debugging output $actionIdentifier:\n  $@";
272
    print $fh $d->get_title()."\n";
273
    print $fh "ALL COOKIES DUMP:\n".Data::Dumper::Dumper($d->get_all_cookies());
274
    print $fh $d->get_page_source()."\n";
275
    close $fh;
276
}
277
278
sub _debugWriteScreenshot {
279
    my ($self, $actionIdentifier, $actionFile) = @_;
280
    my $d = $self->getDriver();
281
282
    ##Write a screenshot of the view to file.
283
    my $ok = $d->capture_screenshot($self->{debugSessionTmpDirectory}.$actionFile.'.png');
284
    Koha::Exception::SystemCall->throw(error => "Cannot capture a screenshot for PageObject $actionIdentifier")
285
                unless $ok;
286
}
287
1; #Make the compiler happy!
(-)a/t/lib/Page/Intra.pm (+106 lines)
Line 0 Link Here
1
package t::lib::Page::Intra;
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
use Koha::Exception::SystemCall;
29
30
use base qw(t::lib::Page);
31
32
=head NAME t::lib::Page::Intra
33
34
=head SYNOPSIS
35
36
PageObject-pattern parent class for Intranet-pages (staff client). Extend this to implement specific pages shown to our users.
37
38
=cut
39
40
=head isPasswordLoginAvailable
41
42
    $page->isPasswordLoginAvailable();
43
44
@RETURN t::lib::Page-object
45
@CROAK if password login is unavailable.
46
=cut
47
48
sub isPasswordLoginAvailable {
49
    my $self = shift;
50
    my $d = $self->getDriver();
51
    $self->debugTakeSessionSnapshot();
52
53
    _getPasswordLoginElements($d);
54
    ok(($d->get_title() =~ /Log in to Koha/), "PasswordLogin available");
55
    return $self;
56
}
57
58
sub doPasswordLogin {
59
    my ($self, $username, $password) = @_;
60
    my $d = $self->getDriver();
61
    $self->debugTakeSessionSnapshot();
62
63
    my ($submitButton, $useridInput, $passwordInput) = _getPasswordLoginElements($d);
64
    $useridInput->send_keys($username);
65
    $passwordInput->send_keys($password);
66
    $submitButton->click();
67
    $self->debugTakeSessionSnapshot();
68
69
    my $cookies = $d->get_all_cookies();
70
    my @cgisessid = grep {$_->{name} eq 'CGISESSID'} @$cookies;
71
72
    ok(($d->get_title() !~ /Log in to Koha/ && #No longer in the login page
73
        $d->get_title() !~ /Access denied/ &&
74
        $cgisessid[0]) #Cookie CGISESSID defined!
75
       , "PasswordLogin succeeded");
76
77
    return $self; #After a succesfull password login, we are directed to the same page we tried to access.
78
}
79
80
sub _getPasswordLoginElements {
81
    my $d = shift;
82
    my $submitButton  = $d->find_element('#submit');
83
    my $useridInput   = $d->find_element('#userid');
84
    my $passwordInput = $d->find_element('#password');
85
    return ($submitButton, $useridInput, $passwordInput);
86
}
87
88
sub doPasswordLogout {
89
    my ($self, $username, $password) = @_;
90
    my $d = $self->getDriver();
91
    $self->debugTakeSessionSnapshot();
92
93
    #Click the dropdown menu to make the logout-link visible
94
    my $logged_in_identifierA = $d->find_element('#drop3'); #What a nice and descriptive HTML element name!
95
    $logged_in_identifierA->click();
96
97
    #Logout
98
    my $logoutA = $d->find_element('#logout');
99
    $logoutA->click();
100
    $self->debugTakeSessionSnapshot();
101
102
    ok(($d->get_title() =~ /Log in to Koha/), "PasswordLogout succeeded");
103
    return $self; #After a succesfull password logout, we are still in the same page we did before logout.
104
}
105
106
1; #Make the compiler happy!
(-)a/t/lib/Page/Mainpage.pm (+45 lines)
Line 0 Link Here
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!
(-)a/t/lib/Page/Opac.pm (+100 lines)
Line 0 Link Here
1
package t::lib::Page::Opac;
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
use Koha::Exception::SystemCall;
29
30
use base qw(t::lib::Page);
31
32
=head NAME t::lib::Page::Opac
33
34
=head SYNOPSIS
35
36
PageObject-pattern parent class for OPAC-pages. Extend this to implement specific pages shown to our users.
37
38
=cut
39
40
=head isPasswordLoginAvailable
41
42
    $page->isPasswordLoginAvailable();
43
44
@RETURN t::lib::Page-object
45
@CROAK if password login is unavailable.
46
=cut
47
48
sub isPasswordLoginAvailable {
49
    my $self = shift;
50
    my $d = $self->getDriver();
51
    $self->debugTakeSessionSnapshot();
52
53
    _getPasswordLoginElements($d);
54
    ok(1, "PasswordLogin available");
55
    return $self;
56
}
57
58
sub doPasswordLogin {
59
    my ($self, $username, $password) = @_;
60
    my $d = $self->getDriver();
61
    $self->debugTakeSessionSnapshot();
62
63
    my ($submitButton, $useridInput, $passwordInput) = _getPasswordLoginElements($d);
64
    $useridInput->send_keys($username);
65
    $passwordInput->send_keys($password);
66
    $submitButton->click();
67
    $self->debugTakeSessionSnapshot();
68
69
    my $cookies = $d->get_all_cookies();
70
    my @cgisessid = grep {$_->{name} eq 'CGISESSID'} @$cookies;
71
72
    my $loggedinusernameSpan = $d->find_element('span.loggedinusername');
73
    ok(($cgisessid[0]), "PasswordLogin succeeded"); #We have the element && Cookie CGISESSID defined!
74
75
    return $self; #After a succesfull password login, we are directed to the same page we tried to access.
76
}
77
78
sub _getPasswordLoginElements {
79
    my $d = shift;
80
    my $submitButton  = $d->find_element('form#auth input[value="Log in"]');
81
    my $useridInput   = $d->find_element('#userid');
82
    my $passwordInput = $d->find_element('#password');
83
    return ($submitButton, $useridInput, $passwordInput);
84
}
85
86
sub doPasswordLogout {
87
    my ($self, $username, $password) = @_;
88
    my $d = $self->getDriver();
89
    $self->debugTakeSessionSnapshot();
90
91
    #Logout
92
    my $logoutA = $d->find_element('#logout');
93
    $logoutA->click();
94
    $self->debugTakeSessionSnapshot();
95
96
    ok(($d->get_title() =~ /Log in to your account/), "PasswordLogout succeeded");
97
    return $self; #After a succesfull password logout, we are still in the same page we did before logout.
98
}
99
100
1; #Make the compiler happy!
(-)a/t/lib/Page/Opac/OpacMain.pm (-1 / +60 lines)
Line 0 Link Here
0
- 
1
package t::lib::Page::Opac::OpacMain;
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 Scalar::Util qw(blessed);
22
23
use base qw(t::lib::Page::Opac);
24
25
use Koha::Exception::BadParameter;
26
27
=head NAME t::lib::Page::Opac::OpacMain
28
29
=head SYNOPSIS
30
31
PageObject providing page functionality as a service!
32
33
=cut
34
35
=head new
36
37
    my $opacmain = t::lib::Page::Opac::OpacMain->new();
38
39
Instantiates a WebDriver and loads the opac/opac-main.pl.
40
@PARAM1 HASHRef of optional and MANDATORY parameters
41
MANDATORY extra parameters:
42
    none atm.
43
44
@RETURNS t::lib::Page::Opac::OpacMain, ready for user actions!
45
=cut
46
47
sub new {
48
    my ($class, $params) = @_;
49
    unless (ref($params) eq 'HASH' || (blessed($params) && $params->isa('t::lib::Page') )) {
50
        $params = {};
51
    }
52
    $params->{resource} = '/cgi-bin/koha/opac-main.pl';
53
    $params->{type}     = 'opac';
54
55
    my $self = $class->SUPER::new($params);
56
57
    return $self;
58
}
59
60
1; #Make the compiler happy!

Return to bug 14536