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

(-)a/t/Cucumber/SImpls/Accountlines.pm (+70 lines)
Line 0 Link Here
1
package SImpls::Accountlines;
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Carp;
22
use Test::More;
23
24
use Koha::Database;
25
26
27
sub deleteAllFines {
28
    my $schema = Koha::Database->new()->schema();
29
    $schema->resultset('Accountline')->search({})->delete_all();
30
}
31
32
sub checkAccountlines {
33
    my $C = shift;
34
    my $S = $C->{stash}->{scenario};
35
    my $F = $C->{stash}->{feature};
36
37
    my $checks = $C->data(); #Get the checks, which might not have manifested itselves to the message_queue_items
38
    ok(($checks && scalar(@$checks) > 0), "You must give checks as the data");
39
40
    #See which checks are supposed to be in the accountlines-table, and which are just to clarify intent.
41
    my @checksToDo;
42
    foreach my $check (@$checks) {
43
        my $status = $check->{fine};
44
        push @checksToDo, $check if ($status ne 'none');
45
    }
46
47
    ##Make sure that there are no trailing Accountlines.
48
    my $schema = Koha::Database->new()->schema();
49
    my $allFinesCount = $schema->resultset('Accountline')->search({})->count();
50
    is($allFinesCount, scalar(@checksToDo), "We should have ".scalar(@checksToDo)." checks for $allFinesCount fines, with no trailing fines.");
51
52
    my $dbh = C4::Context->dbh();
53
    my $check_statement = $dbh->prepare(
54
        "SELECT 1 FROM accountlines a ".
55
        "LEFT JOIN borrowers b ON a.borrowernumber = b.borrowernumber ".
56
        "WHERE b.cardnumber = ? AND a.amountoutstanding = ? ".
57
    "");
58
59
    ##Check that there is a matching Accountline for each given test.
60
    foreach my $check (@checksToDo) {
61
        my @params;
62
        push @params, $check->{cardnumber};
63
        push @params, $check->{fine};
64
        $check_statement->execute( @params );
65
        my $ok = $check_statement->fetchrow();
66
        last unless ok(($ok && $ok == 1), "Check: For params @params");
67
    }
68
}
69
70
1;
(-)a/t/Cucumber/SImpls/Biblios.pm (+48 lines)
Line 0 Link Here
1
package SImpls::Biblios;
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Carp;
22
use Test::More;
23
24
use t::db_dependent::TestObjects::Biblios::BiblioFactory;
25
26
sub addBiblios {
27
    my $C = shift;
28
    my $S = $C->{stash}->{scenario};
29
    my $F = $C->{stash}->{feature};
30
31
    $S->{biblios} = {} unless $S->{biblios};
32
    $F->{biblios} = {} unless $F->{biblios};
33
34
    my $records = t::db_dependent::TestObjects::Biblios::BiblioFactory::createTestGroup($C->data(),'biblioitems.isbn');
35
36
    while( my ($key, $record) = each %$records) {
37
        $S->{biblios}->{ $key } = $record;
38
        $F->{biblios}->{ $key } = $record;
39
    }
40
}
41
42
sub deleteBiblios {
43
    my $C = shift;
44
    my $F = $C->{stash}->{feature};
45
    t::db_dependent::TestObjects::Biblios::BiblioFactory::deleteTestGroup( $F->{biblios} );
46
}
47
48
1;
(-)a/t/Cucumber/SImpls/Borrowers.pm (+106 lines)
Line 0 Link Here
1
package SImpls::Borrowers;
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Carp;
22
use Test::More;
23
24
use Koha::Borrowers;
25
use Koha::Borrower::Debarments;
26
27
use t::db_dependent::TestObjects::Borrowers::BorrowerFactory;
28
29
sub addBorrowers {
30
    my $C = shift;
31
    my $S = $C->{stash}->{scenario};
32
    my $F = $C->{stash}->{feature};
33
    $S->{borrowers} = {} unless $S->{borrowers};
34
    $F->{borrowers} = {} unless $F->{borrowers};
35
36
    my $borrowers = t::db_dependent::TestObjects::Borrowers::BorrowerFactory::createTestGroup($C->data(),'cardnumber');
37
38
    while( my ($key, $borrower) = each %$borrowers) {
39
        $S->{borrowers}->{ $key } = $borrower;
40
        $F->{borrowers}->{ $key } = $borrower;
41
    }
42
}
43
44
sub deleteBorrowers {
45
    my $C = shift;
46
    my $F = $C->{stash}->{feature};
47
    t::db_dependent::TestObjects::Borrowers::BorrowerFactory::deleteTestGroup( $F->{borrowers} );
48
}
49
50
sub checkDebarments {
51
    my $C = shift;
52
    my $S = $C->{stash}->{scenario};
53
    my $F = $C->{stash}->{feature};
54
55
    my $checks = $C->data(); #Get the checks we need to do.
56
    ok(($checks && scalar(@$checks) > 0), "You must give checks as the data");
57
58
    ##Make sure that there are no trailing Debarments.
59
    my $schema = Koha::Database->new()->schema();
60
    my $allDebarmentsCount = $schema->resultset('BorrowerDebarment')->search({})->count();
61
    is($allDebarmentsCount, scalar(@$checks), "We should have ".scalar(@$checks)." checks for $allDebarmentsCount fines, with no trailing fines.");
62
63
    #We need to collect all checks for each borrower, because a single borrower can have multiple checks
64
    my %checksByBorrower;
65
    foreach my $check (@$checks) {
66
        unless ($checksByBorrower{$check->{cardnumber}}) {
67
            $checksByBorrower{$check->{cardnumber}} = [];
68
        }
69
        push( @{$checksByBorrower{$check->{cardnumber}}}, $check );
70
        #Remove keys not needed in the comparison ahead. Leaving keys not found in the debarment-object will ruin the check.
71
        delete $check->{cardnumber};
72
    }
73
74
    ##Check that there is a matching Debarment for each given check.
75
    while( my ($cardnumber, $checks) =  each %checksByBorrower ) {
76
        my $borrower = Koha::Borrowers->find({cardnumber => $cardnumber});
77
        die "checkDebarments():> No borrower for cardnumber '$cardnumber'" unless ($cardnumber);
78
        my $debarments = Koha::Borrower::Debarments::GetDebarments({borrowernumber => $borrower->id()});
79
80
        #Check every check against every debarment, if all checks are satisifed from the found debarments, all is fine!
81
        foreach my $check (@$checks) {
82
            my $checkOk = 0;
83
            for (my $i=0 ; $i<@$debarments ; $i++) {
84
                my $debarment = $debarments->[$i];
85
86
                #Iterate all the keys in check, and see if they match the debarment
87
                my $keysNeedingSuccessfulMatch = scalar(keys(%$check));
88
                while( my ($key, $value) = each %$check ) {
89
                    if ($debarment->{$key} eq $check->{$key}) {
90
                        $keysNeedingSuccessfulMatch--;
91
                    }
92
                }
93
                #This debarment matches this check
94
                if ($keysNeedingSuccessfulMatch == 0) {
95
                    splice @$debarments, $i, 1;
96
                    $i--;
97
                    $checkOk = 1;
98
                    last();
99
                }
100
            }
101
            return unless ok($checkOk, "Debarment '".join(', ',join(' => ',each(%$check)))."' found.");
102
        }
103
    }
104
}
105
106
1;
(-)a/t/Cucumber/SImpls/BranchTransfers.pm (+87 lines)
Line 0 Link Here
1
package SImpls::BranchTransfers;
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Carp;
22
23
use Test::More;
24
use C4::Context;
25
use C4::Items;
26
use C4::Circulation;
27
28
sub verifyItemsInTransit {
29
    my $C = shift;
30
    my $S = $C->{stash}->{scenario};
31
    my $F = $C->{stash}->{feature};
32
    my $checks = $C->data(); #Get the checks, which might not have manifested itselves to the branchtransfers
33
    ok(($checks && scalar(@$checks) > 0), "You must give checks as the data");
34
35
    #See which checks are supposed to be in the branchtransfers-table, and which are just to clarify intent.
36
    my @checksInTable;
37
    foreach my $check (@$checks) {
38
        my $status = $check->{status};
39
        push @checksInTable, $check if (not($status) || ($status ne 'no_trfr'));
40
    }
41
42
    ##Check that there is a matching branchtransfer-row for each given test.
43
    my %testedBranchtransfers; #Collect the branchtransfers here so we can see that we won't accidentally test the same transfer twice,
44
                               # and can tell which branchtransfers are left untested and shouldn't exist according to the test plan.
45
    foreach my $check (@checksInTable) {
46
        my @params; #DEL THIS
47
        my $itemnumber = C4::Items::GetItemnumberFromBarcode( $check->{barcode} );
48
        my @transfer = C4::Circulation::GetTransfers($itemnumber);
49
        ##See if the branchtransfer_id is already tested and fail the test, or add the branchtransfer to the tested group.
50
         #    Throw an failed test only if the test should fail, don't clutter with meaningless tests.
51
        ok((0), "Not testing fromBranch '".$check->{fromBranch}."', toBranch '".$check->{toBranch}."' twice. Awsum!")
52
                if(defined($testedBranchtransfers{$transfer[3]}));
53
        $testedBranchtransfers{$transfer[3]} = \@transfer; #Store the branchtransfer by id
54
55
        last unless ok(($transfer[1] eq $check->{fromBranch} && $transfer[2] eq $check->{toBranch}), "Check: fromBranch '".$check->{fromBranch}."', toBranch '".$check->{toBranch}."'");
56
    }
57
58
    ##!# Check for leaking branchtransfers, eg. unintended side-effects.  #!##
59
    #Remove all tested branchtransfers from all the transfers in DB, and see if we have some more in the DB. This means that our tests leak branchtransfers we didn't intend to have!
60
    my $allBranchtransfers = C4::Circulation::GetAllTransfers();
61
    while (my ($branchtransfer_id, $branchtransferArr) = each(%testedBranchtransfers)) {
62
        for (my $i=0 ; $i<scalar(@$allBranchtransfers) ; $i++) {
63
            my $branchTransfer = $allBranchtransfers->[$i];
64
            if ($branchTransfer->{branchtransfer_id} == $branchtransferArr->[3]) { #If id's match, this branchtransfer is tested.
65
                splice(@$allBranchtransfers, $i, 1); #Remove array element at position $i
66
                last;
67
            }
68
        }
69
    }
70
    #Throw a failed tests for each excess branchtransfer encountered. We never get into this loop if tests work ok.
71
    foreach my $branchTransfer (@$allBranchtransfers) {
72
        my $item = C4::Items::GetItem(  $branchTransfer->{itemnumber}  );
73
        ok((not($branchTransfer)), "Trailing branchtransfer for barcode '".$item->{barcode}."' fromBranch '".$branchTransfer->{frombranch}."' toBranch '".$branchTransfer->{tobranch}."'");
74
    }
75
}
76
77
##We cannot use the Koha internal API, because then these would be preserved as arrived transfers
78
#Sometimes the test feature can fail and leave straggler Transfers, which prevent proper clean up. So it is better to just
79
#remove all Transfers. These tests should be transitive anyway.
80
sub deleteAllTransfers {
81
    my $C = shift;
82
    my $F = $C->{stash}->{feature};
83
    my $schema = Koha::Database->new()->schema();
84
85
    $schema->resultset('Branchtransfer')->search({})->delete_all();
86
}
87
1;
(-)a/t/Cucumber/SImpls/Context.pm (+44 lines)
Line 0 Link Here
1
package SImpls::Context;
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Carp;
22
23
use C4::Context;
24
25
sub setKohaContext {
26
    my $C = shift;
27
28
    my $contextHash = $C->{_data}->[0];
29
    C4::Context->_new_userenv($contextHash->{userenvName} || 'DUMMY SESSION');
30
    C4::Context->set_userenv(
31
            0,
32
            0,
33
            0,
34
            $contextHash->{firstName}      || 'firstname',
35
            $contextHash->{surname}        || 'surname',
36
            $contextHash->{branchCode}     || 'CPL',
37
            $contextHash->{branchName}     || 'Centerville Public Library',
38
            $contextHash->{userFlags}      || 0,
39
            $contextHash->{userEmail}      || 'noemail@example.com',
40
            $contextHash->{branchPrinter}  || 'branchPrinter?',
41
    );
42
}
43
44
1;
(-)a/t/Cucumber/SImpls/FileUtils.pm (+56 lines)
Line 0 Link Here
1
package SImpls::FileUtils;
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Carp;
22
use Test::More;
23
24
sub checkRegexpInsideFiles {
25
    my $C = shift;
26
    my $data = $C->data;
27
28
    ##First cache files to avoid unnecessary file loading
29
    my %files;
30
    foreach my $d (@$data) {
31
        unless ( $files{ $d->{fileName} } ) {
32
            my $directory = $d->{directory};
33
            $directory =~ s/\$KOHA_PATH/$ENV{KOHA_PATH}/gsm;
34
            my $fileContent = File::Slurp::read_file( $directory.$d->{fileName}, {binmode => ':utf8'} )
35
                                or die "common_stepImpl::checkRegexpInsideFiles():> $!";
36
            $files{ $d->{fileName} } = $fileContent;
37
        }
38
    }
39
40
    foreach my $d (@$data) {
41
        my $fileContent = $files{ $d->{fileName} };
42
        my $regexp = $d->{recordFindingRegexp};
43
        last unless ok(($fileContent =~ m/$regexp/u), "File ".$d->{fileName}." matches $regexp");
44
    }
45
}
46
47
sub findFile {
48
    my $C = shift;
49
    my $file = $1;
50
    $file =~ s/\$KOHA_PATH/$ENV{KOHA_PATH}/gsm;
51
52
    ok((-f $file && -r $file), "$file exists and is readable");
53
    $C->{stash}->{scenario}->{file} = $file;
54
}
55
56
1;
(-)a/t/Cucumber/SImpls/Issues.pm (+77 lines)
Line 0 Link Here
1
package SImpls::Issues;
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Carp;
22
use Test::More;
23
24
use C4::Circulation;
25
use t::db_dependent::TestObjects::Issues::IssueFactory;
26
27
sub addIssues {
28
    my $C = shift;
29
    my $homeOrHoldingbranch = shift;
30
    die "addIssues():> \$homeOrHoldingbranch must be 'homebranch' or 'holdingbranch'" unless ($homeOrHoldingbranch eq 'homebranch' || $homeOrHoldingbranch eq 'holdingbranch');
31
    my $S = $C->{stash}->{scenario};
32
    my $F = $C->{stash}->{feature};
33
34
    $S->{issues} = {} unless $S->{issues};
35
    $F->{issues} = {} unless $F->{issues};
36
37
    my $issues = t::db_dependent::TestObjects::Issues::IssueFactory::createTestGroup( $C->data(), undef, $homeOrHoldingbranch );
38
39
    while( my ($key, $issue) = each %$issues) {
40
        $S->{issues}->{ $key } = $issue;
41
        $F->{issues}->{ $key } = $issue;
42
    }
43
}
44
45
##We cannot use the Koha internal API, because then these would be put to the deleteditems, deletedbiblio, old_issues, ... -tables
46
#Sometimes the test feature can fail and leave straggler Issues, which prevent proper clean up. So it is better to just
47
#remove all Issues. These tests should be transitive anyway.
48
sub deleteAllIssues {
49
    my $C = shift;
50
    my $F = $C->{stash}->{feature};
51
    my $schema = Koha::Database->new()->schema();
52
53
    $schema->resultset('Issue')->search({})->delete_all();
54
    $schema->resultset('OldIssue')->search({})->delete_all();
55
}
56
57
sub checkInIssues {
58
    my $C = shift;
59
    my $S = $C->{stash}->{scenario};
60
    my $F = $C->{stash}->{feature};
61
62
    my $homeOrHoldingbranch = shift;
63
    die "checkInAllIssues():> \$homeOrHoldingbranch must be 'homebranch' or 'holdingbranch'" unless ($homeOrHoldingbranch eq 'homebranch' || $homeOrHoldingbranch eq 'holdingbranch');
64
65
    if (ref $S->{issues} eq 'HASH') {
66
        while( my ($key, $issue) = each %{$S->{issues}}) {
67
            my $is = $S->{issues}->{ $key };
68
            my ($doreturn, $messages, $iteminformation, $borrower) = C4::Circulation::AddReturn( $is->{barcode}, $is->{branchcode} );
69
            my $debug; #Just here so I can inspect the AddReturn return values with the DBGP-protocol.
70
        }
71
    }
72
    else {
73
        die "checkInIssues():> No Scenario HASH for Issues!";
74
    }
75
}
76
77
1;
(-)a/t/Cucumber/SImpls/Items.pm (+55 lines)
Line 0 Link Here
1
package SImpls::Items;
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Carp;
22
use Test::More;
23
24
use t::db_dependent::TestObjects::Items::ItemFactory;
25
26
sub addItems {
27
    my $C = shift;
28
    my $S = $C->{stash}->{scenario};
29
    my $F = $C->{stash}->{feature};
30
31
    $S->{items} = {} unless $S->{items};
32
    $F->{items} = {} unless $F->{items};
33
34
    #Find the biblionumber of the parent Biblios
35
    my $data = $C->data();
36
    foreach my $itemHash (@$data) {
37
        my $biblionumber = $S->{biblios}->{  $itemHash->{biblioisbn}  }->{biblionumber};
38
        $itemHash->{biblionumber} = $biblionumber;
39
    }
40
41
    my $items = t::db_dependent::TestObjects::Items::ItemFactory::createTestGroup($data, undef);
42
43
    while( my ($key, $item) = each %$items) {
44
        $S->{items}->{ $key } = $item;
45
        $F->{items}->{ $key } = $item;
46
    }
47
}
48
49
sub deleteItems {
50
    my $C = shift;
51
    my $F = $C->{stash}->{feature};
52
    t::db_dependent::TestObjects::Items::ItemFactory::deleteTestGroup( $F->{items} );
53
}
54
55
1;
(-)a/t/Cucumber/SImpls/LetterTemplates.pm (+68 lines)
Line 0 Link Here
1
package SImpls::LetterTemplates;
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Carp;
22
use Test::More;
23
24
use t::db_dependent::TestObjects::LetterTemplates::LetterTemplateFactory;
25
26
sub addLetterTemplates {
27
    my $C = shift;
28
    my $S = $C->{stash}->{scenario};
29
    my $F = $C->{stash}->{feature};
30
31
    $S->{letterTemplates} = {} unless $S->{letterTemplates};
32
    $F->{letterTemplates} = {} unless $F->{letterTemplates};
33
34
    #Split the given message_transport_types-column to separate mtts
35
    #and create separate letterTemplates for each mtt.
36
    my $data = $C->data();
37
    my @letterTemplatesSeparatedMTTs;
38
    foreach my $lt (@$data) {
39
        my @mtts = map {my $a = $_; $a =~ s/\s+//gsm; $a;} split(',', $lt->{message_transport_types});
40
        delete $lt->{message_transport_types};
41
        foreach my $mtt (@mtts) {
42
            my %newLt = %$lt; #Clone the messageQueue.
43
            $newLt{message_transport_type} = $mtt;
44
            $newLt{content} =~ s/\\n/\n/gsm;
45
            push @letterTemplatesSeparatedMTTs, \%newLt;
46
        }
47
    }
48
49
    my $letterTemplates = t::db_dependent::TestObjects::LetterTemplates::LetterTemplateFactory::createTestGroup(\@letterTemplatesSeparatedMTTs, undef);
50
51
    while( my ($key, $letterTemplate) = each %$letterTemplates) {
52
        $S->{letterTemplates}->{ $key } = $letterTemplate;
53
        $F->{letterTemplates}->{ $key } = $letterTemplate;
54
    }
55
}
56
57
sub deleteLetterTemplates {
58
    my $C = shift;
59
    my $F = $C->{stash}->{feature};
60
    t::db_dependent::TestObjects::LetterTemplates::LetterTemplateFactory::deleteTestGroup( $F->{letterTemplates} );
61
}
62
63
sub deleteAllLetterTemplates {
64
    my $schema = Koha::Database->new()->schema();
65
    $schema->resultset('Letter')->search({})->delete_all();
66
}
67
68
1;
(-)a/t/Cucumber/SImpls/MessageQueues.pm (+217 lines)
Line 0 Link Here
1
package SImpls::MessageQueues;
2
3
# Copyright 2015 Vaara-kirjastot
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 2 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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Carp;
22
use Test::More;
23
24
use Koha::Database;
25
use C4::Context;
26
27
sub addMessageQueues {
28
    my $C = shift;
29
    my $letterCode = shift;
30
    my $messageTransportType = shift;
31
    my $S = $C->{stash}->{scenario};
32
    my $F = $C->{stash}->{feature};
33
34
    $S->{message_queues} = {} unless $S->{message_queues};
35
    $F->{message_queues} = {} unless $F->{message_queues};
36
    foreach my $cardumber (sort keys %{$S->{borrowers}}) {
37
        my $borrower = $S->{borrowers}->{$cardumber};
38
39
        my @repeat;
40
        foreach my $i ( sort keys %{$S->{issues}} ) {
41
            my $issue = $S->{issues}->{$i};
42
            if ( $issue->{borrowernumber} eq $borrower->{borrowernumber} ) {
43
                my $itemForCurrentBorrower = $S->{items}->{  $issue->{itemnumber}  };
44
                push @repeat, {items => $itemForCurrentBorrower};
45
            }
46
        }
47
        my $letter = C4::Letters::GetPreparedLetter (
48
                        module => 'circulation',
49
                        letter_code => $letterCode,
50
                        branchcode => $borrower->{branchcode},
51
                        tables => {borrowers => $borrower},
52
                        #substitute => $substitute,
53
                        repeat => { item => \@repeat },
54
                        message_transport_type => $messageTransportType,
55
        );
56
        my $mqHash = {
57
                        letter                 => $letter,
58
                        borrowernumber         => $borrower->{borrowernumber},
59
                        message_transport_type => $messageTransportType,
60
                        from_address           => C4::Context->preference('KohaAdminEmailAddress'),
61
                        to_address             => 'dontsend@example.com',
62
        };
63
        my $message_queue_id = C4::Letters::EnqueueLetter( $mqHash );
64
        like($message_queue_id, qr/^\d+$/, "Message enqueued.");
65
        $S->{message_queues}->{$message_queue_id} = $mqHash;
66
        $F->{message_queues}->{$message_queue_id} = $mqHash;
67
    }
68
}
69
70
sub deleteAllMessageQueues {
71
    my $C = shift;
72
    my $F = $C->{stash}->{feature};
73
    my $schema = Koha::Database->new()->schema();
74
75
    $schema->resultset('MessageQueue')->search({})->delete_all();
76
}
77
78
sub verifyMessageQueueItems {
79
    my $C = shift;
80
    my $S = $C->{stash}->{scenario};
81
    my $F = $C->{stash}->{feature};
82
    my $checks = $C->data(); #Get the checks, which might not have manifested itselves to the message_queue_items
83
    ok(($checks && scalar(@$checks) > 0), "You must give checks as the data");
84
85
    #See which checks are supposed to be in the message_queue_item-table, and which are just to clarify intent.
86
    my @checksInTable;
87
    foreach my $check (@$checks) {
88
        my $status = $check->{status};
89
        push @checksInTable, $check if ($status ne 'not_odue' && $status ne 'no_rule');
90
    }
91
92
    ##Make sure that there are no trailing MessageQueueItems.
93
    my $schema = Koha::Database->new()->schema();
94
    my $allMessageQueueItemsCount = $schema->resultset('MessageQueueItem')->search({})->count();
95
    is($allMessageQueueItemsCount, scalar(@checksInTable), "We should have ".scalar(@checksInTable)." checks for $allMessageQueueItemsCount message_queue_items, with no trailing items.");
96
97
    #Expressing the following cannot be comfortably done with DBIx
98
    #especially since message_queue_items-table should not have foreign key linkings to items and issues-tables.
99
    my $dbh = C4::Context->dbh();
100
    my $check_statement = $dbh->prepare(
101
        "SELECT 1 FROM message_queue_items mi ".
102
        "LEFT JOIN message_queue mq ON mi.message_id = mq.message_id ".
103
        "LEFT JOIN borrowers b ON mq.borrowernumber = b.borrowernumber ".
104
        "LEFT JOIN items i ON mi.itemnumber = i.itemnumber ".
105
        "LEFT JOIN issues iss ON iss.issue_id = mi.issue_id ".
106
        "WHERE b.cardnumber = ? AND i.barcode = ? AND mi.branch = ? AND mq.letter_code = ? ".
107
        "AND mi.letternumber = ? AND mq.status = ?  AND mq.message_transport_type = ? ".
108
    "");
109
110
    ##Check that there is a matching MessageQueueItem for each given test.
111
    foreach my $check (@checksInTable) {
112
        my @params;
113
        push @params, $check->{cardnumber};
114
        push @params, $check->{barcode};
115
        push @params, $check->{branch};
116
        push @params, $check->{lettercode};
117
        push @params, $check->{letternumber};
118
        push @params, $check->{status};
119
        push @params, $check->{transport_type};
120
        $check_statement->execute( @params );
121
        my $ok = $check_statement->fetchrow();
122
        last unless ok(($ok && $ok == 1), "Check: For params @params");
123
    }
124
}
125
126
sub verifyMessageQueues {
127
    my $C = shift;
128
    my $S = $C->{stash}->{scenario};
129
    my $F = $C->{stash}->{feature};
130
131
    my $checks = $C->data(); #Get the checks, which might not have manifested itselves to the message_queues
132
    ok(($checks && scalar(@$checks) > 0), "You must give checks as the data");
133
134
    ##Make sure that there are no trailing MessageQueueItems.
135
    my $schema = Koha::Database->new()->schema();
136
    my $allMessageQueuesCount = $schema->resultset('MessageQueue')->search({})->count();
137
    is($allMessageQueuesCount, scalar(@$checks), "We should have ".scalar(@$checks)." checks for $allMessageQueuesCount message_queue_items, with no trailing items.");
138
139
    my @all = $schema->resultset('MessageQueue')->search({});
140
    foreach my $a ( @all ) {
141
        print $a->content()."\n";
142
    }
143
144
    if ($checks->[0]->{contentRegexp}) {
145
        verifyMessageQueuesFromContentRegexp($checks);
146
    }
147
    elsif ($checks->[0]->{containedBarcodes}) {
148
        verifyMessageQueuesFromBarcodes($checks);
149
    }
150
    else {
151
        die "\nverifyMessageQueues():> The MessageQueues-data table must contain column 'barcodes', or 'contentRegexp'.\n".
152
            "'barcodes' contains comma separated list of barcodes that must be found inside the message_queue.content.\n".
153
            "'contentRegexp' is a regexp that must match with the message_queue.content.\n";
154
    }
155
}
156
157
sub verifyMessageQueuesFromBarcodes {
158
    my ($checks) = @_;
159
160
    my $dbh = C4::Context->dbh();
161
    my $check_statement = $dbh->prepare(
162
        "SELECT 1 FROM message_queue mq ".
163
        "LEFT JOIN message_queue_items mqi ON mqi.message_id = mq.message_id ".
164
        "LEFT JOIN borrowers b ON mq.borrowernumber = b.borrowernumber ".
165
        "LEFT JOIN items i ON mqi.itemnumber = i.itemnumber ".
166
        "WHERE b.cardnumber = ? ".
167
        "AND i.barcode = ? ".
168
        "AND mq.letter_code = ? ".
169
        "AND mq.status = ? ".
170
        "AND mq.message_transport_type = ? ".
171
    "");
172
173
    ##Check that there is a matching MessageQueue for each given test.
174
    foreach my $check (@$checks) {
175
        my @barcodes = map {my $a = $_; $a =~ s/\s+//gsm; $a;} split(',',$check->{containedBarcodes});
176
        foreach my $bc (@barcodes) {
177
            my @params;
178
            push @params, $check->{cardnumber};
179
            push @params, $bc;
180
            push @params, $check->{lettercode};
181
            push @params, $check->{status};
182
            push @params, $check->{transport_type};
183
            $check_statement->execute( @params );
184
            my $ok = $check_statement->fetchrow();
185
            last unless ok(($ok && $ok == 1), "Check: For params @params");
186
        }
187
    }
188
}
189
sub verifyMessageQueuesFromContentRegexp {
190
    my ($checks) = @_;
191
192
    my $dbh = C4::Context->dbh();
193
    my $check_statement = $dbh->prepare(
194
        "SELECT 1 FROM message_queue mq ".
195
        "LEFT JOIN borrowers b ON mq.borrowernumber = b.borrowernumber ".
196
        "WHERE b.cardnumber = ? ".
197
        "AND mq.letter_code = ? ".
198
        "AND mq.status = ? ".
199
        "AND mq.message_transport_type = ? ".
200
        "AND mq.content REGEXP ? ".
201
    "");
202
203
    ##Check that there is a matching MessageQueue for each given test.
204
    foreach my $check (@$checks) {
205
        my @params;
206
        push @params, $check->{cardnumber};
207
        push @params, $check->{lettercode};
208
        push @params, $check->{status};
209
        push @params, $check->{transport_type};
210
        push @params, $check->{contentRegexp};
211
        $check_statement->execute( @params );
212
        my $ok = $check_statement->fetchrow();
213
        last unless ok(($ok && $ok == 1), "Check: For params @params");
214
    }
215
}
216
217
1;
(-)a/t/Cucumber/SImpls/ScriptRunning.pm (+40 lines)
Line 0 Link Here
1
package SImpls::ScriptRunning;
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Carp;
22
use Test::More;
23
24
sub runScript {
25
    my $C = shift;
26
    my $scriptPath = $C->matches()->[0];
27
    $scriptPath =~ s/\$KOHA_PATH/$ENV{KOHA_PATH}/gsm;
28
    my $params = $C->data();
29
30
    my @args = ($scriptPath);
31
    while (my ($param, $value) = each(%{$params->[0]})) {
32
        push @args, "$param $value";
33
    }
34
35
    my $retval = system("@args");
36
37
    ok(($retval == 0), "System call\n@args\nsucceeded");
38
}
39
40
1;
(-)a/t/Cucumber/SImpls/SystemPreferences.pm (+63 lines)
Line 0 Link Here
1
package SImpls::SystemPreferences;
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Carp;
22
use Test::More;
23
24
use C4::Context;
25
26
sub setSystemPreferences {
27
    my $C = shift;
28
29
    my $data = $C->data();
30
    foreach my $syspref (@$data) {
31
        setSystemPreference($C, $syspref->{systemPreference}, $syspref->{value});
32
    }
33
}
34
sub setSystemPreference {
35
    my ($C, $key, $value) = @_;
36
    my $S = $C->{stash}->{scenario};
37
    my $F = $C->{stash}->{feature};
38
39
    $S->{originalSystempreferences} = {} unless $S->{originalSystempreferences};
40
    $F->{originalSystempreferences} = {} unless $F->{originalSystempreferences};
41
42
    if ($S->{originalSystempreferences}->{$key} && $F->{originalSystempreferences}->{$key}) {
43
        #This syspref has been set from somewhere already, so let's not remove the stored original value.
44
    }
45
    else {
46
        my $oldSysprefValue = C4::Context->preference($key);
47
        $S->{originalSystempreferences}->{$key} = $oldSysprefValue;
48
        $F->{originalSystempreferences}->{$key} = $oldSysprefValue;
49
    }
50
    C4::Context->set_preference($key, $value);
51
}
52
53
sub rollbackSystemPreferences {
54
    my $C = shift;
55
    my $F = $C->{stash}->{feature};
56
    if (ref $F->{originalSystempreferences} eq 'HASH') {
57
        while (my ($syspref, $value) = each(%{$F->{originalSystempreferences}})) {
58
            C4::Context->set_preference($syspref, $value);
59
        }
60
    }
61
}
62
63
1;
(-)a/t/Cucumber/runCucumberTests.t (+104 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
use Test::BDD::Cucumber::Loader;
24
use Test::BDD::Cucumber::Harness::TestBuilder;
25
use Test::BDD::Cucumber::Model::TagSpec;
26
27
use Getopt::Long qw(:config no_ignore_case);
28
29
my $help;
30
my $featureRegexp;
31
my $verbose;
32
my @tags;
33
34
GetOptions(
35
    'h|help'                      => \$help,
36
    'f|featureRegexp:s'           => \$featureRegexp,
37
    'v|verbose:i'                 => \$verbose,
38
    't|tags:s'                    => \@tags,
39
);
40
41
my $usage = <<USAGE;
42
43
perl runCucumberTests.t --verbose 2 --featureRegexp "overdues" --tags \@overdues
44
45
Executes all Cucumber tests. You can narrow down the tests to run using --tags
46
and --featureRegexp, and make various testing configurations with them.
47
48
  --tags                See https://github.com/cucumber/cucumber/wiki/Tags
49
                        ~\@tag is not supported, only \@tag.
50
                        Only runs the scenarios/features these tags are given to.
51
                        This is quite useful when developing, because you can
52
                        easily narrow down which scenarios to execute amidst
53
                        features containing lots of expensive tests.
54
55
  --featureRegexp       Will run only features whose feature description's first
56
                        line matches the given escaped regexp.
57
                        Prefer using tags if possible, since that is the Cucumber-way.
58
59
USAGE
60
61
if ($help) {
62
    print $usage;
63
    exit 0;
64
}
65
66
if ($verbose) {
67
    $ENV{CUCUMBER_VERBOSE} = $verbose;
68
}
69
70
#Set the default Koha context
71
use C4::Context;
72
C4::Context->_new_userenv('DUMMY SESSION');
73
C4::Context->set_userenv(0,0,0,'firstname','surname', 'CPL', 'Library 1', 0, '', '');
74
75
76
######  #  #  #  #  #  #  #  ######
77
###   Run the Cucumber tests.   ###
78
######  #  #  #  #  #  #  #  ######
79
my ( $executor, @features ) = Test::BDD::Cucumber::Loader->load( '.' );
80
81
if ($featureRegexp) {
82
    #Pick only the needed feature
83
    my @filteredFeatures;
84
    for (my $i=0 ; $i<@features ; $i++) {
85
        my $feature = $features[$i];
86
        push @filteredFeatures, ($features[$i]) if $feature->name() =~ m/$featureRegexp/i;
87
    }
88
    @features = @filteredFeatures;
89
}
90
91
my $tagSet;
92
if (scalar(@tags)) {
93
    #Load given tags.
94
    for (my $i=0 ; $i<@tags ; $i++) {
95
        $tags[$i] =~ s/[@]//;
96
    }
97
    $tagSet = Test::BDD::Cucumber::Model::TagSpec->new({
98
       tags => [ and => @tags ],
99
    });
100
}
101
102
my $harness = Test::BDD::Cucumber::Harness::TestBuilder->new({});
103
$executor->execute( $_, $harness, $tagSet ) for @features;
104
done_testing;
(-)a/t/Cucumber/steps/accountlines_steps.pl (+32 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
24
use SImpls::Accountlines;
25
26
Given qr/there are no previous fines/, sub {
27
    SImpls::Accountlines::deleteAllFines(@_);
28
};
29
30
Then qr/the following fines are encumbered on naughty borrowers/, sub {
31
    SImpls::Accountlines::checkAccountlines( @_ );
32
};
(-)a/t/Cucumber/steps/biblios_steps.pl (+28 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
24
use SImpls::Biblios;
25
26
Given qr/a set of Biblios/, sub {
27
    SImpls::Biblios::addBiblios(@_);
28
};
(-)a/t/Cucumber/steps/borrowers_steps.pl (+32 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
24
use SImpls::Borrowers;
25
26
Given qr/a set of Borrowers/, sub {
27
    SImpls::Borrowers::addBorrowers(@_);
28
};
29
30
Then qr/the following borrowers are debarred/, sub {
31
    SImpls::Borrowers::checkDebarments( @_ );
32
};
(-)a/t/Cucumber/steps/branchTransfers_steps.pl (+28 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
24
use SImpls::BranchTransfers;
25
26
Then qr/the following Items are in-transit/, sub {
27
    SImpls::BranchTransfers::verifyItemsInTransit(@_);
28
};
(-)a/t/Cucumber/steps/common_steps.pl (+44 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
24
25
26
When qr/all scenarios are executed, tear down database changes./, sub {
27
    my $C = shift;
28
    #Forcibly make a new schema, because the existing schema might get timeout and cause this tear down step to fail.
29
    #Koha::Database->new_schema() just wraps around the C4::Context->dbh() which has already died :(
30
    #So we must get the new schema forcibly.
31
    my $schema = Koha::Schema->connect( sub { C4::Context->_new_dbh() }, { unsafe => 1 } );
32
    my $db = Koha::Database->new();
33
    $db->set_schema($schema);
34
35
    SImpls::BranchTransfers::deleteAllTransfers($C);
36
    SImpls::Issues::deleteAllIssues($C);
37
    SImpls::Borrowers::deleteBorrowers($C);
38
    SImpls::Items::deleteItems($C);
39
    SImpls::Accountlines::deleteAllFines($C);
40
    SImpls::Biblios::deleteBiblios($C);
41
    SImpls::MessageQueues::deleteAllMessageQueues($C);
42
    SImpls::LetterTemplates::deleteLetterTemplates($C);
43
    SImpls::SystemPreferences::rollbackSystemPreferences($C);
44
};
(-)a/t/Cucumber/steps/context_steps.pl (+30 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
24
25
use SImpls::Context;
26
27
Given qr/the Koha-context, we can proceed with other scenarios./, sub {
28
    my $C = shift;
29
    SImpls::Context::setKohaContext($C);
30
};
(-)a/t/Cucumber/steps/fileUtils_steps.pl (+32 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
24
use SImpls::FileUtils;
25
26
Given qr/a file at '(.*?)'/, sub {
27
    SImpls::FileUtils::findFile( @_ );
28
};
29
30
Then qr/I have the following text inside these files/, sub {
31
    SImpls::FileUtils::checkRegexpInsideFiles( @_ );
32
};
(-)a/t/Cucumber/steps/issues_steps.pl (+43 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
24
use SImpls::Issues;
25
26
Given qr/there are no previous issues/, sub {
27
    SImpls::Issues::deleteAllIssues(@_);
28
};
29
30
Given qr/a set of overdue Issues, checked out from the Items' current holdingbranch/, sub {
31
    my $C = shift;
32
    SImpls::Issues::addIssues($C, 'holdingbranch');
33
};
34
35
Given qr/a set of Issues, checked out from the Items' current '(\w+)'/, sub {
36
    my $C = shift;
37
    SImpls::Issues::addIssues($C, $C->matches()->[0]);
38
};
39
40
When qr/checked-out Items are checked-in to their '(\w+)'/, sub {
41
    my $C = shift;
42
    SImpls::Issues::checkInIssues($C, $C->matches()->[0]);
43
};
(-)a/t/Cucumber/steps/items_steps.pl (+28 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
24
use SImpls::Items;
25
26
Given qr/a set of Items/, sub {
27
    SImpls::Items::addItems(@_);
28
};
(-)a/t/Cucumber/steps/letterTemplates_steps.pl (+28 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
24
use SImpls::LetterTemplates;
25
26
Given qr/a set of letter templates/, sub {
27
    SImpls::LetterTemplates::addLetterTemplates(@_);
28
};
(-)a/t/Cucumber/steps/messageQueue_steps.pl (+39 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
24
use SImpls::MessageQueues;
25
26
Given qr/a bunch of message_queue-rows using letter code '(.*?)' and message_transport_type '(.*?)' based on the given Borrowers, Biblios, Items and Issues/, sub {
27
    my $C = shift;
28
    my $letterCode = $1;
29
    my $messageTransportType = $2;
30
    SImpls::MessageQueues::addMessageQueues($C, $letterCode, $messageTransportType);
31
};
32
33
Then qr/I have the following enqueued message queue items/, sub {
34
    SImpls::MessageQueues::verifyMessageQueueItems( @_ );
35
};
36
37
Then qr/I have the following message queue notices/, sub {
38
    SImpls::MessageQueues::verifyMessageQueues( @_ );
39
};
(-)a/t/Cucumber/steps/scriptRunning_steps.pl (+28 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
24
use SImpls::ScriptRunning;
25
26
When qr/I run '(.*?)'-script with the following parameters/, sub {
27
    SImpls::ScriptRunning::runScript( @_ );
28
};
(-)a/t/Cucumber/steps/systempreferences_steps.pl (+28 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
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, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Test::BDD::Cucumber::StepFile;
23
24
use SImpls::SystemPreferences;
25
26
Given qr/the following system preferences/, sub {
27
    SImpls::SystemPreferences::setSystemPreferences( @_ );
28
};
(-)a/t/Cucumber/testsStructuring.tutorial (-1 / +60 lines)
Line 0 Link Here
0
- 
1
 +--<>--<>--<>--<>-<>--<>--<>--<>--+
2
<> Writing Cucumber tests for Koha <>
3
 +--<>--<>--<>--<>-<>--<>--<>--<>--+
4
5
+---
6
| Cucumber tests are split into 4 different types of files: )==>
7
+---
8
9
1. Feature definitions, features/*/*.feature
10
    These are the user stories which trigger the Cucumber steps.
11
12
2. step-definitions, steps/*_steps.pl
13
    These files define the Cucumber steps and depend only on the step implementations to mimize coupling.
14
15
3. step implementations, SImpls/*/*.pm
16
    These files implement the steps defined in steps-folder, which are not using browser tests. This is all
17
    back-end stuff, like cronjobs, basic CRUD for features, etc.
18
19
4. Page Objects, POs/*/*.pm
20
    These files implement the browser based steps which test interface functionality.
21
22
23
+---
24
| Tests are structured into the following organization: )==>
25
+---
26
27
Step-files can be easily moved around so for now we can just put them in the steps-folder.
28
    t/Cucumber/steps/borrower_steps.pl
29
    t/Cucumber/steps/borrower_rest_steps.pl
30
    t/Cucumber/steps/borrower_po_steps.pl
31
    t/Cucumber/steps/issue_steps.pl
32
    t/Cucumber/steps/biblio_rest_steps.pl
33
34
A Cucumber best-practice is to separate code from the step definitions, and with the step
35
implementations we mimick the Koha module hierarchy.
36
    t/Cucumber/SImpls/Borrowers/Borrowers.pm
37
    t/Cucumber/SImpls/Borrowers/MessagePreferences.pm
38
    t/Cucumber/SImpls/FloatingMatrix/FloatingMatrix.pm
39
40
To test the web pages, we should use a Page Object Pattern, in which each page, like
41
members/memberentry.pl gets it's own matching object to abstract the HTML elements under
42
object methods. Thus writing tests is much easier and features are encapsulated better. So it
43
is easier to maintain interface tests when change happens.
44
Here we mimic the Koha-controllers hierarchy with the goal of each Page Object matching a Koha controller,
45
like members/memberentry.pl
46
    t/Cucumber/POs/Borrowers/MemberEntry.pm
47
    t/Cucumber/POs/Borrowers/Member.pm
48
    t/Cucumber/POs/Borrowers/PrintSlip.pm
49
    t/Cucumber/POs/Biblios/AddBiblio.pm
50
        (we can put REST tests object first like "POs/Borrowers/RESTv1.pm" as an alternative)
51
    t/Cucumber/POs/REST/v1/Biblios.pm
52
    t/Cucumber/POs/REST/v1/Borrowers.pm
53
54
Feature definitions are easily movable to another hierarchy, so we just for now gather them
55
under top-level modules.
56
    t/Cucumber/features/Overdues/calendarCRUD.feature
57
    t/Cucumber/features/Overdues/printProviderLimbo.feature
58
    t/Cucumber/features/Borrowers/borrowersCRUD.feature
59
    t/Cucumber/features/FloatingMatrix/floatingMatrixCRUD.feature
60
    t/Cucumber/features/FloatingMatrix/floatingMatrix.feature

Return to bug 13096