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

(-)a/t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm (+150 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
42
=head createTestGroup( $data [, $hashKey, $testContexts...] )
43
@OVERLOADED
44
45
    my $contacts = t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->createTestGroup([
46
                        {acqprimary     => 1,                     #DEFAULT
47
                         claimissues    => 1,                     #DEFAULT
48
                         claimacquisition => 1,                   #DEFAULT
49
                         serialsprimary => 1,                     #DEFAULT
50
                         position       => 'Boss',                #DEFAULT
51
                         phone          => '+358700123123',       #DEFAULT
52
                         notes          => 'Noted',               #DEFAULT
53
                         name           => "Julius Augustus Caesar", #DEFAULT
54
                         fax            => '+358700123123',       #DEFAULT
55
                         email          => 'vendor@example.com',  #DEFAULT
56
                         booksellerid   => 12124                  #MANDATORY to link to Bookseller
57
                         #id => #Don't use id, since we are just adding a new one
58
                        },
59
                        {...},
60
                    ], undef, $testContext1, $testContext2, $testContext3);
61
62
    #Do test stuff...
63
64
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
65
66
The HASH is keyed with the given $hashKey or 'koha.aqcontacts.name'
67
See C4::Bookseller::Contact->new() for how the table columns need to be given.
68
69
@PARAM1 ARRAYRef of HASHRefs of VendorContact parameters.
70
@PARAM2 koha.aqcontacs-column which is used as the test context HASH key,
71
                defaults to the most best option 'name'.
72
@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple
73
                test contexts. Usually one is enough. These test contexts are
74
                used to help tear down DB changes.
75
@RETURNS HASHRef of $hashKey => object:
76
77
See t::lib::TestObjects::ObjectFactory for more documentation
78
=cut
79
80
sub handleTestObject {
81
    my ($class, $object, $stashes) = @_;
82
83
    my $contact = Koha::Acquisition::Bookseller::Contact->new();
84
    $contact->set($object);
85
    $contact->store();
86
    #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.
87
    my @contacts = Koha::Acquisition::Bookseller::Contacts->search($object);
88
    if (scalar(@contacts)) {
89
        $contact = $contacts[0];
90
    }
91
    else {
92
        die "No Contact added to DB. Fix me to autorecover from this error!";
93
    }
94
95
    return $contact;
96
}
97
98
=head validateAndPopulateDefaultValues
99
@OVERLOAD
100
101
Validates given Object parameters and makes sure that critical fields are given
102
and populates defaults for missing values.
103
=cut
104
105
sub validateAndPopulateDefaultValues {
106
    my ($self, $object, $hashKey) = @_;
107
108
    $object->{acqprimary}     = 1 unless $object->{acqprimary};
109
    $object->{claimissues}    = 1 unless $object->{claimissues};
110
    $object->{claimacquisition} = 1 unless $object->{claimacquisition};
111
    $object->{serialsprimary} = 1 unless $object->{serialsprimary};
112
    $object->{position}       = 'Boss' unless $object->{position};
113
    $object->{phone}          = '+358700123123' unless $object->{phone};
114
    $object->{notes}          = 'Noted' unless $object->{notes};
115
    $object->{name}           = "Julius Augustus Caesar" unless $object->{name};
116
    $object->{fax}            = '+358700123123' unless $object->{fax};
117
    $object->{email}          = 'vendor@example.com' unless $object->{email};
118
    $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey);
119
}
120
121
=head deleteTestGroup
122
@OVERLOADED
123
124
    my $records = createTestGroup();
125
    ##Do funky stuff
126
    deleteTestGroup($records);
127
128
Removes the given test group from the DB.
129
130
=cut
131
132
sub deleteTestGroup {
133
    my ($self, $objects) = @_;
134
135
    while( my ($key, $object) = each %$objects) {
136
        my $contact = Koha::Acquisition::Bookseller::Contacts->cast($object);
137
        eval {
138
            #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them.
139
            my @contacts = Koha::Acquisition::Bookseller::Contacts->search({name => $contact->name});
140
            foreach my $c (@contacts) {
141
                $c->delete();
142
            }
143
        };
144
        if ($@) {
145
            die $@;
146
        }
147
    }
148
}
149
150
1;
(-)a/t/lib/TestObjects/Acquisition/BooksellerFactory.pm (+173 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::Bookseller2;
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
42
=head createTestGroup( $data [, $hashKey, $testContexts...] )
43
@OVERLOADED
44
45
    my $booksellers = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([
46
                        {url => 'www.muscle.com',
47
                         name => 'Bookselling Vendor',
48
                         postal   => 'post',
49
                         phone => '+358700123123',
50
                         notes     => 'Notes',
51
                         listprice => 'EUR',
52
                         listincgst => 0,
53
                         invoiceprice => 'EUR',
54
                         invoiceincgst => 0,
55
                         gstreg => 1,
56
                         gstrate => 0,
57
                         fax => '+358700123123',
58
                         discount => 10,
59
                         deliverytime => 2,
60
                         address1 => 'Where I am',
61
                         active => 1,
62
                         accountnumber => 'IBAN 123456789 FI',
63
                         contacts => [{#Parameters for Koha::Acquisition::Bookseller},
64
                                      {#DEFAULT is to use ContactFactory's default values}],
65
                        },
66
                        {...},
67
                    ], undef, $testContext1, $testContext2, $testContext3);
68
69
    #Do test stuff...
70
71
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
72
73
The HASH is keyed with the given $hashKey or 'koha.aqbookseller.name'
74
75
@PARAM1 ARRAYRef of HASHRefs
76
@PARAM2 koha.aqbookseller-column which is used as the test context HASH key,
77
                defaults to the most best option 'name'.
78
@PARAM3-5 HASHRef of test contexts. You can save the given borrowers to multiple
79
                test contexts. Usually one is enough. These test contexts are
80
                used to help tear down DB changes.
81
@RETURNS HASHRef of $hashKey => Objects:
82
83
See t::lib::TestObjects::ObjectFactory for more documentation
84
=cut
85
86
sub handleTestObject {
87
    my ($class, $object, $stashes) = @_;
88
89
    my $contacts = $object->{contacts};
90
    delete $object->{contacts};
91
92
    my $bookseller = Koha::Acquisition::Bookseller2->new();
93
    $bookseller->set($object);
94
    $bookseller->store();
95
    #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.
96
    my @booksellers = Koha::Acquisition::Booksellers->search($object);
97
    if (scalar(@booksellers)) {
98
        $bookseller = $booksellers[0];
99
    }
100
    else {
101
        die "No Bookseller added to DB. Fix me to autorecover from this error!";
102
    }
103
104
    foreach my $c (@$contacts) {
105
        $c->{booksellerid} = $bookseller->id;
106
    }
107
    $bookseller->{contacts} = t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->createTestGroup($contacts, undef, @$stashes);
108
109
    return $bookseller;
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 ($self, $object, $hashKey) = @_;
121
122
    $object->{url} = 'www.muscle.com' unless $object->{url};
123
    $object->{postal} = 'post' unless $object->{postal};
124
    $object->{phone} = '+358700123123' unless $object->{phone};
125
    $object->{notes} = 'Notes' unless $object->{notes};
126
    $object->{name} = 'Bookselling Vendor' unless $object->{name};
127
    $object->{listprice} = 'EUR' unless $object->{listprice};
128
    $object->{listincgst} = 0 unless $object->{listincgst};
129
    $object->{invoiceprice} = 'EUR' unless $object->{invoiceprice};
130
    $object->{invoiceincgst} = 0 unless $object->{invoiceincgst};
131
    $object->{gstreg} = 1 unless $object->{gstreg};
132
    $object->{gstrate} = 0 unless $object->{gstrate};
133
    $object->{fax} = '+358700123123' unless $object->{fax};
134
    $object->{discount} = 10 unless $object->{discount};
135
    $object->{deliverytime} = 2 unless $object->{deliverytime};
136
    $object->{address1} = 'Where I am' unless $object->{address1};
137
    $object->{active} = 1 unless $object->{active};
138
    $object->{accountnumber} = 'IBAN 123456789 FI' unless $object->{accountnumber};
139
    $object->{contacts} = [{}] unless $object->{contacts}; #Prepare to create one default contact.
140
141
    $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey);
142
}
143
144
=head deleteTestGroup
145
@OVERLOADED
146
147
    my $records = createTestGroup();
148
    ##Do funky stuff
149
    deleteTestGroup($records);
150
151
Removes the given test group from the DB.
152
153
=cut
154
155
sub deleteTestGroup {
156
    my ($self, $objects) = @_;
157
158
    while( my ($key, $object) = each %$objects) {
159
        my $bookseller = Koha::Acquisition::Booksellers->cast($object);
160
        eval {
161
            #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them.
162
            my @booksellers = Koha::Acquisition::Booksellers->search({name => $bookseller->name});
163
            foreach my $b (@booksellers) {
164
                $b->delete();
165
            }
166
        };
167
        if ($@) {
168
            die $@;
169
        }
170
    }
171
}
172
173
1;
(-)a/t/lib/TestObjects/BiblioFactory.pm (+151 lines)
Line 0 Link Here
1
package t::lib::TestObjects::BiblioFactory;
2
3
# Copyright Vaara-kirjastot 2015
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
#
20
21
use Modern::Perl;
22
use Carp;
23
24
use C4::Biblio;
25
26
use Koha::Exception::BadParameter;
27
28
use base qw(t::lib::TestObjects::ObjectFactory);
29
30
sub getDefaultHashKey {
31
    return 'biblioitems.isbn';
32
}
33
34
=head t::lib::TestObjects::createTestGroup
35
36
    my $records = t::lib::TestObjects::BiblioFactory->createTestGroup([
37
                        {'biblio.title' => 'I wish I met your mother',
38
                         'biblio.author'   => 'Pertti Kurikka',
39
                         'biblio.copyrightdate' => '1960',
40
                         'biblioitems.isbn'     => '9519671580',
41
                         'biblioitems.itemtype' => 'BK',
42
                        },
43
                    ], undef, $testContext1, $testContext2, $testContext3);
44
45
Calls C4::Biblio::TransformKohaToMarc() to make a MARC::Record and add it to
46
the DB. Returns a HASH of MARC::Records.
47
The HASH is keyed with the 'biblioitems.isbn', or the given $hashKey. Using for example
48
'biblioitems.isbn' is very much recommended to make linking objects more easy in test cases.
49
The biblionumber is injected to the MARC::Record-object to be easily accessable,
50
so we can get it like this:
51
    $records->{$key}->{biblionumber};
52
53
See C4::Biblio::TransformKohaToMarc() for how the biblio- or biblioitem-tables'
54
columns need to be given.
55
56
@RETURNS HASHRef of MARC::Record-objects
57
58
See t::lib::TestObjects::ObjectFactory for more documentation
59
=cut
60
61
sub handleTestObject {
62
    my ($class, $object, $stashes) = @_;
63
64
    my $record = C4::Biblio::TransformKohaToMarc($object);
65
    my ($biblionumber, $biblioitemnumber) = C4::Biblio::AddBiblio($record,'');
66
67
    #Clone all the parameters of $object to $record
68
    foreach my $key (keys(%$object)) {
69
        $record->{$key} = $object->{$key};
70
    }
71
    $record->{biblionumber} = $biblionumber;
72
73
    return $record;
74
}
75
76
=head getHashKey
77
@OVERLOADS
78
=cut
79
80
sub getHashKey {
81
    my ($class, $object, $primaryKey, $hashKeys) = @_;
82
83
    my @collectedHashKeys;
84
    $hashKeys = [$hashKeys] unless ref($hashKeys) eq 'ARRAY';
85
    foreach my $hashKey (@$hashKeys) {
86
        if (not($hashKey) ||
87
            (not($object->{$hashKey}) && not($object->$hashKey()))
88
           ) {
89
            croak $class."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'.";
90
        }
91
        push @collectedHashKeys, $object->{$hashKey} || $object->$hashKey();
92
    }
93
    return join('-', @collectedHashKeys);
94
}
95
96
=head validateAndPopulateDefaultValues
97
@OVERLOAD
98
99
Validates given Object parameters and makes sure that critical fields are given
100
and populates defaults for missing values.
101
=cut
102
103
sub validateAndPopulateDefaultValues {
104
    my ($self, $object, $hashKey) = @_;
105
106
    unless (ref($object) eq 'HASH' && scalar(%$object)) {
107
        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.");
108
    }
109
    unless ($object->{'biblio.title'}) {
110
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> 'biblio.title' is a mandatory parameter!");
111
    }
112
    $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey);
113
}
114
115
=head
116
117
    my $records = createTestGroup();
118
    ##Do funky stuff
119
    deleteTestGroup($records);
120
121
Removes the given test group from the DB.
122
123
=cut
124
125
sub deleteTestGroup {
126
    my ($class, $records) = @_;
127
128
    my ( $biblionumberFieldCode, $biblionumberSubfieldCode ) =
129
            C4::Biblio::GetMarcFromKohaField( "biblio.biblionumber", '' );
130
131
    my $schema = Koha::Database->new_schema();
132
    while( my ($key, $record) = each %$records) {
133
        my $biblionumber = $record->subfield($biblionumberFieldCode, $biblionumberSubfieldCode);
134
        my @biblios = $schema->resultset('Biblio')->search({"-or" => [{biblionumber => $biblionumber},
135
                                                                      {title => $record->title}]});
136
        foreach my $b (@biblios) {
137
            $b->delete();
138
        }
139
    }
140
}
141
sub _deleteTestGroupFromIdentifiers {
142
    my ($class, $testGroupIdentifiers) = @_;
143
144
    my $schema = Koha::Database->new_schema();
145
    foreach my $isbn (@$testGroupIdentifiers) {
146
        $schema->resultset('Biblio')->search({"biblioitems.isbn" => $isbn},{join => 'biblioitems'})->delete();
147
        $schema->resultset('Biblioitem')->search({isbn => $isbn})->delete();
148
    }
149
}
150
151
1;
(-)a/t/lib/TestObjects/BorrowerFactory.pm (+172 lines)
Line 0 Link Here
1
package t::lib::TestObjects::BorrowerFactory;
2
3
# Copyright Vaara-kirjastot 2015
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
#
20
21
use Modern::Perl;
22
use Carp;
23
use Scalar::Util qw(blessed);
24
25
use C4::Members;
26
use Koha::Borrowers;
27
28
use base qw(t::lib::TestObjects::ObjectFactory);
29
30
sub new {
31
    my ($class) = @_;
32
33
    my $self = {};
34
    bless($self, $class);
35
    return $self;
36
}
37
38
sub getDefaultHashKey {
39
    return 'cardnumber';
40
}
41
42
=head createTestGroup( $data [, $hashKey, $testContexts...] )
43
@OVERLOADED
44
45
    my $borrowerFactory = t::lib::TestObjects::BorrowerFactory->new();
46
    my $borrowers = $borrowerFactory->createTestGroup([
47
                        {firstname => 'Olli-Antti',
48
                         surname   => 'Kivi',
49
                         cardnumber => '11A001',
50
                         branchcode     => 'CPL',
51
                        },
52
                        {firstname => 'Olli-Antti2',
53
                         surname   => 'Kivi2',
54
                         cardnumber => '11A002',
55
                         branchcode     => 'FPL',
56
                        },
57
                    ], undef, $testContext1, $testContext2, $testContext3);
58
59
    #Do test stuff...
60
61
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1);
62
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2);
63
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
64
65
The HASH is keyed with the given $hashKey or 'koha.borrowers.cardnumber'
66
See C4::Members::AddMember() for how the table columns need to be given.
67
68
@PARAM1 ARRAYRef of HASHRefs of C4::Members::AddMember()-parameters.
69
@PARAM2 koha.borrower-column which is used as the test context borrowers HASH key,
70
                defaults to the most best option cardnumber.
