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

(-)a/t/lib/TestContext.pm (+63 lines)
Line 0 Link Here
1
package t::lib::TestContext;
2
3
# Copyright KohaSuomi 2016
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
use Try::Tiny;
25
26
use C4::Context;
27
28
use t::lib::TestObjects::PatronFactory;
29
30
=head setUserenv
31
32
Sets the C4::Context->userenv with nice default values, like:
33
 -Being in 'CPL'
34
35
@PARAM1 Koha::Patron, this object must be persisted to DB beforehand, sets the userenv for this borrower
36
        or PatronFactory-params, which create a new borrower and set the userenv for it.
37
@RETURNS Koha::Patron, the userenv borrower if it was created
38
39
=cut
40
41
sub setUserenv {
42
    my ($borrowerFactoryParams, $testContext) = @_;
43
44
    my $borrower;
45
    if ($borrowerFactoryParams) {
46
        if (blessed($borrowerFactoryParams) && $borrowerFactoryParams->isa('Koha::Patron')) {
47
            #We got a nice persisted borrower
48
            $borrower = $borrowerFactoryParams;
49
        }
50
        else {
51
            $borrower = t::lib::TestObjects::PatronFactory->createTestGroup( $borrowerFactoryParams, undef, $testContext );
52
        }
53
        C4::Context->_new_userenv('DUMMY SESSION');
54
        C4::Context::set_userenv($borrower->borrowernumber, $borrower->userid, $borrower->cardnumber, $borrower->firstname, $borrower->surname, $borrower->branchcode, 'Library 1', {}, $borrower->email, '', '');
55
        return $borrower;
56
    }
57
    else {
58
        C4::Context->_new_userenv('DUMMY SESSION');
59
        C4::Context::set_userenv(0,0,0,'firstname','surname', 'CPL', 'CPL', {}, 'dummysession@example.com', '', '');
60
    }
61
}
62
63
1;
(-)a/t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm (+153 lines)
Line 0 Link Here
1
package t::lib::TestObjects::Acquisition::Bookseller::ContactFactory;
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 Koha::Acquisition::Bookseller::Contacts;
26
use Koha::Acquisition::Bookseller::Contact;
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
sub getDefaultHashKey {
39
    return 'name';
40
}
41
sub getObjectType {
42
    return 'Koha::Acquisition::Bookseller::Contact';
43
}
44
45
=head createTestGroup( $data [, $hashKey, $testContexts...] )
46
@OVERLOADED
47
48
    my $contacts = t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->createTestGroup([
49
                        {acqprimary     => 1,                     #DEFAULT
50
                         claimissues    => 1,                     #DEFAULT
51
                         claimacquisition => 1,                   #DEFAULT
52
                         serialsprimary => 1,                     #DEFAULT
53
                         position       => 'Boss',                #DEFAULT
54
                         phone          => '+358700123123',       #DEFAULT
55
                         notes          => 'Noted',               #DEFAULT
56
                         name           => "Julius Augustus Caesar", #DEFAULT
57
                         fax            => '+358700123123',       #DEFAULT
58
                         email          => 'vendor@example.com',  #DEFAULT
59
                         booksellerid   => 12124                  #MANDATORY to link to Bookseller
60
                         #id => #Don't use id, since we are just adding a new one
61
                        },
62
                        {...},
63
                    ], undef, $testContext1, $testContext2, $testContext3);
64
65
    #Do test stuff...
66
67
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
68
69
The HASH is keyed with the given $hashKey or 'koha.aqcontacts.name'
70
See C4::Bookseller::Contact->new() for how the table columns need to be given.
71
72
@PARAM1 ARRAYRef of HASHRefs of VendorContact parameters.
73
@PARAM2 koha.aqcontacs-column which is used as the test context HASH key,
74
                defaults to the most best option 'name'.
75
@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple
76
                test contexts. Usually one is enough. These test contexts are
77
                used to help tear down DB changes.
78
@RETURNS HASHRef of $hashKey => object:
79
80
See t::lib::TestObjects::ObjectFactory for more documentation
81
=cut
82
83
sub handleTestObject {
84
    my ($class, $object, $stashes) = @_;
85
86
    my $contact = Koha::Acquisition::Bookseller::Contact->new();
87
    $contact->set($object);
88
    $contact->store();
89
    #Refresh from DB the contact we just made, since there is no UNIQUE identifier aside from PK, we cannot know if there are many objects like this.
90
    my @contacts = Koha::Acquisition::Bookseller::Contacts->search($object);
91
    if (scalar(@contacts)) {
92
        $contact = $contacts[0];
93
    }
94
    else {
95
        die "No Contact added to DB. Fix me to autorecover from this error!";
96
    }
97
98
    return $contact;
99
}
100
101
=head validateAndPopulateDefaultValues
102
@OVERLOAD
103
104
Validates given Object parameters and makes sure that critical fields are given
105
and populates defaults for missing values.
106
=cut
107
108
sub validateAndPopulateDefaultValues {
109
    my ($self, $object, $hashKey) = @_;
110
111
    $object->{acqprimary}     = 1 unless $object->{acqprimary};
112
    $object->{claimissues}    = 1 unless $object->{claimissues};
113
    $object->{claimacquisition} = 1 unless $object->{claimacquisition};
114
    $object->{serialsprimary} = 1 unless $object->{serialsprimary};
115
    $object->{position}       = 'Boss' unless $object->{position};
116
    $object->{phone}          = '+358700123123' unless $object->{phone};
117
    $object->{notes}          = 'Noted' unless $object->{notes};
118
    $object->{name}           = "Julius Augustus Caesar" unless $object->{name};
119
    $object->{fax}            = '+358700123123' unless $object->{fax};
120
    $object->{email}          = 'vendor@example.com' unless $object->{email};
121
    $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey);
122
}
123
124
=head deleteTestGroup
125
@OVERLOADED
126
127
    my $records = createTestGroup();
128
    ##Do funky stuff
129
    deleteTestGroup($records);
