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

(-)a/t/lib/TestObjects/BiblioFactory.pm (+115 lines)
Line 0 Link Here
1
package t::lib::TestObjects::BiblioFactory;
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
21
use Modern::Perl;
22
use Carp;
23
24
use C4::Biblio;
25
26
use base qw(t::lib::TestObjects::ObjectFactory);
27
28
sub new {
29
    my ($class) = @_;
30
31
    my $self = {};
32
    bless($self, $class);
33
    return $self;
34
}
35
36
=head t::lib::TestObjects::createTestGroup
37
38
    my $biblioFactory = t::lib::TestObjects::BiblioFactory->new();
39
    my $records = $biblioFactory->createTestGroup([
40
                        {'biblio.title' => 'I wish I met your mother',
41
                         'biblio.author'   => 'Pertti Kurikka',
42
                         'biblio.copyrightdate' => '1960',
43
                         'biblioitems.isbn'     => '9519671580',
44
                         'biblioitems.itemtype' => 'BK',
45
                        },
46
                    ], undef, $testContext1, $testContext2, $testContext3);
47
48
Calls C4::Biblio::TransformKohaToMarc() to make a MARC::Record and add it to
49
the DB. Returns a HASH of MARC::Records.
50
The HASH is keyed with the biblionumber, or the given $hashKey. Using for example
51
'biblioitems.isbn' is very much recommended to make linking objects more easy.
52
The biblionumber is injected to the MARC::Record-object to be easily accessable,
53
so we can get it like this:
54
    $records->{$key}->{biblionumber};
55
56
See C4::Biblio::TransformKohaToMarc() for how the biblio- or biblioitem-tables'
57
columns need to be given.
58
59
See t::lib::TestObjects::ObjectFactory for more documentation
60
=cut
61
62
sub createTestGroup {
63
    my ($self, $biblios, $hashKey, $featureStash, $scenarioStash, $stepStash) = @_;
64
    $self->_validateStashes($featureStash, $scenarioStash, $stepStash);
65
66
    my %records;
67
    foreach my $biblio (@$biblios) {
68
        my $record = C4::Biblio::TransformKohaToMarc($biblio);
69
        my ($biblionumber, $biblioitemnumber) = C4::Biblio::AddBiblio($record,'');
70
        $record->{biblionumber} = $biblionumber;
71
72
        my $key = $self->getHashKey($biblio, $biblionumber, $hashKey);
73
74
        $records{$key} = $record;
75
    }
76
77
    $self->_persistToStashes(\%records, 'biblios', $featureStash, $scenarioStash, $stepStash);
78
79
    return \%records;
80
}
81
82
=head
83
84
    my $records = createTestGroup();
85
    ##Do funky stuff
86
    deleteTestGroup($records);
87
88
Removes the given test group from the DB.
89
90
=cut
91
92
sub deleteTestGroup {
93
    my ($self, $records) = @_;
94
95
    my ( $biblionumberFieldCode, $biblionumberSubfieldCode ) =
96
            C4::Biblio::GetMarcFromKohaField( "biblio.biblionumber", '' );
97
98
    my $schema = Koha::Database->new_schema();
99
    while( my ($key, $record) = each %$records) {
100
        my $biblionumber = $record->subfield($biblionumberFieldCode, $biblionumberSubfieldCode);
101
        $schema->resultset('Biblio')->search($biblionumber)->delete_all();
102
        $schema->resultset('Biblioitem')->search($biblionumber)->delete_all();
103
    }
104
}
105
sub _deleteTestGroupFromIdentifiers {
106
    my ($self, $testGroupIdentifiers) = @_;
107
108
    my $schema = Koha::Database->new_schema();
109
    foreach my $isbn (@$testGroupIdentifiers) {
110
        $schema->resultset('Biblio')->search({"biblioitems.isbn" => $isbn},{join => 'biblioitems'})->delete();
111
        $schema->resultset('Biblioitem')->search({isbn => $isbn})->delete();
112
    }
113
}
114
115
1;
(-)a/t/lib/TestObjects/BorrowerFactory.pm (+182 lines)
Line 0 Link Here
1
package t::lib::TestObjects::BorrowerFactory;
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
21
use Modern::Perl;
22
use Carp;
23
use Scalar::Util qw(blessed);
24
25
use C4::Members;
26
use Koha::Borrowers;
27
28
use base qw(t::lib::TestObjects::ObjectFactory);
29
30
sub new {
31
    my ($class) = @_;
32
33
    my $self = {};
34
    bless($self, $class);
35
    return $self;
36
}
37
38
=head createTestGroup( $data [, $hashKey, $testContexts...] )
39
@OVERLOADED
40
41
    my $borrowerFactory = t::lib::TestObjects::BorrowerFactory->new();
42
    my $borrowers = $borrowerFactory->createTestGroup([
43
                        {firstname => 'Olli-Antti',
44
                         surname   => 'Kivi',
45
                         cardnumber => '11A001',
46
                         branchcode     => 'CPL',
47
                        },
48
                        {firstname => 'Olli-Antti2',
49
                         surname   => 'Kivi2',
50
                         cardnumber => '11A002',
51
                         branchcode     => 'FPL',
52
                        },
53
                    ], undef, $testContext1, $testContext2, $testContext3);
54
55
    #Do test stuff...