71
@PARAM3-5 HASHRef of test contexts. You can save the given borrowers to multiple
72
                test contexts. Usually one is enough. These test contexts are
73
                used to help tear down DB changes.
74
@RETURNS HASHRef of $hashKey => $borrower-objects:
75
76
See t::lib::TestObjects::ObjectFactory for more documentation
77
=cut
78
79
sub handleTestObject {
80
    my ($class, $object, $stashes) = @_;
81
82
    #Try to add the Borrower, but it might fail because of the barcode or other UNIQUE constraint.
83
    #Catch the error and try looking for the Borrower if we suspect it is present in the DB.
84
    my $borrowernumber;
85
    eval {
86
        $borrowernumber = C4::Members::AddMember(%$object);
87
    };
88
    if ($@) {
89
        if (blessed($@) && $@->isa('DBIx::Class::Exception') &&
90
            $@->{msg} =~ /Duplicate entry '.+?' for key 'cardnumber'/) { #DBIx should throw other types of exceptions instead of this general type :(
91
            #This exception type is OK, we ignore this and try fetching the existing Object next.
92
            warn "Recovering from duplicate exception.\n";
93
        }
94
        else {
95
            die $@;
96
        }
97
    }
98
99
    #If adding failed, we still get some strange borrowernumber result.
100
    #Check for sure by finding the real borrower.
101
    my $borrower = Koha::Borrowers->cast( $borrowernumber || $object );
102
    unless ($borrower) {
103
        carp "BorrowerFactory:> No borrower for cardnumber '".$object->{cardnumber}."'";
104
        return();
105
    }
106
107
    return $borrower;
108
}
109
110
=head validateAndPopulateDefaultValues
111
@OVERLOAD
112
113
Validates given Object parameters and makes sure that critical fields are given
114
and populates defaults for missing values.
115
=cut
116
117
sub validateAndPopulateDefaultValues {
118
    my ($self, $borrower, $hashKey) = @_;
119
    $self->SUPER::validateAndPopulateDefaultValues($borrower, $hashKey);
120
121
    $borrower->{categorycode} = 'PT' unless $borrower->{categorycode};
122
    $borrower->{branchcode}   = 'CPL' unless $borrower->{branchcode};
123
    $borrower->{dateofbirth}  = '1985-10-12' unless $borrower->{dateofbirth};
124
}
125
126
=head deleteTestGroup
127
@OVERLOADED
128
129
    my $records = createTestGroup();
130
    ##Do funky stuff
131
    deleteTestGroup($records);
132
133
Removes the given test group from the DB.
134
135
=cut
136
137
sub deleteTestGroup {
138
    my ($self, $objects) = @_;
139
140
    my $schema = Koha::Database->new_schema();
141
    while( my ($key, $object) = each %$objects) {
142
        my $borrower = Koha::Borrowers->cast($object);
143
        eval {
144
            $borrower->delete();
145
        };
146
        if ($@) {
147
            if (blessed($@) && $@->isa('DBIx::Class::Exception') &&
148
                    #Trying to recover. Delete all Checkouts for the Borrower to be able to delete.
149
                    $@->{msg} =~ /a foreign key constraint fails.+?issues_ibfk_1/) { #DBIx should throw other types of exceptions instead of this general type :(
150
151
                my @checkouts = Koha::Checkouts->search({borrowernumber => $borrower->borrowernumber});
152
                foreach my $c (@checkouts) { $c->delete(); }
153
                $borrower->delete();
154
                warn "Recovering from foreign key exception.\n";
155
            }
156
            else {
157
                die $@;
158
            }
159
        }
160
161
    }
162
}
163
sub _deleteTestGroupFromIdentifiers {
164
    my ($self, $testGroupIdentifiers) = @_;
165
166
    my $schema = Koha::Database->new_schema();
167
    foreach my $key (@$testGroupIdentifiers) {
168
        $schema->resultset('Borrower')->find({"cardnumber" => $key})->delete();
169
    }
170
}
171
172
1;
(-)a/t/lib/TestObjects/CheckoutFactory.pm (+197 lines)
Line 0 Link Here
1
package t::lib::TestObjects::CheckoutFactory;
2
3
# Copyright Vaara-kirjastot 2015
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
#
20
21
use Modern::Perl;
22
use Carp;
23
use DateTime;
24
25
use C4::Circulation;
26
use C4::Members;
27
use C4::Items;
28
use Koha::Borrowers;
29
use Koha::Items;
30
31
use base qw(t::lib::TestObjects::ObjectFactory);
32
33
sub new {
34
    my ($class) = @_;
35
36
    my $self = {};
37
    bless($self, $class);
38
    return $self;
39
}
40
41
sub getDefaultHashKey {
42
    return ['cardnumber', 'barcode'];
43
}
44
45
=head t::lib::TestObjects::CheckoutFactory::createTestGroup( $data [, $hashKey], @stashes )
46
47
    my $checkoutFactory = t::lib::TestObjects::CheckoutFactory->new();
48
    my $checkouts = $checkoutFactory->createTestGroup([
49
                        {#Checkout params
50
                        },
51
                        {#More checkout params
52
                        },
53
                    ], undef, $testContext1, $testContext2, $testContext3);