130
131
Removes the given test group from the DB.
132
133
=cut
134
135
sub deleteTestGroup {
136
    my ($self, $objects) = @_;
137
138
    while( my ($key, $object) = each %$objects) {
139
        my $contact = Koha::Acquisition::Bookseller::Contacts->cast($object);
140
        eval {
141
            #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them.
142
            my @contacts = Koha::Acquisition::Bookseller::Contacts->search({name => $contact->name});
143
            foreach my $c (@contacts) {
144
                $c->delete();
145
            }
146
        };
147
        if ($@) {
148
            die $@;
149
        }
150
    }
151
}
152
153
1;
(-)a/t/lib/TestObjects/Acquisition/BooksellerFactory.pm (+176 lines)
Line 0 Link Here
1
package t::lib::TestObjects::Acquisition::BooksellerFactory;
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 Scalar::Util qw(blessed);
23
24
use t::lib::TestObjects::Acquisition::Bookseller::ContactFactory;
25
use Koha::Acquisition::Bookseller;
26
use Koha::Acquisition::Booksellers;
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
sub getDefaultHashKey {
39
    return 'name';
40
}
41
sub getObjectType {
42
    return 'Koha::Acquisition::Bookseller';
43
}
44
45
=head createTestGroup( $data [, $hashKey, $testContexts...] )
46
@OVERLOADED
47
48
    my $booksellers = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([
49
                        {url => 'www.muscle.com',
50
                         name => 'Bookselling Vendor',
51
                         postal   => 'post',
52
                         phone => '+358700123123',
53
                         notes     => 'Notes',
54
                         listprice => 'EUR',
55
                         listincgst => 0,
56
                         invoiceprice => 'EUR',
57
                         invoiceincgst => 0,
58
                         gstreg => 1,
59
                         tax_rate => 0,
60
                         fax => '+358700123123',
61
                         discount => 10,
62
                         deliverytime => 2,
63
                         address1 => 'Where I am',
64
                         active => 1,
65
                         accountnumber => 'IBAN 123456789 FI',
66
                         contacts => [{#Parameters for Koha::Acquisition::Bookseller},
67
                                      {#DEFAULT is to use ContactFactory's default values}],
68
                        },
69
                        {...},
70
                    ], undef, $testContext1, $testContext2, $testContext3);
71
72
    #Do test stuff...
73
74
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
75
76
The HASH is keyed with the given $hashKey or 'koha.aqbookseller.name'
77
78
@PARAM1 ARRAYRef of HASHRefs
79
@PARAM2 koha.aqbookseller-column which is used as the test context HASH key,
80
                defaults to the most best option 'name'.
81
@PARAM3-5 HASHRef of test contexts. You can save the given borrowers to multiple
82
                test contexts. Usually one is enough. These test contexts are
83
                used to help tear down DB changes.
84
@RETURNS HASHRef of $hashKey => Objects:
85
86
See t::lib::TestObjects::ObjectFactory for more documentation
87
=cut
88
89
sub handleTestObject {
90
    my ($class, $object, $stashes) = @_;
91
92
    my $contacts = $object->{contacts};
93
    delete $object->{contacts};
94
95
    my $bookseller = Koha::Acquisition::Bookseller->new();
96
    $bookseller->set($object);
97
    $bookseller->store();
98
    #Refresh from DB the object we just made, since there is no UNIQUE identifier aside from PK, we cannot know if there are many objects like this.
99
    my @booksellers = Koha::Acquisition::Booksellers->search($object);
100
    if (scalar(@booksellers)) {
101
        $bookseller = $booksellers[0];
102
    }
103
    else {
104
        die "No Bookseller added to DB. Fix me to autorecover from this error!";
105
    }
106
107
    foreach my $c (@$contacts) {
108
        $c->{booksellerid} = $bookseller->id;
109
    }
110
    #$bookseller->{contacts} = t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->createTestGroup($contacts, undef, @$stashes);
111
112
    return $bookseller;
113
}
114
115
=head validateAndPopulateDefaultValues
116
@OVERLOAD
117
118
Validates given Object parameters and makes sure that critical fields are given
119
and populates defaults for missing values.
120
=cut
121
122
sub validateAndPopulateDefaultValues {
123
    my ($self, $object, $hashKey) = @_;
124
125
    $object->{url} = 'www.muscle.com' unless $object->{url};
126
    $object->{postal} = 'post' unless $object->{postal};
127
    $object->{phone} = '+358700123123' unless $object->{phone};
128
    $object->{notes} = 'Notes' unless $object->{notes};
129
    $object->{name} = 'Bookselling Vendor' unless $object->{name};
130
    $object->{listprice} = 'EUR' unless $object->{listprice};
131
    $object->{listincgst} = 0 unless $object->{listincgst};
132
    $object->{invoiceprice} = 'EUR' unless $object->{invoiceprice};
133
    $object->{invoiceincgst} = 0 unless $object->{invoiceincgst};
134
    $object->{gstreg} = 1 unless $object->{gstreg};
135
    $object->{tax_rate} = 0 unless $object->{tax_rate};
136
    $object->{fax} = '+358700123123' unless $object->{fax};
137
    $object->{discount} = 10 unless $object->{discount};
138
    $object->{deliverytime} = 2 unless $object->{deliverytime};
139
    $object->{address1} = 'Where I am' unless $object->{address1};
140
    $object->{active} = 1 unless $object->{active};
141
    $object->{accountnumber} = 'IBAN 123456789 FI' unless $object->{accountnumber};
142
    $object->{contacts} = [{}] unless $object->{contacts}; #Prepare to create one default contact.
143
144
    $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey);
145
}
146
147
=head deleteTestGroup
148
@OVERLOADED
149
150
    my $records = createTestGroup();
151
    ##Do funky stuff
152
    deleteTestGroup($records);
153
154
Removes the given test group from the DB.
155
156
=cut
157
158
sub deleteTestGroup {
159
    my ($self, $objects) = @_;
160
161
    while( my ($key, $object) = each %$objects) {
162
        my $bookseller = Koha::Acquisition::Booksellers->cast($object);
163
        eval {
164
            #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them.
165
            my @booksellers = Koha::Acquisition::Booksellers->search({name => $bookseller->name});
166
            foreach my $b (@booksellers) {
167
                $b->delete();
168
            }
169
        };
170
        if ($@) {
171
            die $@;
172
        }
173
    }
174
}
175
176
1;
(-)a/t/lib/TestObjects/BiblioFactory.pm (+247 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
use Scalar::Util qw(blessed);
24
use MARC::Record;
25
use MARC::File::XML;
26
27
use C4::Biblio;
28
use Koha::Database;
29
30
use Koha::Exception::BadParameter;
31
32
use base qw(t::lib::TestObjects::ObjectFactory);
33
34
sub getDefaultHashKey {
35
    return 'biblioitems.isbn';
36
}
37
sub getObjectType {
38
    return 'MARC::Record';
39
}
40
41
=head t::lib::TestObjects::createTestGroup
42
43
    my $record = t::lib::TestObjects::BiblioFactory->createTestGroup(
44
                        $marcxml || $MARC::Record, undef, $testContext1, $testContext2, $testContext3);
45
46
    my $records = t::lib::TestObjects::BiblioFactory->createTestGroup([
47
                        {'biblio.title' => 'I wish I met your mother',
48
                         'biblio.author'   => 'Pertti Kurikka',
49
                         'biblio.copyrightdate' => '1960',
50
                         'biblio.biblionumber' => 1212,
51
                         'biblioitems.isbn'     => '9519671580',
52
                         'biblioitems.itemtype' => 'BK',
53
                        },
54
                    ], undef, $testContext1, $testContext2, $testContext3);
55
56
Factory takes either a HASH of database table keys, or a MARCXML or a MARC::Record.
57
58
Calls C4::Biblio::TransformKohaToMarc() to make a MARC::Record and add it to
59
the DB
60
or
61
transforms a MARC::Record into database tables.
62
Returns a HASH of MARC::Records or a single MARC::Record depedning if input is an ARRAY or a single object.
63
64
The HASH is keyed with the 'biblioitems.isbn', or the given $hashKey. Using for example
65
'biblioitems.isbn' is very much recommended to make linking objects more easy in test cases.
66
The biblionumber is injected to the MARC::Record-object to be easily accessable,
67
so we can get it like this:
68
    $records->{$key}->{biblionumber};
69
70
There is a duplication check to first look for Records with the same ISBN.
71
If a matching ISBN is found, then we use the existing Record instead of adding a new one.
72
73
See C4::Biblio::TransformKohaToMarc() for how the biblio- or biblioitem-tables'
74
columns need to be given.
75
76
@RETURNS HASHRef of MARC::Record-objects
77
78
See t::lib::TestObjects::ObjectFactory for more documentation
79
=cut
80
81
sub handleTestObject {
82
    my ($class, $object, $stashes) = @_;
83
84
    my $record;
85
    #Turn the given MARCXML or MARC::Record into a input object.
86
    if (not(ref($object))) { #scalar, prolly MARCXML
87
        $object = MARC::Record::new_from_xml( $object, "utf8", 'marc21' );
88
    }
89
    elsif ($object->{record} && $object->{record} =~ /<record/) { #This is MARCXML
90
        $object = MARC::Record::new_from_xml( $object->{record}, "utf8", 'marc21' );
91
    }
92
    if (blessed($object) && $object->isa('MARC::Record')) {
93
        ($record, $object) = $class->handleMARCXML($object);
94
    }
95
    else {
96
        ($record, $object) = $class->handleObject($object);
97
    }
98
99
    #Clone all the parameters of $object to $record
100
    foreach my $key (keys(%$object)) {
101
        $record->{$key} = $object->{$key};
102
    }
103
104
    return $record;
105
}
106
107
sub handleMARCXML {
108
    my ($class, $record) = @_;
109
    my ($biblionumber, $biblioitemnumber);
110
    my $object = C4::Biblio::TransformMarcToKoha($record, '');
111
    $object->{record} = $record;
112
113
    $object->{'biblio.title'} = $object->{title};
114
    delete $object->{title};
115
    $object->{'biblioitems.isbn'} = $object->{isbn};
116
    delete $object->{isbn};
117
118
    $class->_validateCriticalFields($object);
119
120
    my $existingBiblio = $class->existingObjectFound($object);
121
122
    unless ($existingBiblio) {
123
        ($biblionumber, $biblioitemnumber) = C4::Biblio::AddBiblio($record, $object->{frameworkcode} || '', undef);
124
        $record->{biblionumber} = $biblionumber;
125
        $record->{biblioitemnumber} = $biblioitemnumber;
126
    }
127
    else {
128
        ($record, $biblionumber, $biblioitemnumber) = C4::Biblio::UpsertBiblio($record, $object->{frameworkcode} || '', undef);
129
        $record->{biblionumber} = $biblionumber;
130
        $record->{biblioitemnumber} = $biblioitemnumber;
131
    }
132
    return ($record, $object);
133
}
134
135
sub handleObject {
136
    my ($class, $object) = @_;
137
    my ($record, $biblionumber, $biblioitemnumber);
138
139
    $class->_validateCriticalFields($object);
140
141
    my $existingBiblio = $class->existingObjectFound($object);
142
143
    unless ($existingBiblio) {
144
        $record = C4::Biblio::TransformKohaToMarc($object);
145
        ($biblionumber, $biblioitemnumber) = C4::Biblio::AddBiblio($record,'');
146
        $record->{biblionumber} = $biblionumber;
147
        $record->{biblioitemnumber} = $biblioitemnumber;
148
    }
149
    else {
150
        my $bn = $existingBiblio->biblionumber->biblionumber;
151
        my $bin = $existingBiblio->biblioitemnumber;
152
        $record = C4::Biblio::GetMarcBiblio($bn); #Funny!
153
        $record->{biblionumber} = $bn;
154
        $record->{biblioitemnumber} = $bin;
155
    }
156
    return ($record, $object);
157
}
158
159
sub existingObjectFound {
160
    my ($class, $object) = @_;
161
    ##First see if the given Record already exists in the DB. For testing purposes we use the isbn as the UNIQUE identifier.
162
    my $resultset = Koha::Database->new()->schema()->resultset('Biblioitem');
163
    my $existingBiblio = $resultset->search({isbn => $object->{"biblioitems.isbn"}})->next();
164
    $existingBiblio = $resultset->search({biblionumber => $object->{"biblio.biblionumber"}})->next() unless $existingBiblio;
165
    return $existingBiblio;
166
}
167
168
sub _validateCriticalFields {
169
    my ($class, $object) = @_;
170
171
    unless (ref($object) eq 'HASH' && scalar(%$object)) {
172
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> Given \$object is empty. You must provide some minimum data to build a Biblio, preferably with somekind of a unique identifier.");
173
    }
174
    unless ($object->{'biblio.title'}) {
175
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> 'biblio.title' is a mandatory parameter!");
176
    }
177
    $object->{'biblioitems.isbn'} = '971-972-call-me' unless $object->{'biblioitems.isbn'};
178
}
179
180
=head getHashKey
181
@OVERLOADS
182
=cut
183
184
sub getHashKey {
185
    my ($class, $object, $primaryKey, $hashKeys) = @_;
186
187
    my @collectedHashKeys;
188
    $hashKeys = [$hashKeys] unless ref($hashKeys) eq 'ARRAY';
189
    foreach my $hashKey (@$hashKeys) {
190
        if (not($hashKey) ||
191
            (not($object->{$hashKey}) && not($object->$hashKey()))
192
           ) {
193
            croak $class."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'.";
194
        }
195
        push @collectedHashKeys, $object->{$hashKey} || $object->$hashKey();
196
    }
197
    return join('-', @collectedHashKeys);
198
}
199
200
=head validateAndPopulateDefaultValues
201
@OVERLOAD
202
203
Validates given Object parameters and makes sure that critical fields are given
204
and populates defaults for missing values.
205
=cut
206
207
sub validateAndPopulateDefaultValues {
208
    my ($self, $object, $hashKey) = @_;
209
}
210
211
=head
212
213
    my $records = createTestGroup();
214
    ##Do funky stuff
215
    deleteTestGroup($records);
216
217
Removes the given test group from the DB.
218
219
=cut
220
221
sub deleteTestGroup {
222
    my ($class, $records) = @_;
223
224
    my ( $biblionumberFieldCode, $biblionumberSubfieldCode ) =
225
            C4::Biblio::GetMarcFromKohaField( "biblio.biblionumber", '' );
226
227
    my $schema = Koha::Database->new_schema();
228
    while( my ($key, $record) = each %$records) {
229
        my $biblionumber = $record->subfield($biblionumberFieldCode, $biblionumberSubfieldCode);
230
        my @biblios = $schema->resultset('Biblio')->search({"-or" => [{biblionumber => $biblionumber},
231
                                                                      {title => $record->title}]});
232
        foreach my $b (@biblios) {
233
            $b->delete();
234
        }
235
    }
236
}
237
#sub _deleteTestGroupFromIdentifiers {
238
#    my ($class, $testGroupIdentifiers) = @_;
239
#
240
#    my $schema = Koha::Database->new_schema();
241
#    foreach my $isbn (@$testGroupIdentifiers) {
242
#        $schema->resultset('Biblio')->search({"biblioitems.isbn" => $isbn},{join => 'biblioitems'})->delete();
243
#        $schema->resultset('Biblioitem')->search({isbn => $isbn})->delete();
244
#    }
245
#}
246
247
1;
(-)a/t/lib/TestObjects/CheckoutFactory.pm (+205 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 Koha::Patrons;
27
use Koha::Items;
28
use Koha::Checkouts;
29
30
use t::lib::TestContext;
31
use t::lib::TestObjects::PatronFactory;
32
use t::lib::TestObjects::ItemFactory;
33
34
use base qw(t::lib::TestObjects::ObjectFactory);
35
36
sub new {
37
    my ($class) = @_;
38
39
    my $self = {};
40
    bless($self, $class);
41
    return $self;
42
}
43
44
sub getDefaultHashKey {
45
    return ['cardnumber', 'barcode'];
46
}
47
sub getObjectType {
48
    return 'Koha::Checkout';
49
}
50
51
=head t::lib::TestObjects::CheckoutFactory::createTestGroup( $data [, $hashKey], @stashes )
52
53
    my $checkoutFactory = t::lib::TestObjects::CheckoutFactory->new();
54
    my $checkouts = $checkoutFactory->createTestGroup([
55
                        {#Checkout params
56
                        },
57
                        {#More checkout params
58
                        },
59
                    ], undef, $testContext1, $testContext2, $testContext3);
60
61
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1);
62
63
@PARAM1, ARRAY of HASHes.
64
  [ {
65
        cardnumber        => '167Azava0001',
66
        barcode           => '167Nfafa0010',
67
        daysOverdue       => 7,     #This Checkout's duedate was 7 days ago. If undef, then uses today as the checkout day.
68
        daysAgoCheckedout => 28, #This Checkout hapened 28 days ago. If undef, then uses today.
69
        checkoutBranchRule => 'homebranch' || 'holdingbranch' #From which branch this item is checked out from.
70
    },
71
    {
72
        ...
73
    }
74
  ]
75
@PARAM2, String, the HASH-element to use as the returning HASHes key.
76
@PARAM3, String, the rule on where to check these Issues out:
77
                 'homebranch', uses the Item's homebranch as the checkout branch
78
                 'holdingbranch', uses the Item's holdingbranch as the checkout branch
79
                 undef, uses the current Environment branch
80
                 '<branchCode>', checks out all Issues from the given branchCode
81
@PARAM4-6 HASHRef of test contexts. You can save the given objects to multiple
82
                test contexts. Usually one is enough. These test contexts are
83
                used to help tear down DB changes.
84
@RETURNS HASHRef of $hashKey => Koha::Checkout-objects.
85
                The HASH is keyed with <cardnumber>-<barcode>, or the given $hashKey.
86
    Example: {
87
        '11A001-167N0212' => Koha::Checkout,
88
        ...
89
    }
90
}
91
=cut
92
93
sub handleTestObject {
94
    my ($class, $checkoutParams, $stashes) = @_;
95
96
    #If running this test factory from unit tests or bare script, the context might not have been initialized.
97
    unless (C4::Context->userenv()) { #Defensive programming to help debug misconfiguration
98
        t::lib::TestContext::setUserenv();
99
    }
100
    my $oldContextBranch = C4::Context->userenv()->{branch};
101
102
    my $borrower = t::lib::TestObjects::PatronFactory->createTestGroup(
103
                                {cardnumber => $checkoutParams->{cardnumber}},
104
                                undef, @$stashes);
105
106
    my $item =     Koha::Items->find({barcode => $checkoutParams->{barcode}});
107
    unless($item) {
108
        my $items = t::lib::TestObjects::ItemFactory->createTestGroup(
109
                                {barcode => $checkoutParams->{barcode}},
110
                                undef, @$stashes);
111
        $item = $items->{ $checkoutParams->{barcode} };
112
    }
113
114
    my $duedate = DateTime->now(time_zone => C4::Context->tz());
115
    if ($checkoutParams->{daysOverdue}) {
116
        $duedate->subtract(days =>  $checkoutParams->{daysOverdue}  );
117
    }
118
119
    my $checkoutdate = DateTime->now(time_zone => C4::Context->tz());
120
    if ($checkoutParams->{daysAgoCheckedout}) {
121
        $checkoutdate->subtract(days =>  $checkoutParams->{daysAgoCheckedout}  );
122
    }
123
124
    #Set the checkout branch
125
    my $checkoutBranch;
126
    my $checkoutBranchRule = $checkoutParams->{checkoutBranchRule};
127
    if (not($checkoutBranchRule)) {
128
        #Use the existing userenv()->{branch}
129
    }
130
    elsif ($checkoutBranchRule eq 'homebranch') {
131
        $checkoutBranch = $item->homebranch;
132
    }
133
    elsif ($checkoutBranchRule eq 'holdingbranch') {
134
        $checkoutBranch = $item->holdingbranch;
135
    }
136
    elsif ($checkoutBranchRule) {
137
        $checkoutBranch = $checkoutBranchRule;
138
    }
139
    C4::Context->userenv()->{branch} = $checkoutBranch if $checkoutBranch;
140
141
    my $datedue = C4::Circulation::AddIssue( $borrower->unblessed, $checkoutParams->{barcode}, $duedate, undef, $checkoutdate );
142
    #We want the issue_id as well.
143
    my $checkout = Koha::Checkouts->find({ borrowernumber => $borrower->borrowernumber, itemnumber => $item->itemnumber });
144
    unless ($checkout) {
145
        carp "CheckoutFactory:> No checkout for cardnumber '".$checkoutParams->{cardnumber}."' and barcode '".$checkoutParams->{barcode}."'";
146
        return;
147
    }
148
149
    ##Inject default hash keys
150
    $checkout->{barcode} = $item->barcode;
151
    $checkout->{cardnumber} = $borrower->cardnumber;
152
    return $checkout;
153
}
154
155
=head validateAndPopulateDefaultValues
156
@OVERLOAD
157
158
Validates given Object parameters and makes sure that critical fields are given
159
and populates defaults for missing values.
160
=cut
161
162
sub validateAndPopulateDefaultValues {
163
    my ($self, $object, $hashKey) = @_;
164
    $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey);
165
166
    unless ($object->{cardnumber}) {
167
        croak __PACKAGE__.":> Mandatory parameter 'cardnumber' missing.";
168
    }
169
    unless ($object->{barcode}) {
170
        croak __PACKAGE__.":> Mandatory parameter 'barcode' missing.";
171
    }
172
173
    if ($object->{checkoutBranchRule} && not($object->{checkoutBranchRule} =~ m/(homebranch)|(holdingbranch)/)) {
174
        croak __PACKAGE__.":> Optional parameter 'checkoutBranchRule' must be one of these: homebranch, holdingbranch";
175
    }
176
}
177
178
=head
179
180
    my $objects = createTestGroup();
181
    ##Do funky stuff
182
    deleteTestGroup($records);
183
184
Removes the given test group from the DB.
185
186
=cut
187
188
sub deleteTestGroup {
189
    my ($self, $objects) = @_;
190
191
    while( my ($key, $object) = each %$objects) {
192
        my $checkout = Koha::Checkouts->cast($object);
193
        $checkout->delete();
194
    }
195
}
196
sub _deleteTestGroupFromIdentifiers {
197
    my ($self, $testGroupIdentifiers) = @_;
198
199
    my $schema = Koha::Database->new_schema();
200
    foreach my $key (@$testGroupIdentifiers) {
201
        $schema->resultset('Issue')->find({"issue_id" => $key})->delete();
202
    }
203
}
204
205
1;
(-)a/t/lib/TestObjects/FileFactory.pm (+117 lines)
Line 0 Link Here
1
package t::lib::TestObjects::FileFactory;
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 File::Spec;
24
use File::Path;
25
26
use Koha::Database;
27
use File::Fu::File;
28
29
use Koha::Exception::BadParameter;
30
31
use base qw(t::lib::TestObjects::ObjectFactory);
32
33
my $tmpdir = File::Spec->tmpdir();
34
35
sub getDefaultHashKey {
36
    return 'OVERLOADED';
37
}
38
sub getObjectType {
39
    return 'File::Fu::File';
40
}
41
42
=head t::lib::TestObjects::createTestGroup
43
44
    my $files = t::lib::TestObjects::FileFactory->createTestGroup([
45
                    {'filepath' => 'atomicupdate/', #this is prepended with the system's default tmp directory, usually /tmp/
46
                     'filename' => '#30-RabiesIsMyDog.pl',
47
                     'content' => 'print "Mermaids are my only love\nI never let them down";',
48
                    },
49
                ], ['filepath', 'filename'], $testContext1, $testContext2, $testContext3);
50
51
Calls Koha::FileFactory to add files with content to your system, and clean up automatically.
52
53
The HASH is keyed with the 'filename', or the given $hashKeys.
54
55
@RETURNS HASHRef of File::Fu::File-objects
56
57
See t::lib::TestObjects::ObjectFactory for more documentation
58
=cut
59
60
sub handleTestObject {
61
    my ($class, $object, $stashes) = @_;
62
63
    my $absolutePath = $tmpdir.'/'.$object->{filepath};
64
    File::Path::make_path($absolutePath);
65
    my $file = File::Fu::File->new($absolutePath.'/'.$object->{filename});
66
67
    $file->write($object->{content}) if $object->{content};
68
69
    return $file;
70
}
71
72
=head validateAndPopulateDefaultValues
73
@OVERLOAD
74
75
Validates given Object parameters and makes sure that critical fields are given
76
and populates defaults for missing values.
77
=cut
78
79
sub validateAndPopulateDefaultValues {
80
    my ($self, $object, $hashKey) = @_;
81
82
    foreach my $param (('filename', 'filepath')) {
83
        unless ($object->{$param}) {
84
            Koha::Exception::BadParameter->throw(
85
                error => __PACKAGE__."->validateAndPopulateDefaultValues():> parameter '$param' is mandatory.");
86
        }
87
        if ($object->{$param} =~ m/(\$|\.\.|~|\s)/) {
88
            Koha::Exception::BadParameter->throw(
89
                error => __PACKAGE__."->validateAndPopulateDefaultValues():> parameter '$param' as '".$object->{$param}."'.".
90
                         'Disallowed characters present  ..  ~  $ + whitespace');
91
        }
92
    }
93
}
94
95
sub deleteTestGroup {
96
    my ($class, $objects) = @_;
97
98
    while( my ($key, $object) = each %$objects) {
99
        $object->remove if $object->e;
100
        #We could as well remove the complete subfolder but I am too afraid to automate "rm -r" here
101
    }
102
}
103
104
=head getHashKey
105
@OVERLOADED
106
107
@RETURNS String, The test context/stash HASH key to differentiate this object
108
                 from all other such test objects.
109
=cut
110
111
sub getHashKey {
112
    my ($class, $fileObject, $primaryKey, $hashKeys) = @_;
113
114
    return $fileObject->get_file();
115
}
116
117
1;
(-)a/t/lib/TestObjects/FinesFactory.pm (+166 lines)
Line 0 Link Here
1
package t::lib::TestObjects::FinesFactory;
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
use Try::Tiny;
25
26
use C4::Members;
27
use C4::Accounts;
28
use Koha::Patrons;
29
30
use base qw(t::lib::TestObjects::ObjectFactory);
31
32
use t::lib::TestObjects::PatronFactory;
33
34
use Koha::Exception::ObjectExists;
35
36
sub new {
37
    my ($class) = @_;
38
39
    my $self = {};
40
    bless($self, $class);
41
    return $self;
42
}
43
44
sub getDefaultHashKey {
45
    return 'note';
46
}
47
sub getObjectType {
48
    return 'HASH';
49
}
50
51
=head createTestGroup( $data [, $hashKey, $testContexts...] )
52
@OVERLOADED
53
54
    FinesFactory creates new fines into accountlines.
55
    After testing, all fines created by the FinesFactory will be
56
    deleted at tearDown.
57
58
    my $fines = t::lib::TestObjects::FinesFactory->createTestGroup([
59
                         amount => 10.0,
60
                         cardnumber => $borrowers->{'superuberadmin'}->cardnumber,
61
                         accounttype => 'FU',
62
                         note => 'unique identifier',
63
                         },
64
                    ], undef, $testContext1, $testContext2, $testContext3);
65
66
    #Do test stuff...
67
68
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1);
69
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2);
70
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
71
72
See t::lib::TestObjects::ObjectFactory for more documentation
73
=cut
74
75
sub handleTestObject {
76
    my ($class, $fine, $stashes) = @_;
77
78
    my $borrower;
79
    try {
80
        $borrower = Koha::Patrons->cast($fine->{cardnumber});
81
    } catch {
82
        die $_ unless (blessed($_) && $_->can('rethrow'));
83
        if ($_->isa('Koha::Exception::UnknownObject')) {
84
            $borrower = t::lib::TestObjects::PatronFactory->createTestGroup({cardnumber => $fine->{cardnumber}}, undef, @$stashes);
85
        }
86
        else {
87
            $_->rethrow();
88
        }
89
    };
90
91
    my $accountno = C4::Accounts::getnextacctno($borrower->borrowernumber);
92
93
    C4::Accounts::manualinvoice(
94
        $borrower->borrowernumber,      # borrowernumber
95
        $fine->{itemnumber},            # itemnumber
96
        $fine->{description},           # description
97
        $fine->{accounttype},           # accounttype
98
        $fine->{amount},                # amountoutstanding
99
        $fine->{note}                   # note, unique identifier
100
    );
101
102
    my $new_fine = $fine;
103
104
    $new_fine->{accountno} = $accountno;
105
106
    return $new_fine;
107
}
108
109
=head validateAndPopulateDefaultValues
110
@OVERLOAD
111
112
Validates given Object parameters and makes sure that critical fields are given
113
and populates defaults for missing values.
114
=cut
115
116
sub validateAndPopulateDefaultValues {
117
    my ($class, $object, $hashKey) = @_;
118
    $class->SUPER::validateAndPopulateDefaultValues($object, $hashKey);
119
120
    unless ($object->{cardnumber}) {
121
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> 'cardnumber' is a mandatory parameter!");
122
    }
123
    unless ($object->{note}) {
124
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> 'note' is a mandatory parameter!");
125
    }
126
127
    $object->{itemnumber} = undef unless defined $object->{itemnumber};
128
    $object->{description} = "Test payment" unless defined $object->{description};
129
    $object->{accounttype} = "FU" unless defined $object->{accounttype};
130
}
131
132
=head deleteTestGroup
133
@OVERLOADED
134
135
    my $records = createTestGroup();
136
    ##Do funky stuff
137
    deleteTestGroup($prefs);
138
139
Removes the given test group from the DB.
140
141
=cut
142
143
sub deleteTestGroup {
144
    my ($class, $acct) = @_;
145
146
    my $schema = Koha::Database->new_schema();
147
    while( my ($key, $val) = each %$acct) {
148
        if ($schema->resultset('Accountline')->find({"note" => $val->{note} })) {
149
            $schema->resultset('Accountline')->find({"note" => $val->{note} })->delete();
150
        }
151
    }
152
}
153
154
sub _deleteTestGroupFromIdentifiers {
155
    my ($self, $testGroupIdentifiers) = @_;
156
157
    my $schema = Koha::Database->new_schema();
158
    foreach my $key (@$testGroupIdentifiers) {
159
        if ($schema->resultset('Accountline')->find({"note" => $key})) {
160
            $schema->resultset('Accountline')->find({"note" => $key})->delete();
161
        }
162
    }
163
}
164
165
166
1;
(-)a/t/lib/TestObjects/HoldFactory.pm (+201 lines)
Line 0 Link Here
1
package t::lib::TestObjects::HoldFactory;
2
3
# Copyright KohaSuomi 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::Context;
26
use Koha::Database;
27
use C4::Circulation;
28
use C4::Members;
29
use C4::Items;
30
use C4::Reserves;
31
use Koha::Patrons;
32
use Koha::Biblios;
33
use Koha::Items;
34
use Koha::Checkouts;
35
36
use t::lib::TestObjects::PatronFactory;
37
use t::lib::TestObjects::ItemFactory;
38
use t::lib::TestObjects::BiblioFactory;
39
40
use base qw(t::lib::TestObjects::ObjectFactory);
41
42
sub new {
43
    my ($class) = @_;
44
45
    my $self = {};
46
    bless($self, $class);
47
    return $self;
48
}
49
50
sub getDefaultHashKey {
51
    return ['reservenotes'];
52
}
53
sub getObjectType {
54
    return 'HASH';
55
}
56
57
=head t::lib::TestObjects::HoldFactory::createTestGroup( $data [, $hashKey], @stashes )
58
59
    my $holds = t::lib::TestObjects::HoldFactory->createTestGroup([
60
                        {#Hold params
61
                        },
62
                        {#More hold params
63
                        },
64
                    ], undef, $testContext1, $testContext2, $testContext3);
65
66
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1);
67
68
@PARAM1, ARRAY of HASHes.
69
  [ {
70
        cardnumber        => '167Azava0001', #Patron's cardnumber
71
        isbn              => '971040323123', #ISBN of the Biblio, even if the record normally doesn't have a ISBN, you must mock one on it.
72
        barcode           => undef || '911N12032',    #Item's barcode, if this is an Item-level hold.
73
        branchcode        => 'CPL',
74
        waitingdate       => undef || '2015-01-15', #Since when has this hold been waiting for pickup?
75
    },
76
    {
77
        ...
78
    }
79
  ]
80
@PARAM2, String, the HASH-element to use as the returning HASHes key.
81
@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple
82
                test contexts. Usually one is enough. These test contexts are
83
                used to help tear down DB changes.
84
@RETURNS HASHRef of $hashKey => HASH-objects representing koha.reserves-table columns
85
                The HASH is keyed with <reservenotes>, or the given $hashKey.
86
    Example: {
87
        '11A001-971040323123-43' => {...},
88
        'my-nice-hold' => {...},
89
        ...
90
    }