56
57
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1);
58
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2);
59
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
60
61
The HASH is keyed with the given $hashKey or 'koha.borrowers.cardnumber'
62
See C4::Members::AddMember() for how the table columns need to be given.
63
64
@PARAM1 ARRAYRef of HASHRefs of C4::Members::AddMember()-parameters.
65
@PARAM2 koha.borrower-column which is used as the test context borrowers HASH key,
66
                defaults to the most best option cardnumber.
67
@PARAM3-5 HASHRef of test contexts. You can save the given borrowers to multiple
68
                test contexts. Usually one is enough. These test contexts are
69
                used to help tear down DB changes.
70
@RETURNS HASHRef of $hashKey => $borrower-objects:
71
72
See t::lib::TestObjects::ObjectFactory for more documentation
73
=cut
74
75
sub createTestGroup {
76
    my ($self, $objects, $hashKey, $featureStash, $scenarioStash, $stepStash) = @_;
77
    $self->_validateStashes($featureStash, $scenarioStash, $stepStash);
78
    $hashKey = 'cardnumber' unless $hashKey;
79
80
    my %objects;
81
    foreach my $object (@$objects) {
82
83
        $self->validateAndPopulateDefaultValues($object, $hashKey);
84
85
        #Try to add the Borrower, but it might fail because of the barcode or other UNIQUE constraint.
86
        #Catch the error and try looking for the Borrower if we suspect it is present in the DB.
87
        my $borrowernumber;
88
        eval {
89
            $borrowernumber = C4::Members::AddMember(%$object);
90
        };
91
        if ($@) {
92
            if (blessed($@) && $@->isa('DBIx::Class::Exception') &&
93
                $@->{msg} =~ /Duplicate entry '.+?' for key 'cardnumber'/) { #DBIx should throw other types of exceptions instead of this general type :(
94
                #This exception type is OK, we ignore this and try fetching the existing Object next.
95
                warn "Recovering from duplicate exception.\n";
96
            }
97
            else {
98
                die $@;
99
            }
100
        }
101
102
        #If adding failed, we still get some strange borrowernumber result.
103
        #Check for sure by finding the real borrower.
104
        my $borrower = Koha::Borrowers->cast( $borrowernumber || $object );
105
        unless ($borrower) {
106
            carp "BorrowerFactory:> No borrower for cardnumber '".$object->{cardnumber}."'";
107
            next();
108
        }
109
110
        my $key = $self->getHashKey($borrower, $borrowernumber, $hashKey);
111
112
        $objects{$key} = $borrower;
113
    }
114
115
    $self->_persistToStashes(\%objects, 'borrowers', $featureStash, $scenarioStash, $stepStash);
116
117
    return \%objects;
118
}
119
120
=head validateAndPopulateDefaultValues
121
@OVERLOAD
122
123
Validates given Object parameters and makes sure that critical fields are given
124
and populates defaults for missing values.
125
=cut
126
127
sub validateAndPopulateDefaultValues {
128
    my ($self, $borrower, $hashKey) = @_;
129
    $self->SUPER::validateAndPopulateDefaultValues($borrower, $hashKey);
130
131
    $borrower->{categorycode} = 'PT' unless $borrower->{categorycode};
132
    $borrower->{branchcode}   = 'CPL' unless $borrower->{branchcode};
133
    $borrower->{dateofbirth}  = '1985-10-12' unless $borrower->{dateofbirth};
134
}
135
136
=head deleteTestGroup
137
@OVERLOADED
138
139
    my $records = createTestGroup();
140
    ##Do funky stuff
141
    deleteTestGroup($records);
142
143
Removes the given test group from the DB.
144
145
=cut
146
147
sub deleteTestGroup {
148
    my ($self, $objects) = @_;
149
150
    my $schema = Koha::Database->new_schema();
151
    while( my ($key, $object) = each %$objects) {
152
        my $borrower = Koha::Borrowers->cast($object);
153
        eval {
154
            $borrower->delete();
155
        };
156
        if ($@) {
157
            if (blessed($@) && $@->isa('DBIx::Class::Exception') &&
158
                    #Trying to recover. Delete all Checkouts for the Borrower to be able to delete.
159
                    $@->{msg} =~ /a foreign key constraint fails.+?issues_ibfk_1/) { #DBIx should throw other types of exceptions instead of this general type :(
160
161
                my @checkouts = Koha::Checkouts->search({borrowernumber => $borrower->borrowernumber});
162
                foreach my $c (@checkouts) { $c->delete(); }
163
                $borrower->delete();
164
                warn "Recovering from foreign key exception.\n";
165
            }
166
            else {
167
                die $@;
168
            }
169
        }
170
        
171
    }
172
}
173
sub _deleteTestGroupFromIdentifiers {
174
    my ($self, $testGroupIdentifiers) = @_;
175
176
    my $schema = Koha::Database->new_schema();
177
    foreach my $key (@$testGroupIdentifiers) {
178
        $schema->resultset('Borrower')->find({"cardnumber" => $key})->delete();
179
    }
180
}
181
182
1;
(-)a/t/lib/TestObjects/CheckoutFactory.pm (+182 lines)
Line 0 Link Here
1
package t::lib::TestObjects::CheckoutFactory;
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
21
use Modern::Perl;
22
use Carp;
23
use DateTime;
24
25
use C4::Circulation;
26
use C4::Members;
27
use C4::Items;
28
use Koha::Borrowers;
29
use Koha::Items;
30
31
use base qw(t::lib::TestObjects::ObjectFactory);
32
33
sub new {
34
    my ($class) = @_;
35
36
    my $self = {};
37
    bless($self, $class);
38
    return $self;
39
}
40
41
=head t::lib::TestObjects::CheckoutFactory::createTestGroup( $data [, $hashKey, $checkoutBranchRule] )
42
43
    my $checkoutFactory = t::lib::TestObjects::CheckoutFactory->new();