54
55
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1);
56
57
@PARAM1, ARRAY of HASHes.
58
  [ {
59
        cardnumber        => '167Azava0001',
60
        barcode           => '167Nfafa0010',
61
        daysOverdue       => 7,     #This Checkout's duedate was 7 days ago. If undef, then uses today as the checkout day.
62
        daysAgoCheckedout => 28, #This Checkout hapened 28 days ago. If undef, then uses today.
63
        checkoutBranchRule => 'homebranch' || 'holdingbranch' #From which branch this item is checked out from.
64
    },
65
    {
66
        ...
67
    }
68
  ]
69
@PARAM2, String, the HASH-element to use as the returning HASHes key.
70
@PARAM3, String, the rule on where to check these Issues out:
71
                 'homebranch', uses the Item's homebranch as the checkout branch
72
                 'holdingbranch', uses the Item's holdingbranch as the checkout branch
73
                 undef, uses the current Environment branch
74
                 '<branchCode>', checks out all Issues from the given branchCode
75
@PARAM4-6 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 => $checkout-objects.
79
                The HASH is keyed with <cardnumber>-<barcode>, or the given $hashKey.
80
    Example: {
81
    '11A001-167N0212' => {
82
        cardnumber => <cardnumber>,
83
        barcode => <barcode>,
84
        ...other Checkout-object columns...
85
    },
86
    ...
87
}
88
=cut
89
90
sub handleTestObject {
91
    my ($class, $checkoutParams, $stashes) = @_;
92
93
    #If running this test factory from unit tests or bare script, the context might not have been initialized.
94
    unless (C4::Context->userenv()) {
95
        C4::Context->_new_userenv('testGroupsTest');
96
        C4::Context->set_userenv(undef, undef, undef,
97
                           undef, undef,
98
                           'CPL', undef, undef,
99
                           undef, undef, undef);
100
    }
101
    my $oldContextBranch = C4::Context->userenv()->{branch};
102
103
    my $borrower = Koha::Borrowers->cast($checkoutParams->{cardnumber});
104
    my $item =     Koha::Items->cast($checkoutParams->{barcode});
105
106
    my $duedate = DateTime->now(time_zone => C4::Context->tz());
107
    if ($checkoutParams->{daysOverdue}) {
108
        $duedate->subtract(days =>  $checkoutParams->{daysOverdue}  );
109
    }
110
111
    my $checkoutdate = DateTime->now(time_zone => C4::Context->tz());
112
    if ($checkoutParams->{daysAgoCheckedout}) {
113
        $checkoutdate->subtract(days =>  $checkoutParams->{daysAgoCheckedout}  );
114
    }
115
116
    #Set the checkout branch
117
    my $checkoutBranch;
118
    my $checkoutBranchRule = $checkoutParams->{checkoutBranchRule};
119
    if (not($checkoutBranchRule)) {
120
        #Use the existing userenv()->{branch}
121
    }
122
    elsif ($checkoutBranchRule eq 'homebranch') {
123
        $checkoutBranch = $item->homebranch;
124
    }
125
    elsif ($checkoutBranchRule eq 'holdingbranch') {
126
        $checkoutBranch = $item->holdingbranch;
127
    }
128
    elsif ($checkoutBranchRule) {
129
        $checkoutBranch = $checkoutBranchRule;
130
    }
131
    C4::Context->userenv()->{branch} = $checkoutBranch if $checkoutBranch;
132
133
    my $datedue = C4::Circulation::AddIssue( $borrower->unblessed, $checkoutParams->{barcode}, $duedate, undef, $checkoutdate );
134
    #We want the issue_id as well.
135
    my $checkout = Koha::Checkouts->find({ borrowernumber => $borrower->borrowernumber, itemnumber => $item->itemnumber });
136
    unless ($checkout) {
137
        carp "CheckoutFactory:> No checkout for cardnumber '".$checkoutParams->{cardnumber}."' and barcode '".$checkoutParams->{barcode}."'";
138
        return;
139
    }
140
141
    return $checkout;
142
}
143
144
=head validateAndPopulateDefaultValues
145
@OVERLOAD
146
147
Validates given Object parameters and makes sure that critical fields are given
148
and populates defaults for missing values.
149
=cut
150
151
sub validateAndPopulateDefaultValues {
152
    my ($self, $object, $hashKey) = @_;
153
    $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey);
154
155
    unless ($object->{cardnumber}) {
156
        croak __PACKAGE__.":> Mandatory parameter 'cardnumber' missing.";
157
    }
158
    $object->{borrower} = Koha::Borrowers->cast($object->{cardnumber});
159
160
    unless ($object->{barcode}) {
161
        croak __PACKAGE__.":> Mandatory parameter 'barcode' missing.";
162
    }
163
    $object->{item} = Koha::Items->cast($object->{barcode});
164
165
    if ($object->{checkoutBranchRule} && not($object->{checkoutBranchRule} =~ m/(homebranch)|(holdingbranch)/)) {
166
        croak __PACKAGE__.":> Optional parameter 'checkoutBranchRule' must be one of these: homebranch, holdingbranch";
167
    }
168
}
169
170
=head
171
172
    my $objects = createTestGroup();
173
    ##Do funky stuff
174
    deleteTestGroup($records);
175
176
Removes the given test group from the DB.
177
178
=cut
179
180
sub deleteTestGroup {
181
    my ($self, $objects) = @_;
182
183
    while( my ($key, $object) = each %$objects) {
184
        my $checkout = Koha::Checkouts->cast($object);
185
        $checkout->delete();
186
    }
187
}
188
sub _deleteTestGroupFromIdentifiers {
189
    my ($self, $testGroupIdentifiers) = @_;
190
191
    my $schema = Koha::Database->new_schema();
192
    foreach my $key (@$testGroupIdentifiers) {
193
        $schema->resultset('Issue')->find({"issue_id" => $key})->delete();
194
    }
195
}
196
197
1;
(-)a/t/lib/TestObjects/ItemFactory.pm (+137 lines)
Line 0 Link Here
1
package t::lib::TestObjects::ItemFactory;
2
3
# Copyright Vaara-kirjastot 2015
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
#
20
21
use Modern::Perl;
22
use Carp;
23
24
use C4::Items;
25
use Koha::Items;
26
use Koha::Checkouts;
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 'barcode';
40
}
41
42
=head t::lib::TestObjects::ItemFactory::createTestGroup( $data [, $hashKey] )
43
@OVERLOADED
44
45
Returns a HASH of objects.
46
Each Item is expected to contain the biblionumber of the Biblio they are added into.
47
    eg. $item->{biblionumber} = 550242;
48
49
The HASH is keyed with the 'barcode', or the given $hashKey.
50
51
See C4::Items::AddItem() for how the table columns need to be given.
52
53
See t::lib::TestObjects::ObjectFactory for more documentation
54
=cut
55
56
sub handleTestObject {
57
    my ($class, $object, $stashes) = @_;
58
59
    my ($biblionumber, $biblioitemnumber, $itemnumber);
60
    eval {
61
        ($biblionumber, $biblioitemnumber, $itemnumber) = C4::Items::AddItem($object, $object->{biblionumber});
62
    };
63
    if ($@) {
64
        if (blessed($@) && $@->isa('DBIx::Class::Exception') &&
65
            $@->{msg} =~ /Duplicate entry '.+?' for key 'itembarcodeidx'/) { #DBIx should throw other types of exceptions instead of this general type :(
66
            #This exception type is OK, we ignore this and try fetching the existing Object next.
67
            warn "Recovering from duplicate exception.\n";
68
        }
69
        else {
70
            die $@;
71
        }
72
    }
73
    my $item = Koha::Items->cast($itemnumber || $object);
74
    unless ($item) {
75
        carp "ItemFactory:> No item for barcode '".$object->{barcode}."'";
76
        next();
77
    }
78
79
    return $item;
80
}
81
82
=head validateAndPopulateDefaultValues
83
@OVERLOAD
84
85
Validates given Object parameters and makes sure that critical fields are given
86
and populates defaults for missing values.
87
=cut
88
89
sub validateAndPopulateDefaultValues {
90
    my ($self, $item, $hashKey) = @_;
91
    $self->SUPER::validateAndPopulateDefaultValues($item, $hashKey);
92
93
    $item->{homebranch}     = 'CPL' unless $item->{homebranch};
94
    $item->{holdingbranch}  = 'CPL' unless $item->{holdingbranch};
95
    $item->{itemcallnumber} = 'PRE 84.FAN POST' unless $item->{itemcallnumber};
96
}
97
98
=head
99
@OVERLOADED
100
101
    my $objects = createTestGroup();
102
    ##Do funky stuff
103
    deleteTestGroup($records);
104
105
Removes the given test group from the DB.
106
107
=cut
108
109
sub deleteTestGroup {
110
    my ($self, $objects) = @_;
111
112
    while( my ($key, $object) = each %$objects) {
113
        my $item = Koha::Items->cast($object);
114
115
        #Delete all attached checkouts
116
        my @checkouts = Koha::Checkouts->search({itemnumber => $item->itemnumber});
117
        foreach my $c (@checkouts) {
118
            $c->delete;
119
        }
120
121
        $item->delete();
122
    }
123
}
124
sub _deleteTestGroupFromIdentifiers {
125
    my ($self, $testGroupIdentifiers) = @_;
126
127
    foreach my $key (@$testGroupIdentifiers) {
128
        my $item = Koha::Items->cast($key);
129
        my @checkouts = Koha::Checkouts->search({itemnumber => $item->itemnumber});
130
        foreach my $c (@checkouts) {
131
            $c->delete;
132
        }
133
        $item->delete();
134
    }
135
}
136
137
1;
(-)a/t/lib/TestObjects/LetterTemplateFactory.pm (+96 lines)
Line 0 Link Here
1
package t::lib::TestObjects::LetterTemplateFactory;
2
3
# Copyright Vaara-kirjastot 2015
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
#
20
21
use Modern::Perl;
22
use Carp;
23
24
use C4::Letters;
25
use Koha::LetterTemplates;
26
27
use base qw(t::lib::TestObjects::ObjectFactory);
28
29
sub new {
30
    my ($class) = @_;
31
32
    my $self = {};
33
    bless($self, $class);
34
    return $self;
35
}
36
37
sub getDefaultHashKey {
38
    return ['module', 'code', 'branchcode', 'message_transport_type'];
39
}
40
41
=head t::lib::TestObjects::LetterTemplateFactory->createTestGroup
42
Returns a HASH of Koha::LetterTemplate-objects
43
The HASH is keyed with the PRIMARY KEYS eg. 'circulation-ODUE2-CPL-print', or the given $hashKey.
44
=cut
45
46
#Incredibly the Letters-module has absolutely no Create or Update-component to operate on Letter templates?
47
#Tests like these are brittttle. :(
48
sub handleTestObject {
49
    my ($class, $object, $stashes) = @_;
50
51
    my $schema = Koha::Database->new->schema();
52
    my $rs = $schema->resultset('Letter');
53
    my $result = $rs->update_or_create({
54
            module     => $object->{module},
55
            code       => $object->{code},
56
            branchcode => ($object->{branchcode}) ? $object->{branchcode} : '',
57
            name       => $object->{name},
58
            is_html    => $object->{is_html},
59
            title      => $object->{title},
60
            message_transport_type => $object->{message_transport_type},
61
            content    => $object->{content},
62
    });
63
64
    return Koha::LetterTemplates->cast($result);
65
}
66
67
=head
68
69
Removes the given test group from the DB.
70
71
=cut
72
73
sub deleteTestGroup {
74
    my ($self, $letterTemplates) = @_;
75
76
    my $schema = Koha::Database->new_schema();
77
    while( my ($key, $letterTemplate) = each %$letterTemplates ) {
78
        $letterTemplate->delete();
79
    }
80
}
81
82
sub _deleteTestGroupFromIdentifiers {
83
    my $testGroupIdentifiers = shift;
84
85
    my $schema = Koha::Database->new_schema();
86
    foreach my $key (@$testGroupIdentifiers) {
87
        my ($module, $code, $branchcode, $mtt) = split('-',$key);
88
        $schema->resultset('Letter')->find({module => $module,
89
                                                    code => $code,
90
                                                    branchcode => $branchcode,
91
                                                    message_transport_type => $mtt,
92
                                                })->delete();
93
    }
94
}
95
96
1;
(-)a/t/lib/TestObjects/ObjectFactory.pm (+269 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 BorrowerFactory
32
                        {firstname => 'Olli-Antti',
33
                         surname   => 'Kivi',
34
                         cardnumber => '11A001',
35
                         branchcode     => 'CPL',
36
                         ...
37
                        },
38
                        #Or if using the ItemFactory
39
                        {biblionumber => 123413,
40
                         barcode   => '11N002',
41
                         homebranch => 'FPL',
42
                         ...
43
                        },
44
                    ], $hashKey, $testContext1, $testContext2, $testContext3);