91
}
92
=cut
93
94
sub handleTestObject {
95
    my ($class, $object, $stashes) = @_;
96
$DB::single=1;
97
    C4::Reserves::AddReserve($object->{branchcode} || 'CPL',
98
                                        $object->{borrower}->borrowernumber,
99
                                        $object->{biblio}->{biblionumber},
100
                                        undef, #bibitems
101
                                        undef, #priority
102
                                        $object->{reservedate}, #resdate
103
                                        $object->{expirationdate}, #expdate
104
                                        $object->{reservenotes}, #notes
105
                                        undef, #title
106
                                        ($object->{item} ? $object->{item}->itemnumber : undef), #checkitem
107
                                        undef, #found
108
                            );
109
    my $reserve_id = C4::Reserves::GetReserveId({biblionumber   => $object->{biblio}->{biblionumber},
110
                                            itemnumber     => ($object->{item} ? $object->{item}->itemnumber : undef),
111
                                            borrowernumber => $object->{borrower}->borrowernumber,
112
                                        });
113
    unless ($reserve_id) {
114
        die "HoldFactory->handleTestObject():> Couldn't create a reserve. for isbn => ".$object->{isbn}.", barcode => ".$object->{barcode}.
115
            ", item => ".($object->{barcode} ? $object->{barcode} : '')."\n";
116
    }
117
    my $hold = C4::Reserves::GetReserve($reserve_id);
118
    foreach my $key (keys %$object) {
119
        $hold->{$key} = $object->{$key};
120
    }
121
122
    if ($object->{waitingdate}) {
123
        eval {
124
            C4::Reserves::ModReserveAffect($hold->{item}->itemnumber, $hold->{borrower}->borrowernumber);
125
126
            #Modify the waitingdate. An ugly hack for a ugly module. Bear with me my men!
127
            my $dbh = C4::Context->dbh;
128
            my $query = "UPDATE reserves SET waitingdate = ? WHERE  reserve_id = ?";
129
            my $sth = $dbh->prepare($query);
130
            $sth->execute( $hold->{waitingdate}, $hold->{reserve_id} );
131
        };
132
        if ($@) {
133
            warn "HoldFactory->handleTestObject():> Error when setting the waitingdate for ".$class->getHashKey($object)."$@";
134
        }
135
    }
136
137
    return $hold;
138
}
139
140
=head validateAndPopulateDefaultValues
141
@OVERLOAD
142
143
Validates given Object parameters and makes sure that critical fields are given
144
and populates defaults for missing values.
145
=cut
146
147
sub validateAndPopulateDefaultValues {
148
    my ($self, $object, $hashKey, $stashes) = @_;
149
    $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey);
150
151
    unless ($object->{cardnumber}) {
152
        croak __PACKAGE__.":> Mandatory parameter 'cardnumber' missing.";
153
    }
154
    unless ($object->{isbn}) {
155
        croak __PACKAGE__.":> Mandatory parameter 'isbn' missing.";
156
    }
157
158
    my $borrower = t::lib::TestObjects::PatronFactory->createTestGroup(
159
                                {cardnumber => $object->{cardnumber}},
160
                                undef, @$stashes);
161
    $object->{borrower} = $borrower if $borrower;
162
163
    my $biblio = t::lib::TestObjects::BiblioFactory->createTestGroup({"biblio.title" => "Test holds' Biblio",
164
                                                                           "biblioitems.isbn" => $object->{isbn}},
165
                                                                          undef, @$stashes);
166
    $object->{biblio} = $biblio if $biblio;
167
168
    #Get test Item
169
    if ($object->{barcode}) {
170
        my $item = t::lib::TestObjects::ItemFactory->createTestGroup({barcode => $object->{barcode}, isbn => $object->{isbn}}, undef, @$stashes);
171
        $object->{item} = $item;
172
    }
173
174
    return $object;
175
}
176
177
=head
178
179
    my $objects = createTestGroup();
180
    ##Do funky stuff
181
    deleteTestGroup($records);
182
183
Removes the given test group from the DB.
184
185
=cut
186
187
sub deleteTestGroup {
188
    my ($self, $objects) = @_;
189
190
    #For some reason DBIx cannot delete from OldReserves-table so using DBI and not losing sleep
191
    my $dbh = C4::Context->dbh();
192
    my $del_old_sth = $dbh->prepare("DELETE FROM old_reserves WHERE reserve_id = ?");
193
    my $del_sth = $dbh->prepare("DELETE FROM reserves WHERE reserve_id = ?");
194
195
    while( my ($key, $object) = each %$objects) {
196
        $del_sth->execute($object->{reserve_id});
197
        $del_old_sth->execute($object->{reserve_id});
198
    }
199
}
200
201
1;
(-)a/t/lib/TestObjects/ItemFactory.pm (+161 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::Biblios;
26
use Koha::Biblioitems;
27
use Koha::Items;
28
use Koha::Checkouts;
29
30
use t::lib::TestObjects::BiblioFactory;
31
32
use Scalar::Util qw(blessed);
33
34
use base qw(t::lib::TestObjects::ObjectFactory);
35
36
sub new {
37
    my ($class) = @_;
38
39
    my $self = {};
40
    bless($self, $class);
41
    return $self;
42
}
43
44
sub getDefaultHashKey {
45
    return 'barcode';
46
}
47
sub getObjectType {
48
    return 'Koha::Item';
49
}
50
51
=head t::lib::TestObjects::ItemFactory::createTestGroup( $data [, $hashKey] )
52
@OVERLOADED
53
54
Returns a HASH of objects.
55
Each Item is expected to contain the biblionumber of the Biblio they are added into.
56
    eg. $item->{biblionumber} = 550242;
57
58
The HASH is keyed with the 'barcode', or the given $hashKey.
59
60
See C4::Items::AddItem() for how the table columns need to be given.
61
62
See t::lib::TestObjects::ObjectFactory for more documentation
63
=cut
64
65
sub handleTestObject {
66
    my ($class, $object, $stashes) = @_;
67
68
    #Look for the parent biblio, if we don't find one, create a default one.
69
    my ($biblionumber, $biblioitemnumber, $itemnumber);
70
    my $biblio = t::lib::TestObjects::BiblioFactory->createTestGroup({"biblio.title" => "Test Items' Biblio",
71
                                                                       "biblioitems.isbn" => $object->{isbn},
72
                                                                       "biblio.biblionumber" => $object->{biblionumber}},
73
                                                                          undef, @$stashes);
74
    $object->{biblionumber} = $biblio->{biblionumber};
75
    $object->{biblio} = $biblio;
76
77
    #Ok we got a biblio, now we can add an Item for it. First see if the Item already exists.
78
    my $item;
79
    eval {
80
        eval {
81
            $item = Koha::Items->cast($object);
82
        };
83
        unless ($item) {
84
            ($biblionumber, $biblioitemnumber, $itemnumber) = C4::Items::AddItem($object, $object->{biblionumber});
85
        }
86
    };
87
    if ($@) {
88
        if (blessed($@) && $@->isa('DBIx::Class::Exception') &&
89
            $@->{msg} =~ /Duplicate entry '.+?' for key 'itembarcodeidx'/) { #DBIx should throw other types of exceptions instead of this general type :(
90
            #This exception type is OK, we ignore this and try fetching the existing Object next.
91
            warn "Recovering from duplicate exception.\n";
92
        }
93
        else {
94
            die $@;
95
        }
96
    }
97
    $item = Koha::Items->cast($itemnumber || $object) unless $item;
98
    unless ($item) {
99
        carp "ItemFactory:> No item for barcode '".$object->{barcode}."'";
100
        next();
101
    }
102
103
    return $item;
104
}
105
106
=head validateAndPopulateDefaultValues
107
@OVERLOAD
108
109
Validates given Object parameters and makes sure that critical fields are given
110
and populates defaults for missing values.
111
=cut
112
113
sub validateAndPopulateDefaultValues {
114
    my ($self, $item, $hashKey) = @_;
115
    $self->SUPER::validateAndPopulateDefaultValues($item, $hashKey);
116
117
    $item->{homebranch}     = $item->{homebranch} || 'CPL';
118
    $item->{holdingbranch}  = $item->{holdingbranch} || $item->{homebranch} || 'CPL';
119
    $item->{itemcallnumber} = 'PRE 84.FAN POST' unless $item->{itemcallnumber};
120
}
121
122
=head
123
@OVERLOADED
124
125
    my $objects = createTestGroup();
126
    ##Do funky stuff
127
    deleteTestGroup($records);
128
129
Removes the given test group from the DB.
130
131
=cut
132
133
sub deleteTestGroup {
134
    my ($self, $objects) = @_;
135
136
    while( my ($key, $object) = each %$objects) {
137
        my $item = Koha::Items->cast($object);
138
139
        #Delete all attached checkouts
140
        my @checkouts = Koha::Checkouts->search({itemnumber => $item->itemnumber});
141
        foreach my $c (@checkouts) {
142
            $c->delete;
143
        }
144
145
        $item->delete();
146
    }
147
}
148
sub _deleteTestGroupFromIdentifiers {
149
    my ($self, $testGroupIdentifiers) = @_;
150
151
    foreach my $key (@$testGroupIdentifiers) {
152
        my $item = Koha::Items->cast($key);
153
        my @checkouts = Koha::Checkouts->search({itemnumber => $item->itemnumber});
154
        foreach my $c (@checkouts) {
155
            $c->delete;
156
        }
157
        $item->delete();
158
    }
159
}
160
161
1;
(-)a/t/lib/TestObjects/LetterTemplateFactory.pm (+99 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::Notice::Templates;
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
sub getDefaultHashKey {
38
    return ['module', 'code', 'branchcode', 'message_transport_type'];
39
}
40
sub getObjectType {
41
    return 'Koha::Notice::Template';
42
}
43
44
=head t::lib::TestObjects::LetterTemplateFactory->createTestGroup
45
Returns a HASH of Koha::Notice::Template-objects
46
The HASH is keyed with the PRIMARY KEYS eg. 'circulation-ODUE2-CPL-print', or the given $hashKey.
47
=cut
48
49
#Incredibly the Letters-module has absolutely no Create or Update-component to operate on Letter templates?
50
#Tests like these are brittttle. :(
51
sub handleTestObject {
52
    my ($class, $object, $stashes) = @_;
53
54
    my $schema = Koha::Database->new->schema();
55
    my $rs = $schema->resultset('Letter');
56
    my $result = $rs->update_or_create({
57
            module     => $object->{module},
58
            code       => $object->{code},
59
            branchcode => ($object->{branchcode}) ? $object->{branchcode} : '',
60
            name       => $object->{name},
61
            is_html    => $object->{is_html},
62
            title      => $object->{title},
63
            message_transport_type => $object->{message_transport_type},
64
            content    => $object->{content},
65
    });
66
67
    return Koha::Notice::Templates->cast($result);
68
}
69
70
=head
71
72
Removes the given test group from the DB.
73
74
=cut
75
76
sub deleteTestGroup {
77
    my ($self, $letterTemplates) = @_;
78
79
    my $schema = Koha::Database->new_schema();
80
    while( my ($key, $letterTemplate) = each %$letterTemplates ) {
81
        $letterTemplate->delete();
82
    }
83
}
84
85
sub _deleteTestGroupFromIdentifiers {
86
    my $testGroupIdentifiers = shift;
87
88
    my $schema = Koha::Database->new_schema();
89
    foreach my $key (@$testGroupIdentifiers) {
90
        my ($module, $code, $branchcode, $mtt) = split('-',$key);
91
        $schema->resultset('Letter')->find({module => $module,
92
                                                    code => $code,
93
                                                    branchcode => $branchcode,
94
                                                    message_transport_type => $mtt,
95
                                                })->delete();
96
    }
97
}
98
99
1;
(-)a/t/lib/TestObjects/MatcherFactory.pm (+213 lines)
Line 0 Link Here
1
package t::lib::TestObjects::MatcherFactory;
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::Matcher;
25
26
use base qw(t::lib::TestObjects::ObjectFactory);
27
28
sub getDefaultHashKey {
29
    return 'code';
30
}
31
sub getObjectType {
32
    return 'C4::Matcher';
33
}
34
35
=head t::lib::TestObjects::createTestGroup
36
37
    my $matchers = t::lib::TestObjects::MatcherFactory->createTestGroup([
38
                            {code => 'MATCHER',
39
                             description => 'I dunno',
40
                             threshold => 1000,
41
                             matchpoints => [
42
                                {
43
                                   index       => 'title',
44
                                   score       => 500,
45
                                   components => [{
46
                                        tag         => '245',
47
                                        subfields   => 'a',
48
                                        offset      => 0,
49
                                        length      => 0,
50
                                        norms       => [''],
51
                                   }]
52
                                },
53
                                {
54
                                   index       => 'author',
55
                                   score       => 500,
56
                                   components => [{
57
                                        tag         => '100',
58
                                        subfields   => 'a',
59
                                        offset      => 0,
60
                                        length      => 0,
61
                                        norms       => [''],
62
                                   }]
63
                                }
64
                             ],
65
                            required_checks => [
66
                                {
67
                                    source => [{
68
                                        tag         => '020',
69
                                        subfields   => 'a',
70
                                        offset      => 0,
71
                                        length      => 0,
72
                                        norms       => ['copy'],
73
                                    }],
74
                                    target => [{
75
                                        tag         => '024',
76
                                        subfields   => 'a',
77
                                        offset      => 0,
78
                                        length      => 0,
79
                                        norms       => ['paste'],
80
                                    }],
81
                                },
82
                                {
83
                                    source => [{
84
                                        tag         => '044',
85
                                        subfields   => 'a',
86
                                        offset      => 0,
87
                                        length      => 0,
88
                                        norms       => ['copy'],
89
                                    }],
90
                                    target => [{
91
                                        tag         => '048',
92
                                        subfields   => 'a',
93
                                        offset      => 0,
94
                                        length      => 0,
95
                                        norms       => ['paste'],
96
                                    }],
97
                                }
98
                            ],
99
                            },
100
                        ], undef, $testContext1, $testContext2, $testContext3);
101
102
Calls C4::Matcher to add a C4::Matcher object or objects to DB.
103
104
The HASH is keyed with the 'koha.marc_matchers.code', or the given $hashKey.
105
106
There is a duplication check to first look for C4::Matcher-rows with the same 'code'.
107
If a matching C4::Matcher is found, then we use the existing object.
108
109
@RETURNS HASHRef of C4::Matcher-objects
110
         or a C4::Matcher-object
111
112
See t::lib::TestObjects::ObjectFactory for more documentation
113
=cut
114
115
sub handleTestObject {
116
    my ($class, $object, $stashes) = @_;
117
118
    ##First see if the given Record already exists in the DB. For testing purposes we use the isbn as the UNIQUE identifier.
119
    my $matcher;
120
    my $id = C4::Matcher::GetMatcherId($object->{code});
121
    if ($id) {
122
        $matcher = C4::Matcher->fetch($id);
123
    }
124
    else {
125
        $matcher = C4::Matcher->new('biblio', $object->{threshold} || 1000);
126
127
        $matcher->code( $object->{code} );
128
        $matcher->description( $object->{description} ) if $object->{description};
129
130
        ##Add matchpoints
131
        if ($object->{matchpoints}) {
132
            foreach my $mc (@{$object->{matchpoints}}) {
133
                $matcher->add_matchpoint($mc->{index}, $mc->{score}, $mc->{components});
134
            }
135
        }
136
        else {
137
            $matcher->add_matchpoint('title', 500, [{
138
            tag         => '245',
139
                    subfields   => 'a',
140
                    offset      => 0,
141
                    length      => 0,
142
                    norms       => [''],
143
            }]);
144
            $matcher->add_matchpoint('author', 500, [{
145
            tag         => '100',
146
                    subfields   => 'a',
147
                    offset      => 0,
148
                    length      => 0,
149
                    norms       => [''],
150
            }]);
151
        }
152
153
        ##Add match checks
154
        if ($object->{required_checks}) {
155
            foreach my $rc (@{$object->{required_checks}}) {
156
                $matcher->add_required_check($rc->{source}, $rc->{target});
157
            }
158
        }
159
        else {
160
            $matcher->add_required_check(
161
                [{
162
            tag         => '020',
163
                    subfields   => 'a',
164
                    offset      => 0,
165
                    length      => 0,
166
                    norms       => ['copy'],
167
                }],
168
                [{
169
            tag         => '024',
170
                    subfields   => 'a',
171
                    offset      => 0,
172
                    length      => 0,
173
                    norms       => ['paste'],
174
                }]
175
            );
176
        }
177
178
        $matcher->store();
179
    }
180
181
    return $matcher;
182
}
183
184
=head validateAndPopulateDefaultValues
185
@OVERLOAD
186
187
Validates given Object parameters and makes sure that critical fields are given
188
and populates defaults for missing values.
189
=cut
190
191
sub validateAndPopulateDefaultValues {
192
    my ($self, $object, $hashKey) = @_;
193
194
    $object->{code} = 'MATCHER' unless $object->{code};
195
196
    $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey);
197
}
198
199
sub deleteTestGroup {
200
    my ($class, $objects) = @_;
201
202
    while( my ($key, $object) = each %$objects) {
203
        my $matcher = $objects->{$key};
204
        eval {
205
            C4::Matcher->delete( $matcher->{id} );
206
        };
207
        if ($@) {
208
            warn "$class->deleteTestGroup():> Error hapened: $@\n";
209
        }
210
    }
211
}
212
213
1;
(-)a/t/lib/TestObjects/MessageQueueFactory.pm (+158 lines)
Line 0 Link Here
1
package t::lib::TestObjects::MessageQueueFactory;
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
use Try::Tiny;
25
26
use C4::Members;
27
use C4::Letters;
28
use Koha::Patrons;
29
30
use t::lib::TestObjects::PatronFactory;
31
32
use base qw(t::lib::TestObjects::ObjectFactory);
33
34
use Koha::Exception::ObjectExists;
35
36
sub new {
37
    my ($class) = @_;
38
39
    my $self = {};
40
    bless($self, $class);
41
    return $self;
42
}
43
44
sub getDefaultHashKey {
45
    return 'from_address';
46
}
47
sub getObjectType {
48
    return 'HASH';
49
}
50
51
=head createTestGroup( $data [, $hashKey, $testContexts...] )
52
@OVERLOADED
53
54
    MessageQueueFactory creates a new message into message_queue table with 'pending'
55
    status. After testing, all messages created by the MessageQueueFactory will be
56
    deleted at tearDown.
57
58
    my $messages = t::lib::TestObjects::MessageQueueFactory->createTestGroup([
59
                         subject => "Test title",
60
                         content => "Tessst content",
61
                         cardnumber => $borrowers->{'superuberadmin'}->cardnumber,
62
                         message_transport_type => 'sms',
63
                         from_address => 'test@unique.com',
64
                         },
65
                    ], undef, $testContext1, $testContext2, $testContext3);
66
67
    #Do test stuff...