44
    my $checkouts = $checkoutFactory->createTestGroup([
45
                        {#Checkout params
46
                        },
47
                        {#More checkout params
48
                        },
49
                    ], undef, $testContext1, $testContext2, $testContext3);
50
51
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1);
52
53
@PARAM1, ARRAY of HASHes.
54
  [ {
55
        cardnumber        => '167Azava0001',
56
        barcode           => '167Nfafa0010',
57
        daysOverdue       => 7,     #This Checkout's duedate was 7 days ago. If undef, then uses today as the checkout day.
58
        daysAgoCheckedout => 28, #This Checkout hapened 28 days ago. If undef, then uses today.
59
    },
60
    {
61
        ...
62
    }
63
  ]
64
@PARAM2, String, the HASH-element to use as the returning HASHes key.
65
@PARAM3, String, the rule on where to check these Issues out:
66
                 'homebranch', uses the Item's homebranch as the checkout branch
67
                 'holdingbranch', uses the Item's holdingbranch as the checkout branch
68
                 undef, uses the current Environment branch
69
                 '<branchCode>', checks out all Issues from the given branchCode
70
@PARAM4-6 HASHRef of test contexts. You can save the given objects to multiple
71
                test contexts. Usually one is enough. These test contexts are
72
                used to help tear down DB changes.
73
@RETURNS HASHRef of $hashKey => $checkout-objects.
74
                The HASH is keyed with <cardnumber>-<barcode>, or the given $hashKey.
75
    Example: {
76
    '11A001-167N0212' => {
77
        cardnumber => <cardnumber>,
78
        barcode => <barcode>,
79
        ...other Checkout-object columns...
80
    },
81
    ...
82
}
83
=cut
84
85
sub createTestGroup {
86
    my ($self, $objects, $hashKey, $checkoutBranchRule, $featureStash, $scenarioStash, $stepStash) = @_;
87
    $self->_validateStashes($featureStash, $scenarioStash, $stepStash);
88
89
    #If running this test factory from unit tests or bare script, the context might not have been initialized.
90
    unless (C4::Context->userenv()) {
91
        C4::Context->_new_userenv('testGroupsTest');
92
        C4::Context->set_userenv(undef, undef, undef,
93
                           undef, undef,
94
                           'CPL', undef, undef,
95
                           undef, undef, undef);
96
    }
97
    my $oldContextBranch = C4::Context->userenv()->{branch};
98
99
    my %objects;
100
    foreach my $checkoutParams (@$objects) {
101
        my $borrower = C4::Members::GetMember(cardnumber => $checkoutParams->{cardnumber});
102
        my $item =     Koha::Items->cast($checkoutParams->{barcode});
103
104
        my $duedate = DateTime->now(time_zone => C4::Context->tz());
105
        if ($checkoutParams->{daysOverdue}) {
106
            $duedate->subtract(days =>  $checkoutParams->{daysOverdue}  );
107
        }
108
109
        my $checkoutdate = DateTime->now(time_zone => C4::Context->tz());
110
        if ($checkoutParams->{daysAgoCheckedout}) {
111
            $checkoutdate->subtract(days =>  $checkoutParams->{daysAgoCheckedout}  );
112
        }
113
114
        #Set the checkout branch
115
        my $checkoutBranch;
116
        if (not($checkoutBranchRule)) {
117
            #Use the existing userenv()->{branch}
118
        }
119
        elsif ($checkoutBranchRule eq 'homebranch') {
120
            $checkoutBranch = $item->homebranch;
121
        }
122
        elsif ($checkoutBranchRule eq 'holdingbranch') {
123
            $checkoutBranch = $item->holdingbranch;
124
        }
125
        elsif ($checkoutBranchRule) {
126
            $checkoutBranch = $checkoutBranchRule;
127
        }
128
        C4::Context->userenv()->{branch} = $checkoutBranch if $checkoutBranch;
129
130
        my $datedue = C4::Circulation::AddIssue( $borrower, $checkoutParams->{barcode}, $duedate, undef, $checkoutdate );
131
        #We want the issue_id as well.
132
        my $checkout = Koha::Checkouts->find({ borrowernumber => $borrower->{borrowernumber}, itemnumber => $item->itemnumber });
133
        unless ($checkout) {
134
            carp "CheckoutFactory:> No checkout for cardnumber '".$checkoutParams->{cardnumber}."' and barcode '".$checkoutParams->{barcode}."'";
135
            next();
136
        }
137
138
        my $key;
139
        if ($hashKey) {
140
            $key = $self->getHashKey($checkout, $checkout->issue_id, $hashKey);
141
        }
142
        else {
143
            $key = $checkoutParams->{cardnumber}.'-'.$checkoutParams->{barcode};
144
        }
145
146
        $objects{$key} = $checkout;
147
    }
148
149
    $self->_persistToStashes(\%objects, 'checkouts', $featureStash, $scenarioStash, $stepStash);
150
151
    C4::Context->userenv()->{branch} = $oldContextBranch;
152
    return \%objects;
153
}
154
155
=head
156
157
    my $objects = createTestGroup();
