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 (+270 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
our $hostProtocol = 'http';
68
our $hostAddress = 'localhost';
69
our $hostPort = '443';
70
71
sub new {
72
    my ($class, $params) = @_;
73
    $params = _mergeDefaultConfig($params);
74
75
    my $self = {};
76
    bless($self, $class);
77
    unless ($params->{driver}) {
78
        my ($driver) = t::lib::WebDriverFactory::getUserAgentDrivers({phantomjs => $params});
79
        $self->{driver} = $driver;
80
    }
81
    $self->{type}     = $params->{type}; #This parameter is mandatory. _mergeDefaultConfig() dies without it.
82
    $self->{resource} = $params->{resource} || '/';
83
    $self->{resource} .= "?".join('&', @{$params->{getParams}}) if $params->{getParams};
84
    $self->{header}   = $params->{header}   || undef;
85
    $self->{footer}   = $params->{footer}   || undef;
86
87
    $self->{userInteractionDelay} = $params->{userInteractionDelay} || 500;
88
89
    $self->{driver}->get( $self->{resource} );
90
91
    $self->debugSetEnvironment(); #If debugging is enabled
92
93
    return $self;
94
}
95
96
=head rebrandFromPageObject
97
When we are getting redirected from one page to another we rebrand the existing PageObject
98
as another PageObject to have the new page's services available.
99
=cut
100
101
sub rebrandFromPageObject {
102
    my ($class, $self) = @_;
103
    bless($self, $class);
104
    return $self;
105
}
106
107
=head _mergeDefaultConfig
108
109
@THROWS Koha::Exception::BadParameter
110
=cut
111
112
sub _mergeDefaultConfig {
113
    my ($params) = @_;
114
    unless (ref($params) eq 'HASH' && $params->{type}) {
115
        Koha::Exception::BadParameter->throw(error => "t::lib::Page:> When instantiating Page-objects, you must define the 'type'-parameter.");
116
    }
117
118
    my $testServerConfigs = C4::Context->config('testservers');
119
    my $conf = $testServerConfigs->{ $params->{type} };
120
    Koha::Exception::BadParameter->throw(error => "t::lib::Page:> Unknown 'type'-parameter '".$params->{type}."'. Values 'opac', 'staff' and 'rest' are supported.")
121
                unless $conf;
122
    #Merge given $params-config on top of the $KOHA_CONF's testservers-directives
123
    @$conf{keys %$params} = values %$params;
124
    return $conf;
125
}
126
127
=head quit
128
Wrapper for Selenium::Remote::Driver->quit(),
129
Delete the session & close open browsers.
130
131
When ending this browser session, it is polite to quit, or there is a risk of leaving
132
floating test browsers floating around.
133
=cut
134
135
sub quit {
136
    my ($self) = @_;
137
    $self->getDriver()->quit();
138
}
139
140
=head pause
141
Wrapper for Selenium::Remote::Driver->pause(),
142
=cut
143
144
sub pause {
145
    my ($self, $pauseMillis) = @_;
146
    $self->getDriver()->pause($pauseMillis);
147
    return $self;
148
}
149
150
=head isPasswordLoginAvailable
151
152
    $page->isPasswordLoginAvailable();
153
154
@RETURN t::lib::Page-object
155
@CROAK if password login is unavailable.
156
=cut
157
158
sub isPasswordLoginAvailable {
159
    my $self = shift;
160
    my $d = $self->getDriver();
161
    $self->debugTakeSessionSnapshot();
162
163
    _getPasswordLoginElements($d);
164
    ok(($d->get_title() =~ /Log in to Koha/), "PasswordLoginAvailable");
165
    return $self;
166
}
167
sub doPasswordLogin {
168
    my ($self, $username, $password) = @_;
169
    my $d = $self->getDriver();
170
    $self->debugTakeSessionSnapshot();
171
172
    my ($submitButton, $useridInput, $passwordInput) = _getPasswordLoginElements($d);
173
    $useridInput->send_keys($username);
174
    $passwordInput->send_keys($password);
175
    $submitButton->click();
176
    $self->debugTakeSessionSnapshot();
177
178
    my $cookies = $d->get_all_cookies();
179
    my @cgisessid = grep {$_->{name} eq 'CGISESSID'} @$cookies;
180
181
    ok(($d->get_title() !~ /Log in to Koha/ && #No longer in the login page
182
        $cgisessid[0]) #Cookie CGISESSID defined!
183
       , "PasswordLoginSucceeded");
184
185
    return $self; #After a succesfull password login, we are directed to the same page we tried to access.
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
################################################
196
  ##  INTRODUCING OBJECT ACCESSORS  ##
197
################################################
198
sub setDriver {
199
    my ($self, $driver) = @_;
200
    $self->{driver} = $driver;
201
}
202
sub getDriver {
203
    my ($self) = @_;
204
    return $self->{driver};
205
}
206
207
################################################
208
  ##  INTRODUCING TESTING HELPERS  ##
209
################################################
210
sub debugSetEnvironment {
211
    my ($self) = @_;
212
    if ($ENV{KOHA_PAGEOBJECT_DEBUG}) {
213
        $self->{debugSessionId} = sprintf("%03i",rand(999));
214
        $self->{debugSessionTmpDirectory} = "/tmp/PageObjectDebug/";
215
        $self->{debugSessionTmpDirectory} = $ENV{KOHA_PAGEOBJECT_DEBUG} if (not(ref($ENV{KOHA_PAGEOBJECT_DEBUG})) && length($ENV{KOHA_PAGEOBJECT_DEBUG}) > 1);
216
        my $error = system(("mkdir", "-p", $self->{debugSessionTmpDirectory}));
217
        Koha::Exception::SystemCall->throw(error => "Trying to create a temporary directory for PageObject debugging session '".$self->{debugSessionId}."' failed:\n  $?")
218
                if $error;
219
        $self->{debugInternalCounter} = 0;
220
221
        print "\n\n--Starting PageObject debugging session '".$self->{debugSessionId}."'\n\n";
222
    }
223
}
224
225
sub debugTakeSessionSnapshot {
226
    my ($self) = @_;
227
    if ($ENV{KOHA_PAGEOBJECT_DEBUG}) {
228
        my ($actionIdentifier, $actionFile) = $self->_debugGetSessionIdentifier(2);
229
230
        $self->_debugWriteHTML($actionIdentifier, $actionFile);
231
        $self->_debugWriteScreenshot($actionIdentifier, $actionFile);
232
        $self->{debugInternalCounter}++;
233
    }
234
}
235
236
sub _debugGetSessionIdentifier {
237
    my ($self, $callerDepth) = @_;
238
    $callerDepth = $callerDepth || 2;
239
    ##Create a unique and descriptive identifier for this program state.
240
    my ($package, $filename, $line, $subroutine) = caller($callerDepth); #Get where we are called from
241
    $subroutine = $2 if ($subroutine =~ /(::|->)([^:->]+)$/); #Get the last part of the package, the subroutine name.
242
    my $actionIdentifier = "[session '".$self->{debugSessionId}."', counter '".sprintf("%03i",$self->{debugInternalCounter})."', caller '$subroutine']";
243
    my $actionFile = $self->{debugSessionId}.'_'.sprintf("%03i",$self->{debugInternalCounter}).'_'.$subroutine;
244
    return ($actionIdentifier, $actionFile);
245
}
246
247
sub _debugWriteHTML {
248
    require Data::Dumper;
249
    my ($self, $actionIdentifier, $actionFile) = @_;
250
    my $d = $self->getDriver();
251
252
    ##Write the current Response data
253
    open(my $fh, ">:encoding(UTF-8)", $self->{debugSessionTmpDirectory}.$actionFile.'.html')
254
                or die "Trying to open a filehandle for PageObject debugging output $actionIdentifier:\n  $@";
255
    print $fh $d->get_title()."\n";
256
    print $fh "ALL COOKIES DUMP:\n".Data::Dumper::Dumper($d->get_all_cookies());
257
    print $fh $d->get_page_source()."\n";
258
    close $fh;
259
}
260
261
sub _debugWriteScreenshot {
262
    my ($self, $actionIdentifier, $actionFile) = @_;
263
    my $d = $self->getDriver();
264
265
    ##Write a screenshot of the view to file.
266
    my $ok = $d->capture_screenshot($self->{debugSessionTmpDirectory}.$actionFile.'.png');
267
    Koha::Exception::SystemCall->throw(error => "Cannot capture a screenshot for PageObject $actionIdentifier")
268
                unless $ok;
269
}
270
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