45
46
    #Do test stuff...
47
48
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1);
49
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2);
50
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
51
52
The HASH is keyed with the given $hashKey or 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
@PARAM2 koha.<object>-column which is used as the test context HASH key to find individual Objects,
59
                usually defaults to to one of the UNIQUE database keys.
60
@PARAM3-5 HASHRef of test contexts. You can save the given Objects to multiple
61
                test contexts. Usually one is enough. These test contexts are
62
                used to help tear down DB changes.
63
@RETURNS HASHRef of $hashKey => Objects, eg.
64
                { $hashKey => {#borrower1 HASH},
65
                  $hashKey => {#borrower2 HASH},
66
                }
67
=cut
68
69
sub createTestGroup {
70
    my ($class, $objects, $hashKey, $featureStash, $scenarioStash, $stepStash) = @_;
71
    my $stashes = [$featureStash, $scenarioStash, $stepStash];
72
    $class->_validateStashes(@$stashes);
73
    $hashKey = $class->getDefaultHashKey() unless $hashKey;
74
75
    $objects = [$objects] unless ref($objects) eq 'ARRAY';
76
    my %objects;
77
    foreach my $o (@$objects) {
78
        $class->validateAndPopulateDefaultValues($o, $hashKey, $stashes);
79
80
        my $addedObject = $class->handleTestObject($o, $stashes);
81
        if (not($addedObject) ||
82
            not(ref($addedObject) eq 'HASH' || $addedObject->isa('Koha::Object') || $addedObject->isa('MARC::Record') )
83
           ) {
84
            Koha::Exception::UnknownObject->throw(error => __PACKAGE__."->createTestGroup():> Subroutine '$class->handleTestObject()' must return a HASH or a Koha::Object");
85
        }
86
87
        my $key = $class->getHashKey($addedObject, undef, $hashKey);
88
        $objects{$key} = $addedObject;
89
    }
90
91
    $class->_persistToStashes(\%objects, $class->getHashGroupName(), @$stashes);
92
93
    return \%objects;
94
}
95
96
=head getHashGroupName
97
@OVERRIDABLE
98
99
@RETURNS String, the test context/stash key under which all of these test objects are put.
100
                 The key is calculated by default from the last components of the Object package,
101
                 but it is possible to override this method from the subclass to force another key.
102
                 Eg. 't::lib::PageObject::Acquisition::Bookseller::ContactFactory' becomes
103
                     acquisition-bookseller-contact
104
=cut
105
106
sub getHashGroupName {
107
    my ($class) = @_;
108
109
    my $excludedPackageStart = 't::lib::TestObjects';
110
    unless ($class =~ m/^${excludedPackageStart}::(.+?)Factory/i) {
111
        Koha::Exception::BadParameter->throw(error =>
112
            "$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'");
113
    }
114
    my @e = split('::', lc($1));
115
    return join('-', @e);
116
}
117
118
sub handleTestObject {} #OVERLOAD THIS FROM SUBCLASS
119
sub deleteTestGroup {} #OVERLOAD THIS FROM SUBCLASS
120
121
=head tearDownTestContext
122
123
Given a testContext stash populated using one of the TestObjectFactory implementations createTestGroup()-subroutines,
124
Removes all the persisted objects in the stash.
125
126
TestObjectFactories must be lazy loaded here to make it possible for them to subclass this.
127
=cut
128
129
sub tearDownTestContext {
130
    my ($self, $stash) = @_;
131
132
    ##You should introduce tearDowns in such an order that to not provoke FOREIGN KEY issues.
133
    if ($stash->{'serial-subscription'}) {
134
        require t::lib::TestObjects::Serial::SubscriptionFactory;
135
        t::lib::TestObjects::Serial::SubscriptionFactory->deleteTestGroup($stash->{'serial-subscription'});
136
        delete $stash->{'serial-subscription'};
137
    }
138
    if ($stash->{'acquisition-bookseller-contact'}) {
139
        require t::lib::TestObjects::Acquisition::Bookseller::ContactFactory;
140
        t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->deleteTestGroup($stash->{'acquisition-bookseller-contact'});
141
        delete $stash->{'acquisition-bookseller-contact'};
142
    }
143
    if ($stash->{'acquisition-bookseller'}) {
144
        require t::lib::TestObjects::Acquisition::BooksellerFactory;
145
        t::lib::TestObjects::Acquisition::BooksellerFactory->deleteTestGroup($stash->{'acquisition-bookseller'});
146
        delete $stash->{'acquisition-bookseller'};
147
    }
148
    if ($stash->{checkout}) {
149
        require t::lib::TestObjects::CheckoutFactory;
150
        t::lib::TestObjects::CheckoutFactory->deleteTestGroup($stash->{checkout});
151
        delete $stash->{checkout};
152
    }
153
    if ($stash->{item}) {
154
        require t::lib::TestObjects::ItemFactory;
155
        t::lib::TestObjects::ItemFactory->deleteTestGroup($stash->{item});
156
        delete $stash->{item};
157
    }
158
    if ($stash->{biblio}) {
159
        require t::lib::TestObjects::BiblioFactory;
160
        t::lib::TestObjects::BiblioFactory->deleteTestGroup($stash->{biblio});
161
        delete $stash->{biblio};
162
    }
163
    if ($stash->{borrower}) {
164
        require t::lib::TestObjects::BorrowerFactory;
165
        t::lib::TestObjects::BorrowerFactory->deleteTestGroup($stash->{borrower});
166
        delete $stash->{borrower};
167
    }
168
    if ($stash->{letterTemplate}) {
169
        require t::lib::TestObjects::LetterTemplateFactory;
170
        t::lib::TestObjects::LetterTemplateFactory->deleteTestGroup($stash->{letterTemplate});
171
        delete $stash->{letterTemplate};
172
    }
173
    if ($stash->{systempreference}) {
174
        require t::lib::TestObjects::SystemPreferenceFactory;
175
        t::lib::TestObjects::SystemPreferenceFactory->deleteTestGroup($stash->{systempreference});
176
        delete $stash->{systempreference};
177
    }
178
}
179
180
=head getHashKey
181
@OVERLOADABLE
182
183
@RETURNS String, The test context/stash HASH key to differentiate this object
184
                 from all other such test objects.
185
=cut
186
187
sub getHashKey {
188
    my ($class, $object, $primaryKey, $hashKeys) = @_;
189
190
    my @collectedHashKeys;
191
    $hashKeys = [$hashKeys] unless ref($hashKeys) eq 'ARRAY';
192
    foreach my $hashKey (@$hashKeys) {
193
        if (ref($object) eq 'HASH') {
194
            if ($hashKey && not($object->{$hashKey})) {
195
                croak $class."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'.";
196
            }
197
            push @collectedHashKeys, $object->{$hashKey};
198
        }
199
        else {
200
            if ($hashKey && not($object->$hashKey())) {
201
                croak $class."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'.";
202
            }
203
            push @collectedHashKeys, $object->$hashKey();
204
        }
205
    }
206
    return join('-', @collectedHashKeys);
207
}
208
209
=head validateAndPopulateDefaultValues
210
@INTERFACE
211
212
Validates given Object parameters and makes sure that critical fields are given
213
and populates defaults for missing values.
214
You must overload this in the subclassing factory if you want to validate and check the given parameters
215
=cut
216
217
sub validateAndPopulateDefaultValues {
218
    my ($self, $object, $hashKeys) = @_;
219
220
    $hashKeys = [$hashKeys] unless ref($hashKeys) eq 'ARRAY';
221
    foreach my $hashKey (@$hashKeys) {
222
        unless ($object->{$hashKey}) {
223
            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.");
224
        }
225
    }
226
}
227
228
=head _validateStashes
229
230
    _validateStashes($featureStash, $scenarioStash, $stepStash);
231
232
Validates that the given stahses are what they are supposed to be... ,  HASHrefs.
233
@THROWS Koha::Exception::BadParameter, if validation failed.
234
=cut
235
236
sub _validateStashes {
237
    my ($self, $featureStash, $scenarioStash, $stepStash) = @_;
238
239
    if ($featureStash && not(ref($featureStash) eq 'HASH')) {
240
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$featureStash' is not a HASHRef! Leave it 'undef' if you don't want to use it.");
241
    }
242
    if ($scenarioStash && not(ref($scenarioStash) eq 'HASH')) {
243
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$scenarioStash' is not a HASHRef! Leave it 'undef' if you don't want to use it.");
244
    }
245
    if ($stepStash && not(ref($stepStash) eq 'HASH')) {
246
        Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$stepStash' is not a HASHRef! Leave it 'undef' if you don't want to use it.");
247
    }
248
}
249
250
=head _persistToStashes
251
252
    _persistToStashes($objects, $stashKey, $featureStash, $scenarioStash, $stepStash);
253
254
Saves the given HASH to the given stashes using the given stash key.
255
=cut
256
257
sub _persistToStashes {
258
    my ($self, $objects, $stashKey, $featureStash, $scenarioStash, $stepStash) = @_;
259
260
    if ($featureStash || $scenarioStash || $stepStash) {
261
        while( my ($key, $biblio) = each %$objects) {
262
            $featureStash->{$stashKey}->{ $key }  = $biblio if $featureStash;
263
            $scenarioStash->{$stashKey}->{ $key } = $biblio if $scenarioStash;
264
            $stepStash->{$stashKey}->{ $key }     = $biblio if $stepStash;
265
        }
266
    }
267
}
268
269
1;
(-)a/t/lib/TestObjects/Serial/FrequencyFactory.pm (+149 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
42
=head createTestGroup( $data [, $hashKey, $testContexts...] )
43
@OVERLOADED
44
45
    my $frequencies = t::lib::TestObjects::Serial::FrequencyFactory->createTestGroup([
46
                        {acqprimary     => 1,                     #DEFAULT
47
                         claimissues    => 1,                     #DEFAULT
48
                         claimacquisition => 1,                   #DEFAULT
49
                         serialsprimary => 1,                     #DEFAULT
50
                         position       => 'Boss',                #DEFAULT
51
                         phone          => '+358700123123',       #DEFAULT
52
                         notes          => 'Noted',               #DEFAULT
53
                         name           => "Julius Augustus Caesar", #DEFAULT
54
                         fax            => '+358700123123',       #DEFAULT
55
                         email          => 'vendor@example.com',  #DEFAULT
56
                         booksellerid   => 12124                  #MANDATORY to link to Bookseller
57
                         #id => #Don't use id, since we are just adding a new one
58
                        },
59
                        {...},
60
                    ], undef, $testContext1, $testContext2, $testContext3);
61
62
    #Do test stuff...
63
64
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
65
66
The HASH is keyed with the given $hashKey or 'koha.subscription_frequencies.description'
67
68
@PARAM1 ARRAYRef of HASHRefs
69
@PARAM2 koha.subscription_frequencies-column which is used as the test context HASH key,
70
                defaults to the most best option 'description'.
71
@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple
72
                test contexts. Usually one is enough. These test contexts are
73
                used to help tear down DB changes.
74
@RETURNS HASHRef of $hashKey => object:
75
76
See t::lib::TestObjects::ObjectFactory for more documentation
77
=cut
78
79
sub handleTestObject {
80
    my ($class, $object, $stashes) = @_;
81
82
    my $contact = Koha::Acquisition::Bookseller::Contact->new();
83
    $contact->set($object);
84
    $contact->store();
85
    #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.
86
    my @contacts = Koha::Acquisition::Bookseller::Contacts->search($object);
87
    if (scalar(@contacts)) {
88
        $contact = $contacts[0];
89
    }
90
    else {
91
        die "No Contact added to DB. Fix me to autorecover from this error!";
92
    }
93
94
    return $contact;
95
}
96
97
=head validateAndPopulateDefaultValues
98
@OVERLOAD
99
100
Validates given Object parameters and makes sure that critical fields are given
101
and populates defaults for missing values.
102
=cut
103
104
sub validateAndPopulateDefaultValues {
105
    my ($self, $object, $hashKey) = @_;
106
107
    $object->{acqprimary}     = 1 unless $object->{acqprimary};
108
    $object->{claimissues}    = 1 unless $object->{claimissues};
109
    $object->{claimacquisition} = 1 unless $object->{claimacquisition};
110
    $object->{serialsprimary} = 1 unless $object->{serialsprimary};
111
    $object->{position}       = 'Boss' unless $object->{position};
112
    $object->{phone}          = '+358700123123' unless $object->{phone};
113
    $object->{notes}          = 'Noted' unless $object->{notes};
114
    $object->{name}           = "Julius Augustus Caesar" unless $object->{name};
115
    $object->{fax}            = '+358700123123' unless $object->{fax};
116
    $object->{email}          = 'vendor@example.com' unless $object->{email};
117
    $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey);
118
}
119
120
=head deleteTestGroup
121
@OVERLOADED
122
123
    my $records = createTestGroup();
124
    ##Do funky stuff
125
    deleteTestGroup($records);
126
127
Removes the given test group from the DB.
128
129
=cut
130
131
sub deleteTestGroup {
132
    my ($self, $objects) = @_;
133
134
    while( my ($key, $object) = each %$objects) {
135
        my $contact = Koha::Acquisition::Bookseller::Contacts->cast($object);
136
        eval {
137
            #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them.
138
            my @contacts = Koha::Acquisition::Bookseller::Contacts->search({name => $contact->name});
139
            foreach my $c (@contacts) {
140
                $c->delete();
141
            }
142
        };
143
        if ($@) {
144
            die $@;
145
        }
146
    }
147
}
148
149
1;
(-)a/t/lib/TestObjects/Serial/SubscriptionFactory.pm (+300 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
25
use C4::Serials;
26
27
use t::lib::TestObjects::BorrowerFactory;
28
use Koha::Borrowers;
29
use t::lib::TestObjects::Acquisition::BooksellerFactory;
30
use Koha::Acquisition::Booksellers;
31
use t::lib::TestObjects::BiblioFactory;
32
use Koha::Biblios;
33
use t::lib::TestObjects::ItemFactory;
34
use Koha::Items;
35
36
use Koha::Serial::Subscriptions;
37
38
use base qw(t::lib::TestObjects::ObjectFactory);
39
40
sub getDefaultHashKey {
41
    return 'internalnotes';
42
}
43
44
=head createTestGroup( $data [, $hashKey, $testContexts...] )
45
46
    my $subscriptions = t::lib::TestObjects::Serial::SubscriptionFactory->createTestGroup([
47
            {
48
                internalnotes => 'MagazineName-CPL-1', #MANDATORY! Used as the hash-key
49
                receiveSerials => 3, #DEFAULT undef, receives this many serials using the default values.
50
                librarian => 12 || Koha::Borrower, #DEFAULT creates a "Subscription Master" Borrower
51
                branchcode => 'CPL', #DEFAULT
52
                aqbookseller => 54 || Koha::Acquisition::Bookseller, #DEFAULT creates a 'Bookselling Vendor'.
53
                cost => undef, #DEFAULT
54
                aqbudgetid => undef, #DEFAULT
55
                biblio => 21 || Koha::Biblio, #DEFAULT creates a "Serial magazine" Record
56
                startdate => '2015-01-01', #DEFAULTs to 1.1 this year, so the subscription is active by default.
57
                periodicity => 7 || Koha::Serial::Subscription::Frequency, #DEFAULTS to a Frequency of 1/month.
58
                numberlength => 12, #DEFAULT one year subscription, only one of ['numberlength', 'weeklength', 'monthlength'] is needed
59
                weeklength => 52, #DEFAULT one year subscription
60
                monthlength => 12, #DEFAULT one year subscription
61
                lastvalue1 => 2015, #DEFAULT this year
62
                innerloop1 => undef, #DEFAULT
63
                lastvalue2 => 1, #DEFAULT
64
                innerloop2 => undef, #DEFAULT
65
                lastvalue3 => 1, #DEFAULT
66
                innerloop3 => undef, #DEFAULT
67
                status => 1, #DEFAULT
68
                notes => 'Public note', #DEFAULT
69
                letter => 'RLIST', #DEFAULT
70
                firstacquidate => '2015-01-01', #DEFAULT, same as startdate
71
                irregularity => undef, #DEFAULT
72
                numberpattern => 2 || Koha::Serial::Numberpattern, #DEFAULT 2, which is 'Volume, Number, Issue'
73
                locale => undef, #DEFAULT
74
                callnumber => MAG 10.2 AZ, #DEFAULT
75
                manualhistory => 0, #DEFAULT
76
                serialsadditems => 1, #DEFAULT
77
                staffdisplaycount => 20, #DEFAULT
78
                opacdisplaycount => 20, #DEFAULT
79
                graceperiod => 2, #DEFAULT
80
                location => 'DISPLAY', #DEFAULT
81
                enddate => undef, #DEFAULT, calculated
82
                skip_serialseq => 1, #DEFAULT
83
            },
84
            {...
85
            },
86
        ], undef, $testContext1, $testContext2, $testContext3);
87
88
    #Do test stuff...
89
90
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3);
91
92
The HASH is keyed with the given $hashKey or 'koha.subscription.internalnotes'
93
We default to internalnotes because there is really no unique identifier
94
to describe the created subscription which wouldn't change across different test runs.
95
96
See C4::Serials::NewSubscription() for how the table columns need to be given.
97
98
@PARAM1 ARRAYRef of HASHRefs
99
@PARAM2 koha.subscription-column which is used as the test context HASH key,
100
@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple
101
                test contexts. Usually one is enough. These test contexts are
102
                used to help tear down DB changes.
103
@RETURNS HASHRef of $hashKey => $borrower-objects:
104
105
See t::lib::TestObjects::ObjectFactory for more documentation
106
=cut
107
108
sub handleTestObject {
109
    my ($class, $o, $stashes) = @_;
110
111
    my $subscriptionid;
112
    eval {
113
        $subscriptionid = C4::Serials::NewSubscription(
114
                                $o->{librarian}->id,
115
                                $o->{branchcode},
116
                                $o->{aqbookseller}->id,
117
                                $o->{cost},
118
                                $o->{aqbudgetid},
119
                                $o->{biblio}->{biblionumber} || $o->{biblio}->biblionumber,
120
                                $o->{startdate},
121
                                $o->{periodicity},
122
                                $o->{numberlength},
123
                                $o->{weeklength},
124
                                $o->{monthlength},
125
                                $o->{lastvalue1},
126
                                $o->{innerloop1},
127
                                $o->{lastvalue2},
128
                                $o->{innerloop2},
129
                                $o->{lastvalue3},
130
                                $o->{innerloop3},
131
                                $o->{status},
132
                                $o->{notes},
133
                                $o->{letter},
134
                                $o->{firstacquidate},
135
                                $o->{irregularity},
136
                                $o->{numberpattern},
137
                                $o->{locale},
138
                                $o->{callnumber},
139
                                $o->{manualhistory},
140
                                $o->{internalnotes},
141
                                $o->{serialsadditems},
142
                                $o->{staffdisplaycount},
143
                                $o->{opacdisplaycount},
144
                                $o->{graceperiod},
145
                                $o->{location},
146
                                $o->{enddate},
147
                                $o->{skip_serialseq}
148
                        );
149
    };
150
    if ($@) {
151
        die $@;
152
    }
153
154
    my $subscription = Koha::Serial::Subscriptions->cast( $subscriptionid );
155
    $subscription->periodicity($o->{periodicity});
156
    $subscription->numberpattern($o->{numberpattern});
157
158
    $class->receiveDefaultSerials($subscription, $o->{receiveSerials});
159
160
    return $subscription;
161
}
162
163
=head validateAndPopulateDefaultValues
164
@OVERLOAD
165
166
Validates given Object parameters and makes sure that critical fields are given
167
and populates defaults for missing values.
168
=cut
169
170
sub validateAndPopulateDefaultValues {
171
    my ($self, $object, $hashKey, $stashes) = @_;
172
173
    if ($object->{librarian}) {
174
        $object->{librarian} = Koha::Borrowers->cast($object->{librarian});
175
    }
176
    else {
177
        $object->{librarian} = t::lib::TestObjects::BorrowerFactory->createTestGroup([
178
                                                        {cardnumber => 'SERIAL420KILLER',
179
                                                         firstname => 'Subscription',
180
                                                         surname => 'Master'}], undef, @$stashes)
181
                                                        ->{SERIAL420KILLER};
182
    }
183
    if ($object->{aqbookseller}) {
184
        $object->{aqbookseller} = Koha::Acquisition::Booksellers->cast($object->{aqbookseller});
185
    }
186
    else {
187
        $object->{aqbookseller} = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([
188
                                                        {}], undef, @$stashes)
189
                                                        ->{'Bookselling Vendor'};
190
    }
191
    if ($object->{biblio}) {
192
        $object->{biblio} = Koha::Biblios->cast($object->{biblio});
193
    }
194
    else {
195
        $object->{biblio} = t::lib::TestObjects::BiblioFactory->createTestGroup([
196
                                    {'biblio.title' => 'Serial magazine',
197
                                     'biblio.author'   => 'Pertti Kurikka',
198
                                     'biblio.copyrightdate' => '2015',
199
                                     'biblioitems.isbn'     => 'isbnisnotsocoolnowadays!',
200
                                     'biblioitems.itemtype' => 'CR',
201
                                    },
202
                                ], undef, @$stashes)
203
                                ->{'isbnisnotsocoolnowadays!'};
204
    }
205
206
    unless ($object->{internalnotes}) {
207
        croak __PACKAGE__.":> Mandatory parameter 'internalnotes' missing. This is used as the returning hash-key!";
208
    }
209
    $object->{periodicity}   = 7 unless $object->{periodicity};
210
    $object->{numberpattern} = 2 unless $object->{numberpattern};
211
    $object->{branchcode}    = 'CPL' unless $object->{branchcode};
212
    $object->{cost}          = undef unless $object->{cost};
213
    $object->{aqbudgetid}    = undef unless $object->{aqbudgetid};
214
    $object->{startdate}     = '2015-01-01' unless $object->{startdate};
215
    $object->{numberlength}  = undef unless $object->{numberlength};
216
    $object->{weeklength}    = undef unless $object->{weeklength} || $object->{numberlength};
217
    $object->{monthlength}   = 12 unless $object->{monthlength} || $object->{weeklength} || $object->{numberlength};
218
    $object->{lastvalue1}    = 2015 unless $object->{lastvalue1};
219
    $object->{innerloop1}    = undef unless $object->{innerloop1};
220
    $object->{lastvalue2}    = 1 unless $object->{lastvalue2};
221
    $object->{innerloop2}    = undef unless $object->{innerloop2};
222
    $object->{lastvalue3}    = 1 unless $object->{lastvalue3};
223
    $object->{innerloop3}    = undef unless $object->{innerloop3};
224
    $object->{status}        = 1 unless $object->{status};
225
    $object->{notes}         = 'Public note' unless $object->{notes};
226
    $object->{letter}        = 'RLIST' unless $object->{letter};
227
    $object->{firstacquidate} = '2015-01-01' unless $object->{firstacquidate};
228
    $object->{irregularity}  = undef unless $object->{irregularity};
229
    $object->{locale}        = undef unless $object->{locale};
230
    $object->{callnumber}    = 'MAG 10.2 AZ' unless $object->{callnumber};
231
    $object->{manualhistory} = 0 unless $object->{manualhistory};
232
    $object->{serialsadditems} = 1 unless $object->{serialsadditems};
233
    $object->{staffdisplaycount} = 20 unless $object->{staffdisplaycount};
234
    $object->{opacdisplaycount} = 20 unless $object->{opacdisplaycount};
235
    $object->{graceperiod}   = 2 unless $object->{graceperiod};
236
    $object->{location}      = 'DISPLAY' unless $object->{location};
237
    $object->{enddate}       = undef unless $object->{enddate};
238
    $object->{skip_serialseq} = 1 unless $object->{skip_serialseq};
239
}
240
241
sub receiveDefaultSerials {
242
    my ($class, $subscription, $receiveSerials, $stashes) = @_;
243
    return unless $receiveSerials;
244
245
    foreach (1..$receiveSerials) {
246
        my ($totalIssues, $waitingSerial) = C4::Serials::GetSerials($subscription->subscriptionid);
247
        C4::Serials::ModSerialStatus($waitingSerial->{serialid},
248
                                     $waitingSerial->{serialseq},
249
                                     Koha::DateUtils::dt_from_string($waitingSerial->{planneddate})->ymd('-'),
250
                                     Koha::DateUtils::dt_from_string($waitingSerial->{publisheddate})->ymd('-'),
251
                                     2, #Status => 2 == Received
252
                                     $waitingSerial->{notes},
253
                                    );
254
        my $items = t::lib::TestObjects::ItemFactory->createTestGroup({barcode => $waitingSerial->{serialid}."-".Koha::DateUtils::dt_from_string($waitingSerial->{publisheddate})->ymd('-'),
255
                                                                       enumchron => $waitingSerial->{serialseq},
256
                                                                       biblionumber => $subscription->biblionumber,
257
                                                                    }, undef, @$stashes);
258
        C4::Serials::AddItem2Serial( $waitingSerial->{serialid},
259
                                     $items->{ shift([values(%$items)])->barcode }->itemnumber, ); #Perl is wonderful :)
260
    }
261
}
262
263
=head deleteTestGroup
264
@OVERLOADED
265
266
    my $records = createTestGroup();
267
    ##Do funky stuff
268
    deleteTestGroup($records);
269
270
Removes the given test group from the DB.
271
Also removes all attached serialitems and serials
272
273
=cut
274
275
sub deleteTestGroup {
276
    my ($self, $objects) = @_;
277
278
    my $schema = Koha::Database->new_schema();
279
    while( my ($key, $object) = each %$objects) {
280
        my $subscription = Koha::Serial::Subscriptions->cast($object);
281
        eval {
282
            my @serials = $schema->resultset('Serial')->search({subscriptionid => $subscription->subscriptionid});
283
284
            ##Because serialitems-table doesn't have a primery key, resorting to a DBI hack.
285
            my $dbh = C4::Context->dbh();
286
            my $sth_delete_serialitems = $dbh->prepare("DELETE FROM serialitems WHERE serialid = ?");
287
288
            foreach my $s (@serials) {
289
                $sth_delete_serialitems->execute($s->serialid);
290
                $s->delete();
291
            }
292
            $subscription->delete();
293
        };
294
        if ($@) {
295
            die $@;
296
        }
297
    }
298
}
299
300
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 C4::Members;
26
use Koha::Borrowers;
27
28
use base qw(t::lib::TestObjects::ObjectFactory);
29
30
use Koha::Exception::ObjectExists;
31
32
sub new {
33
    my ($class) = @_;
34
35
    my $self = {};
36
    bless($self, $class);
37
    return $self;
38
}
39
40
sub getDefaultHashKey {
41
    return 'preference';
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/objectFactories.t (-1 / +478 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright Vaara-kirjastot 2015
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
#
20
21
use Modern::Perl;
22
23
use Test::More;
24
use DateTime;
25
26
use Koha::DateUtils;
27
28
use t::lib::TestObjects::ObjectFactory;
29
use t::lib::TestObjects::BorrowerFactory;
30
use Koha::Borrowers;
31
use t::lib::TestObjects::ItemFactory;
32
use Koha::Items;
33
use t::lib::TestObjects::BiblioFactory;
34
use Koha::Biblios;
35
use t::lib::TestObjects::CheckoutFactory;
36
use Koha::Checkouts;
37
use t::lib::TestObjects::LetterTemplateFactory;
38
use Koha::LetterTemplates;
39
use t::lib::TestObjects::Acquisition::Bookseller::ContactFactory;
40
use Koha::Acquisition::Bookseller::Contacts;
41
use t::lib::TestObjects::Acquisition::BooksellerFactory;
42
use Koha::Acquisition::Booksellers;
43
use t::lib::TestObjects::Serial::SubscriptionFactory;
44
use Koha::Serial::Subscriptions;
45
use Koha::Serial::Subscription::Frequencies;
46
use Koha::Serial::Subscription::Numberpatterns;
47
use Koha::Serial::Serials;
48
use t::lib::TestObjects::SystemPreferenceFactory;
49
use C4::Context;
50
51
52
my $testContext = {}; #Gather all created Objects here so we can finally remove them all.
53
54
55
56
########## Serial subtests ##########
57
subtest 't::lib::TestObjects::Serial' => sub {
58
    my ($subscriptions, $subscription, $frequency, $numberpattern, $biblio, $borrower, $bookseller, $items, $serials);
59
    my $subtestContext = {};
60
    my $dontDeleteTestContext = {};
61
    ##Create and delete
62
    $subscriptions = t::lib::TestObjects::Serial::SubscriptionFactory->createTestGroup([
63
                                {internalnotes => 'TESTDEFAULTS',
64
                                 receiveSerials => 3},
65
                                ], undef, $subtestContext);
66
    $subscription = Koha::Serial::Subscriptions->find( $subscriptions->{'TESTDEFAULTS'}->subscriptionid );
67
    $frequency = $subscription->periodicity();
68
    $numberpattern = $subscription->numberpattern();
69
    $biblio = $subscription->biblio();
70
    $borrower = $subscription->borrower();
71
    $bookseller = $subscription->bookseller();
72
    $items = $subscription->items();
73
    $serials = $subscription->serials();
74
    ok(($subscriptions->{'TESTDEFAULTS'}->callnumber eq $subscription->callnumber &&
75
        $subscriptions->{'TESTDEFAULTS'}->subscriptionid eq $subscription->subscriptionid),
76
       "Default Subscription created.");
77
    ok($subscriptions->{'TESTDEFAULTS'}->numberpattern->label eq $numberpattern->label,
78
       "Default Numberpattern '".$numberpattern->label."' used.");
79
    ok($subscriptions->{'TESTDEFAULTS'}->periodicity->description eq $frequency->description,
80
       "Default Periodicity '".$frequency->description."' used.");
81
    ok($subscriptions->{'TESTDEFAULTS'}->biblio->title eq $biblio->title,
82
       "Default Biblio '".$biblio->title."' created.");
83
    ok($subscriptions->{'TESTDEFAULTS'}->bookseller->name eq $bookseller->name,
84
       "Default Bookseller '".$bookseller->name."' created.");
85
    ok($serials->[0]->isa('Koha::Serial::Serial') && $serials->[0]->serialseq eq 'Vol. 2015, Number 1, Issue 1' &&
86
       $serials->[1]->isa('Koha::Serial::Serial') && $serials->[1]->serialseq eq 'Vol. 2015, Number 1, Issue 2' &&
87
       $serials->[2]->isa('Koha::Serial::Serial') && $serials->[2]->serialseq eq 'Vol. 2015, Number 1, Issue 3' &&
88
       $serials->[3]->isa('Koha::Serial::Serial') && $serials->[3]->serialseq eq 'Vol. 2015, Number 1, Issue 4'
89
       , "Got 4 default Serials");
90
    ok($items->[0]->isa('Koha::Item') && $items->[0]->enumchron eq 'Vol. 2015, Number 1, Issue 1' &&
91
       $items->[1]->isa('Koha::Item') && $items->[1]->enumchron eq 'Vol. 2015, Number 1, Issue 2' &&
92
       $items->[2]->isa('Koha::Item') && $items->[2]->enumchron eq 'Vol. 2015, Number 1, Issue 3'
93
       , "Received 3 default Serial Items");
94
95
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
96
    $subscription = Koha::Serial::Subscriptions->find( $subscriptions->{'TESTDEFAULTS'}->subscriptionid );
97
    ok(not(defined($subscription)), "Default Subscription deleted.");
98
    $biblio = Koha::Biblios->find( $biblio->id );
99
    ok(not(defined($biblio)), "Default Biblio deleted.");
100
    $borrower = Koha::Borrowers->find( $borrower->id );
101
    ok(not(defined($borrower)), "Default Borrower deleted.");
102
    $bookseller = Koha::Acquisition::Booksellers->find( $bookseller->id );
103
    ok(not(defined($bookseller)), "Default Bookseller deleted.");
104
    $frequency = Koha::Serial::Subscription::Frequencies->find( $frequency->id );
105
    ok($frequency, "Attached Frequency not deleted.");
106
    $numberpattern = Koha::Serial::Subscription::Numberpatterns->find( $numberpattern->id );
107
    ok($numberpattern, "Attached Numbering Pattern not deleted.");
108
    $serials = [Koha::Serial::Serials->search({ subscriptionid => $serials->[0]->subscriptionid})];
109
    $items = [Koha::Items->search({"-or" => [{itemnumber => $items->[0]->itemnumber},
110
                                            {itemnumber => $items->[1]->itemnumber},
111
                                            {itemnumber => $items->[2]->itemnumber},
112
                                           ]})];
113
    ok(not($serials->[0] &&
114
           $serials->[1] &&
115
           $serials->[2] &&
116
           $serials->[3])
117
       , "4 default Serials deleted.");
118
    ok(not($items->[0] &&
119
           $items->[1] &&
120
           $items->[2])
121
       , "3 default Serial Items deleted");
122
123
    ### TESTING NOT DELETING A GIVEN BIBLIO OR BORROWER ###
124
    my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([
125
                        {'biblio.title' => 'I wish I met your mother',
126
                         'biblio.author'   => 'Pertti Kurikka',
127
                         'biblio.copyrightdate' => '1960',
128
                         'biblioitems.isbn'     => '9519671580',
129
                         'biblioitems.itemtype' => 'BK',
130
                        },
131
                    ], 'biblioitems.isbn', $dontDeleteTestContext);
132
    my $borrowers = t::lib::TestObjects::BorrowerFactory->createTestGroup([
133
                        {firstname  => 'Olli-Antti',
134
                         surname    => 'Kivi',
135
                         cardnumber => '11A001',
136
                         branchcode => 'CPL',
137
                        },
138
                    ], undef, $dontDeleteTestContext);
139
    my $booksellers = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([{
140
                        name => "Undeletable Magazine vendor"}],
141
                        undef, $dontDeleteTestContext);
142
    $subscriptions = t::lib::TestObjects::Serial::SubscriptionFactory->createTestGroup([
143
                                {internalnotes => 'TESTDEFAULTS',
144
                                 biblio => $biblios->{'9519671580'}->{biblionumber},
145
                                 librarian => $borrowers->{'11A001'},
146
                                 aqbookseller => $booksellers->{"Undeletable Magazine vendor"},
147
                                },
148
                                ], undef, $subtestContext);
149
    $subscription = Koha::Serial::Subscriptions->find( $subscriptions->{'TESTDEFAULTS'}->subscriptionid );
150
    $biblio = $subscription->biblio();
151
    $borrower = $subscription->borrower();
152
    $bookseller = $subscription->bookseller();
153
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
154
    $biblio = Koha::Biblios->find( $biblio->id );
155
    ok(defined($biblio), "Attached Biblio not deleted.");
156
    $borrower = Koha::Borrowers->find( $borrower->id );
157
    ok(defined($borrower), "Attached Borrower not deleted.");
158
    $bookseller = Koha::Acquisition::Booksellers->find( $bookseller->id );
159
    ok(defined($bookseller), "Attached Bookseller not deleted.");
160
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($dontDeleteTestContext);
161
};
162
163
164
165
########## Acquisition subtests ##########
166
subtest 't::lib::TestObjects::Acquisition' => sub {
167
    my ($booksellers, $bookseller, $contacts, $contact);
168
    my $subtestContext = {};
169
    ##Create and delete
170
    $booksellers = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([{}], undef, $subtestContext);
171
    $bookseller = Koha::Acquisition::Booksellers->find({name => 'Bookselling Vendor'});
172
    $contact = Koha::Acquisition::Bookseller::Contacts->find({name => 'Julius Augustus Caesar'});
173
    ok(($booksellers->{'Bookselling Vendor'}->name eq 'Bookselling Vendor' &&
174
       $bookseller->name eq 'Bookselling Vendor'),
175
       "Default Bookseller 'Bookselling Vendor' created.");
176
    ok(($booksellers->{'Bookselling Vendor'}->{contacts}->{'Julius Augustus Caesar'}->name eq 'Julius Augustus Caesar' &&
177
        $contact->name eq 'Julius Augustus Caesar'),
178
        "Default Contact 'Julius Augustus Caesar' created.");
179
180
    $contacts = t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->createTestGroup([
181
                                        {name => 'Hippocrates',
182
                                         booksellerid => $booksellers->{'Bookselling Vendor'}->id}]
183
                                         , undef, $subtestContext);
184
    $contact = Koha::Acquisition::Bookseller::Contacts->find({name => 'Hippocrates'});
185
    ok(($contacts->{'Hippocrates'}->name, 'Hippocrates' &&
186
       $contact->name eq 'Hippocrates'),
187
       "Contact 'Hippocrates' created.");
188
189
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
190
    $contact = Koha::Acquisition::Bookseller::Contacts->find({name => 'Julius Augustus Caesar'});
191
    ok(not(defined($contact)), "Contact 'Julius Augustus Caesar' deleted.");
192
    $contact = Koha::Acquisition::Bookseller::Contacts->find({name => 'Hippocrates'});
193
    ok(not(defined($contact)), "Contact 'Hippocrates' deleted.");
194
    $bookseller = Koha::Acquisition::Booksellers->find({name => 'Bookselling Vendor'});
195
    ok(not(defined($bookseller)), "Bookseller 'Bookselling Vendor' deleted.");
196
};
197
198
199
200
########## BorrowerFactory subtests ##########
201
subtest 't::lib::TestObjects::BorrowerFactory' => sub {
202
    my $subtestContext = {};
203
    ##Create and Delete. Add one
204
    my $f = t::lib::TestObjects::BorrowerFactory->new();
205
    my $objects = $f->createTestGroup([
206
                        {firstname => 'Olli-Antti',
207
                         surname   => 'Kivi',
208
                         cardnumber => '11A001',
209
                         branchcode     => 'CPL',
210
                        },
211
                    ], undef, $subtestContext, undef, $testContext);
212
    is($objects->{'11A001'}->cardnumber, '11A001', "Borrower '11A001'.");
213
    ##Add one more to test incrementing the subtestContext.
214
    $objects = $f->createTestGroup([
215
                        {firstname => 'Olli-Antti2',
216
                         surname   => 'Kivi2',
217
                         cardnumber => '11A002',
218
                         branchcode     => 'FFL',
219
                        },
220
                    ], undef, $subtestContext, undef, $testContext);
221
    is($subtestContext->{borrower}->{'11A001'}->cardnumber, '11A001', "Borrower '11A001' from \$subtestContext."); #From subtestContext
222
    is($objects->{'11A002'}->branchcode,                     'FFL',    "Borrower '11A002'."); #from just created hash.
223
224
    ##Delete objects
225
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
226
    my $object11A001 = Koha::Borrowers->find({cardnumber => '11A001'});
227
    ok (not($object11A001), "Borrower '11A001' deleted");
228
    my $object11A002 = Koha::Borrowers->find({cardnumber => '11A002'});
229
    ok (not($object11A002), "Borrower '11A002' deleted");
230
231
    #Prepare for global autoremoval.
232
    $objects = $f->createTestGroup([
233
                        {firstname => 'Olli-Antti',
234
                         surname   => 'Kivi',
235
                         cardnumber => '11A001',
236
                         branchcode     => 'CPL',
237
                        },
238
                        {firstname => 'Olli-Antti2',
239
                         surname   => 'Kivi2',
240
                         cardnumber => '11A002',
241
                         branchcode     => 'FFL',
242
                        },
243
                    ], undef, undef, undef, $testContext);
244
};
245
246
247
248
########## BiblioFactory and ItemFactory subtests ##########
249
subtest 't::lib::TestObjects::BiblioFactory and ::ItemFactory' => sub {
250
    my $subtestContext = {};
251
    ##Create and Delete. Add one
252
    my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([
253
                        {'biblio.title' => 'I wish I met your mother',
254
                         'biblio.author'   => 'Pertti Kurikka',
255
                         'biblio.copyrightdate' => '1960',
256
                         'biblioitems.isbn'     => '9519671580',
257
                         'biblioitems.itemtype' => 'BK',
258
                        },
259
                    ], 'biblioitems.isbn', $subtestContext, undef, $testContext);
260
    my $objects = t::lib::TestObjects::ItemFactory->createTestGroup([
261
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
262
                         barcode => '167Nabe0001',
263
                         homebranch   => 'CPL',
264
                         holdingbranch => 'CPL',
265
                         price     => '0.50',
266
                         replacementprice => '0.50',
267
                         itype => 'BK',
268
                         biblioisbn => '9519671580',
269
                         itemcallnumber => 'PK 84.2',
270
                        },
271
                    ], 'barcode', $subtestContext, undef, $testContext);
272
273
    is($objects->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001'.");
274
    ##Add one more to test incrementing the subtestContext.
275
    $objects = t::lib::TestObjects::ItemFactory->createTestGroup([
276
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
277
                         barcode => '167Nabe0002',
278
                         homebranch   => 'CPL',
279
                         holdingbranch => 'FFL',
280
                         price     => '3.50',
281
                         replacementprice => '3.50',
282
                         itype => 'BK',
283
                         biblioisbn => '9519671580',
284
                         itemcallnumber => 'JK 84.2',
285
                        },
286
                    ], 'barcode', $subtestContext, undef, $testContext);
287
288
    is($subtestContext->{item}->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001' from \$subtestContext.");
289
    is($objects->{'167Nabe0002'}->holdingbranch,           'FFL',         "Item '167Nabe0002'.");
290
    is(ref($biblios->{9519671580}), 'MARC::Record', "Biblio 'I wish I met your mother'.");
291
292
    ##Delete objects
293
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
294
    my $object1 = Koha::Items->find({barcode => '167Nabe0001'});
295
    ok (not($object1), "Item '167Nabe0001' deleted");
296
    my $object2 = Koha::Items->find({barcode => '167Nabe0002'});
297
    ok (not($object2), "Item '167Nabe0002' deleted");
298
    my $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"});
299
    ok (not($object2), "Biblio 'I wish I met your mother' deleted");
300
};
301
302
303
304
########## CheckoutFactory subtests ##########
305
subtest 't::lib::TestObjects::CheckoutFactory' => sub {
306
    my $subtestContext = {};
307
    ##Create and Delete using dependencies in the $testContext instantiated in previous subtests.
308
    my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([
309
                        {'biblio.title' => 'I wish I met your mother',
310
                         'biblio.author'   => 'Pertti Kurikka',
311
                         'biblio.copyrightdate' => '1960',
312
                         'biblioitems.isbn'     => '9519671580',
313
                         'biblioitems.itemtype' => 'BK',
314
                        },
315
                    ], 'biblioitems.isbn', undef, undef, $subtestContext);
316
    my $items = t::lib::TestObjects::ItemFactory->createTestGroup([
317
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
318
                         barcode => '167Nabe0001',
319
                         homebranch   => 'CPL',
320
                         holdingbranch => 'CPL',
321
                         price     => '0.50',
322
                         replacementprice => '0.50',
323
                         itype => 'BK',
324
                         biblioisbn => '9519671580',
325
                         itemcallnumber => 'PK 84.2',
326
                        },
327
                        {biblionumber => $biblios->{9519671580}->{biblionumber},
328
                         barcode => '167Nabe0002',
329
                         homebranch   => 'CPL',
330
                         holdingbranch => 'FFL',
331
                         price     => '3.50',
332
                         replacementprice => '3.50',
333
                         itype => 'BK',
334
                         biblioisbn => '9519671580',
335
                         itemcallnumber => 'JK 84.2',
336
                        },
337
                    ], 'barcode', undef, undef, $subtestContext);
338
    my $objects = t::lib::TestObjects::CheckoutFactory->createTestGroup([
339
                    {
340
                        cardnumber        => '11A001',
341
                        barcode           => '167Nabe0001',
342
                        daysOverdue       => 7,
343
                        daysAgoCheckedout => 28,
344
                    },
345
                    {
346
                        cardnumber        => '11A002',
347
                        barcode           => '167Nabe0002',
348
                        daysOverdue       => -7,
349
                        daysAgoCheckedout => 14,
350
                        checkoutBranchRule => 'holdingbranch',
351
                    },
352
                    ], undef, undef, undef, undef);
353
354
    is($objects->{'11A001-167Nabe0001'}->branchcode,
355
       'CPL',
356
       "Checkout '11A001-167Nabe0001' checked out from the default context branch 'CPL'.");
357
    is($objects->{'11A002-167Nabe0002'}->branchcode,
358
       'FFL',
359
       "Checkout '11A002-167Nabe0002' checked out from the holdingbranch 'FFL'.");
360
    is(Koha::DateUtils::dt_from_string($objects->{'11A001-167Nabe0001'}->issuedate)->day(),
361
       DateTime->now(time_zone => C4::Context->tz())->subtract(days => '28')->day()
362
       , "Checkout '11A001-167Nabe0001', adjusted issuedates match.");
363
    is(Koha::DateUtils::dt_from_string($objects->{'11A002-167Nabe0002'}->date_due)->day(),
364
       DateTime->now(time_zone => C4::Context->tz())->subtract(days => '-7')->day()
365
       , "Checkout '11A002-167Nabe0002', adjusted date_dues match.");
366
367
    t::lib::TestObjects::CheckoutFactory->deleteTestGroup($objects);
368
    my $object1 = Koha::Checkouts->find({borrowernumber => $objects->{'11A001-167Nabe0001'}->borrowernumber,
369
                                         itemnumber => $objects->{'11A001-167Nabe0001'}->itemnumber});
370
    ok (not($object1), "Checkout '11A001-167Nabe0001' deleted");
371
    my $object2 = Koha::Checkouts->find({borrowernumber => $objects->{'11A002-167Nabe0002'}->borrowernumber,
372
                                         itemnumber => $objects->{'11A002-167Nabe0002'}->itemnumber});
373
    ok (not($object2), "Checkout '11A002-167Nabe0002' deleted");
374
};
375
376
377
378
########## LetterTemplateFactory subtests ##########
379
subtest 't::lib::TestObjects::LetterTemplateFactory' => sub {
380
    my $subtestContext = {};
381
    ##Create and Delete using dependencies in the $testContext instantiated in previous subtests.
382
    my $f = t::lib::TestObjects::LetterTemplateFactory->new();
383
    my $hashLT = {letter_id => 'circulation-ODUE1-CPL-print',
384
                module => 'circulation',
385
                code => 'ODUE1',
386
                branchcode => 'CPL',
387
                name => 'Notice1',
388
                is_html => undef,
389
                title => 'Notice1',
390
                message_transport_type => 'print',
391
                content => '<item>Barcode: <<items.barcode>>, bring it back!</item>',
392
            };
393
    my $objects = $f->createTestGroup([
394
                    $hashLT,
395
                    ], undef, undef, undef, undef);
396
397
    my $letterTemplate = Koha::LetterTemplates->find($hashLT);
398
    is($objects->{'circulation-ODUE1-CPL-print'}->name, $letterTemplate->name, "LetterTemplate 'circulation-ODUE1-CPL-print'");
399
400
    #Delete them
401
    $f->deleteTestGroup($objects);
402
    $letterTemplate = Koha::LetterTemplates->find($hashLT);
403
    ok(not(defined($letterTemplate)), "LetterTemplate 'circulation-ODUE1-CPL-print' deleted");
404
};
405
406
407
408
########## SystemPreferenceFactory subtests ##########
409
subtest 't::lib::TestObjects::SystemPreferenceFactory' => sub {
410
    my $subtestContext = {};
411
412
    # take syspref 'opacuserlogin' and save its current value
413
    my $current_pref_value = C4::Context->preference("opacuserlogin");
414
415
    is($current_pref_value, $current_pref_value, "System Preference 'opacuserlogin' original value '".(($current_pref_value) ? $current_pref_value : 0)."'");
416
417
    # reverse the value for testing
418
    my $pref_new_value = !$current_pref_value;
419
420
421
    my $objects = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([
422
                    {preference => 'opacuserlogin',
423
                    value      => $pref_new_value # set the reversed value
424
                    },
425
                    ], undef, $subtestContext, undef, undef);
426
427
    is(C4::Context->preference("opacuserlogin"), $pref_new_value, "System Preference opacuserlogin reversed to '".(($pref_new_value) ? $pref_new_value:0)."'");
428
429
    # let's change it again to test that only the original preference value is saved
430
    $objects = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([
431
            {preference => 'opacuserlogin',
432
             value      => 2 # set the reversed value
433
            },
434
            ], undef, $subtestContext, undef, undef);
435
436
    is(C4::Context->preference("opacuserlogin"), 2, "System Preference opacuserlogin set to '2'");
437
438
    #Delete them
439
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext);
440
    is(C4::Context->preference("opacuserlogin"), $current_pref_value, "System Preference opacuserlogin restored to '".(($current_pref_value) ? $current_pref_value:0)."' after test group deletion");
441
};
442
443
444
445
########## Global test context subtests ##########
446
subtest 't::lib::TestObjects::ObjectFactory clearing global test context' => sub {
447
    my $object11A001 = Koha::Borrowers->find({cardnumber => '11A001'});
448
    ok ($object11A001, "Global Borrower '11A001' exists");
449
    my $object11A002 = Koha::Borrowers->find({cardnumber => '11A002'});
450
    ok ($object11A002, "Global Borrower '11A002' exists");
451
452
    my $object1 = Koha::Items->find({barcode => '167Nabe0001'});
453
    ok ($object1, "Global Item '167Nabe0001' exists");
454
    my $object2 = Koha::Items->find({barcode => '167Nabe0002'});
455
    ok ($object2, "Global Item '167Nabe0002' exists");
456
    my $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"});
457
    ok ($object2, "Global Biblio 'I wish I met your mother' exists");
458
459
    t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext);
460
461
    $object11A001 = Koha::Borrowers->find({cardnumber => '11A001'});
462
    ok (not($object11A001), "Global Borrower '11A001' deleted");
463
    $object11A002 = Koha::Borrowers->find({cardnumber => '11A002'});
464
    ok (not($object11A002), "Global Borrower '11A002' deleted");
465
466
    $object1 = Koha::Items->find({barcode => '167Nabe0001'});
467
    ok (not($object1), "Global Item '167Nabe0001' deleted");
468
    $object2 = Koha::Items->find({barcode => '167Nabe0002'});
469
    ok (not($object2), "Global Item '167Nabe0002' deleted");
470
    $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"});
471
    ok (not($object2), "Global Biblio 'I wish I met your mother' deleted");
472
};
473
474
475
476
done_testing();
477
478
1;

Return to bug 13906