158
    ##Do funky stuff
159
    deleteTestGroup($records);
160
161
Removes the given test group from the DB.
162
163
=cut
164
165
sub deleteTestGroup {
166
    my ($self, $objects) = @_;
167
168
    while( my ($key, $object) = each %$objects) {
169
        my $checkout = Koha::Checkouts->cast($object);
170
        $checkout->delete();
171
    }
172
}
173
sub _deleteTestGroupFromIdentifiers {
174
    my ($self, $testGroupIdentifiers) = @_;
175
176
    my $schema = Koha::Database->new_schema();
177
    foreach my $key (@$testGroupIdentifiers) {
178
        $schema->resultset('Issue')->find({"issue_id" => $key})->delete();
179
    }
180
}
181
182
1;
(-)a/t/lib/TestObjects/ItemFactory.pm (+115 lines)
Line 0 Link Here
1
package t::lib::TestObjects::ItemFactory;
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
21
use Modern::Perl;
22
use Carp;
23
24
use C4::Items;
25
use Koha::Items;
26
27
use base qw(t::lib::TestObjects::ObjectFactory);
28
29
sub new {
30
    my ($class) = @_;
31
32
    my $self = {};
33
    bless($self, $class);
34
    return $self;
35
}
36
37
=head t::lib::TestObjects::ItemFactory::createTestGroup( $data [, $hashKey] )
38
@OVERLOADED
39
40
Returns a HASH of objects.
41
Each Item is expected to contain the biblionumber of the Biblio they are added into.
42
    eg. $item->{biblionumber} = 550242;
43
44
The HASH is keyed with the PRIMARY KEY, or the given $hashKey.
45
46
See C4::Items::AddItem() for how the table columns need to be given.
47
48
See t::lib::TestObjects::ObjectFactory for more documentation
49
=cut
50
51
sub createTestGroup {
52
    my ($self, $objects, $hashKey, $featureStash, $scenarioStash, $stepStash) = @_;
53
    $self->_validateStashes($featureStash, $scenarioStash, $stepStash);
54
55
    my %objects;
56
    foreach my $object (@$objects) {
57
        my ($biblionumber, $biblioitemnumber, $itemnumber);
58
        eval {
59
            ($biblionumber, $biblioitemnumber, $itemnumber) = C4::Items::AddItem($object, $object->{biblionumber});
60
        };
61
        if ($@) {
62
            if (blessed($@) && $@->isa('DBIx::Class::Exception') &&
63
                $@->{msg} =~ /Duplicate entry '.+?' for key 'itembarcodeidx'/) { #DBIx should throw other types of exceptions instead of this general type :(
64
                #This exception type is OK, we ignore this and try fetching the existing Object next.
65
                warn "Recovering from duplicate exception.\n";
66
            }
67
            else {
68
                die $@;
69
            }
70
        }
71
        my $item = Koha::Items->cast($itemnumber || $object);
72
        unless ($item) {
73
            carp "ItemFactory:> No item for barcode '".$object->{barcode}."'";
74
            next();
75
        }
76
77
        my $key = $self->getHashKey($item, $itemnumber, $hashKey);
78
79
        $objects{$key} = $item;
80
    }
81
82
    $self->_persistToStashes(\%objects, 'items', $featureStash, $scenarioStash, $stepStash);
83
84
    return \%objects;
85
}
86
87
=head
88
@OVERLOADED
89
90
    my $objects = createTestGroup();
91
    ##Do funky stuff
92
    deleteTestGroup($records);