68
69
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1);
70
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2);
71
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
72
73
See t::lib::TestObjects::ObjectFactory for more documentation
74
=cut
75
76
sub handleTestObject {
77
    my ($class, $notice, $stashes) = @_;
78
79
    my ($borrower, $letter, $message_id);
80
    try {
81
        $borrower = Koha::Patrons->cast($notice->{cardnumber});
82
    } catch {
83
        if (blessed($_)) {
84
            $_->rethrow();
85
        }
86
        else {
87
            die $_;
88
        }
89
    };
90
91
    $letter = {
92
        title => $notice->{subject} || '',
93
        content => $notice->{content},
94
        content_type => $notice->{content_type},
95
        letter_code => $notice->{letter_code},
96
    };
97
    $message_id = C4::Letters::EnqueueLetter({
98
        letter                 => $letter,
99
        borrowernumber         => $borrower->borrowernumber,
100
        message_transport_type => $notice->{message_transport_type},
101
        to_address             => $notice->{to_address},
102
        from_address           => $notice->{from_address},
103
    });
104
105
    #return the persisted MessageQueue with linked objects referenced
106
    $notice = C4::Letters::GetMessage($message_id);
107
    $notice->{borrower} = $borrower;
108
109
    return $notice;
110
}
111
112
=head validateAndPopulateDefaultValues
113
@OVERLOAD
114
115
Validates given Object parameters and makes sure that critical fields are given
116
and populates defaults for missing values.
117
=cut
118
119
sub validateAndPopulateDefaultValues {
120
    my ($class, $object, $hashKey) = @_;
121
    $class->SUPER::validateAndPopulateDefaultValues($object, $hashKey);
122
123
    unless ($object->{cardnumber}) {
124
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> 'cardnumber' is a mandatory parameter!");
125
    }
126
    unless ($object->{from_address}) {
127
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> 'from_address' is a mandatory parameter!");
128
    }
129
130
    # Other required fields
131
    $object->{subject} = "Hello world" unless defined $object->{subject};
132
    $object->{message_transport_type} = 'email' unless defined $object->{message_transport_type};
133
    $object->{content} = "Example message content" unless defined $object->{content};
134
}
135
136
=head deleteTestGroup
137
@OVERLOADED
138
139
    my $records = createTestGroup();
140
    ##Do funky stuff
141
    deleteTestGroup($prefs);