93
94
Removes the given test group from the DB.
95
96
=cut
97
98
sub deleteTestGroup {
99
    my ($self, $objects) = @_;
100
101
    while( my ($key, $object) = each %$objects) {
102
        my $item = Koha::Items->cast($object);
103
        $item->delete();
104
    }
105
}
106
sub _deleteTestGroupFromIdentifiers {
107
    my ($self, $testGroupIdentifiers) = @_;
108
109
    foreach my $key (@$testGroupIdentifiers) {
110
        my $item = Koha::Items->cast($key);
111
        $item->delete();
112
    }
113
}
114
115
1;
(-)a/t/lib/TestObjects/LetterTemplateFactory.pm (+103 lines)
Line 0 Link Here
1
package t::lib::TestObjects::LetterTemplateFactory;
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
21
use Modern::Perl;
22
use Carp;
23
24
use C4::Letters;
25
use Koha::LetterTemplates;
26
27
use base qw(t::lib::TestObjects::ObjectFactory);
28
29
sub new {
30
    my ($class) = @_;
31
32
    my $self = {};
33
    bless($self, $class);
34
    return $self;
35
}
36
37
=head t::lib::TestObjects::LetterTemplateFactory->createTestGroup
38
Returns a HASH of Koha::LetterTemplate-objects
39
The HASH is keyed with the PRIMARY KEYS eg. 'circulation-ODUE2-CPL-print', or the given $hashKey.
40
=cut
41
42
#Incredibly the Letters-module has absolutely no Create or Update-component to operate on Letter templates?
43
#Tests like these are brittttle. :(
44
sub createTestGroup {
45
    my ($self, $objects, $hashKey, $featureStash, $scenarioStash, $stepStash) = @_;
46
    $self->_validateStashes($featureStash, $scenarioStash, $stepStash);
47
48
    my %objects;
49
    my $schema = Koha::Database->new()->schema();
50
    foreach my $object (@$objects) {
51
        my $rs = $schema->resultset('Letter');
52
        my $result = $rs->update_or_create({
53
                module     => $object->{module},
54
                code       => $object->{code},
55
                branchcode => ($object->{branchcode}) ? $object->{branchcode} : '',
56
                name       => $object->{name},
57
                is_html    => $object->{is_html},
58
                title      => $object->{title},
59
                message_transport_type => $object->{message_transport_type},
60
                content    => $object->{content},
61
        });
62
63
        my @pks = $result->id();
64
        my $key = $self->getHashKey($object, join('-',@pks), $hashKey);
65
66
        $objects{$key} = Koha::LetterTemplates->cast($result);
67
    }
68
69
    $self->_persistToStashes(\%objects, 'letterTemplates', $featureStash, $scenarioStash, $stepStash);
70
71
    return \%objects;
72
}
73
74
=head
75
76
Removes the given test group from the DB.
77
78
=cut
79
80
sub deleteTestGroup {
81
    my ($self, $letterTemplates) = @_;
82
83
    my $schema = Koha::Database->new_schema();
84
    while( my ($key, $letterTemplate) = each %$letterTemplates ) {
85
        $letterTemplate->delete();
86
    }
87
}
88
89
sub _deleteTestGroupFromIdentifiers {
90
    my $testGroupIdentifiers = shift;
91
92
    my $schema = Koha::Database->new_schema();
93
    foreach my $key (@$testGroupIdentifiers) {
94
        my ($module, $code, $branchcode, $mtt) = split('-',$key);
95
        $schema->resultset('Letter')->find({module => $module,
96
                                                    code => $code,
97
                                                    branchcode => $branchcode,
98
                                                    message_transport_type => $mtt,
99
                                                })->delete();
100
    }
101
}
102
103
1;
(-)a/t/lib/TestObjects/ObjectFactory.pm (+186 lines)
Line 0 Link Here
1
package t::lib::TestObjects::ObjectFactory;
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
21
use Modern::Perl;
22
use Carp;
23
24
use Koha::Exception::BadParameter;
25
26
=head createTestGroup( $data [, $hashKey, $testContexts...] )
27
@ABSTRACT, OVERLOAD THIS FROM SUBCLASS
28
29
    my $factory = t::lib::TestObjects::ObjectFactory->new();
30
    my $objects = $factory->createTestGroup([
31
                        #Imagine if using the BorrowerFactory
32
                        {firstname => 'Olli-Antti',
33
                         surname   => 'Kivi',
34
                         cardnumber => '11A001',
35
                         branchcode     => 'CPL',
36
                         ...
37
                        },
38
                        #Or if using the ItemFactory
39
                        {biblionumber => 123413,
40
                         barcode   => '11N002',
41
                         homebranch => 'FPL',
42
                         ...
43
                        },
44
                    ], $hashKey, $testContext1, $testContext2, $testContext3);
45
46
    #Do test stuff...
47
48
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1);
49
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2);
50
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
51
52
The HASH is keyed with the given $hashKey or 'koha.<object>.cardnumber'
53
See the object constructor defined in the implementing Factory-class for how
54
the table columns need to be given.
55
56
@PARAM1 ARRAYRef of HASHRefs of desired Object constructor parameters
57
@PARAM2 koha.<object>-column which is used as the test context HASH key to find individual Objects,
58
                defaults to to one of the UNIQUE database keys.
59
@PARAM3-5 HASHRef of test contexts. You can save the given Objects to multiple
60
                test contexts. Usually one is enough. These test contexts are
61
                used to help tear down DB changes.