142
143
Removes the given test group from the DB.
144
145
=cut
146
147
sub deleteTestGroup {
148
    my ($class, $messages) = @_;
149
150
    my $schema = Koha::Database->new_schema();
151
    while( my ($key, $msg) = each %$messages) {
152
        if ($schema->resultset('MessageQueue')->find({"message_id" => $msg->{message_id}})) {
153
            $schema->resultset('MessageQueue')->find({"message_id" => $msg->{message_id}})->delete();
154
        }
155
    }
156
}
157
158
1;
(-)a/t/lib/TestObjects/ObjectFactory.pm (+405 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
use Scalar::Util qw(blessed);
24
use Koha::Exception::BadParameter;
25
use Koha::Exception::UnknownObject;
26
27
=head createTestGroup( $data [, $hashKey, $testContexts...] )
28
29
    my $factory = t::lib::TestObjects::ObjectFactory->new();
30
    my $objects = $factory->createTestGroup([
31
                        #Imagine if using the PatronFactory
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 the default hash key accessed with
53
getDefaultHashKey()
54
See the createTestGroup() documentation in the implementing Factory-class for how
55
the table columns need to be given.
56
57
@PARAM1 ARRAYRef of HASHRefs of desired Object constructor parameters
58
        or
59
        HASHRef of desired Object constructor parameters
60
@PARAM2 koha.<object>-column which is used as the test context HASH key to find individual Objects,
61
                usually defaults to to one of the UNIQUE database keys.
62
@PARAM3-5 HASHRef of test contexts. You can save the given Objects to multiple
63
                test contexts. Usually one is enough. These test contexts are
64
                used to help tear down DB changes.
65
@RETURNS HASHRef of $hashKey => Objects, eg.
66
                { $hashKey => {#borrower1 HASH},
67
                  $hashKey => {#borrower2 HASH},
68
                }
69
         or
70
         Object, single object reference if the constructors parameters were given as a HASHRef instead
71
=cut
72
73
sub createTestGroup {
74
    my ($class, $objects, $hashKey, $featureStash, $scenarioStash, $stepStash) = @_;
75
    my $stashes = [$featureStash, $scenarioStash, $stepStash];
76
    $class->_validateStashes(@$stashes);
77
    $hashKey = $class->getDefaultHashKey() unless $hashKey;
78
79
    my $retType = 'HASHRef';
80
    unless (ref($objects) eq 'ARRAY') {
81
        $objects = [$objects];
82
        $retType = 'SCALAR';
83
    }
84
85
    my %objects;
86
    foreach my $o (@$objects) {
87
        $class->validateAndPopulateDefaultValues($o, $hashKey, $stashes);
88
89
        my $addedObject = $class->handleTestObject($o, $stashes);
90
        if (not($addedObject) ||
91
            (blessed($addedObject) && not($addedObject->isa($class->getObjectType()))) ||
92
            not(ref($addedObject) eq $class->getObjectType() )
93
           ) {
94
            Koha::Exception::UnknownObject->throw(error => __PACKAGE__."->createTestGroup():> Subroutine '$class->handleTestObject()' must return a HASH or a Koha::Object");
95
        }
96
97
        my $key = $class->getHashKey($addedObject, undef, $hashKey);
98
        $objects{$key} = $addedObject;
99
    }
100
101
    $class->_persistToStashes(\%objects, $class->getHashGroupName(), @$stashes);
102
103
    if ($retType eq 'HASHRef') {
104
        return \%objects;
105
    }
106
    else {
107
        foreach my $key (keys %objects) {
108
            return $objects{$key};
109
        }
110
    }
111
}
112
113
=head getHashGroupName
114
@OVERRIDABLE
115
116
@RETURNS String, the test context/stash key under which all of these test objects are put.
117
                 The key is calculated by default from the last components of the Object package,
118
                 but it is possible to override this method from the subclass to force another key.
119
                 Eg. 't::lib::PageObject::Acquisition::Bookseller::ContactFactory' becomes
120
                     acquisition-bookseller-contact
121
=cut
122
123
sub getHashGroupName {
124
    my ($class) = @_;
125
126
    my $excludedPackageStart = 't::lib::TestObjects';
127
    unless ($class =~ m/^${excludedPackageStart}::(.+?)Factory/i) {
128
        Koha::Exception::BadParameter->throw(error =>
129
            "$class->getHashGroupName():> Couldn't parse the class name to the default test stash group name. Your class is badly named. Expected format '${excludedPackageStart}::<Module>[::Submodule]::<Class>Factory'");
130
    }
131
    my @e = split('::', lc($1));
132
    return join('-', @e);
133
}
134
135
sub handleTestObject {} #OVERLOAD THIS FROM SUBCLASS
136
sub deleteTestGroup {} #OVERLOAD THIS FROM SUBCLASS
137
138
=head tearDownTestContext
139
140
Given a testContext stash populated using one of the TestObjectFactory implementations createTestGroup()-subroutines,
141
Removes all the persisted objects in the stash.
142
143
TestObjectFactories must be lazy loaded here to make it possible for them to subclass this.
144
=cut
145
146
sub tearDownTestContext {
147
    my ($self, $stash) = @_;
148
    unless (ref($stash) eq 'HASH') {
149
        Koha::Exception::BadParameter->throw(error => "Parameter '\$stash' is not a HASHref. You must call this subroutine with -> instead of ::");
150
    }
151
152
    ##You should introduce tearDowns in such an order that to not provoke FOREIGN KEY issues.
153
    if ($stash->{'file'}) {
154
        require t::lib::TestObjects::FileFactory;
155
        t::lib::TestObjects::FileFactory->deleteTestGroup($stash->{'file'});
156
        delete $stash->{'file'};
157
    }
158
    if ($stash->{'serial-subscription'}) {
159
        require t::lib::TestObjects::Serial::SubscriptionFactory;
160
        t::lib::TestObjects::Serial::SubscriptionFactory->deleteTestGroup($stash->{'serial-subscription'});
161
        delete $stash->{'serial-subscription'};
162
    }
163
    if ($stash->{'acquisition-bookseller-contact'}) {
164
        require t::lib::TestObjects::Acquisition::Bookseller::ContactFactory;
165
        t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->deleteTestGroup($stash->{'acquisition-bookseller-contact'});
166
        delete $stash->{'acquisition-bookseller-contact'};
167
    }
168
    if ($stash->{'acquisition-bookseller'}) {
169
        require t::lib::TestObjects::Acquisition::BooksellerFactory;
170
        t::lib::TestObjects::Acquisition::BooksellerFactory->deleteTestGroup($stash->{'acquisition-bookseller'});
171
        delete $stash->{'acquisition-bookseller'};
172
    }
173
    if ($stash->{'labels-sheet'}) {
174
        require t::lib::TestObjects::Labels::SheetFactory;
175
        t::lib::TestObjects::Labels::SheetFactory->deleteTestGroup($stash->{'labels-sheet'});
176
        delete $stash->{'labels-sheet'};
177
    }
178
    if ($stash->{checkout}) {
179
        require t::lib::TestObjects::CheckoutFactory;
180
        t::lib::TestObjects::CheckoutFactory->deleteTestGroup($stash->{checkout});
181
        delete $stash->{checkout};
182
    }
183
    if ($stash->{item}) {
184
        require t::lib::TestObjects::ItemFactory;
185
        t::lib::TestObjects::ItemFactory->deleteTestGroup($stash->{item});
186
        delete $stash->{item};
187
    }
188
    if ($stash->{biblio}) {
189
        require t::lib::TestObjects::BiblioFactory;
190
        t::lib::TestObjects::BiblioFactory->deleteTestGroup($stash->{biblio});
191
        delete $stash->{biblio};
192
    }
193
    if ($stash->{atomicupdate}) {
194
        require t::lib::TestObjects::AtomicUpdateFactory;
195
        t::lib::TestObjects::AtomicUpdateFactory->deleteTestGroup($stash->{atomicupdate});
196
        delete $stash->{atomicupdate};
197
    }
198
    if ($stash->{patron}) {
199
        require t::lib::TestObjects::PatronFactory;
200
        t::lib::TestObjects::PatronFactory->deleteTestGroup($stash->{patron});
201
        delete $stash->{patron};
202
    }
203
    if ($stash->{hold}) {
204
        require t::lib::TestObjects::HoldFactory;
205
        t::lib::TestObjects::HoldFactory->deleteTestGroup($stash->{hold});
206
        delete $stash->{hold};
207
    }
208
    if ($stash->{lettertemplate}) {
209
        require t::lib::TestObjects::LetterTemplateFactory;
210
        t::lib::TestObjects::LetterTemplateFactory->deleteTestGroup($stash->{lettertemplate});
211
        delete $stash->{letterTemplate};
212
    }
213
    if ($stash->{systempreference}) {
214
        require t::lib::TestObjects::SystemPreferenceFactory;
215
        t::lib::TestObjects::SystemPreferenceFactory->deleteTestGroup($stash->{systempreference});
216
        delete $stash->{systempreference};
217
    }
218
    if ($stash->{matcher}) {
219
        require t::lib::TestObjects::MatcherFactory;
220
        t::lib::TestObjects::MatcherFactory->deleteTestGroup($stash->{matcher});
221
        delete $stash->{matcher};
222
    }
223
    if ($stash->{messagequeue}) {
224
        require t::lib::TestObjects::MessageQueueFactory;
225
        t::lib::TestObjects::MessageQueueFactory->deleteTestGroup($stash->{messagequeue});
226
        delete $stash->{messagequeue};
227
    }
228
    if ($stash->{fines}) {
229
        require t::lib::TestObjects::FinesFactory;
230
        t::lib::TestObjects::FinesFactory->deleteTestGroup($stash->{fines});
231
        delete $stash->{fines};
232
    }
233
}
234
235
=head getHashKey
236
@OVERLOADABLE
237
238
@RETURNS String, The test context/stash HASH key to differentiate this object
239
                 from all other such test objects.
240
=cut
241
242
sub getHashKey {
243
    my ($class, $object, $primaryKey, $hashKeys) = @_;
244
245
    my @collectedHashKeys;
246
    $hashKeys = $class->getDefaultHashKey unless $hashKeys;
247
    $hashKeys = [$hashKeys] unless ref($hashKeys) eq 'ARRAY';
248
    foreach my $hashKey (@$hashKeys) {
249
        if (ref($object) eq 'HASH') {
250
            if ($hashKey && not($object->{$hashKey})) {
251
                croak $class."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'.";
252
            }
253
            push @collectedHashKeys, $object->{$hashKey};
254
        }
255
        else {
256
            my $key = $object->{$hashKey};
257
            eval {
258
                $key = $object->$hashKey();
259
            } unless $key;
260
            if ($hashKey && not($key)) {
261
                croak $class."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'. ".($@) ? $@ : '';
262
            }
263
            push @collectedHashKeys, $key;
264
        }
265
    }
266
    return join('-', @collectedHashKeys);
267
}
268
269
=head
270
271
=cut
272
273
sub addToContext {
274
    my ($class, $objects, $hashKeys, $featureStash, $scenarioStash, $stepStash) = @_;
275
    my @stashes = ($featureStash, $scenarioStash, $stepStash);
276
277
    if (ref($objects) eq 'ARRAY') {
278
        foreach my $object (@$objects) {
279
            $class->addToContext($object, $hashKeys, @stashes);
280
        }
281
        return undef; #End recursion
282
    }
283
    elsif (ref($objects) eq 'HASH') {
284
        #Apparently we get a HASH of keyed objects.
285
        $class->_persistToStashes($objects, $class->getHashGroupName(), @stashes);
286
        return undef; #End recursion
287
    }
288
    else {
289
        #Here $objects is verified to be a single object, instead of a group of objects.
290
        #We create a hash key for it and append it to the stashes.
291
        my $hash = { $class->getHashKey($objects, undef, $class->getDefaultHashKey) => $objects};
292
        $class->_persistToStashes($hash, $class->getHashGroupName(), @stashes);
293
    }
294
}
295
296
=head validateAndPopulateDefaultValues
297
@INTERFACE
298
299
Validates given Object parameters and makes sure that critical fields are given
300
and populates defaults for missing values.
301
You must overload this in the subclassing factory if you want to validate and check the given parameters
302
=cut
303
304
sub validateAndPopulateDefaultValues {
305
    my ($self, $object, $hashKeys) = @_;
306
307
    $hashKeys = [$hashKeys] unless ref($hashKeys) eq 'ARRAY';
308
    foreach my $hashKey (@$hashKeys) {
309
        unless ($object->{$hashKey}) {
310
            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.");
311
        }
312
    }
313
}
314
315
=head validateObjectType
316
317
    try {
318
        $object = $class->validateObjectType($object);
319
    } catch {
320
        ...
321
    }
322
323
Validates if the given Object matches the expected type of the subclassing TestObjectFactory.
324
@PARAM1 Object that needs to be validated.
325
@THROWS Koha::Exception::UnknownObject, if the given object is not of the same type that the object factory creates.
326
327
=cut
328
329
sub validateObjectType {
330
    my ($class, $object) = @_;
331
332
    my $invalid = 0;
333
    if (blessed($object)) {
334
        unless ($object->isa( $class->getObjectType() )) {
335
            $invalid = 1;
336
        }
337
    }
338
    else {
339
        unless (ref($object) eq $class->getObjectType()) {
340
            $invalid = 1;
341
        }
342
    }
343
344
    Koha::Exception::UnknownObject->throw(
345
        error => "$class->validateObjectType():> Given object '$object' isn't a '".$class->getObjectType()."'-object."
346
    ) if $invalid;
347
348
    return $object;
349
}
350
351
=head getObjectType
352
@OVERLOAD
353
Get the type of objects this factory creates.
354
@RETURN String, the object package this factory creates. eg. Koha::Patron
355
=cut
356
357
sub getObjectType {
358
    my ($class) = @_;
359
    die "You must overload 'validateObjectType()' in the implementing ObjectFactory subclass '$class'.";
360
    return 'Koha::Object derivative or other Object';
361
}
362
363
=head _validateStashes
364
365
    _validateStashes($featureStash, $scenarioStash, $stepStash);
366
367
Validates that the given stahses are what they are supposed to be... ,  HASHrefs.
368
@THROWS Koha::Exception::BadParameter, if validation failed.
369
=cut
370
371
sub _validateStashes {
372
    my ($self, $featureStash, $scenarioStash, $stepStash) = @_;
373
374
    if ($featureStash && not(ref($featureStash) eq 'HASH')) {
375
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$featureStash' is not a HASHRef! Leave it 'undef' if you don't want to use it.");
376
    }
377
    if ($scenarioStash && not(ref($scenarioStash) eq 'HASH')) {
378
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$scenarioStash' is not a HASHRef! Leave it 'undef' if you don't want to use it.");
379
    }
380
    if ($stepStash && not(ref($stepStash) eq 'HASH')) {
381
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$stepStash' is not a HASHRef! Leave it 'undef' if you don't want to use it.");
382
    }
383
}
384
385
=head _persistToStashes
386
387
    _persistToStashes($objects, $stashKey, $featureStash, $scenarioStash, $stepStash);
388
389
Saves the given HASH to the given stashes using the given stash key.
390
=cut
391
392
sub _persistToStashes {
393
    my ($class, $objects, $stashKey, $featureStash, $scenarioStash, $stepStash) = @_;
394
395
    if ($featureStash || $scenarioStash || $stepStash) {
396
        while( my ($key, $object) = each %$objects) {
397
            $class->validateObjectType($object); #Make sure we put in what we are expected to
398
            $featureStash->{$stashKey}->{ $key }  = $object if $featureStash;
399
            $scenarioStash->{$stashKey}->{ $key } = $object if $scenarioStash;
400
            $stepStash->{$stashKey}->{ $key }     = $object if $stepStash;
401
        }
402
    }
403
}
404
405
1;
(-)a/t/lib/TestObjects/PatronFactory.pm (+178 lines)
Line 0 Link Here
1
package t::lib::TestObjects::PatronFactory;
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
use Encode;
25
26
use C4::Members;
27
use Koha::Patrons;
28
29
use base qw(t::lib::TestObjects::ObjectFactory);
30
31
sub new {
32
    my ($class) = @_;
33
34
    my $self = {};
35
    bless($self, $class);
36
    return $self;
37
}
38
39
sub getDefaultHashKey {
40
    return 'cardnumber';
41
}
42
sub getObjectType {
43
    return 'Koha::Patron';
44
}
45
46
=head createTestGroup( $data [, $hashKey, $testContexts...] )
47
@OVERLOADED
48
49
    my $borrowerFactory = t::lib::TestObjects::PatronFactory->new();
50
    my $borrowers = $borrowerFactory->createTestGroup([
51
                        {firstname => 'Olli-Antti',
52
                         surname   => 'Kivi',
53
                         cardnumber => '11A001',
54
                         branchcode     => 'CPL',
55
                        },
56
                        {firstname => 'Olli-Antti2',
57
                         surname   => 'Kivi2',
58
                         cardnumber => '11A002',
59
                         branchcode     => 'FPL',
60
                        },
61
                    ], undef, $testContext1, $testContext2, $testContext3);
62
63
    #Do test stuff...
64
65
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1);
66
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2);
67
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
68
69
The HASH is keyed with the given $hashKey or 'koha.borrowers.cardnumber'
70
See C4::Members::AddMember() for how the table columns need to be given.
71
72
@PARAM1 ARRAYRef of HASHRefs of C4::Members::AddMember()-parameters.
73
@PARAM2 koha.borrower-column which is used as the test context borrowers HASH key,
74
                defaults to the most best option cardnumber.
75
@PARAM3-5 HASHRef of test contexts. You can save the given borrowers to multiple
76
                test contexts. Usually one is enough. These test contexts are
77
                used to help tear down DB changes.
78
@RETURNS HASHRef of $hashKey => $borrower-objects:
79
80
See t::lib::TestObjects::ObjectFactory for more documentation
81
=cut
82
83
sub handleTestObject {
84
    my ($class, $object, $stashes) = @_;
85
86
    my $borrower;
87
    eval {
88
        $borrower = Koha::Patrons->cast($object); #Try getting the patron first
89
    };
90
91
    my $borrowernumber;
92
    unless ($borrower) {
93
        #Try to add the Patron, but it might fail because of the barcode or other UNIQUE constraint.
94
        #Catch the error and try looking for the Patron if we suspect it is present in the DB.
95
        eval {
96
            $borrowernumber = C4::Members::AddMember(%$object);
97
        };
98
        if ($@) {
99
            if (blessed($@) && $@->isa('DBIx::Class::Exception') &&
100
                $@->{msg} =~ /Duplicate entry '.+?' for key 'cardnumber'/) { #DBIx should throw other types of exceptions instead of this general type :(
101
                #This exception type is OK, we ignore this and try fetching the existing Object next.
102
                warn "Recovering from duplicate exception.\n";
103
            }
104
            else {
105
                die $@;
106
            }
107
        }
108
        #If adding failed, we still get some strange borrowernumber result.
109
        #Check for sure by finding the real patron.
110
        $borrower = Koha::Patrons->cast( $borrowernumber || $object );
111
    }
112
113
    unless ($borrower) {
114
        carp "PatronFactory:> No borrower for cardnumber '".$object->{cardnumber}."'";
115
        return();
116
    }
117
118
    return $borrower;
119
}
120
121
=head validateAndPopulateDefaultValues
122
@OVERLOAD
123
124
Validates given Object parameters and makes sure that critical fields are given
125
and populates defaults for missing values.
126
=cut
127
128
sub validateAndPopulateDefaultValues {
129
    my ($self, $borrower, $hashKey) = @_;
130
    $self->SUPER::validateAndPopulateDefaultValues($borrower, $hashKey);
131
132
    $borrower->{firstname} = 'Maija' unless $borrower->{firstname};
133
    $borrower->{surname} = Encode::decode('UTF-8', 'Meikäläinen') unless $borrower->{surname};
134
    $borrower->{cardnumber} = '167A000001TEST' unless $borrower->{cardnumber};
135
    $borrower->{categorycode} = 'PT' unless $borrower->{categorycode};
136
    $borrower->{branchcode}   = 'CPL' unless $borrower->{branchcode};
137
    $borrower->{dateofbirth}  = '1985-10-12' unless $borrower->{dateofbirth};
138
}
139
140
=head deleteTestGroup
141
@OVERLOADED
142
143
    my $records = createTestGroup();
144
    ##Do funky stuff
145
    deleteTestGroup($records);
146
147
Removes the given test group from the DB.
148
149
=cut
150
151
sub deleteTestGroup {
152
    my ($self, $objects) = @_;
153
154
    my $schema = Koha::Database->new_schema();
155
    while( my ($key, $object) = each %$objects) {
156
        my $borrower = Koha::Patrons->cast($object);
157
        eval {
158
            $borrower->delete();
159
        };
160
        if ($@) {
161
            if (blessed($@) && $@->isa('DBIx::Class::Exception') &&
162
                    #Trying to recover. Delete all Checkouts for the Patron to be able to delete.
163
                    $@->{msg} =~ /a foreign key constraint fails.+?issues_ibfk_1/) { #DBIx should throw other types of exceptions instead of this general type :(
164
165
                my @checkouts = Koha::Checkouts->search({borrowernumber => $borrower->borrowernumber});
166
                foreach my $c (@checkouts) { $c->delete(); }
167
                $borrower->delete();
168
                warn "Recovering from foreign key exception.\n";
169
            }
170
            else {
171
                die $@;
172
            }
173
        }
174
175
    }
176
}
177
178
1;
(-)a/t/lib/TestObjects/Serial/FrequencyFactory.pm (+152 lines)
Line 0 Link Here
1
package t::lib::TestObjects::Serial::FrequencyFactory;
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 Koha::Serial::Subscription::Frequency;
26
use Koha::Serial::Subscription::Frequencies;
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
sub getDefaultHashKey {
39
    return 'description';
40
}
41
sub getObjectType {
42
    return 'Koha::Serial::Subscription::Frequency';
43
}
44
45
=head createTestGroup( $data [, $hashKey, $testContexts...] )
46
@OVERLOADED
47
48
    my $frequencies = t::lib::TestObjects::Serial::FrequencyFactory->createTestGroup([
49
                        {acqprimary     => 1,                     #DEFAULT
50
                         claimissues    => 1,                     #DEFAULT
51
                         claimacquisition => 1,                   #DEFAULT
52
                         serialsprimary => 1,                     #DEFAULT
53
                         position       => 'Boss',                #DEFAULT
54
                         phone          => '+358700123123',       #DEFAULT
55
                         notes          => 'Noted',               #DEFAULT
56
                         name           => "Julius Augustus Caesar", #DEFAULT
57
                         fax            => '+358700123123',       #DEFAULT
58
                         email          => 'vendor@example.com',  #DEFAULT
59
                         booksellerid   => 12124                  #MANDATORY to link to Bookseller
60
                         #id => #Don't use id, since we are just adding a new one
61
                        },
62
                        {...},
63
                    ], undef, $testContext1, $testContext2, $testContext3);
64
65
    #Do test stuff...
66
67
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
68
69
The HASH is keyed with the given $hashKey or 'koha.subscription_frequencies.description'
70
71
@PARAM1 ARRAYRef of HASHRefs
72
@PARAM2 koha.subscription_frequencies-column which is used as the test context HASH key,
73
                defaults to the most best option 'description'.
74
@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple
75
                test contexts. Usually one is enough. These test contexts are
76
                used to help tear down DB changes.
77
@RETURNS HASHRef of $hashKey => object:
78
79
See t::lib::TestObjects::ObjectFactory for more documentation
80
=cut
81
82
sub handleTestObject {
83
    my ($class, $object, $stashes) = @_;
84
85
    my $contact = Koha::Acquisition::Bookseller::Contact->new();
86
    $contact->set($object);
87
    $contact->store();
88
    #Refresh from DB the contact we just made, since there is no UNIQUE identifier aside from PK, we cannot know if there are many objects like this.
89
    my @contacts = Koha::Acquisition::Bookseller::Contacts->search($object);
90
    if (scalar(@contacts)) {
91
        $contact = $contacts[0];
92
    }
93
    else {
94
        die "No Contact added to DB. Fix me to autorecover from this error!";
95
    }
96
97
    return $contact;
98
}
99
100
=head validateAndPopulateDefaultValues
101
@OVERLOAD
102
103
Validates given Object parameters and makes sure that critical fields are given
104
and populates defaults for missing values.
105
=cut
106
107
sub validateAndPopulateDefaultValues {
108
    my ($self, $object, $hashKey) = @_;
109
110
    $object->{acqprimary}     = 1 unless $object->{acqprimary};
111
    $object->{claimissues}    = 1 unless $object->{claimissues};
112
    $object->{claimacquisition} = 1 unless $object->{claimacquisition};
113
    $object->{serialsprimary} = 1 unless $object->{serialsprimary};
114
    $object->{position}       = 'Boss' unless $object->{position};
115
    $object->{phone}          = '+358700123123' unless $object->{phone};
116
    $object->{notes}          = 'Noted' unless $object->{notes};
117
    $object->{name}           = "Julius Augustus Caesar" unless $object->{name};
118
    $object->{fax}            = '+358700123123' unless $object->{fax};
119
    $object->{email}          = 'vendor@example.com' unless $object->{email};
120
    $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey);
121
}
122
123
=head deleteTestGroup
124
@OVERLOADED
125
126
    my $records = createTestGroup();
127
    ##Do funky stuff
128
    deleteTestGroup($records);
129
130
Removes the given test group from the DB.
131
132
=cut
133
134
sub deleteTestGroup {
135
    my ($self, $objects) = @_;
136
137
    while( my ($key, $object) = each %$objects) {
138
        my $contact = Koha::Acquisition::Bookseller::Contacts->cast($object);
139
        eval {
140
            #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them.
141
            my @contacts = Koha::Acquisition::Bookseller::Contacts->search({name => $contact->name});
142
            foreach my $c (@contacts) {
143
                $c->delete();
144
            }
145
        };
146
        if ($@) {
147
            die $@;
148
        }
149
    }
150
}
151
152
1;
(-)a/t/lib/TestObjects/Serial/SubscriptionFactory.pm (+312 lines)
Line 0 Link Here
1
package t::lib::TestObjects::Serial::SubscriptionFactory;
2
3
# Copyright KohaSuomi 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
use DateTime;
25
26
use C4::Context;
27
use C4::Serials;
28
29
use t::lib::TestObjects::PatronFactory;
30
use Koha::Patrons;
31
use t::lib::TestObjects::Acquisition::BooksellerFactory;
32
use Koha::Acquisition::Booksellers;
33
use t::lib::TestObjects::BiblioFactory;
34
use Koha::Biblios;
35
use t::lib::TestObjects::ItemFactory;
36
use Koha::Items;
37
38
use Koha::Subscriptions;
39
40
use base qw(t::lib::TestObjects::ObjectFactory);
41
42
sub getDefaultHashKey {
43
    return 'internalnotes';
44
}
45
sub getObjectType {
46
    return 'Koha::Subscription';
47
}
48
49
=head createTestGroup( $data [, $hashKey, $testContexts...] )
50
51
    my $subscriptions = t::lib::TestObjects::Serial::SubscriptionFactory->createTestGroup([
52
            {
53
                internalnotes => 'MagazineName-CPL-1', #MANDATORY! Used as the hash-key
54
                receiveSerials => 3, #DEFAULT undef, receives this many serials using the default values.
55
                librarian => 12 || Koha::Patron, #DEFAULT creates a "Subscription Master" Patron
56
                branchcode => 'CPL', #DEFAULT
57
                aqbookseller => 54 || Koha::Acquisition::Bookseller, #DEFAULT creates a 'Bookselling Vendor'.
58
                cost => undef, #DEFAULT
59
                aqbudgetid => undef, #DEFAULT
60
                biblio => 21 || Koha::Biblio, #DEFAULT creates a "Serial magazine" Record
61
                startdate => '2015-01-01', #DEFAULTs to 1.1 this year, so the subscription is active by default.
62
                periodicity => 2 || Koha::Serial::Subscription::Frequency, #DEFAULTS to a Frequency of 1/week.
63
                numberlength => 12, #DEFAULT one year subscription, only one of ['numberlength', 'weeklength', 'monthlength'] is needed
64
                weeklength => 52, #DEFAULT one year subscription
65
                monthlength => 12, #DEFAULT one year subscription
66
                lastvalue1 => 2015, #DEFAULT this year
67
                innerloop1 => undef, #DEFAULT
68
                lastvalue2 => 1, #DEFAULT
69
                innerloop2 => undef, #DEFAULT
70
                lastvalue3 => 1, #DEFAULT
71
                innerloop3 => undef, #DEFAULT
72
                status => 1, #DEFAULT
73
                notes => 'Public note', #DEFAULT
74
                letter => 'RLIST', #DEFAULT
75
                firstacquidate => '2015-01-01', #DEFAULT, same as startdate
76
                irregularity => undef, #DEFAULT
77
                numberpattern => 2 || Koha::Serial::Numberpattern, #DEFAULT 2, which is 'Volume, Number, Issue'
78
                locale => undef, #DEFAULT
79
                callnumber => MAG 10.2 AZ, #DEFAULT
80
                manualhistory => 0, #DEFAULT
81
                serialsadditems => 1, #DEFAULT
82
                staffdisplaycount => 20, #DEFAULT
83
                opacdisplaycount => 20, #DEFAULT
84
                graceperiod => 2, #DEFAULT
85
                location => 'DISPLAY', #DEFAULT
86
                enddate => undef, #DEFAULT, calculated
87
                skip_serialseq => 1, #DEFAULT
88
            },
89
            {...
90
            },
91
        ], undef, $testContext1, $testContext2, $testContext3);
92
93
    #Do test stuff...
94
95
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
96
97
The HASH is keyed with the given $hashKey or 'koha.subscription.internalnotes'
98
We default to internalnotes because there is really no unique identifier
99
to describe the created subscription which wouldn't change across different test runs.
100
101
See C4::Serials::NewSubscription() for how the table columns need to be given.
102
103
@PARAM1 ARRAYRef of HASHRefs
104
@PARAM2 koha.subscription-column which is used as the test context HASH key,
105
@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple
106
                test contexts. Usually one is enough. These test contexts are
107
                used to help tear down DB changes.
108
@RETURNS HASHRef of $hashKey => $borrower-objects:
109
110
See t::lib::TestObjects::ObjectFactory for more documentation
111
=cut
112
113
sub handleTestObject {
114
    my ($class, $o, $stashes) = @_;
115
116
    my $subscriptionid;
117
    eval {
118
        $subscriptionid = C4::Serials::NewSubscription(
119
                                $o->{librarian}->id,
120
                                $o->{branchcode},
121
                                $o->{aqbookseller}->id,
122
                                $o->{cost},
123
                                $o->{aqbudgetid},
124
                                $o->{biblio}->{biblionumber} || $o->{biblio}->biblionumber,
125
                                $o->{startdate},
126
                                $o->{periodicity},
127
                                $o->{numberlength},
128
                                $o->{weeklength},
129
                                $o->{monthlength},
130
                                $o->{lastvalue1},
131
                                $o->{innerloop1},
132
                                $o->{lastvalue2},
133
                                $o->{innerloop2},
134
                                $o->{lastvalue3},
135
                                $o->{innerloop3},
136
                                $o->{status},
137
                                $o->{notes},
138
                                $o->{letter},
139
                                $o->{firstacquidate},
140
                                $o->{irregularity} || '',
141
                                $o->{numberpattern},
142
                                $o->{locale},
143
                                $o->{callnumber},
144
                                $o->{manualhistory},
145
                                $o->{internalnotes},
146
                                $o->{serialsadditems},
147
                                $o->{staffdisplaycount},
148
                                $o->{opacdisplaycount},
149
                                $o->{graceperiod},
150
                                $o->{location},
151
                                $o->{enddate},
152
                                $o->{skip_serialseq}
153
                        );
154
    };
155
    if ($@) {
156
        die $@;
157
    }
158
159
    my $subscription = Koha::Subscriptions->cast( $subscriptionid );
160
    $subscription->periodicity($o->{periodicity});
161
    $subscription->numberpattern($o->{numberpattern});
162
163
    $class->receiveDefaultSerials($subscription, $o->{receiveSerials});
164
165
    return $subscription;
166
}
167
168
=head validateAndPopulateDefaultValues
169
@OVERLOAD
170
171
Validates given Object parameters and makes sure that critical fields are given
172
and populates defaults for missing values.
173
=cut
174
175
sub validateAndPopulateDefaultValues {
176
    my ($self, $object, $hashKey, $stashes) = @_;
177
178
    #Get this year so we can use it to populate always active Objects.
179
    my $now = DateTime->now(time_zone => C4::Context->tz());
180
    my $year = $now->year();
181
182
    if ($object->{librarian}) {
183
        $object->{librarian} = Koha::Patrons->cast($object->{librarian});
184
    }
185
    else {
186
        $object->{librarian} = t::lib::TestObjects::PatronFactory->createTestGroup([
187
                                                        {cardnumber => 'SERIAL420KILLER',
188
                                                         firstname => 'Subscription',
189
                                                         surname => 'Master'}], undef, @$stashes)
190
                                                        ->{SERIAL420KILLER};
191
    }
192
    if ($object->{aqbookseller}) {
193
        $object->{aqbookseller} = Koha::Acquisition::Booksellers->cast($object->{aqbookseller});
194
    }
195
    else {
196
        $object->{aqbookseller} = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([
197
                                                        {}], undef, @$stashes)
198
                                                        ->{'Bookselling Vendor'};
199
    }
200
    if ($object->{biblio}) {
201
        $object->{biblio} = Koha::Biblios->cast($object->{biblio});
202
    }
203
    else {
204
        $object->{biblio} = t::lib::TestObjects::BiblioFactory->createTestGroup([
205
                                    {'biblio.title' => 'Serial magazine',
206
                                     'biblio.author'   => 'Pertti Kurikka',
207
                                     'biblio.copyrightdate' => $year,
208
                                     'biblioitems.isbn'     => 'isbnisnotsocoolnowadays!',
209
                                     'biblioitems.itemtype' => 'CR',
210
                                    },
211
                                ], undef, @$stashes)
212
                                ->{'isbnisnotsocoolnowadays!'};
213
    }
214
    unless ($object->{internalnotes}) {
215
        croak __PACKAGE__.":> Mandatory parameter 'internalnotes' missing. This is used as the returning hash-key!";
216
    }
217
218
    $object->{periodicity}   = 4 unless $object->{periodicity};
219
    $object->{numberpattern} = 2 unless $object->{numberpattern};
220
    $object->{branchcode}    = 'CPL' unless $object->{branchcode};
221
    $object->{cost}          = undef unless $object->{cost};
222
    $object->{aqbudgetid}    = undef unless $object->{aqbudgetid};
223
    $object->{startdate}     = "$year-01-01" unless $object->{startdate};
224
    $object->{numberlength}  = undef unless $object->{numberlength};
225
    $object->{weeklength}    = undef unless $object->{weeklength} || $object->{numberlength};
226
    $object->{monthlength}   = 12 unless $object->{monthlength} || $object->{weeklength} || $object->{numberlength};
227
    $object->{lastvalue1}    = $year unless $object->{lastvalue1};
228
    $object->{innerloop1}    = undef unless $object->{innerloop1};
229
    $object->{lastvalue2}    = 1 unless $object->{lastvalue2};
230
    $object->{innerloop2}    = undef unless $object->{innerloop2};
231
    $object->{lastvalue3}    = 1 unless $object->{lastvalue3};
232
    $object->{innerloop3}    = undef unless $object->{innerloop3};
233
    $object->{status}        = 1 unless $object->{status};
234
    $object->{notes}         = 'Public note' unless $object->{notes};
235
    $object->{letter}        = 'RLIST' unless $object->{letter};
236
    $object->{firstacquidate} = "$year-01-01" unless $object->{firstacquidate};
237
    $object->{irregularity}  = undef unless $object->{irregularity};
238
    $object->{locale}        = undef unless $object->{locale};
239
    $object->{callnumber}    = 'MAG 10.2 AZ' unless $object->{callnumber};
240
    $object->{manualhistory} = 0 unless $object->{manualhistory};
241
    $object->{serialsadditems} = 1 unless $object->{serialsadditems};
242
    $object->{staffdisplaycount} = 20 unless $object->{staffdisplaycount};
243
    $object->{opacdisplaycount} = 20 unless $object->{opacdisplaycount};
244
    $object->{graceperiod}   = 2 unless $object->{graceperiod};
245
    $object->{location}      = 'DISPLAY' unless $object->{location};
246
    $object->{enddate}       = undef unless $object->{enddate};
247
    $object->{skip_serialseq} = 1 unless $object->{skip_serialseq};
248
}
249
250
sub receiveDefaultSerials {
251
    my ($class, $subscription, $receiveSerials, $stashes) = @_;
252
    return unless $receiveSerials;
253
254
    foreach (1..$receiveSerials) {
255
        my ($totalIssues, $waitingSerial) = C4::Serials::GetSerials($subscription->subscriptionid);
256
        C4::Serials::ModSerialStatus($waitingSerial->{serialid},
257
                                     $waitingSerial->{serialseq},
258
                                     Koha::DateUtils::dt_from_string($waitingSerial->{planneddate})->ymd('-'),
259
                                     Koha::DateUtils::dt_from_string($waitingSerial->{publisheddate})->ymd('-'),
260
                                     Koha::DateUtils::dt_from_string($waitingSerial->{publisheddate})->ymd('-'),
261
                                     2, #Status => 2 == Received
262
                                     $waitingSerial->{notes},
263
                                    );
264
        my $item = t::lib::TestObjects::ItemFactory->createTestGroup({ barcode => $waitingSerial->{serialid}."-".Koha::DateUtils::dt_from_string($waitingSerial->{publisheddate})->ymd('-'),
265
                                                                       enumchron => $waitingSerial->{serialseq},
266
                                                                       biblionumber => $subscription->biblionumber,
267
                                                                       homebranch => $subscription->branchcode,
268
                                                                       location => $subscription->location,
269
                                                                    }, undef, @$stashes);
270
        C4::Serials::AddItem2Serial( $waitingSerial->{serialid},
271
                                     $item->itemnumber, );
272
    }
273
}
274
275
=head deleteTestGroup
276
@OVERLOADED
277
278
    my $records = createTestGroup();
279
    ##Do funky stuff
280
    deleteTestGroup($records);
281
282
Removes the given test group from the DB.
283
Also removes all attached serialitems and serials
284
285
=cut
286
287
sub deleteTestGroup {
288
    my ($self, $objects) = @_;
289
290
    my $schema = Koha::Database->new_schema();
291
    while( my ($key, $object) = each %$objects) {
292
        my $subscription = Koha::Subscriptions->cast($object);
293
        eval {
294
            my @serials = $schema->resultset('Serial')->search({subscriptionid => $subscription->subscriptionid});
295
296
            ##Because serialitems-table doesn't have a primary key, resorting to a DBI hack.
297
            my $dbh = C4::Context->dbh();
298
            my $sth_delete_serialitems = $dbh->prepare("DELETE FROM serialitems WHERE serialid = ?");
299
300
            foreach my $s (@serials) {
301
                $sth_delete_serialitems->execute($s->serialid);
302
                $s->delete();
303
            }
304
            $subscription->delete();
305
        };
306
        if ($@) {
307
            die $@;
308
        }
309
    }
310
}
311
312
1;
(-)a/t/lib/TestObjects/SystemPreferenceFactory.pm (+128 lines)
Line 0 Link Here
1
package t::lib::TestObjects::SystemPreferenceFactory;
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 base qw(t::lib::TestObjects::ObjectFactory);
26
27
use Koha::Exception::ObjectExists;
28
29
sub new {
30
    my ($class) = @_;
31
32
    my $self = {};
33
    bless($self, $class);
34
    return $self;
35
}
36
37
sub getDefaultHashKey {
38
    return 'preference';
39
}
40
sub getObjectType {
41
    return 'HASH';
42
}
43
44
=head createTestGroup( $data [, $hashKey, $testContexts...] )
45
@OVERLOADED
46
47
    my $preferences = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([
48
                        {preference => 'ValidateEmailAddress',
49
                         value      => 1,
50
                        },
51
                        {preference => 'ValidatePhoneNumber',
52
                         value      => 'OFF',
53
                        },
54
                    ], undef, $testContext1, $testContext2, $testContext3);
55
56
    #Do test stuff...
57
58
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1);
59
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2);
60
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
61
62
See t::lib::TestObjects::ObjectFactory for more documentation
63
=cut
64
65
sub handleTestObject {
66
    my ($class, $pref, $stashes) = @_;
67
68
    my $preference = $pref->{preference};
69
70
    # Check if preference is already stored, so we wont lose the original preference
71
    my $alreadyStored;
72
    my $stashablePref = $pref;
73
    foreach my $stash (@$stashes) {
74
        if (exists $stash->{systempreference}->{$preference}) {
75
            $alreadyStored = 1;
76
            $stashablePref = $stash->{systempreference}->{$preference};
77
            last();
78
        }
79
    }
80
    $stashablePref->{old_value} = C4::Context->preference($pref->{preference}) unless ($alreadyStored);
81
82
    C4::Context->set_preference($pref->{preference}, $pref->{value});
83
84
    $stashablePref->{value} = $pref->{value};
85
86
    return $stashablePref;
87
}
88
89
=head validateAndPopulateDefaultValues
90
@OVERLOAD
91
92
Validates given Object parameters and makes sure that critical fields are given
93
and populates defaults for missing values.
94
=cut
95
96
sub validateAndPopulateDefaultValues {
97
    my ($class, $preference, $hashKey) = @_;
98
    $class->SUPER::validateAndPopulateDefaultValues($preference, $hashKey);
99
100
    if (not(defined(C4::Context->preference($preference->{preference})))) {
101
        croak __PACKAGE__.":> Preference '".$preference->{preference}."' not found.";
102
        next;
103
    }
104
    unless (exists($preference->{value})) {
105
        croak __PACKAGE__.":> Mandatory parameter 'value' not found.";
106
    }
107
}
108
109
=head deleteTestGroup
110
@OVERLOADED
111
112
    my $records = createTestGroup();
113
    ##Do funky stuff
114
    deleteTestGroup($prefs);
115
116
Removes the given test group from the DB.
117
118
=cut
119
120
sub deleteTestGroup {
121
    my ($class, $preferences) = @_;
122
123
    while( my ($key, $pref) = each %$preferences) {
124
        C4::Context->set_preference($pref->{preference}, $pref->{old_value});
125
    }
126
}
127
128
1;
(-)a/t/lib/TestObjects/t/biblioItemFactory.t (+160 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright KohaSuomi 2016
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 Test::More;
23
24
use t::lib::TestObjects::ItemFactory;
25
use Koha::Items;
26
use t::lib::TestObjects::BiblioFactory;
27
use Koha::Biblios;
28
use C4::Biblio;
29
30
my $marcxml = <<RECORD;
31
<record>
32
  <leader>00510cam a22002054a 4500</leader>
33
  <controlfield tag="001">300841</controlfield>
34
  <controlfield tag="003">KYYTI</controlfield>
35
  <controlfield tag="005">20150216235917.0</controlfield>
36
  <controlfield tag="008">       1988    xxk|||||||||| ||||1|eng|c</controlfield>
37
  <datafield tag="020" ind1=" " ind2=" ">
38
    <subfield code="a">0233982213</subfield>
39
    <subfield code="q">NID.</subfield>
40
  </datafield>
41
  <datafield tag="041" ind1="0" ind2=" ">
42
    <subfield code="a">eng</subfield>
43
    <subfield code="a">vie</subfield>
44
  </datafield>
45
  <datafield tag="084" ind1=" " ind2=" ">
46
    <subfield code="a">85.25</subfield>
47
    <subfield code="2">ykl</subfield>
48
  </datafield>
49
  <datafield tag="245" ind1="1" ind2="4">
50
    <subfield code="a">THE WISHING TREE /</subfield>
51
    <subfield code="c">USHA BAHL.</subfield>
52
  </datafield>
53
  <datafield tag="260" ind1=" " ind2=" ">
54
    <subfield code="c">1990</subfield>
55
  </datafield>
56
  <datafield tag="942" ind1=" " ind2=" ">
57
    <subfield code="c">BK</subfield>
58
    <subfield code="1">1996-05-01 00:00:00</subfield>
59
  </datafield>
60
</record>
61
RECORD
62
63
my $subtestContext = {};
64
subtest "Create biblios from db columns", \&createBibliosFromDBColumns;
65
sub createBibliosFromDBColumns {
66
    ##Create and Delete. Add one
67
    my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([
68
                        {'biblio.title' => 'I wish I met your mother',
69
                         'biblio.author'   => 'Pertti Kurikka',
70
                         'biblio.copyrightdate' => '1960',
71
                         'biblioitems.isbn'     => '9519671580',
72
                         'biblioitems.itemtype' => 'BK',
73
                        },
74
                    ], 'biblioitems.isbn', $subtestContext);
75
    my $objects = t::lib::TestObjects::ItemFactory->createTestGroup([
76
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
77
                         barcode => '167Nabe0001',
78
                         homebranch   => 'CPL',
79
                         holdingbranch => 'CPL',
80
                         price     => '0.50',
81
                         replacementprice => '0.50',
82
                         itype => 'BK',
83
                         biblioisbn => '9519671580',
84
                         itemcallnumber => 'PK 84.2',
85
                        },
86
                    ], 'barcode', $subtestContext);
87
88
    is($objects->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001'.");
89
    ##Add one more to test incrementing the subtestContext.
90
    $objects = t::lib::TestObjects::ItemFactory->createTestGroup([
91
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
92
                         barcode => '167Nabe0002',
93
                         homebranch   => 'CPL',
94
                         holdingbranch => 'FFL',
95
                         price     => '3.50',
96
                         replacementprice => '3.50',
97
                         itype => 'BK',
98
                         biblioisbn => '9519671580',
99
                         itemcallnumber => 'JK 84.2',
100
                        },
101
                    ], 'barcode', $subtestContext);
102
103
    is($subtestContext->{item}->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001' from \$subtestContext.");
104
    is($objects->{'167Nabe0002'}->holdingbranch,           'FFL',         "Item '167Nabe0002'.");
105
    is(ref($biblios->{9519671580}), 'MARC::Record', "Biblio 'I wish I met your mother'.");
106
107
    ##Delete objects
108
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
109
    my $object1 = Koha::Items->find({barcode => '167Nabe0001'});
110
    ok (not($object1), "Item '167Nabe0001' deleted");
111
    my $object2 = Koha::Items->find({barcode => '167Nabe0002'});
112
    ok (not($object2), "Item '167Nabe0002' deleted");
113
    my $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"});
114
    ok (not($object2), "Biblio 'I wish I met your mother' deleted");
115
}
116
117
118
subtest "Create biblios from MARCXML", \&createBibliosFromMARCXML;
119
sub createBibliosFromMARCXML {
120
    my ($record, $biblio);
121
122
    ##Create from a HASH with a reference to MARCXML
123
    $record = t::lib::TestObjects::BiblioFactory->createTestGroup(
124
                                    {record => $marcxml}, 'biblioitems.isbn', $subtestContext);
125
126
    $biblio = C4::Biblio::GetBiblioData($record->{biblionumber});
127
    is($biblio->{title},
128
       'THE WISHING TREE /',
129
       'Title ok');
130
    is($biblio->{copyrightdate},
131
       '1990',
132
       'Copyrightdate ok');
133
134
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
135
136
    $biblio = C4::Biblio::GetBiblioData($record->{biblionumber});
137
    ok(not($biblio),
138
       'Biblio deleted');
139
140
141
    ##Create from a MARCXML scalar
142
    $record = t::lib::TestObjects::BiblioFactory->createTestGroup(
143
                                    $marcxml, 'biblioitems.isbn', $subtestContext);
144
145
    $biblio = C4::Biblio::GetBiblioData($record->{biblionumber});
146
    is($biblio->{title},
147
       'THE WISHING TREE /',
148
       'Title ok');
149
    is($biblio->{copyrightdate},
150
       '1990',
151
       'Copyrightdate ok');
152
153
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
154
155
    $biblio = C4::Biblio::GetBiblioData($record->{biblionumber});
156
    ok(not($biblio),
157
       'Biblio deleted');
158
}
159
160
done_testing();
(-)a/t/lib/TestObjects/t/checkoutFactory.t (+102 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright KohaSuomi 2016
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 t::lib::TestObjects::ItemFactory;
27
use Koha::Items;
28
use t::lib::TestObjects::BiblioFactory;
29
use Koha::Biblios;
30
use t::lib::TestObjects::CheckoutFactory;
31
use Koha::Checkouts;
32
33
my $subtestContext = {};
34
##Create and Delete using dependencies in the $testContext instantiated in previous subtests.
35
my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([
36
                    {'biblio.title' => 'I wish I met your mother',
37
                     'biblio.author'   => 'Pertti Kurikka',
38
                     'biblio.copyrightdate' => '1960',
39
                     'biblioitems.isbn'     => '9519671580',
40
                     'biblioitems.itemtype' => 'BK',
41
                    },
42
                ], 'biblioitems.isbn', $subtestContext);
43
my $items = t::lib::TestObjects::ItemFactory->createTestGroup([
44
                    {biblionumber => $biblios->{9519671580}->{biblionumber},
45
                     barcode => '167Nabe0001',
46
                     homebranch   => 'CPL',
47
                     holdingbranch => 'CPL',
48
                     price     => '0.50',
49
                     replacementprice => '0.50',
50
                     itype => 'BK',
51
                     biblioisbn => '9519671580',
52
                     itemcallnumber => 'PK 84.2',
53
                    },
54
                    {biblionumber => $biblios->{9519671580}->{biblionumber},
55
                     barcode => '167Nabe0002',
56
                     homebranch   => 'CPL',
57
                     holdingbranch => 'FFL',
58
                     price     => '3.50',
59
                     replacementprice => '3.50',
60
                     itype => 'BK',
61
                     biblioisbn => '9519671580',
62
                     itemcallnumber => 'JK 84.2',
63
                    },
64
                ], 'barcode', $subtestContext);
65
my $objects = t::lib::TestObjects::CheckoutFactory->createTestGroup([
66
                {
67
                    cardnumber        => '11A001',
68
                    barcode           => '167Nabe0001',
69
                    daysOverdue       => 7,
70
                    daysAgoCheckedout => 28,
71
                },
72
                {
73
                    cardnumber        => '11A002',
74
                    barcode           => '167Nabe0002',
75
                    daysOverdue       => -7,
76
                    daysAgoCheckedout => 14,
77
                    checkoutBranchRule => 'holdingbranch',
78
                },
79
                ], undef, $subtestContext);
80
81
is($objects->{'11A001-167Nabe0001'}->branchcode,
82
   'CPL',
83
   "Checkout '11A001-167Nabe0001' checked out from the default context branch 'CPL'.");
84
is($objects->{'11A002-167Nabe0002'}->branchcode,
85
   'FFL',
86
   "Checkout '11A002-167Nabe0002' checked out from the holdingbranch 'FFL'.");
87
is(Koha::DateUtils::dt_from_string($objects->{'11A001-167Nabe0001'}->issuedate)->day(),
88
   DateTime->now(time_zone => C4::Context->tz())->subtract(days => '28')->day()
89
   , "Checkout '11A001-167Nabe0001', adjusted issuedates match.");
90
is(Koha::DateUtils::dt_from_string($objects->{'11A002-167Nabe0002'}->date_due)->day(),
91
   DateTime->now(time_zone => C4::Context->tz())->subtract(days => '-7')->day()
92
   , "Checkout '11A002-167Nabe0002', adjusted date_dues match.");
93
94
t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
95
my $object1 = Koha::Checkouts->find({borrowernumber => $objects->{'11A001-167Nabe0001'}->borrowernumber,
96
                                     itemnumber => $objects->{'11A001-167Nabe0001'}->itemnumber});
97
ok (not($object1), "Checkout '11A001-167Nabe0001' deleted");
98
my $object2 = Koha::Checkouts->find({borrowernumber => $objects->{'11A002-167Nabe0002'}->borrowernumber,
99
                                     itemnumber => $objects->{'11A002-167Nabe0002'}->itemnumber});
100
ok (not($object2), "Checkout '11A002-167Nabe0002' deleted");
101
102
done_testing();
(-)a/t/lib/TestObjects/t/fileFactory.t (+75 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright KohaSuomi 2016
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 Test::More;
23
24
use t::lib::TestObjects::FileFactory;
25
use File::Slurp;
26
use File::Fu::File;
27
28
my ($files);
29
my $subtestContext = {};
30
31
$files = t::lib::TestObjects::FileFactory->createTestGroup([
32
                    {'filepath' => 'atomicupdate',
33
                     'filename' => '#30-RabiesIsMyDog.pl',
34
                     'content' => 'print "Mermaids are my only love\nI never let them down";',
35
                    },
36
                    {'filepath' => 'atomicupdate',
37
                     'filename' => '#31-FrogsArePeopleToo.pl',
38
                     'content' => 'print "Listen to the Maker!";',
39
                    },
40
                    {'filepath' => 'atomicupdate',
41
                     'filename' => '#32-AnimalLover.pl',
42
                     'content' => "print 'Do not hurt them!;",
43
                    },
44
                ], undef, $subtestContext);
45
46
my $file30content = File::Slurp::read_file( $files->{'#30-RabiesIsMyDog.pl'}->absolutely );
47
ok($file30content =~ m/Mermaids are my only love/,
48
   "'#30-RabiesIsMyDog.pl' created and content matches");
49
my $file31content = File::Slurp::read_file( $files->{'#31-FrogsArePeopleToo.pl'}->absolutely );
50
ok($file31content =~ m/Listen to the Maker!/,
51
   "'#31-FrogsArePeopleToo.pl' created and content matches");
52
my $file32content = File::Slurp::read_file( $files->{'#32-AnimalLover.pl'}->absolutely );
53
ok($file32content =~ m/Do not hurt them!/,
54
   "'#32-AnimalLover.pl' created and content matches");
55
56
##addToContext() test, create new file
57
my $dir = $files->{'#32-AnimalLover.pl'}->dirname();
58
my $file = File::Fu::File->new("$dir/addToContext.txt");
59
$file->touch;
60
t::lib::TestObjects::FileFactory->addToContext($file, undef, $subtestContext);
61
ok($file->e,
62
   "'addToContext.txt' created");
63
64
t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
65
66
ok(not(-e $files->{'#30-RabiesIsMyDog.pl'}->absolutely),
67
   "'#30-RabiesIsMyDog.pl' deleted");
68
ok(not(-e $files->{'#31-FrogsArePeopleToo.pl'}->absolutely),
69
   "'#31-FrogsArePeopleToo.pl' deleted");
70
ok(not(-e $files->{'#32-AnimalLover.pl'}->absolutely),
71
   "'#32-AnimalLover.pl' deleted");
72
ok(not(-e $file->absolutely),
73
   "'addToContext.txt' deleted");
74
75
done_testing();
(-)a/t/lib/TestObjects/t/finesFactory.t (+76 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright KohaSuomi 2016
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 Test::More;
23
24
use Koha::Patrons;
25
use t::lib::TestObjects::FinesFactory;
26
use C4::Members;
27
28
my $subtestContext = {};
29
30
#Check if the precondition Patron exists, it shouldn't
31
my $borrower = Koha::Patrons->find({cardnumber => '1A23' });
32
ok(not(defined($borrower)), "Fines borrower not defined");
33
34
#Create the Fine
35
my $finesfactory = t::lib::TestObjects::FinesFactory->createTestGroup([{
36
    amount => 10.0,
37
    cardnumber => '1A23',
38
    accounttype => 'FU',
39
    note => 'unique identifier',
40
},
41
42
    ], undef, $subtestContext);
43
44
#Check if the previously non-existent Patron is now autogenerated?
45
$borrower = Koha::Patrons->find({cardnumber => '1A23' });
46
ok($borrower && ref($borrower) eq 'Koha::Patron', "Fines borrower autogenerated");
47
48
# check that the fine exists in accountlines
49
my ($total,$fines,undef) = C4::Members::GetMemberAccountRecords($borrower->borrowernumber);
50
51
my $found_testFine = 0;
52
foreach my $fine (@$fines){
53
    if ($fine->{note} eq 'unique identifier'){
54
        $found_testFine = 1;
55
        last;
56
    }
57
}
58
59
ok($found_testFine, 'Fine \'unique identifier\', accountlines match.');
60
61
# delete the fine
62
t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
63
64
# confirm the deletion
65
($total,$fines,undef) = C4::Members::GetMemberAccountRecords($borrower->borrowernumber);
66
67
$found_testFine = 0;
68
foreach my $fine (@$fines){
69
    if ($fine->{note} eq 'unique identifier'){
70
        $found_testFine = 1;
71
        last;
72
    }
73
}
74
is($found_testFine, 0, 'Fine \'unique identifier\', deleted.');
75
76
done_testing();
(-)a/t/lib/TestObjects/t/holdFactory.t (+76 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright KohaSuomi 2016
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 Test::More;
23
24
use C4::Reserves;
25
use t::lib::TestObjects::HoldFactory;
26
27
my $subtestContext = {};
28
##Create and Delete using dependencies in the $testContext instantiated in previous subtests.
29
my $hold = t::lib::TestObjects::HoldFactory->createTestGroup(
30
                    {cardnumber        => '1A01',
31
                     isbn              => '971',
32
                     barcode           => '1N01',
33
                     branchcode        => 'CPL',
34
                     waitingdate       => '2015-01-15',
35
                    },
36
                    ['cardnumber','isbn','barcode'], $subtestContext);
37
38
is($hold->{branchcode},
39
   'CPL',
40
   "Hold '1A01-971-1N01' pickup location is 'CPL'.");
41
is($hold->{waitingdate},
42
   '2015-01-15',
43
   "Hold '1A01-971-1N01' waiting date is '2015-01-15'.");
44
45
#using the default test hold identifier reservenotes to distinguish hard-to-identify holds.
46
my $holds2 = t::lib::TestObjects::HoldFactory->createTestGroup([
47
                    {cardnumber        => '1A01',
48
                     isbn              => '971',
49
                     barcode           => '1N02',
50
                     branchcode        => 'CPL',
51
                     reservenotes      => 'nice hold',
52
                    },
53
                    {cardnumber        => '1A01',
54
                     barcode           => '1N03',
55
                     isbn              => '971',
56
                     branchcode        => 'CPL',
57
                     reservenotes      => 'better hold',
58
                    },
59
                ], undef, $subtestContext);
60
61
is($holds2->{'nice hold'}->{branchcode},
62
    'CPL',
63
    "Hold 'nice hold' pickup location is 'CPL'.");
64
is($holds2->{'nice hold'}->{borrower}->cardnumber,
65
    '1A01',
66
    "Hold 'nice hold' cardnumber is '1A01'.");
67
is($holds2->{'better hold'}->{isbn},
68
    '971',
69
    "Hold 'better hold' isbn '971'.");
70
71
t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
72
73
my $holds_deleted = Koha::Holds->search({biblionumber => $hold->{biblio}->{biblionumber}});
74
ok (not($holds_deleted->count), "Holds deleted");
75
76
done_testing();
(-)a/t/lib/TestObjects/t/letterTemplateFactory.t (+56 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright KohaSuomi 2016
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 Test::More;
23
24
use t::lib::TestObjects::LetterTemplateFactory;
25
use Koha::Notice::Templates;
26
27
my $testContext = {}; #Gather all created Objects here so we can finally remove them all.
28
my $now = DateTime->now(time_zone => C4::Context->tz());
29
my $year = $now->year();
30
31
my $subtestContext = {};
32
##Create and Delete using dependencies in the $testContext instantiated in previous subtests.
33
my $f = t::lib::TestObjects::LetterTemplateFactory->new();
34
my $hashLT = {letter_id => 'circulation-ODUE1-CPL-print',
35
            module => 'circulation',
36
            code => 'ODUE1',
37
            branchcode => 'CPL',
38
            name => 'Notice1',
39
            is_html => undef,
40
            title => 'Notice1',
41
            message_transport_type => 'print',
42
            content => '<item>Barcode: <<items.barcode>>, bring it back!</item>',
43
        };
44
my $objects = $f->createTestGroup([
45
                $hashLT,
46
                ], undef, $subtestContext);
47
48
my $letterTemplate = Koha::Notice::Templates->find($hashLT);
49
is($objects->{'circulation-ODUE1-CPL-print'}->name, $letterTemplate->name, "LetterTemplate 'circulation-ODUE1-CPL-print'");
50
51
#Delete them
52
t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
53
$letterTemplate = Koha::Notice::Templates->find($hashLT);
54
ok(not(defined($letterTemplate)), "LetterTemplate 'circulation-ODUE1-CPL-print' deleted");
55
56
done_testing();
(-)a/t/lib/TestObjects/t/matcherFactory.t (+146 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright KohaSuomi 2016
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 Test::More;
23
24
use t::lib::TestObjects::MatcherFactory;
25
26
my ($matchers, $matcher, $mp1, $mp2, $reqCheck);
27
my $subtestContext = {};
28
##Create and Delete using dependencies in the $testContext instantiated in previous subtests.
29
$matchers = t::lib::TestObjects::MatcherFactory->createTestGroup([
30
                    {
31
                        code => 'MATCHLORD',
32
                        description => 'I am lord',
33
                        threshold => 1001,
34
                        matchpoints => [
35
                           {
36
                              index       => 'title',
37
                              score       => 500,
38
                              components => [{
39
                                   tag         => '130',
40
                                   subfields   => 'a',
41
                                   offset      => 0,
42
                                   length      => 0,
43
                                   norms       => ['hello'],
44
                              }]
45
                           },
46
                           {
47
                              index       => 'isbn',
48
                              score       => 500,
49
                              components => [{
50
                                   tag         => '020',
51
                                   subfields   => 'a',
52
                                   offset      => 0,
53
                                   length      => 0,
54
                                   norms       => ['isbn'],
55
                              }]
56
                           }
57
                        ],
58
                        required_checks => [{
59
                            source => [{
60
                                tag         => '049',
61
                                subfields   => 'c',
62
                                offset      => 0,
63
                                length      => 0,
64
                                norms       => ['copy'],
65
                            }],
66
                            target => [{
67
                                tag         => '521',
68
                                subfields   => 'a',
69
                                offset      => 0,
70
                                length      => 0,
71
                                norms       => ['paste'],
72
                            }],
73
                        }],
74
                    },
75
                    {} #One with defauĺts
76
                ], undef, $subtestContext);
77
#################
78
## MATCHERLORD ##
79
is($matchers->{MATCHLORD}->code,
80
   'MATCHLORD',
81
   'MATCHLORD');
82
is($matchers->{MATCHLORD}->threshold,
83
   1001,
84
   'threshold 1001');
85
$mp1 = $matchers->{MATCHLORD}->{matchpoints}->[0];
86
is($mp1->{components}->[0]->{tag},
87
   '130',
88
   'matchpoint 130');
89
is($mp1->{components}->[0]->{norms}->[0],
90
   'hello',
91
   'matchpoint hello');
92
$mp2 = $matchers->{MATCHLORD}->{matchpoints}->[1];
93
is($mp2->{components}->[0]->{tag},
94
   '020',
95
   'matchpoint 020');
96
is($mp2->{components}->[0]->{norms}->[0],
97
   'isbn',
98
   'matchpoint isbn');
99
$reqCheck = $matchers->{MATCHLORD}->{'required_checks'}->[0];
100
is($reqCheck->{source_matchpoint}->{components}->[0]->{tag},
101
   '049',
102
   'required checks source matchpoint tag 049');
103
is($reqCheck->{target_matchpoint}->{components}->[0]->{tag},
104
   '521',
105
   'required checks target matchpoint tag 521');
106
107
108
#############
109
## MATCHER ##
110
is($matchers->{MATCHER}->code,
111
   'MATCHER',
112
   'MATCHER');
113
is($matchers->{MATCHER}->threshold,
114
   1000,
115
   'threshold 1000');
116
$mp1 = $matchers->{MATCHER}->{matchpoints}->[0];
117
is($mp1->{components}->[0]->{tag},
118
   '245',
119
   'matchpoint 245');
120
is($mp1->{components}->[0]->{offset},
121
   '0',
122
   'matchpoint 0');
123
$mp2 = $matchers->{MATCHER}->{matchpoints}->[1];
124
is($mp2->{components}->[0]->{tag},
125
   '100',
126
   'matchpoint 020');
127
is($mp2->{components}->[0]->{norms}->[0],
128
   '',
129
   'matchpoint ""');
130
$reqCheck = $matchers->{MATCHER}->{'required_checks'}->[0];
131
is($reqCheck->{source_matchpoint}->{components}->[0]->{tag},
132
   '020',
133
   'required checks source matchpoint tag 020');
134
is($reqCheck->{target_matchpoint}->{components}->[0]->{tag},
135
   '024',
136
   'required checks target matchpoint tag 024');
137
138
139
t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
140
141
$matcher = C4::Matcher->fetch( $matchers->{MATCHER}->{id} );
142
ok(not($matcher), "Matcher MATCHER deleted");
143
$matcher = C4::Matcher->fetch( $matchers->{MATCHLORD}->{id} );
144
ok(not($matcher), "Matcher MATCHLORD deleted");
145
146
done_testing();
(-)a/t/lib/TestObjects/t/messageQueueFactory.t (+79 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright KohaSuomi 2016
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 Test::More;
23
24
use Koha::Patrons;
25
use t::lib::TestObjects::MessageQueueFactory;
26
use C4::Letters;
27
28
my $subtestContext = {};
29
30
my $f = t::lib::TestObjects::PatronFactory->new();
31
my $objects = $f->createTestGroup([
32
                        {firstname => 'Olli-Antti',
33
                         surname   => 'Kivi',
34
                         cardnumber => '1A23',
35
                         branchcode     => 'CPL',
36
                        },
37
                    ], undef, $subtestContext);
38
39
#Create the MessageQueue
40
my $messages = t::lib::TestObjects::MessageQueueFactory->createTestGroup([{
41
    subject => "The quick brown fox",
42
    content => "Jumps over the lazy dog.",
43
    cardnumber => '1A23',
44
    message_transport_type => 'sms',
45
    from_address => '11A001@example.com',
46
},
47
48
    ], undef, $subtestContext);
49
50
# check that the message exists in queue
51
my $queued_messages = C4::Letters->_get_unsent_messages();
52
53
my $found_testMessage = 0;
54
foreach my $message (@$queued_messages){
55
    if ($message->{from_address} eq '11A001@example.com'){
56
        $found_testMessage = 1;
57
        last;
58
    }
59
}
60
61
ok($found_testMessage, 'MessageQueue \'11A001@example.com\', message_queue match.');
62
63
# delete the queued message
64
t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
65
66
# confirm the deletion
67
$queued_messages = C4::Letters->_get_unsent_messages();
68
69
$found_testMessage = 0;
70
foreach my $message (@$queued_messages){
71
    if ($message->{from_address} eq '11A001@example.com'){
72
        $found_testMessage = 1;
73
        last;
74
    }
75
}
76
77
is($found_testMessage, 0, 'MessageQueue \'11A001@example.com\', deleted.');
78
79
done_testing();
(-)a/t/lib/TestObjects/t/objectFactories.t (+575 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright KohaSuomi 2016
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
25
=head
26
27
This is the old objectFactories.t which was split to pieces.
28
Put each TestObjectFactory's tests to its own separate file.
29
30
=cut
31
32
use DateTime;
33
34
use Koha::DateUtils;
35
36
use t::lib::TestObjects::ObjectFactory;
37
use t::lib::TestObjects::Serial::SubscriptionFactory;
38
use Koha::Serials;
39
use Koha::Subscriptions;
40
use t::lib::TestObjects::PatronFactory;
41
use Koha::Patrons;
42
use t::lib::TestObjects::ItemFactory;
43
use Koha::Items;
44
use t::lib::TestObjects::BiblioFactory;
45
use Koha::Biblios;
46
use t::lib::TestObjects::CheckoutFactory;
47
use Koha::Checkouts;
48
use t::lib::TestObjects::LetterTemplateFactory;
49
use Koha::Notice::Templates;
50
use t::lib::TestObjects::FileFactory;
51
use File::Slurp;
52
use File::Fu::File;
53
use t::lib::TestObjects::SystemPreferenceFactory;
54
use t::lib::TestObjects::MessageQueueFactory;
55
use C4::Letters;
56
use t::lib::TestObjects::HoldFactory;
57
use C4::Context;
58
59
60
my $testContext = {}; #Gather all created Objects here so we can finally remove them all.
61
my $now = DateTime->now(time_zone => C4::Context->tz());
62
my $year = $now->year();
63
64
65
########## SubscriptionFactory subtests ##########
66
subtest "t::lib::TestObjects::SubscriptionFactory" => \&testSubscriptionFactory;
67
sub testSubscriptionFactory {
68
    my $subtestContext = {};
69
    my $biblionumber; #Get the biblionumber the test Subscription is for.
70
71
    eval {
72
    my $subscription = t::lib::TestObjects::Serial::SubscriptionFactory->createTestGroup(
73
                                                   {internalnotes => 'TSUB1',
74
                                                    receiveSerials => 5,
75
                                                    staffdisplaycount => 10,
76
                                                    opacdisplaycount => 15,
77
                                                   },
78
                                                    undef, $subtestContext);
79
    $biblionumber = $subscription->biblionumber;
80
81
    C4::Context->interface('opac');
82
    is($subscription->opacdisplaycount,
83
       15,
84
       "Get opacdisplaycount.");
85
    C4::Context->interface('opac');
86
    is($subscription->staffdisplaycount,
87
       10,
88
       "Get staffdisplaycount.");
89
90
    my $serials = Koha::Serials->search({
91
        subscriptionid => $subscription->subscriptionid
92
    })->as_list;
93
    ok($serials->[0]->serialseq_x == $year &&
94
       $serials->[0]->serialseq_y == 1 &&
95
       $serials->[0]->serialseq_z == 1,
96
       "Patterns x,y,z set for the first serial.");
97
    ok($serials->[2]->serialseq_x == $year &&
98
       $serials->[2]->serialseq_y == 1 &&
99
       $serials->[2]->serialseq_z == 3,
100
       "Patterns x,y,z set for the third serial.");
101
    ok($serials->[4]->serialseq_x == $year &&
102
       $serials->[4]->serialseq_y == 2 &&
103
       $serials->[4]->serialseq_z == 1,
104
       "Patterns x,y,z set for the fifth serial.");
105
106
    my @items = Koha::Items->search({biblionumber => $biblionumber});
107
    is(scalar(@items), 5, "Created Items while receiving Serials");
108
    };
109
    if ($@) {
110
        ok(0, "Subtest crashed with error:\n$@\n");
111
    }
112
113
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
114
115
    my @items = Koha::Items->search({biblionumber => $biblionumber});
116
    is(scalar(@items), 0, "Created Items torn down");
117
}
118
119
120
121
########## HoldFactory subtests ##########
122
subtest 't::lib::TestObjects::HoldFactory' => \&testHoldFactory;
123
sub testHoldFactory {
124
    my $subtestContext = {};
125
    ##Create and Delete using dependencies in the $testContext instantiated in previous subtests.
126
    my $hold = t::lib::TestObjects::HoldFactory->createTestGroup(
127
                        {cardnumber        => '1A01',
128
                         isbn              => '971',
129
                         barcode           => '1N01',
130
                         branchcode        => 'CPL',
131
                         waitingdate       => '2015-01-15',
132
                        },
133
                        ['cardnumber','isbn','barcode'], $subtestContext);
134
135
    is($hold->{branchcode},
136
       'CPL',
137
       "Hold '1A01-971-1N01' pickup location is 'CPL'.");
138
    is($hold->{waitingdate},
139
       '2015-01-15',
140
       "Hold '1A01-971-1N01' waiting date is '2015-01-15'.");
141
142
    #using the default test hold identifier reservenotes to distinguish hard-to-identify holds.
143
    my $holds2 = t::lib::TestObjects::HoldFactory->createTestGroup([
144
                        {cardnumber        => '1A01',
145
                         isbn              => '971',
146
                         barcode           => '1N02',
147
                         branchcode        => 'CPL',
148
                         reservenotes      => 'nice hold',
149
                        },
150
                        {cardnumber        => '1A01',
151
                         barcode           => '1N03',
152
                         isbn              => '971',
153
                         branchcode        => 'CPL',
154
                         reservenotes      => 'better hold',
155
                        },
156
                    ], undef, $subtestContext);
157
158
    is($holds2->{'nice hold'}->{branchcode},
159
        'CPL',
160
        "Hold 'nice hold' pickup location is 'CPL'.");
161
    is($holds2->{'nice hold'}->{borrower}->cardnumber,
162
        '1A01',
163
        "Hold 'nice hold' cardnumber is '1A01'.");
164
    is($holds2->{'better hold'}->{isbn},
165
        '971',
166
        "Hold 'better hold' isbn '971'.");
167
168
    t::lib::TestObjects::HoldFactory->deleteTestGroup($subtestContext->{hold});
169
170
    my $holds_deleted = Koha::Holds->search({biblionumber => $hold->{biblio}->{biblionumber}});
171
    ok (not($holds_deleted->count), "Holds deleted");
172
};
173
174
175
176
########## FileFactory subtests ##########
177
subtest 't::lib::TestObjects::FileFactory' => \&testFileFactory;
178
sub testFileFactory {
179
    my ($files);
180
    my $subtestContext = {};
181
182
    $files = t::lib::TestObjects::FileFactory->createTestGroup([
183
                        {'filepath' => 'atomicupdate',
184
                         'filename' => '#30-RabiesIsMyDog.pl',
185
                         'content' => 'print "Mermaids are my only love\nI never let them down";',
186
                        },
187
                        {'filepath' => 'atomicupdate',
188
                         'filename' => '#31-FrogsArePeopleToo.pl',
189
                         'content' => 'print "Listen to the Maker!";',
190
                        },
191
                        {'filepath' => 'atomicupdate',
192
                         'filename' => '#32-AnimalLover.pl',
193
                         'content' => "print 'Do not hurt them!;",
194
                        },
195
                    ], undef, $subtestContext);
196
197
    my $file30content = File::Slurp::read_file( $files->{'#30-RabiesIsMyDog.pl'}->absolutely );
198
    ok($file30content =~ m/Mermaids are my only love/,
199
       "'#30-RabiesIsMyDog.pl' created and content matches");
200
    my $file31content = File::Slurp::read_file( $files->{'#31-FrogsArePeopleToo.pl'}->absolutely );
201
    ok($file31content =~ m/Listen to the Maker!/,
202
       "'#31-FrogsArePeopleToo.pl' created and content matches");
203
    my $file32content = File::Slurp::read_file( $files->{'#32-AnimalLover.pl'}->absolutely );
204
    ok($file32content =~ m/Do not hurt them!/,
205
       "'#32-AnimalLover.pl' created and content matches");
206
207
    ##addToContext() test, create new file
208
    my $dir = $files->{'#32-AnimalLover.pl'}->dirname();
209
    my $file = File::Fu::File->new("$dir/addToContext.txt");
210
    $file->touch;
211
    t::lib::TestObjects::FileFactory->addToContext($file, undef, $subtestContext);
212
    ok($file->e,
213
       "'addToContext.txt' created");
214
215
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
216
217
    ok(not(-e $files->{'#30-RabiesIsMyDog.pl'}->absolutely),
218
       "'#30-RabiesIsMyDog.pl' deleted");
219
    ok(not(-e $files->{'#31-FrogsArePeopleToo.pl'}->absolutely),
220
       "'#31-FrogsArePeopleToo.pl' deleted");
221
    ok(not(-e $files->{'#32-AnimalLover.pl'}->absolutely),
222
       "'#32-AnimalLover.pl' deleted");
223
    ok(not(-e $file->absolutely),
224
       "'addToContext.txt' deleted");
225
};
226
227
228
229
########## PatronFactory subtests ##########
230
subtest 't::lib::TestObjects::PatronFactory' => \&testPatronFactory;
231
sub testPatronFactory {
232
    my $subtestContext = {};
233
    ##Create and Delete. Add one
234
    my $f = t::lib::TestObjects::PatronFactory->new();
235
    my $objects = $f->createTestGroup([
236
                        {firstname => 'Olli-Antti',
237
                         surname   => 'Kivi',
238
                         cardnumber => '11A001',
239
                         branchcode     => 'CPL',
240
                        },
241
                    ], undef, $subtestContext, undef, $testContext);
242
    is($objects->{'11A001'}->cardnumber, '11A001', "Patron '11A001'.");
243
    ##Add one more to test incrementing the subtestContext.
244
    $objects = $f->createTestGroup([
245
                        {firstname => 'Olli-Antti2',
246
                         surname   => 'Kivi2',
247
                         cardnumber => '11A002',
248
                         branchcode     => 'FFL',
249
                        },
250
                    ], undef, $subtestContext, undef, $testContext);
251
    is($subtestContext->{patron}->{'11A001'}->cardnumber, '11A001', "Patron '11A001' from \$subtestContext."); #From subtestContext
252
    is($objects->{'11A002'}->branchcode,                     'FFL',    "Patron '11A002'."); #from just created hash.
253
254
    ##Delete objects
255
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
256
    foreach my $cn (('11A001', '11A002')) {
257
        ok (not(Koha::Patrons->find({cardnumber => $cn})),
258
            "Patron '11A001' deleted");
259
    }
260
261
    #Prepare for global autoremoval.
262
    $objects = $f->createTestGroup([
263
                        {firstname => 'Olli-Antti',
264
                         surname   => 'Kivi',
265
                         cardnumber => '11A001',
266
                         branchcode     => 'CPL',
267
                        },
268
                        {firstname => 'Olli-Antti2',
269
                         surname   => 'Kivi2',
270
                         cardnumber => '11A002',
271
                         branchcode     => 'FFL',
272
                        },
273
                    ], undef, undef, undef, $testContext);
274
};
275
276
277
278
########## BiblioFactory and ItemFactory subtests ##########
279
subtest 't::lib::TestObjects::BiblioFactory and ::ItemFactory' => \&testBiblioItemFactories;
280
sub testBiblioItemFactories {
281
    my $subtestContext = {};
282
    ##Create and Delete. Add one
283
    my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([
284
                        {'biblio.title' => 'I wish I met your mother',
285
                         'biblio.author'   => 'Pertti Kurikka',
286
                         'biblio.copyrightdate' => '1960',
287
                         'biblioitems.isbn'     => '9519671580',
288
                         'biblioitems.itemtype' => 'BK',
289
                        },
290
                    ], 'biblioitems.isbn', $subtestContext, undef, $testContext);
291
    my $objects = t::lib::TestObjects::ItemFactory->createTestGroup([
292
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
293
                         barcode => '167Nabe0001',
294
                         homebranch   => 'CPL',
295
                         holdingbranch => 'CPL',
296
                         price     => '0.50',
297
                         replacementprice => '0.50',
298
                         itype => 'BK',
299
                         biblioisbn => '9519671580',
300
                         itemcallnumber => 'PK 84.2',
301
                        },
302
                    ], 'barcode', $subtestContext, undef, $testContext);
303
304
    is($objects->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001'.");
305
    ##Add one more to test incrementing the subtestContext.
306
    $objects = t::lib::TestObjects::ItemFactory->createTestGroup([
307
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
308
                         barcode => '167Nabe0002',
309
                         homebranch   => 'CPL',
310
                         holdingbranch => 'FFL',
311
                         price     => '3.50',
312
                         replacementprice => '3.50',
313
                         itype => 'BK',
314
                         biblioisbn => '9519671580',
315
                         itemcallnumber => 'JK 84.2',
316
                        },
317
                    ], 'barcode', $subtestContext, undef, $testContext);
318
319
    is($subtestContext->{item}->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001' from \$subtestContext.");
320
    is($objects->{'167Nabe0002'}->holdingbranch,           'FFL',         "Item '167Nabe0002'.");
321
    is(ref($biblios->{9519671580}), 'MARC::Record', "Biblio 'I wish I met your mother'.");
322
323
    ##Delete objects
324
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
325
    my $object1 = Koha::Items->find({barcode => '167Nabe0001'});
326
    ok (not($object1), "Item '167Nabe0001' deleted");
327
    my $object2 = Koha::Items->find({barcode => '167Nabe0002'});
328
    ok (not($object2), "Item '167Nabe0002' deleted");
329
    my $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"});
330
    ok (not($object2), "Biblio 'I wish I met your mother' deleted");
331
};
332
333
334
335
########## CheckoutFactory subtests ##########
336
subtest 't::lib::TestObjects::CheckoutFactory' => \&testCheckoutFactory;
337
sub testCheckoutFactory {
338
    my $subtestContext = {};
339
    ##Create and Delete using dependencies in the $testContext instantiated in previous subtests.
340
    my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([
341
                        {'biblio.title' => 'I wish I met your mother',
342
                         'biblio.author'   => 'Pertti Kurikka',
343
                         'biblio.copyrightdate' => '1960',
344
                         'biblioitems.isbn'     => '9519671580',
345
                         'biblioitems.itemtype' => 'BK',
346
                        },
347
                    ], 'biblioitems.isbn', undef, undef, $subtestContext);
348
    my $items = t::lib::TestObjects::ItemFactory->createTestGroup([
349
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
350
                         barcode => '167Nabe0001',
351
                         homebranch   => 'CPL',
352
                         holdingbranch => 'CPL',
353
                         price     => '0.50',
354
                         replacementprice => '0.50',
355
                         itype => 'BK',
356
                         biblioisbn => '9519671580',
357
                         itemcallnumber => 'PK 84.2',
358
                        },
359
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
360
                         barcode => '167Nabe0002',
361
                         homebranch   => 'CPL',
362
                         holdingbranch => 'FFL',
363
                         price     => '3.50',
364
                         replacementprice => '3.50',
365
                         itype => 'BK',
366
                         biblioisbn => '9519671580',
367
                         itemcallnumber => 'JK 84.2',
368
                        },
369
                    ], 'barcode', undef, undef, $subtestContext);
370
    my $objects = t::lib::TestObjects::CheckoutFactory->createTestGroup([
371
                    {
372
                        cardnumber        => '11A001',
373
                        barcode           => '167Nabe0001',
374
                        daysOverdue       => 7,
375
                        daysAgoCheckedout => 28,
376
                    },
377
                    {
378
                        cardnumber        => '11A002',
379
                        barcode           => '167Nabe0002',
380
                        daysOverdue       => -7,
381
                        daysAgoCheckedout => 14,
382
                        checkoutBranchRule => 'holdingbranch',
383
                    },
384
                    ], undef, undef, undef, undef);
385
386
    is($objects->{'11A001-167Nabe0001'}->branchcode,
387
       'CPL',
388
       "Checkout '11A001-167Nabe0001' checked out from the default context branch 'CPL'.");
389
    is($objects->{'11A002-167Nabe0002'}->branchcode,
390
       'FFL',
391
       "Checkout '11A002-167Nabe0002' checked out from the holdingbranch 'FFL'.");
392
    is(Koha::DateUtils::dt_from_string($objects->{'11A001-167Nabe0001'}->issuedate)->day(),
393
       DateTime->now(time_zone => C4::Context->tz())->subtract(days => '28')->day()
394
       , "Checkout '11A001-167Nabe0001', adjusted issuedates match.");
395
    is(Koha::DateUtils::dt_from_string($objects->{'11A002-167Nabe0002'}->date_due)->day(),
396
       DateTime->now(time_zone => C4::Context->tz())->subtract(days => '-7')->day()
397
       , "Checkout '11A002-167Nabe0002', adjusted date_dues match.");
398
399
    t::lib::TestObjects::CheckoutFactory->deleteTestGroup($objects);
400
    my $object1 = Koha::Checkouts->find({borrowernumber => $objects->{'11A001-167Nabe0001'}->borrowernumber,
401
                                         itemnumber => $objects->{'11A001-167Nabe0001'}->itemnumber});
402
    ok (not($object1), "Checkout '11A001-167Nabe0001' deleted");
403
    my $object2 = Koha::Checkouts->find({borrowernumber => $objects->{'11A002-167Nabe0002'}->borrowernumber,
404
                                         itemnumber => $objects->{'11A002-167Nabe0002'}->itemnumber});
405
    ok (not($object2), "Checkout '11A002-167Nabe0002' deleted");
406
};
407
408
409
410
########## LetterTemplateFactory subtests ##########
411
subtest 't::lib::TestObjects::LetterTemplateFactory' => \&testLetterTemplateFactory;
412
sub testLetterTemplateFactory {
413
    my $subtestContext = {};
414
    ##Create and Delete using dependencies in the $testContext instantiated in previous subtests.
415
    my $f = t::lib::TestObjects::LetterTemplateFactory->new();
416
    my $hashLT = {letter_id => 'circulation-ODUE1-CPL-print',
417
                module => 'circulation',
418
                code => 'ODUE1',
419
                branchcode => 'CPL',
420
                name => 'Notice1',
421
                is_html => undef,
422
                title => 'Notice1',
423
                message_transport_type => 'print',
424
                content => '<item>Barcode: <<items.barcode>>, bring it back!</item>',
425
            };
426
    my $objects = $f->createTestGroup([
427
                    $hashLT,
428
                    ], undef, undef, undef, undef);
429
430
    my $letterTemplate = Koha::Notice::Templates->find($hashLT);
431
    is($objects->{'circulation-ODUE1-CPL-print'}->name, $letterTemplate->name, "LetterTemplate 'circulation-ODUE1-CPL-print'");
432
433
    #Delete them
434
    $f->deleteTestGroup($objects);
435
    $letterTemplate = Koha::Notice::Templates->find($hashLT);
436
    ok(not(defined($letterTemplate)), "LetterTemplate 'circulation-ODUE1-CPL-print' deleted");
437
};
438
439
440
441
########## SystemPreferenceFactory subtests ##########
442
subtest 't::lib::TestObjects::SystemPreferenceFactory' => \&testSystemPreferenceFactory;
443
sub testSystemPreferenceFactory {
444
    my $subtestContext = {};
445
446
    # take syspref 'opacuserlogin' and save its current value
447
    my $current_pref_value = C4::Context->preference("opacuserlogin");
448
449
    is($current_pref_value, $current_pref_value, "System Preference 'opacuserlogin' original value '".(($current_pref_value) ? $current_pref_value : 0)."'");
450
451
    # reverse the value for testing
452
    my $pref_new_value = !$current_pref_value || 0;
453
454
    my $objects = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([
455
                    {preference => 'opacuserlogin',
456
                    value      => $pref_new_value # set the reversed value
457
                    },
458
                    ], undef, $subtestContext, undef, undef);
459
460
    is(C4::Context->preference("opacuserlogin"), $pref_new_value, "System Preference opacuserlogin reversed to '".(($pref_new_value) ? $pref_new_value:0)."'");
461
462
    # let's change it again to test that only the original preference value is saved
463
    $objects = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([
464
            {preference => 'opacuserlogin',
465
             value      => 2 # set the reversed value
466
            },
467
            ], undef, $subtestContext, undef, undef);
468
469
    is(C4::Context->preference("opacuserlogin"), 2, "System Preference opacuserlogin set to '2'");
470
471
    #Delete them
472
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
473
    is(C4::Context->preference("opacuserlogin"), $current_pref_value, "System Preference opacuserlogin restored to '".(($current_pref_value) ? $current_pref_value:0)."' after test group deletion");
474
};
475
476
477
478
########## MessageQueueFactory subtests ##########
479
subtest 't::lib::TestObjects::MessageQueueFactory' => \&testMessageQueueFactory;
480
sub testMessageQueueFactory {
481
    my $subtestContext = {};
482
483
    #Check if the precondition Patron exists, it shouldn't
484
    my $f = t::lib::TestObjects::PatronFactory->new();
485
    my $objects = $f->createTestGroup([
486
                        {firstname => 'Olli-Antti',
487
                         surname   => 'Kivi',
488
                         cardnumber => '1A23',
489
                         branchcode     => 'CPL',
490
                        },
491
                    ], undef, $subtestContext, undef, $testContext);
492
493
    #Create the MessageQueue
494
    my $messages = t::lib::TestObjects::MessageQueueFactory->createTestGroup([{
495
        subject => "The quick brown fox",
496
        content => "Jumps over the lazy dog.",
497
        cardnumber => '1A23',
498
        message_transport_type => 'sms',
499
        from_address => '11A001@example.com',
500
    },
501
502
        ], undef, $subtestContext);
503
504
    # check that the message exists in queue
505
    my $queued_messages = C4::Letters->_get_unsent_messages();
506
507
    my $found_testMessage = 0;
508
    foreach my $message (@$queued_messages){
509
        if ($message->{from_address} eq '11A001@example.com'){
510
            $found_testMessage = 1;
511
            last;
512
        }
513
    }
514
515
    ok($found_testMessage, 'MessageQueue \'11A001@example.com\', message_queue match.');
516
517
    # delete the queued message
518
    t::lib::TestObjects::MessageQueueFactory->deleteTestGroup($messages);
519
520
    # confirm the deletion
521
    $queued_messages = C4::Letters->_get_unsent_messages();
522
523
    $found_testMessage = 0;
524
    foreach my $message (@$queued_messages){
525
        if ($message->{from_address} eq '11A001@example.com'){
526
            $found_testMessage = 1;
527
            last;
528
        }
529
    }
530
531
    is($found_testMessage, 0, 'MessageQueue \'11A001@example.com\', deleted.');
532
533
    #Delete them
534
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
535
};
536
537
538
539
########## Global test context subtests ##########
540
subtest 't::lib::TestObjects::ObjectFactory clearing global test context' => \&testGlobalSubtestContext;
541
sub testGlobalSubtestContext {
542
    my $object11A001 = Koha::Patrons->find({cardnumber => '11A001'});
543
    ok ($object11A001, "Global Patron '11A001' exists");
544
    my $object11A002 = Koha::Patrons->find({cardnumber => '11A002'});
545
    ok ($object11A002, "Global Patron '11A002' exists");
546
547
    my $object1 = Koha::Items->find({barcode => '167Nabe0001'});
548
    ok ($object1, "Global Item '167Nabe0001' exists");
549
    my $object2 = Koha::Items->find({barcode => '167Nabe0002'});
550
    ok ($object2, "Global Item '167Nabe0002' exists");
551
    my $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"});
552
    ok ($object2, "Global Biblio 'I wish I met your mother' exists");
553
554
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext);
555
556
    $object11A001 = Koha::Patrons->find({cardnumber => '11A001'});
557
    ok (not($object11A001), "Global Patron '11A001' deleted");
558
    $object11A002 = Koha::Patrons->find({cardnumber => '11A002'});
559
    ok (not($object11A002), "Global Patron '11A002' deleted");
560
561
    $object1 = Koha::Items->find({barcode => '167Nabe0001'});
562
    ok (not($object1), "Global Item '167Nabe0001' deleted");
563
    $object2 = Koha::Items->find({barcode => '167Nabe0002'});
564
    ok (not($object2), "Global Item '167Nabe0002' deleted");
565
    $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"});
566
    ok (not($object2), "Global Biblio 'I wish I met your mother' deleted");
567
};
568
569
570
571
done_testing();
572
=cut
573
574
ok(1,"TODO:: Write test context interaction tests");
575
done_testing();
(-)a/t/lib/TestObjects/t/patronFactory.t (+56 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright KohaSuomi 2016
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 Test::More;
23
24
use t::lib::TestObjects::PatronFactory;
25
use Koha::Patrons;
26
27
my $subtestContext = {};
28
##Create and Delete. Add one
29
my $f = t::lib::TestObjects::PatronFactory->new();
30
my $objects = $f->createTestGroup([
31
                    {firstname => 'Olli-Antti',
32
                     surname   => 'Kivi',
33
                     cardnumber => '11A001',
34
                     branchcode     => 'CPL',
35
                    },
36
                ], undef, $subtestContext);
37
is($objects->{'11A001'}->cardnumber, '11A001', "Patron '11A001'.");
38
##Add one more to test incrementing the subtestContext.
39
$objects = $f->createTestGroup([
40
                    {firstname => 'Olli-Antti2',
41
                     surname   => 'Kivi2',
42
                     cardnumber => '11A002',
43
                     branchcode     => 'FFL',
44
                    },
45
                ], undef, $subtestContext);
46
is($subtestContext->{patron}->{'11A001'}->cardnumber, '11A001', "Patron '11A001' from \$subtestContext."); #From subtestContext
47
is($objects->{'11A002'}->branchcode,                  'FFL',    "Patron '11A002'."); #from just created hash.
48
49
##Delete objects
50
t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
51
foreach my $cn (('11A001', '11A002')) {
52
    ok (not(Koha::Patrons->find({cardnumber => $cn})),
53
        "Patron '11A001' deleted");
54
}
55
56
done_testing();
(-)a/t/lib/TestObjects/t/systemPreferenceFactory.t (-1 / +58 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright KohaSuomi 2016
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 Test::More;
23
24
use t::lib::TestObjects::SystemPreferenceFactory;
25
use C4::Context;
26
27
my $subtestContext = {};
28
29
# take syspref 'opacuserlogin' and save its current value
30
my $current_pref_value = C4::Context->preference("opacuserlogin");
31
32
is($current_pref_value, $current_pref_value, "System Preference 'opacuserlogin' original value '".(($current_pref_value) ? $current_pref_value : 0)."'");
33
34
# reverse the value for testing
35
my $pref_new_value = !$current_pref_value || 0;
36
37
my $objects = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([
38
                {preference => 'opacuserlogin',
39
                value      => $pref_new_value # set the reversed value
40
                },
41
                ], undef, $subtestContext, undef, undef);
42
43
is(C4::Context->preference("opacuserlogin"), $pref_new_value, "System Preference opacuserlogin reversed to '".(($pref_new_value) ? $pref_new_value:0)."'");
44
45
# let's change it again to test that only the original preference value is saved
46
$objects = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([
47
        {preference => 'opacuserlogin',
48
         value      => 2 # set the reversed value
49
        },
50
        ], undef, $subtestContext, undef, undef);
51
52
is(C4::Context->preference("opacuserlogin"), 2, "System Preference opacuserlogin set to '2'");
53
54
#Delete them
55
t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
56
is(C4::Context->preference("opacuserlogin"), $current_pref_value, "System Preference opacuserlogin restored to '".(($current_pref_value) ? $current_pref_value:0)."' after test group deletion");
57
58
done_testing();

Return to bug 13906