62
@RETURNS HASHRef of $hashKey => Objects, eg.
63
                {
64
                    borrowers => { $hashKey => {#borrower1 HASH},
65
                                   $hashKey => {#borrower2 HASH},
66
                                }
67
                }
68
=cut
69
70
sub createTestGroup {} #OVERLOAD THIS FROM SUBCLASS
71
sub deleteTestGroup {} #OVERLOAD THIS FROM SUBCLASS
72
73
=head tearDownTestContext
74
75
Given a testContext stash populated using one of the TestObjectFactory implementations createTestGroup()-subroutines,
76
Removes all the persisted objects in the stash.
77
78
TestObjectFactories must be lazy loaded here to make it possible for them to subclass this.
79
=cut
80
81
sub tearDownTestContext {
82
    my ($self, $stash) = @_;
83
84
    ##You should introduce tearDowns in such an order that to not provoke FOREIGN KEY issues.
85
    if ($stash->{checkouts}) {
86
        require t::lib::TestObjects::CheckoutFactory;
87
        t::lib::TestObjects::CheckoutFactory->deleteTestGroup($stash->{checkouts});
88
        delete $stash->{checkouts};
89
    }
90
    if ($stash->{items}) {
91
        require t::lib::TestObjects::ItemFactory;
92
        t::lib::TestObjects::ItemFactory->deleteTestGroup($stash->{items});
93
        delete $stash->{items};
94
    }
95
    if ($stash->{biblios}) {
96
        require t::lib::TestObjects::BiblioFactory;
97
        t::lib::TestObjects::BiblioFactory->deleteTestGroup($stash->{biblios});
98
        delete $stash->{biblios};
99
    }
100
    if ($stash->{borrowers}) {
101
        require t::lib::TestObjects::BorrowerFactory;
102
        t::lib::TestObjects::BorrowerFactory->deleteTestGroup($stash->{borrowers});
103
        delete $stash->{borrowers};
104
    }
105
    if ($stash->{letterTemplates}) {
106
        require t::lib::TestObjects::LetterTemplateFactory;
107
        t::lib::TestObjects::LetterTemplateFactory->deleteTestGroup($stash->{letterTemplates});
108
        delete $stash->{letterTemplates};
109
    }
110
}
111
112
sub getHashKey {
113
    my ($self, $object, $primaryKey, $hashKey) = @_;
114
115
    if (ref($object) eq 'HASH') {
116
        if ($hashKey && not($object->{$hashKey})) {
117
            carp ref($self)."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'.";
118
        }
119
        return ($hashKey) ? $object->{$hashKey} : $primaryKey;
120
    }
121
    else {
122
        if ($hashKey && not($object->$hashKey())) {
123
            carp ref($self)."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'.";
124
        }
125
        return ($hashKey) ? $object->$hashKey() : $primaryKey;
126
    }
127
}
128
129
=head validateAndPopulateDefaultValues
130
@INTERFACE
131
132
Validates given Object parameters and makes sure that critical fields are given
133
and populates defaults for missing values.
134
You must overload this in the subclassing factory if you want to validate and check the given parameters
135
=cut
136
137
sub validateAndPopulateDefaultValues {
138
    my ($self, $object, $hashKey) = @_;
139
140
    unless ($object->{$hashKey}) {
141
        Koha::Exception::BadParameter->throw(error => ref($self)."():> You want to access test Objects using hashKey '$hashKey', but you haven't supplied it as a Object parameter. ObjectFactories need a unique identifier to function properly.");
142
    }
143
}
144
145
=head _validateStashes
146
147
    _validateStashes($featureStash, $scenarioStash, $stepStash);
148
149
Validates that the given stahses are what they are supposed to be... ,  HASHrefs.
150
@THROWS Koha::Exception::BadParameter, if validation failed.
151
=cut
152
153
sub _validateStashes {
154
    my ($self, $featureStash, $scenarioStash, $stepStash) = @_;
155
156
    if ($featureStash && not(ref($featureStash) eq 'HASH')) {
157
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$featureStash' is not a HASHRef! Leave it 'undef' if you don't want to use it.");
158
    }
159
    if ($scenarioStash && not(ref($scenarioStash) eq 'HASH')) {
160
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$scenarioStash' is not a HASHRef! Leave it 'undef' if you don't want to use it.");
161
    }
162
    if ($stepStash && not(ref($stepStash) eq 'HASH')) {
163
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$stepStash' is not a HASHRef! Leave it 'undef' if you don't want to use it.");
164
    }
165
}
166
167
=head _persistToStashes
168
169
    _persistToStashes($objects, $stashKey, $featureStash, $scenarioStash, $stepStash);
170
171
Saves the given HASH to the given stashes using the given stash key.
172
=cut
173
174
sub _persistToStashes {
175
    my ($self, $objects, $stashKey, $featureStash, $scenarioStash, $stepStash) = @_;
176
177
    if ($featureStash || $scenarioStash || $stepStash) {
178
        while( my ($key, $borrower) = each %$objects) {
179
            $featureStash->{$stashKey}->{ $key }  = $borrower if $featureStash;
180
            $scenarioStash->{$stashKey}->{ $key } = $borrower if $scenarioStash;
181
            $stepStash->{$stashKey}->{ $key }     = $borrower if $stepStash;
182
        }
183
    }
184
}
185
186
1;
(-)a/t/lib/TestObjects/objectFactories.t (-1 / +284 lines)
Line 0 Link Here
0
- 
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
21
use Modern::Perl;
22
23
use Test::More;
24
use DateTime;
25
26
use Koha::DateUtils;
27
28
use t::lib::TestObjects::ObjectFactory;
29
use t::lib::TestObjects::BorrowerFactory;
30
use Koha::Borrowers;
31
use t::lib::TestObjects::ItemFactory;
32
use Koha::Items;
33
use t::lib::TestObjects::BiblioFactory;
34
use Koha::Biblios;
35
use t::lib::TestObjects::CheckoutFactory;
36
use Koha::Checkouts;
37
use t::lib::TestObjects::LetterTemplateFactory;
38
use Koha::LetterTemplates;
39
40
41
my $testContext = {}; #Gather all created Objects here so we can finally remove them all.
42
43
44
45
########## BorrowerFactory subtests ##########
46
subtest 't::lib::TestObjects::BorrowerFactory' => sub {
47
    my $subtestContext = {};
48
    ##Create and Delete. Add one
49
    my $f = t::lib::TestObjects::BorrowerFactory->new();
50
    my $objects = $f->createTestGroup([
51
                        {firstname => 'Olli-Antti',
52
                         surname   => 'Kivi',
53
                         cardnumber => '11A001',
54
                         branchcode     => 'CPL',
55
                        },
56
                    ], undef, $subtestContext, undef, $testContext);
57
    is($objects->{'11A001'}->cardnumber, '11A001', "Borrower '11A001'.");
58
    ##Add one more to test incrementing the subtestContext.
59
    $objects = $f->createTestGroup([
60
                        {firstname => 'Olli-Antti2',
61
                         surname   => 'Kivi2',
62
                         cardnumber => '11A002',
63
                         branchcode     => 'FFL',
64
                        },
65
                    ], undef, $subtestContext, undef, $testContext);
66
    is($subtestContext->{borrowers}->{'11A001'}->cardnumber, '11A001', "Borrower '11A001' from \$subtestContext."); #From subtestContext
67
    is($objects->{'11A002'}->branchcode,                     'FFL',    "Borrower '11A002'."); #from just created hash.
68
69
    ##Delete objects
70
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
71
    my $object11A001 = Koha::Borrowers->find({cardnumber => '11A001'});
72
    ok (not($object11A001), "Borrower '11A001' deleted");
73
    my $object11A002 = Koha::Borrowers->find({cardnumber => '11A002'});
74
    ok (not($object11A002), "Borrower '11A002' deleted");
75
76
    #Prepare for autoremoval.
77
    $objects = $f->createTestGroup([
78
                        {firstname => 'Olli-Antti',
79
                         surname   => 'Kivi',
80
                         cardnumber => '11A001',
81
                         branchcode     => 'CPL',
82
                        },
83
                        {firstname => 'Olli-Antti2',
84
                         surname   => 'Kivi2',
85
                         cardnumber => '11A002',
86
                         branchcode     => 'FFL',
87
                        },
88
                    ], undef, undef, undef, $testContext);
89
};
90
91
92
93
########## BiblioFactory and ItemFactory subtests ##########
94
subtest 't::lib::TestObjects::BiblioFactory and ::ItemFactory' => sub {
95
    my $subtestContext = {};
96
    ##Create and Delete. Add one
97
    my $fb = t::lib::TestObjects::BiblioFactory->new();
98
    my $biblios = $fb->createTestGroup([
99
                        {'biblio.title' => 'I wish I met your mother',
100
                         'biblio.author'   => 'Pertti Kurikka',
101
                         'biblio.copyrightdate' => '1960',
102
                         'biblioitems.isbn'     => '9519671580',
103
                         'biblioitems.itemtype' => 'BK',
104
                        },
105
                    ], 'biblioitems.isbn', $subtestContext, undef, $testContext);
106
    my $f = t::lib::TestObjects::ItemFactory->new();
107
    my $objects = $f->createTestGroup([
108
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
109
                         barcode => '167Nabe0001',
110
                         homebranch   => 'CPL',
111
                         holdingbranch => 'CPL',
112
                         price     => '0.50',
113
                         replacementprice => '0.50',
114
                         itype => 'BK',
115
                         biblioisbn => '9519671580',
116
                         itemcallnumber => 'PK 84.2',
117
                        },
118
                    ], 'barcode', $subtestContext, undef, $testContext);
119
120
    is($objects->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001'.");
121
    ##Add one more to test incrementing the subtestContext.
122
    $objects = $f->createTestGroup([
123
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
124
                         barcode => '167Nabe0002',
125
                         homebranch   => 'CPL',
126
                         holdingbranch => 'FFL',
127
                         price     => '3.50',
128
                         replacementprice => '3.50',
129
                         itype => 'BK',
130
                         biblioisbn => '9519671580',
131
                         itemcallnumber => 'JK 84.2',
132
                        },
133
                    ], 'barcode', $subtestContext, undef, $testContext);
134
135
    is($subtestContext->{items}->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001' from \$subtestContext.");
136
    is($objects->{'167Nabe0002'}->holdingbranch,           'FFL',         "Item '167Nabe0002'.");
137
    is(ref($biblios->{9519671580}), 'MARC::Record', "Biblio 'I wish I met your mother'.");
138
139
    ##Delete objects
140
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
141
    my $object1 = Koha::Items->find({barcode => '167Nabe0001'});
142
    ok (not($object1), "Item '167Nabe0001' deleted");
143
    my $object2 = Koha::Items->find({barcode => '167Nabe0002'});
144
    ok (not($object2), "Item '167Nabe0002' deleted");
145
    my $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"});
146
    ok (not($object2), "Biblio 'I wish I met your mother' deleted");
147
148
    #Prepare for autoremoval.
149
    $biblios = $fb->createTestGroup([
150
                        {'biblio.title' => 'I wish I met your mother',
151
                         'biblio.author'   => 'Pertti Kurikka',
152
                         'biblio.copyrightdate' => '1960',
153
                         'biblioitems.isbn'     => '9519671580',
154
                         'biblioitems.itemtype' => 'BK',
155
                        },
156
                    ], 'biblioitems.isbn', undef, undef, $testContext);
157
    $objects = $f->createTestGroup([
158
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
159
                         barcode => '167Nabe0001',
160
                         homebranch   => 'CPL',
161
                         holdingbranch => 'CPL',
162
                         price     => '0.50',
163
                         replacementprice => '0.50',
164
                         itype => 'BK',
165
                         biblioisbn => '9519671580',
166
                         itemcallnumber => 'PK 84.2',
167
                        },
168
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
169
                         barcode => '167Nabe0002',
170
                         homebranch   => 'CPL',
171
                         holdingbranch => 'FFL',
172
                         price     => '3.50',
173
                         replacementprice => '3.50',
174
                         itype => 'BK',
175
                         biblioisbn => '9519671580',
176
                         itemcallnumber => 'JK 84.2',
177
                        },
178
                    ], 'barcode', undef, undef, $testContext);
179
};
180
181
182
183
########## CheckoutFactory subtests ##########
184
subtest 't::lib::TestObjects::CheckoutFactory' => sub {
185
    my $subtestContext = {};
186
    ##Create and Delete using dependencies in the $testContext instantiated in previous subtests.
187
    my $f = t::lib::TestObjects::CheckoutFactory->new();
188
    my $objects = $f->createTestGroup([
189
                    {
190
                        cardnumber        => '11A001',
191
                        barcode           => '167Nabe0001',
192
                        daysOverdue       => 7,
193
                        daysAgoCheckedout => 28,
194
                    },
195
                    {
196
                        cardnumber        => '11A002',
197
                        barcode           => '167Nabe0002',
198
                        daysOverdue       => -7,
199
                        daysAgoCheckedout => 14,
200
                    },
201
                    ], undef, undef, undef, undef);
202
203
    is(Koha::DateUtils::dt_from_string($objects->{'11A001-167Nabe0001'}->issuedate)->day(),
204
       DateTime->now(time_zone => C4::Context->tz())->subtract(days => '28')->day()
205
       , "Checkout '11A001-167Nabe0001', adjusted issuedates match.");
206
    is(Koha::DateUtils::dt_from_string($objects->{'11A002-167Nabe0002'}->date_due)->day(),
207
       DateTime->now(time_zone => C4::Context->tz())->subtract(days => '-7')->day()
208
       , "Checkout '11A002-167Nabe0002', adjusted date_dues match.");
209
210
    $f->deleteTestGroup($objects);
211
    my $object1 = Koha::Checkouts->find({borrowernumber => $objects->{'11A001-167Nabe0001'}->borrowernumber,
212
                                         itemnumber => $objects->{'11A001-167Nabe0001'}->itemnumber});
213
    ok (not($object1), "Checkout '11A001-167Nabe0001' deleted");
214
    my $object2 = Koha::Checkouts->find({borrowernumber => $objects->{'11A002-167Nabe0002'}->borrowernumber,
215
                                         itemnumber => $objects->{'11A002-167Nabe0002'}->itemnumber});
216
    ok (not($object2), "Checkout '11A002-167Nabe0002' deleted");
217
};
218
219
220
221
########## LetterTemplateFactory subtests ##########
222
subtest 't::lib::TestObjects::LetterTemplateFactory' => sub {
223
    my $subtestContext = {};
224
    ##Create and Delete using dependencies in the $testContext instantiated in previous subtests.
225
    my $f = t::lib::TestObjects::LetterTemplateFactory->new();
226
    my $hashLT = {letter_id => 'circulation-ODUE1-CPL-print',
227
                module => 'circulation',
228
                code => 'ODUE1',
229
                branchcode => 'CPL',
230
                name => 'Notice1',
231
                is_html => undef,
232
                title => 'Notice1',
233
                message_transport_type => 'print',
234
                content => '<item>Barcode: <<items.barcode>>, bring it back!</item>',
235
            };
236
    my $objects = $f->createTestGroup([
237
                    $hashLT,
238
                    ], undef, undef, undef, undef);
239
240
    my $letterTemplate = Koha::LetterTemplates->find($hashLT);
241
    is($objects->{'circulation-ODUE1-CPL-print'}->name, $letterTemplate->name, "LetterTemplate 'circulation-ODUE1-CPL-print'");
242
243
    #Delete them
244
    $f->deleteTestGroup($objects);
245
    $letterTemplate = Koha::LetterTemplates->find($hashLT);
246
    ok(not(defined($letterTemplate)), "LetterTemplate 'circulation-ODUE1-CPL-print' deleted");
247
};
248
249
250
251
########## Global test context subtests ##########
252
subtest 't::lib::TestObjects::ObjectFactory clearing global test context' => sub {
253
    my $object11A001 = Koha::Borrowers->find({cardnumber => '11A001'});
254
    ok ($object11A001, "Global Borrower '11A001' exists");
255
    my $object11A002 = Koha::Borrowers->find({cardnumber => '11A002'});
256
    ok ($object11A002, "Global Borrower '11A002' exists");
257
258
    my $object1 = Koha::Items->find({barcode => '167Nabe0001'});
259
    ok ($object1, "Global Item '167Nabe0001' exists");
260
    my $object2 = Koha::Items->find({barcode => '167Nabe0002'});
261
    ok ($object2, "Global Item '167Nabe0002' exists");
262
    my $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"});
263
    ok ($object2, "Global Biblio 'I wish I met your mother' exists");
264
265
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext);
266
267
    $object11A001 = Koha::Borrowers->find({cardnumber => '11A001'});
268
    ok (not($object11A001), "Global Borrower '11A001' deleted");
269
    $object11A002 = Koha::Borrowers->find({cardnumber => '11A002'});
270
    ok (not($object11A002), "Global Borrower '11A002' deleted");
271
272
    $object1 = Koha::Items->find({barcode => '167Nabe0001'});
273
    ok (not($object1), "Global Item '167Nabe0001' deleted");
274
    $object2 = Koha::Items->find({barcode => '167Nabe0002'});
275
    ok (not($object2), "Global Item '167Nabe0002' deleted");
276
    $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"});
277
    ok (not($object2), "Global Biblio 'I wish I met your mother' deleted");
278
};
279
280
281
282
done_testing();
283
284
1;

Return to bug 13906