From 08a97f9c3530b0b1865f59ba36e95234417eb96c Mon Sep 17 00:00:00 2001 From: Olli-Antti Kivilahti Date: Wed, 15 Mar 2017 16:31:13 +0200 Subject: [PATCH] Bug 13906 - TestObjectFactory(ies) for Koha objects. Enable easy Test object creation/deletion from HASHes. Doing tests should be easy. One biggest hindrance in doing tests is the difficulty of doing so in Koha. We use a lot of hard-coded SQL, which occasionally requires quite a bit of fiddling to get it right. Satisfying complex object dependency chains is hard. For example, testing Overdue notice sending, one must create -letters -overuderules -circulationrules -borrowers -biblios -items -issues (checkouts) ... Also one must take care to clean up the database modifications afterward to make encapsulated tests which don't leak over other tests. This is especially so for front-end testing. TestObjectFactories significantly alleviate this pain. They try to recover from errors, like when the previous test crashed and left testing objects into the DB, preventing adding them again. Also they store what object they created to 3 different levels of stashes to facilitate complex test configurations, and they have the dignity to clean-up the test contexts after testing has happened (if the script doesn't crash)! UNIT TESTS included! USAGE: use t::lib::TestObjects::PatronFactory; %#Setting up the test context my $testContext = {}; my $password = '1234'; my $patronFactory = t::lib::TestObjects::PatronFactory->new(); my $patrons = $patronFactory->createTestGroup([ {firstname => 'Olli-Antti', surname => 'Kivi', cardnumber => '1A01', branchcode => 'CPL', flags => '1', #superlibrarian, not exactly a very good way of doing permission testing? userid => 'mini_admin', password => $password, }, ], undef, $testContext); %#Test context set, starting testing: eval { ... #Run your tests here }; if ($@) { #Catch all leaking errors and gracefully terminate. warn $@; tearDown(); exit 1; } %#All tests done, tear down test context tearDown(); done_testing; sub tearDown { t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext); } --- t/lib/TestContext.pm | 63 +++ .../Acquisition/Bookseller/ContactFactory.pm | 153 ++++++ t/lib/TestObjects/Acquisition/BooksellerFactory.pm | 176 +++++++ t/lib/TestObjects/BiblioFactory.pm | 247 +++++++++ t/lib/TestObjects/CheckoutFactory.pm | 205 ++++++++ t/lib/TestObjects/FileFactory.pm | 117 +++++ t/lib/TestObjects/FinesFactory.pm | 166 ++++++ t/lib/TestObjects/HoldFactory.pm | 201 +++++++ t/lib/TestObjects/ItemFactory.pm | 161 ++++++ t/lib/TestObjects/LetterTemplateFactory.pm | 99 ++++ t/lib/TestObjects/MatcherFactory.pm | 213 ++++++++ t/lib/TestObjects/MessageQueueFactory.pm | 158 ++++++ t/lib/TestObjects/ObjectFactory.pm | 405 +++++++++++++++ t/lib/TestObjects/PatronFactory.pm | 178 +++++++ t/lib/TestObjects/Serial/FrequencyFactory.pm | 152 ++++++ t/lib/TestObjects/Serial/SubscriptionFactory.pm | 312 +++++++++++ t/lib/TestObjects/SystemPreferenceFactory.pm | 128 +++++ t/lib/TestObjects/t/biblioItemFactory.t | 160 ++++++ t/lib/TestObjects/t/checkoutFactory.t | 102 ++++ t/lib/TestObjects/t/fileFactory.t | 75 +++ t/lib/TestObjects/t/finesFactory.t | 76 +++ t/lib/TestObjects/t/holdFactory.t | 76 +++ t/lib/TestObjects/t/letterTemplateFactory.t | 56 ++ t/lib/TestObjects/t/matcherFactory.t | 146 ++++++ t/lib/TestObjects/t/messageQueueFactory.t | 79 +++ t/lib/TestObjects/t/objectFactories.t | 575 +++++++++++++++++++++ t/lib/TestObjects/t/patronFactory.t | 56 ++ t/lib/TestObjects/t/systemPreferenceFactory.t | 58 +++ 28 files changed, 4593 insertions(+) create mode 100644 t/lib/TestContext.pm create mode 100644 t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm create mode 100644 t/lib/TestObjects/Acquisition/BooksellerFactory.pm create mode 100644 t/lib/TestObjects/BiblioFactory.pm create mode 100644 t/lib/TestObjects/CheckoutFactory.pm create mode 100644 t/lib/TestObjects/FileFactory.pm create mode 100644 t/lib/TestObjects/FinesFactory.pm create mode 100644 t/lib/TestObjects/HoldFactory.pm create mode 100644 t/lib/TestObjects/ItemFactory.pm create mode 100644 t/lib/TestObjects/LetterTemplateFactory.pm create mode 100644 t/lib/TestObjects/MatcherFactory.pm create mode 100644 t/lib/TestObjects/MessageQueueFactory.pm create mode 100644 t/lib/TestObjects/ObjectFactory.pm create mode 100644 t/lib/TestObjects/PatronFactory.pm create mode 100644 t/lib/TestObjects/Serial/FrequencyFactory.pm create mode 100644 t/lib/TestObjects/Serial/SubscriptionFactory.pm create mode 100644 t/lib/TestObjects/SystemPreferenceFactory.pm create mode 100644 t/lib/TestObjects/t/biblioItemFactory.t create mode 100644 t/lib/TestObjects/t/checkoutFactory.t create mode 100644 t/lib/TestObjects/t/fileFactory.t create mode 100644 t/lib/TestObjects/t/finesFactory.t create mode 100644 t/lib/TestObjects/t/holdFactory.t create mode 100644 t/lib/TestObjects/t/letterTemplateFactory.t create mode 100644 t/lib/TestObjects/t/matcherFactory.t create mode 100644 t/lib/TestObjects/t/messageQueueFactory.t create mode 100644 t/lib/TestObjects/t/objectFactories.t create mode 100644 t/lib/TestObjects/t/patronFactory.t create mode 100644 t/lib/TestObjects/t/systemPreferenceFactory.t diff --git a/t/lib/TestContext.pm b/t/lib/TestContext.pm new file mode 100644 index 0000000..50e71c5 --- /dev/null +++ b/t/lib/TestContext.pm @@ -0,0 +1,63 @@ +package t::lib::TestContext; + +# Copyright KohaSuomi 2016 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use Scalar::Util qw(blessed); +use Try::Tiny; + +use C4::Context; + +use t::lib::TestObjects::PatronFactory; + +=head setUserenv + +Sets the C4::Context->userenv with nice default values, like: + -Being in 'CPL' + +@PARAM1 Koha::Patron, this object must be persisted to DB beforehand, sets the userenv for this borrower + or PatronFactory-params, which create a new borrower and set the userenv for it. +@RETURNS Koha::Patron, the userenv borrower if it was created + +=cut + +sub setUserenv { + my ($borrowerFactoryParams, $testContext) = @_; + + my $borrower; + if ($borrowerFactoryParams) { + if (blessed($borrowerFactoryParams) && $borrowerFactoryParams->isa('Koha::Patron')) { + #We got a nice persisted borrower + $borrower = $borrowerFactoryParams; + } + else { + $borrower = t::lib::TestObjects::PatronFactory->createTestGroup( $borrowerFactoryParams, undef, $testContext ); + } + C4::Context->_new_userenv('DUMMY SESSION'); + C4::Context::set_userenv($borrower->borrowernumber, $borrower->userid, $borrower->cardnumber, $borrower->firstname, $borrower->surname, $borrower->branchcode, 'Library 1', {}, $borrower->email, '', ''); + return $borrower; + } + else { + C4::Context->_new_userenv('DUMMY SESSION'); + C4::Context::set_userenv(0,0,0,'firstname','surname', 'CPL', 'CPL', {}, 'dummysession@example.com', '', ''); + } +} + +1; diff --git a/t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm b/t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm new file mode 100644 index 0000000..6385e6d --- /dev/null +++ b/t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm @@ -0,0 +1,153 @@ +package t::lib::TestObjects::Acquisition::Bookseller::ContactFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use Scalar::Util qw(blessed); + +use Koha::Acquisition::Bookseller::Contacts; +use Koha::Acquisition::Bookseller::Contact; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return 'name'; +} +sub getObjectType { + return 'Koha::Acquisition::Bookseller::Contact'; +} + +=head createTestGroup( $data [, $hashKey, $testContexts...] ) +@OVERLOADED + + my $contacts = t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->createTestGroup([ + {acqprimary => 1, #DEFAULT + claimissues => 1, #DEFAULT + claimacquisition => 1, #DEFAULT + serialsprimary => 1, #DEFAULT + position => 'Boss', #DEFAULT + phone => '+358700123123', #DEFAULT + notes => 'Noted', #DEFAULT + name => "Julius Augustus Caesar", #DEFAULT + fax => '+358700123123', #DEFAULT + email => 'vendor@example.com', #DEFAULT + booksellerid => 12124 #MANDATORY to link to Bookseller + #id => #Don't use id, since we are just adding a new one + }, + {...}, + ], undef, $testContext1, $testContext2, $testContext3); + + #Do test stuff... + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); + +The HASH is keyed with the given $hashKey or 'koha.aqcontacts.name' +See C4::Bookseller::Contact->new() for how the table columns need to be given. + +@PARAM1 ARRAYRef of HASHRefs of VendorContact parameters. +@PARAM2 koha.aqcontacs-column which is used as the test context HASH key, + defaults to the most best option 'name'. +@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple + test contexts. Usually one is enough. These test contexts are + used to help tear down DB changes. +@RETURNS HASHRef of $hashKey => object: + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $object, $stashes) = @_; + + my $contact = Koha::Acquisition::Bookseller::Contact->new(); + $contact->set($object); + $contact->store(); + #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. + my @contacts = Koha::Acquisition::Bookseller::Contacts->search($object); + if (scalar(@contacts)) { + $contact = $contacts[0]; + } + else { + die "No Contact added to DB. Fix me to autorecover from this error!"; + } + + return $contact; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $object, $hashKey) = @_; + + $object->{acqprimary} = 1 unless $object->{acqprimary}; + $object->{claimissues} = 1 unless $object->{claimissues}; + $object->{claimacquisition} = 1 unless $object->{claimacquisition}; + $object->{serialsprimary} = 1 unless $object->{serialsprimary}; + $object->{position} = 'Boss' unless $object->{position}; + $object->{phone} = '+358700123123' unless $object->{phone}; + $object->{notes} = 'Noted' unless $object->{notes}; + $object->{name} = "Julius Augustus Caesar" unless $object->{name}; + $object->{fax} = '+358700123123' unless $object->{fax}; + $object->{email} = 'vendor@example.com' unless $object->{email}; + $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); +} + +=head deleteTestGroup +@OVERLOADED + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $objects) = @_; + + while( my ($key, $object) = each %$objects) { + my $contact = Koha::Acquisition::Bookseller::Contacts->cast($object); + eval { + #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them. + my @contacts = Koha::Acquisition::Bookseller::Contacts->search({name => $contact->name}); + foreach my $c (@contacts) { + $c->delete(); + } + }; + if ($@) { + die $@; + } + } +} + +1; diff --git a/t/lib/TestObjects/Acquisition/BooksellerFactory.pm b/t/lib/TestObjects/Acquisition/BooksellerFactory.pm new file mode 100644 index 0000000..ff30f9e --- /dev/null +++ b/t/lib/TestObjects/Acquisition/BooksellerFactory.pm @@ -0,0 +1,176 @@ +package t::lib::TestObjects::Acquisition::BooksellerFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Scalar::Util qw(blessed); + +use t::lib::TestObjects::Acquisition::Bookseller::ContactFactory; +use Koha::Acquisition::Bookseller; +use Koha::Acquisition::Booksellers; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return 'name'; +} +sub getObjectType { + return 'Koha::Acquisition::Bookseller'; +} + +=head createTestGroup( $data [, $hashKey, $testContexts...] ) +@OVERLOADED + + my $booksellers = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([ + {url => 'www.muscle.com', + name => 'Bookselling Vendor', + postal => 'post', + phone => '+358700123123', + notes => 'Notes', + listprice => 'EUR', + listincgst => 0, + invoiceprice => 'EUR', + invoiceincgst => 0, + gstreg => 1, + tax_rate => 0, + fax => '+358700123123', + discount => 10, + deliverytime => 2, + address1 => 'Where I am', + active => 1, + accountnumber => 'IBAN 123456789 FI', + contacts => [{#Parameters for Koha::Acquisition::Bookseller}, + {#DEFAULT is to use ContactFactory's default values}], + }, + {...}, + ], undef, $testContext1, $testContext2, $testContext3); + + #Do test stuff... + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); + +The HASH is keyed with the given $hashKey or 'koha.aqbookseller.name' + +@PARAM1 ARRAYRef of HASHRefs +@PARAM2 koha.aqbookseller-column which is used as the test context HASH key, + defaults to the most best option 'name'. +@PARAM3-5 HASHRef of test contexts. You can save the given borrowers to multiple + test contexts. Usually one is enough. These test contexts are + used to help tear down DB changes. +@RETURNS HASHRef of $hashKey => Objects: + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $object, $stashes) = @_; + + my $contacts = $object->{contacts}; + delete $object->{contacts}; + + my $bookseller = Koha::Acquisition::Bookseller->new(); + $bookseller->set($object); + $bookseller->store(); + #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. + my @booksellers = Koha::Acquisition::Booksellers->search($object); + if (scalar(@booksellers)) { + $bookseller = $booksellers[0]; + } + else { + die "No Bookseller added to DB. Fix me to autorecover from this error!"; + } + + foreach my $c (@$contacts) { + $c->{booksellerid} = $bookseller->id; + } + #$bookseller->{contacts} = t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->createTestGroup($contacts, undef, @$stashes); + + return $bookseller; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $object, $hashKey) = @_; + + $object->{url} = 'www.muscle.com' unless $object->{url}; + $object->{postal} = 'post' unless $object->{postal}; + $object->{phone} = '+358700123123' unless $object->{phone}; + $object->{notes} = 'Notes' unless $object->{notes}; + $object->{name} = 'Bookselling Vendor' unless $object->{name}; + $object->{listprice} = 'EUR' unless $object->{listprice}; + $object->{listincgst} = 0 unless $object->{listincgst}; + $object->{invoiceprice} = 'EUR' unless $object->{invoiceprice}; + $object->{invoiceincgst} = 0 unless $object->{invoiceincgst}; + $object->{gstreg} = 1 unless $object->{gstreg}; + $object->{tax_rate} = 0 unless $object->{tax_rate}; + $object->{fax} = '+358700123123' unless $object->{fax}; + $object->{discount} = 10 unless $object->{discount}; + $object->{deliverytime} = 2 unless $object->{deliverytime}; + $object->{address1} = 'Where I am' unless $object->{address1}; + $object->{active} = 1 unless $object->{active}; + $object->{accountnumber} = 'IBAN 123456789 FI' unless $object->{accountnumber}; + $object->{contacts} = [{}] unless $object->{contacts}; #Prepare to create one default contact. + + $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); +} + +=head deleteTestGroup +@OVERLOADED + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $objects) = @_; + + while( my ($key, $object) = each %$objects) { + my $bookseller = Koha::Acquisition::Booksellers->cast($object); + eval { + #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them. + my @booksellers = Koha::Acquisition::Booksellers->search({name => $bookseller->name}); + foreach my $b (@booksellers) { + $b->delete(); + } + }; + if ($@) { + die $@; + } + } +} + +1; diff --git a/t/lib/TestObjects/BiblioFactory.pm b/t/lib/TestObjects/BiblioFactory.pm new file mode 100644 index 0000000..eb8257d --- /dev/null +++ b/t/lib/TestObjects/BiblioFactory.pm @@ -0,0 +1,247 @@ +package t::lib::TestObjects::BiblioFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use Scalar::Util qw(blessed); +use MARC::Record; +use MARC::File::XML; + +use C4::Biblio; +use Koha::Database; + +use Koha::Exception::BadParameter; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub getDefaultHashKey { + return 'biblioitems.isbn'; +} +sub getObjectType { + return 'MARC::Record'; +} + +=head t::lib::TestObjects::createTestGroup + + my $record = t::lib::TestObjects::BiblioFactory->createTestGroup( + $marcxml || $MARC::Record, undef, $testContext1, $testContext2, $testContext3); + + my $records = t::lib::TestObjects::BiblioFactory->createTestGroup([ + {'biblio.title' => 'I wish I met your mother', + 'biblio.author' => 'Pertti Kurikka', + 'biblio.copyrightdate' => '1960', + 'biblio.biblionumber' => 1212, + 'biblioitems.isbn' => '9519671580', + 'biblioitems.itemtype' => 'BK', + }, + ], undef, $testContext1, $testContext2, $testContext3); + +Factory takes either a HASH of database table keys, or a MARCXML or a MARC::Record. + +Calls C4::Biblio::TransformKohaToMarc() to make a MARC::Record and add it to +the DB +or +transforms a MARC::Record into database tables. +Returns a HASH of MARC::Records or a single MARC::Record depedning if input is an ARRAY or a single object. + +The HASH is keyed with the 'biblioitems.isbn', or the given $hashKey. Using for example +'biblioitems.isbn' is very much recommended to make linking objects more easy in test cases. +The biblionumber is injected to the MARC::Record-object to be easily accessable, +so we can get it like this: + $records->{$key}->{biblionumber}; + +There is a duplication check to first look for Records with the same ISBN. +If a matching ISBN is found, then we use the existing Record instead of adding a new one. + +See C4::Biblio::TransformKohaToMarc() for how the biblio- or biblioitem-tables' +columns need to be given. + +@RETURNS HASHRef of MARC::Record-objects + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $object, $stashes) = @_; + + my $record; + #Turn the given MARCXML or MARC::Record into a input object. + if (not(ref($object))) { #scalar, prolly MARCXML + $object = MARC::Record::new_from_xml( $object, "utf8", 'marc21' ); + } + elsif ($object->{record} && $object->{record} =~ /{record}, "utf8", 'marc21' ); + } + if (blessed($object) && $object->isa('MARC::Record')) { + ($record, $object) = $class->handleMARCXML($object); + } + else { + ($record, $object) = $class->handleObject($object); + } + + #Clone all the parameters of $object to $record + foreach my $key (keys(%$object)) { + $record->{$key} = $object->{$key}; + } + + return $record; +} + +sub handleMARCXML { + my ($class, $record) = @_; + my ($biblionumber, $biblioitemnumber); + my $object = C4::Biblio::TransformMarcToKoha($record, ''); + $object->{record} = $record; + + $object->{'biblio.title'} = $object->{title}; + delete $object->{title}; + $object->{'biblioitems.isbn'} = $object->{isbn}; + delete $object->{isbn}; + + $class->_validateCriticalFields($object); + + my $existingBiblio = $class->existingObjectFound($object); + + unless ($existingBiblio) { + ($biblionumber, $biblioitemnumber) = C4::Biblio::AddBiblio($record, $object->{frameworkcode} || '', undef); + $record->{biblionumber} = $biblionumber; + $record->{biblioitemnumber} = $biblioitemnumber; + } + else { + ($record, $biblionumber, $biblioitemnumber) = C4::Biblio::UpsertBiblio($record, $object->{frameworkcode} || '', undef); + $record->{biblionumber} = $biblionumber; + $record->{biblioitemnumber} = $biblioitemnumber; + } + return ($record, $object); +} + +sub handleObject { + my ($class, $object) = @_; + my ($record, $biblionumber, $biblioitemnumber); + + $class->_validateCriticalFields($object); + + my $existingBiblio = $class->existingObjectFound($object); + + unless ($existingBiblio) { + $record = C4::Biblio::TransformKohaToMarc($object); + ($biblionumber, $biblioitemnumber) = C4::Biblio::AddBiblio($record,''); + $record->{biblionumber} = $biblionumber; + $record->{biblioitemnumber} = $biblioitemnumber; + } + else { + my $bn = $existingBiblio->biblionumber->biblionumber; + my $bin = $existingBiblio->biblioitemnumber; + $record = C4::Biblio::GetMarcBiblio($bn); #Funny! + $record->{biblionumber} = $bn; + $record->{biblioitemnumber} = $bin; + } + return ($record, $object); +} + +sub existingObjectFound { + my ($class, $object) = @_; + ##First see if the given Record already exists in the DB. For testing purposes we use the isbn as the UNIQUE identifier. + my $resultset = Koha::Database->new()->schema()->resultset('Biblioitem'); + my $existingBiblio = $resultset->search({isbn => $object->{"biblioitems.isbn"}})->next(); + $existingBiblio = $resultset->search({biblionumber => $object->{"biblio.biblionumber"}})->next() unless $existingBiblio; + return $existingBiblio; +} + +sub _validateCriticalFields { + my ($class, $object) = @_; + + unless (ref($object) eq 'HASH' && scalar(%$object)) { + 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."); + } + unless ($object->{'biblio.title'}) { + Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> 'biblio.title' is a mandatory parameter!"); + } + $object->{'biblioitems.isbn'} = '971-972-call-me' unless $object->{'biblioitems.isbn'}; +} + +=head getHashKey +@OVERLOADS +=cut + +sub getHashKey { + my ($class, $object, $primaryKey, $hashKeys) = @_; + + my @collectedHashKeys; + $hashKeys = [$hashKeys] unless ref($hashKeys) eq 'ARRAY'; + foreach my $hashKey (@$hashKeys) { + if (not($hashKey) || + (not($object->{$hashKey}) && not($object->$hashKey())) + ) { + croak $class."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'."; + } + push @collectedHashKeys, $object->{$hashKey} || $object->$hashKey(); + } + return join('-', @collectedHashKeys); +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $object, $hashKey) = @_; +} + +=head + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($class, $records) = @_; + + my ( $biblionumberFieldCode, $biblionumberSubfieldCode ) = + C4::Biblio::GetMarcFromKohaField( "biblio.biblionumber", '' ); + + my $schema = Koha::Database->new_schema(); + while( my ($key, $record) = each %$records) { + my $biblionumber = $record->subfield($biblionumberFieldCode, $biblionumberSubfieldCode); + my @biblios = $schema->resultset('Biblio')->search({"-or" => [{biblionumber => $biblionumber}, + {title => $record->title}]}); + foreach my $b (@biblios) { + $b->delete(); + } + } +} +#sub _deleteTestGroupFromIdentifiers { +# my ($class, $testGroupIdentifiers) = @_; +# +# my $schema = Koha::Database->new_schema(); +# foreach my $isbn (@$testGroupIdentifiers) { +# $schema->resultset('Biblio')->search({"biblioitems.isbn" => $isbn},{join => 'biblioitems'})->delete(); +# $schema->resultset('Biblioitem')->search({isbn => $isbn})->delete(); +# } +#} + +1; diff --git a/t/lib/TestObjects/CheckoutFactory.pm b/t/lib/TestObjects/CheckoutFactory.pm new file mode 100644 index 0000000..1a6a0d7 --- /dev/null +++ b/t/lib/TestObjects/CheckoutFactory.pm @@ -0,0 +1,205 @@ +package t::lib::TestObjects::CheckoutFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use DateTime; + +use C4::Circulation; +use Koha::Patrons; +use Koha::Items; +use Koha::Checkouts; + +use t::lib::TestContext; +use t::lib::TestObjects::PatronFactory; +use t::lib::TestObjects::ItemFactory; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return ['cardnumber', 'barcode']; +} +sub getObjectType { + return 'Koha::Checkout'; +} + +=head t::lib::TestObjects::CheckoutFactory::createTestGroup( $data [, $hashKey], @stashes ) + + my $checkoutFactory = t::lib::TestObjects::CheckoutFactory->new(); + my $checkouts = $checkoutFactory->createTestGroup([ + {#Checkout params + }, + {#More checkout params + }, + ], undef, $testContext1, $testContext2, $testContext3); + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1); + +@PARAM1, ARRAY of HASHes. + [ { + cardnumber => '167Azava0001', + barcode => '167Nfafa0010', + daysOverdue => 7, #This Checkout's duedate was 7 days ago. If undef, then uses today as the checkout day. + daysAgoCheckedout => 28, #This Checkout hapened 28 days ago. If undef, then uses today. + checkoutBranchRule => 'homebranch' || 'holdingbranch' #From which branch this item is checked out from. + }, + { + ... + } + ] +@PARAM2, String, the HASH-element to use as the returning HASHes key. +@PARAM3, String, the rule on where to check these Issues out: + 'homebranch', uses the Item's homebranch as the checkout branch + 'holdingbranch', uses the Item's holdingbranch as the checkout branch + undef, uses the current Environment branch + '', checks out all Issues from the given branchCode +@PARAM4-6 HASHRef of test contexts. You can save the given objects to multiple + test contexts. Usually one is enough. These test contexts are + used to help tear down DB changes. +@RETURNS HASHRef of $hashKey => Koha::Checkout-objects. + The HASH is keyed with -, or the given $hashKey. + Example: { + '11A001-167N0212' => Koha::Checkout, + ... + } +} +=cut + +sub handleTestObject { + my ($class, $checkoutParams, $stashes) = @_; + + #If running this test factory from unit tests or bare script, the context might not have been initialized. + unless (C4::Context->userenv()) { #Defensive programming to help debug misconfiguration + t::lib::TestContext::setUserenv(); + } + my $oldContextBranch = C4::Context->userenv()->{branch}; + + my $borrower = t::lib::TestObjects::PatronFactory->createTestGroup( + {cardnumber => $checkoutParams->{cardnumber}}, + undef, @$stashes); + + my $item = Koha::Items->find({barcode => $checkoutParams->{barcode}}); + unless($item) { + my $items = t::lib::TestObjects::ItemFactory->createTestGroup( + {barcode => $checkoutParams->{barcode}}, + undef, @$stashes); + $item = $items->{ $checkoutParams->{barcode} }; + } + + my $duedate = DateTime->now(time_zone => C4::Context->tz()); + if ($checkoutParams->{daysOverdue}) { + $duedate->subtract(days => $checkoutParams->{daysOverdue} ); + } + + my $checkoutdate = DateTime->now(time_zone => C4::Context->tz()); + if ($checkoutParams->{daysAgoCheckedout}) { + $checkoutdate->subtract(days => $checkoutParams->{daysAgoCheckedout} ); + } + + #Set the checkout branch + my $checkoutBranch; + my $checkoutBranchRule = $checkoutParams->{checkoutBranchRule}; + if (not($checkoutBranchRule)) { + #Use the existing userenv()->{branch} + } + elsif ($checkoutBranchRule eq 'homebranch') { + $checkoutBranch = $item->homebranch; + } + elsif ($checkoutBranchRule eq 'holdingbranch') { + $checkoutBranch = $item->holdingbranch; + } + elsif ($checkoutBranchRule) { + $checkoutBranch = $checkoutBranchRule; + } + C4::Context->userenv()->{branch} = $checkoutBranch if $checkoutBranch; + + my $datedue = C4::Circulation::AddIssue( $borrower->unblessed, $checkoutParams->{barcode}, $duedate, undef, $checkoutdate ); + #We want the issue_id as well. + my $checkout = Koha::Checkouts->find({ borrowernumber => $borrower->borrowernumber, itemnumber => $item->itemnumber }); + unless ($checkout) { + carp "CheckoutFactory:> No checkout for cardnumber '".$checkoutParams->{cardnumber}."' and barcode '".$checkoutParams->{barcode}."'"; + return; + } + + ##Inject default hash keys + $checkout->{barcode} = $item->barcode; + $checkout->{cardnumber} = $borrower->cardnumber; + return $checkout; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $object, $hashKey) = @_; + $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); + + unless ($object->{cardnumber}) { + croak __PACKAGE__.":> Mandatory parameter 'cardnumber' missing."; + } + unless ($object->{barcode}) { + croak __PACKAGE__.":> Mandatory parameter 'barcode' missing."; + } + + if ($object->{checkoutBranchRule} && not($object->{checkoutBranchRule} =~ m/(homebranch)|(holdingbranch)/)) { + croak __PACKAGE__.":> Optional parameter 'checkoutBranchRule' must be one of these: homebranch, holdingbranch"; + } +} + +=head + + my $objects = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $objects) = @_; + + while( my ($key, $object) = each %$objects) { + my $checkout = Koha::Checkouts->cast($object); + $checkout->delete(); + } +} +sub _deleteTestGroupFromIdentifiers { + my ($self, $testGroupIdentifiers) = @_; + + my $schema = Koha::Database->new_schema(); + foreach my $key (@$testGroupIdentifiers) { + $schema->resultset('Issue')->find({"issue_id" => $key})->delete(); + } +} + +1; diff --git a/t/lib/TestObjects/FileFactory.pm b/t/lib/TestObjects/FileFactory.pm new file mode 100644 index 0000000..a6e5da8 --- /dev/null +++ b/t/lib/TestObjects/FileFactory.pm @@ -0,0 +1,117 @@ +package t::lib::TestObjects::FileFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use File::Spec; +use File::Path; + +use Koha::Database; +use File::Fu::File; + +use Koha::Exception::BadParameter; + +use base qw(t::lib::TestObjects::ObjectFactory); + +my $tmpdir = File::Spec->tmpdir(); + +sub getDefaultHashKey { + return 'OVERLOADED'; +} +sub getObjectType { + return 'File::Fu::File'; +} + +=head t::lib::TestObjects::createTestGroup + + my $files = t::lib::TestObjects::FileFactory->createTestGroup([ + {'filepath' => 'atomicupdate/', #this is prepended with the system's default tmp directory, usually /tmp/ + 'filename' => '#30-RabiesIsMyDog.pl', + 'content' => 'print "Mermaids are my only love\nI never let them down";', + }, + ], ['filepath', 'filename'], $testContext1, $testContext2, $testContext3); + +Calls Koha::FileFactory to add files with content to your system, and clean up automatically. + +The HASH is keyed with the 'filename', or the given $hashKeys. + +@RETURNS HASHRef of File::Fu::File-objects + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $object, $stashes) = @_; + + my $absolutePath = $tmpdir.'/'.$object->{filepath}; + File::Path::make_path($absolutePath); + my $file = File::Fu::File->new($absolutePath.'/'.$object->{filename}); + + $file->write($object->{content}) if $object->{content}; + + return $file; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $object, $hashKey) = @_; + + foreach my $param (('filename', 'filepath')) { + unless ($object->{$param}) { + Koha::Exception::BadParameter->throw( + error => __PACKAGE__."->validateAndPopulateDefaultValues():> parameter '$param' is mandatory."); + } + if ($object->{$param} =~ m/(\$|\.\.|~|\s)/) { + Koha::Exception::BadParameter->throw( + error => __PACKAGE__."->validateAndPopulateDefaultValues():> parameter '$param' as '".$object->{$param}."'.". + 'Disallowed characters present .. ~ $ + whitespace'); + } + } +} + +sub deleteTestGroup { + my ($class, $objects) = @_; + + while( my ($key, $object) = each %$objects) { + $object->remove if $object->e; + #We could as well remove the complete subfolder but I am too afraid to automate "rm -r" here + } +} + +=head getHashKey +@OVERLOADED + +@RETURNS String, The test context/stash HASH key to differentiate this object + from all other such test objects. +=cut + +sub getHashKey { + my ($class, $fileObject, $primaryKey, $hashKeys) = @_; + + return $fileObject->get_file(); +} + +1; diff --git a/t/lib/TestObjects/FinesFactory.pm b/t/lib/TestObjects/FinesFactory.pm new file mode 100644 index 0000000..bf5f18c --- /dev/null +++ b/t/lib/TestObjects/FinesFactory.pm @@ -0,0 +1,166 @@ +package t::lib::TestObjects::FinesFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use Scalar::Util qw(blessed); +use Try::Tiny; + +use C4::Members; +use C4::Accounts; +use Koha::Patrons; + +use base qw(t::lib::TestObjects::ObjectFactory); + +use t::lib::TestObjects::PatronFactory; + +use Koha::Exception::ObjectExists; + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return 'note'; +} +sub getObjectType { + return 'HASH'; +} + +=head createTestGroup( $data [, $hashKey, $testContexts...] ) +@OVERLOADED + + FinesFactory creates new fines into accountlines. + After testing, all fines created by the FinesFactory will be + deleted at tearDown. + + my $fines = t::lib::TestObjects::FinesFactory->createTestGroup([ + amount => 10.0, + cardnumber => $borrowers->{'superuberadmin'}->cardnumber, + accounttype => 'FU', + note => 'unique identifier', + }, + ], undef, $testContext1, $testContext2, $testContext3); + + #Do test stuff... + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $fine, $stashes) = @_; + + my $borrower; + try { + $borrower = Koha::Patrons->cast($fine->{cardnumber}); + } catch { + die $_ unless (blessed($_) && $_->can('rethrow')); + if ($_->isa('Koha::Exception::UnknownObject')) { + $borrower = t::lib::TestObjects::PatronFactory->createTestGroup({cardnumber => $fine->{cardnumber}}, undef, @$stashes); + } + else { + $_->rethrow(); + } + }; + + my $accountno = C4::Accounts::getnextacctno($borrower->borrowernumber); + + C4::Accounts::manualinvoice( + $borrower->borrowernumber, # borrowernumber + $fine->{itemnumber}, # itemnumber + $fine->{description}, # description + $fine->{accounttype}, # accounttype + $fine->{amount}, # amountoutstanding + $fine->{note} # note, unique identifier + ); + + my $new_fine = $fine; + + $new_fine->{accountno} = $accountno; + + return $new_fine; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($class, $object, $hashKey) = @_; + $class->SUPER::validateAndPopulateDefaultValues($object, $hashKey); + + unless ($object->{cardnumber}) { + Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> 'cardnumber' is a mandatory parameter!"); + } + unless ($object->{note}) { + Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> 'note' is a mandatory parameter!"); + } + + $object->{itemnumber} = undef unless defined $object->{itemnumber}; + $object->{description} = "Test payment" unless defined $object->{description}; + $object->{accounttype} = "FU" unless defined $object->{accounttype}; +} + +=head deleteTestGroup +@OVERLOADED + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($prefs); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($class, $acct) = @_; + + my $schema = Koha::Database->new_schema(); + while( my ($key, $val) = each %$acct) { + if ($schema->resultset('Accountline')->find({"note" => $val->{note} })) { + $schema->resultset('Accountline')->find({"note" => $val->{note} })->delete(); + } + } +} + +sub _deleteTestGroupFromIdentifiers { + my ($self, $testGroupIdentifiers) = @_; + + my $schema = Koha::Database->new_schema(); + foreach my $key (@$testGroupIdentifiers) { + if ($schema->resultset('Accountline')->find({"note" => $key})) { + $schema->resultset('Accountline')->find({"note" => $key})->delete(); + } + } +} + + +1; diff --git a/t/lib/TestObjects/HoldFactory.pm b/t/lib/TestObjects/HoldFactory.pm new file mode 100644 index 0000000..0928c9c --- /dev/null +++ b/t/lib/TestObjects/HoldFactory.pm @@ -0,0 +1,201 @@ +package t::lib::TestObjects::HoldFactory; + +# Copyright KohaSuomi 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use DateTime; + +use C4::Context; +use Koha::Database; +use C4::Circulation; +use C4::Members; +use C4::Items; +use C4::Reserves; +use Koha::Patrons; +use Koha::Biblios; +use Koha::Items; +use Koha::Checkouts; + +use t::lib::TestObjects::PatronFactory; +use t::lib::TestObjects::ItemFactory; +use t::lib::TestObjects::BiblioFactory; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return ['reservenotes']; +} +sub getObjectType { + return 'HASH'; +} + +=head t::lib::TestObjects::HoldFactory::createTestGroup( $data [, $hashKey], @stashes ) + + my $holds = t::lib::TestObjects::HoldFactory->createTestGroup([ + {#Hold params + }, + {#More hold params + }, + ], undef, $testContext1, $testContext2, $testContext3); + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1); + +@PARAM1, ARRAY of HASHes. + [ { + cardnumber => '167Azava0001', #Patron's cardnumber + isbn => '971040323123', #ISBN of the Biblio, even if the record normally doesn't have a ISBN, you must mock one on it. + barcode => undef || '911N12032', #Item's barcode, if this is an Item-level hold. + branchcode => 'CPL', + waitingdate => undef || '2015-01-15', #Since when has this hold been waiting for pickup? + }, + { + ... + } + ] +@PARAM2, String, the HASH-element to use as the returning HASHes key. +@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple + test contexts. Usually one is enough. These test contexts are + used to help tear down DB changes. +@RETURNS HASHRef of $hashKey => HASH-objects representing koha.reserves-table columns + The HASH is keyed with , or the given $hashKey. + Example: { + '11A001-971040323123-43' => {...}, + 'my-nice-hold' => {...}, + ... + } +} +=cut + +sub handleTestObject { + my ($class, $object, $stashes) = @_; +$DB::single=1; + C4::Reserves::AddReserve($object->{branchcode} || 'CPL', + $object->{borrower}->borrowernumber, + $object->{biblio}->{biblionumber}, + undef, #bibitems + undef, #priority + $object->{reservedate}, #resdate + $object->{expirationdate}, #expdate + $object->{reservenotes}, #notes + undef, #title + ($object->{item} ? $object->{item}->itemnumber : undef), #checkitem + undef, #found + ); + my $reserve_id = C4::Reserves::GetReserveId({biblionumber => $object->{biblio}->{biblionumber}, + itemnumber => ($object->{item} ? $object->{item}->itemnumber : undef), + borrowernumber => $object->{borrower}->borrowernumber, + }); + unless ($reserve_id) { + die "HoldFactory->handleTestObject():> Couldn't create a reserve. for isbn => ".$object->{isbn}.", barcode => ".$object->{barcode}. + ", item => ".($object->{barcode} ? $object->{barcode} : '')."\n"; + } + my $hold = C4::Reserves::GetReserve($reserve_id); + foreach my $key (keys %$object) { + $hold->{$key} = $object->{$key}; + } + + if ($object->{waitingdate}) { + eval { + C4::Reserves::ModReserveAffect($hold->{item}->itemnumber, $hold->{borrower}->borrowernumber); + + #Modify the waitingdate. An ugly hack for a ugly module. Bear with me my men! + my $dbh = C4::Context->dbh; + my $query = "UPDATE reserves SET waitingdate = ? WHERE reserve_id = ?"; + my $sth = $dbh->prepare($query); + $sth->execute( $hold->{waitingdate}, $hold->{reserve_id} ); + }; + if ($@) { + warn "HoldFactory->handleTestObject():> Error when setting the waitingdate for ".$class->getHashKey($object)."$@"; + } + } + + return $hold; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $object, $hashKey, $stashes) = @_; + $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); + + unless ($object->{cardnumber}) { + croak __PACKAGE__.":> Mandatory parameter 'cardnumber' missing."; + } + unless ($object->{isbn}) { + croak __PACKAGE__.":> Mandatory parameter 'isbn' missing."; + } + + my $borrower = t::lib::TestObjects::PatronFactory->createTestGroup( + {cardnumber => $object->{cardnumber}}, + undef, @$stashes); + $object->{borrower} = $borrower if $borrower; + + my $biblio = t::lib::TestObjects::BiblioFactory->createTestGroup({"biblio.title" => "Test holds' Biblio", + "biblioitems.isbn" => $object->{isbn}}, + undef, @$stashes); + $object->{biblio} = $biblio if $biblio; + + #Get test Item + if ($object->{barcode}) { + my $item = t::lib::TestObjects::ItemFactory->createTestGroup({barcode => $object->{barcode}, isbn => $object->{isbn}}, undef, @$stashes); + $object->{item} = $item; + } + + return $object; +} + +=head + + my $objects = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $objects) = @_; + + #For some reason DBIx cannot delete from OldReserves-table so using DBI and not losing sleep + my $dbh = C4::Context->dbh(); + my $del_old_sth = $dbh->prepare("DELETE FROM old_reserves WHERE reserve_id = ?"); + my $del_sth = $dbh->prepare("DELETE FROM reserves WHERE reserve_id = ?"); + + while( my ($key, $object) = each %$objects) { + $del_sth->execute($object->{reserve_id}); + $del_old_sth->execute($object->{reserve_id}); + } +} + +1; diff --git a/t/lib/TestObjects/ItemFactory.pm b/t/lib/TestObjects/ItemFactory.pm new file mode 100644 index 0000000..f81f12f --- /dev/null +++ b/t/lib/TestObjects/ItemFactory.pm @@ -0,0 +1,161 @@ +package t::lib::TestObjects::ItemFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; + +use C4::Items; +use Koha::Biblios; +use Koha::Biblioitems; +use Koha::Items; +use Koha::Checkouts; + +use t::lib::TestObjects::BiblioFactory; + +use Scalar::Util qw(blessed); + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return 'barcode'; +} +sub getObjectType { + return 'Koha::Item'; +} + +=head t::lib::TestObjects::ItemFactory::createTestGroup( $data [, $hashKey] ) +@OVERLOADED + +Returns a HASH of objects. +Each Item is expected to contain the biblionumber of the Biblio they are added into. + eg. $item->{biblionumber} = 550242; + +The HASH is keyed with the 'barcode', or the given $hashKey. + +See C4::Items::AddItem() for how the table columns need to be given. + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $object, $stashes) = @_; + + #Look for the parent biblio, if we don't find one, create a default one. + my ($biblionumber, $biblioitemnumber, $itemnumber); + my $biblio = t::lib::TestObjects::BiblioFactory->createTestGroup({"biblio.title" => "Test Items' Biblio", + "biblioitems.isbn" => $object->{isbn}, + "biblio.biblionumber" => $object->{biblionumber}}, + undef, @$stashes); + $object->{biblionumber} = $biblio->{biblionumber}; + $object->{biblio} = $biblio; + + #Ok we got a biblio, now we can add an Item for it. First see if the Item already exists. + my $item; + eval { + eval { + $item = Koha::Items->cast($object); + }; + unless ($item) { + ($biblionumber, $biblioitemnumber, $itemnumber) = C4::Items::AddItem($object, $object->{biblionumber}); + } + }; + if ($@) { + if (blessed($@) && $@->isa('DBIx::Class::Exception') && + $@->{msg} =~ /Duplicate entry '.+?' for key 'itembarcodeidx'/) { #DBIx should throw other types of exceptions instead of this general type :( + #This exception type is OK, we ignore this and try fetching the existing Object next. + warn "Recovering from duplicate exception.\n"; + } + else { + die $@; + } + } + $item = Koha::Items->cast($itemnumber || $object) unless $item; + unless ($item) { + carp "ItemFactory:> No item for barcode '".$object->{barcode}."'"; + next(); + } + + return $item; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $item, $hashKey) = @_; + $self->SUPER::validateAndPopulateDefaultValues($item, $hashKey); + + $item->{homebranch} = $item->{homebranch} || 'CPL'; + $item->{holdingbranch} = $item->{holdingbranch} || $item->{homebranch} || 'CPL'; + $item->{itemcallnumber} = 'PRE 84.FAN POST' unless $item->{itemcallnumber}; +} + +=head +@OVERLOADED + + my $objects = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $objects) = @_; + + while( my ($key, $object) = each %$objects) { + my $item = Koha::Items->cast($object); + + #Delete all attached checkouts + my @checkouts = Koha::Checkouts->search({itemnumber => $item->itemnumber}); + foreach my $c (@checkouts) { + $c->delete; + } + + $item->delete(); + } +} +sub _deleteTestGroupFromIdentifiers { + my ($self, $testGroupIdentifiers) = @_; + + foreach my $key (@$testGroupIdentifiers) { + my $item = Koha::Items->cast($key); + my @checkouts = Koha::Checkouts->search({itemnumber => $item->itemnumber}); + foreach my $c (@checkouts) { + $c->delete; + } + $item->delete(); + } +} + +1; diff --git a/t/lib/TestObjects/LetterTemplateFactory.pm b/t/lib/TestObjects/LetterTemplateFactory.pm new file mode 100644 index 0000000..47050c3 --- /dev/null +++ b/t/lib/TestObjects/LetterTemplateFactory.pm @@ -0,0 +1,99 @@ +package t::lib::TestObjects::LetterTemplateFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; + +use C4::Letters; +use Koha::Notice::Templates; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return ['module', 'code', 'branchcode', 'message_transport_type']; +} +sub getObjectType { + return 'Koha::Notice::Template'; +} + +=head t::lib::TestObjects::LetterTemplateFactory->createTestGroup +Returns a HASH of Koha::Notice::Template-objects +The HASH is keyed with the PRIMARY KEYS eg. 'circulation-ODUE2-CPL-print', or the given $hashKey. +=cut + +#Incredibly the Letters-module has absolutely no Create or Update-component to operate on Letter templates? +#Tests like these are brittttle. :( +sub handleTestObject { + my ($class, $object, $stashes) = @_; + + my $schema = Koha::Database->new->schema(); + my $rs = $schema->resultset('Letter'); + my $result = $rs->update_or_create({ + module => $object->{module}, + code => $object->{code}, + branchcode => ($object->{branchcode}) ? $object->{branchcode} : '', + name => $object->{name}, + is_html => $object->{is_html}, + title => $object->{title}, + message_transport_type => $object->{message_transport_type}, + content => $object->{content}, + }); + + return Koha::Notice::Templates->cast($result); +} + +=head + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $letterTemplates) = @_; + + my $schema = Koha::Database->new_schema(); + while( my ($key, $letterTemplate) = each %$letterTemplates ) { + $letterTemplate->delete(); + } +} + +sub _deleteTestGroupFromIdentifiers { + my $testGroupIdentifiers = shift; + + my $schema = Koha::Database->new_schema(); + foreach my $key (@$testGroupIdentifiers) { + my ($module, $code, $branchcode, $mtt) = split('-',$key); + $schema->resultset('Letter')->find({module => $module, + code => $code, + branchcode => $branchcode, + message_transport_type => $mtt, + })->delete(); + } +} + +1; diff --git a/t/lib/TestObjects/MatcherFactory.pm b/t/lib/TestObjects/MatcherFactory.pm new file mode 100644 index 0000000..02b7afb --- /dev/null +++ b/t/lib/TestObjects/MatcherFactory.pm @@ -0,0 +1,213 @@ +package t::lib::TestObjects::MatcherFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; + +use C4::Matcher; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub getDefaultHashKey { + return 'code'; +} +sub getObjectType { + return 'C4::Matcher'; +} + +=head t::lib::TestObjects::createTestGroup + + my $matchers = t::lib::TestObjects::MatcherFactory->createTestGroup([ + {code => 'MATCHER', + description => 'I dunno', + threshold => 1000, + matchpoints => [ + { + index => 'title', + score => 500, + components => [{ + tag => '245', + subfields => 'a', + offset => 0, + length => 0, + norms => [''], + }] + }, + { + index => 'author', + score => 500, + components => [{ + tag => '100', + subfields => 'a', + offset => 0, + length => 0, + norms => [''], + }] + } + ], + required_checks => [ + { + source => [{ + tag => '020', + subfields => 'a', + offset => 0, + length => 0, + norms => ['copy'], + }], + target => [{ + tag => '024', + subfields => 'a', + offset => 0, + length => 0, + norms => ['paste'], + }], + }, + { + source => [{ + tag => '044', + subfields => 'a', + offset => 0, + length => 0, + norms => ['copy'], + }], + target => [{ + tag => '048', + subfields => 'a', + offset => 0, + length => 0, + norms => ['paste'], + }], + } + ], + }, + ], undef, $testContext1, $testContext2, $testContext3); + +Calls C4::Matcher to add a C4::Matcher object or objects to DB. + +The HASH is keyed with the 'koha.marc_matchers.code', or the given $hashKey. + +There is a duplication check to first look for C4::Matcher-rows with the same 'code'. +If a matching C4::Matcher is found, then we use the existing object. + +@RETURNS HASHRef of C4::Matcher-objects + or a C4::Matcher-object + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $object, $stashes) = @_; + + ##First see if the given Record already exists in the DB. For testing purposes we use the isbn as the UNIQUE identifier. + my $matcher; + my $id = C4::Matcher::GetMatcherId($object->{code}); + if ($id) { + $matcher = C4::Matcher->fetch($id); + } + else { + $matcher = C4::Matcher->new('biblio', $object->{threshold} || 1000); + + $matcher->code( $object->{code} ); + $matcher->description( $object->{description} ) if $object->{description}; + + ##Add matchpoints + if ($object->{matchpoints}) { + foreach my $mc (@{$object->{matchpoints}}) { + $matcher->add_matchpoint($mc->{index}, $mc->{score}, $mc->{components}); + } + } + else { + $matcher->add_matchpoint('title', 500, [{ + tag => '245', + subfields => 'a', + offset => 0, + length => 0, + norms => [''], + }]); + $matcher->add_matchpoint('author', 500, [{ + tag => '100', + subfields => 'a', + offset => 0, + length => 0, + norms => [''], + }]); + } + + ##Add match checks + if ($object->{required_checks}) { + foreach my $rc (@{$object->{required_checks}}) { + $matcher->add_required_check($rc->{source}, $rc->{target}); + } + } + else { + $matcher->add_required_check( + [{ + tag => '020', + subfields => 'a', + offset => 0, + length => 0, + norms => ['copy'], + }], + [{ + tag => '024', + subfields => 'a', + offset => 0, + length => 0, + norms => ['paste'], + }] + ); + } + + $matcher->store(); + } + + return $matcher; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $object, $hashKey) = @_; + + $object->{code} = 'MATCHER' unless $object->{code}; + + $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); +} + +sub deleteTestGroup { + my ($class, $objects) = @_; + + while( my ($key, $object) = each %$objects) { + my $matcher = $objects->{$key}; + eval { + C4::Matcher->delete( $matcher->{id} ); + }; + if ($@) { + warn "$class->deleteTestGroup():> Error hapened: $@\n"; + } + } +} + +1; diff --git a/t/lib/TestObjects/MessageQueueFactory.pm b/t/lib/TestObjects/MessageQueueFactory.pm new file mode 100644 index 0000000..1f2f472 --- /dev/null +++ b/t/lib/TestObjects/MessageQueueFactory.pm @@ -0,0 +1,158 @@ +package t::lib::TestObjects::MessageQueueFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use Scalar::Util qw(blessed); +use Try::Tiny; + +use C4::Members; +use C4::Letters; +use Koha::Patrons; + +use t::lib::TestObjects::PatronFactory; + +use base qw(t::lib::TestObjects::ObjectFactory); + +use Koha::Exception::ObjectExists; + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return 'from_address'; +} +sub getObjectType { + return 'HASH'; +} + +=head createTestGroup( $data [, $hashKey, $testContexts...] ) +@OVERLOADED + + MessageQueueFactory creates a new message into message_queue table with 'pending' + status. After testing, all messages created by the MessageQueueFactory will be + deleted at tearDown. + + my $messages = t::lib::TestObjects::MessageQueueFactory->createTestGroup([ + subject => "Test title", + content => "Tessst content", + cardnumber => $borrowers->{'superuberadmin'}->cardnumber, + message_transport_type => 'sms', + from_address => 'test@unique.com', + }, + ], undef, $testContext1, $testContext2, $testContext3); + + #Do test stuff... + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $notice, $stashes) = @_; + + my ($borrower, $letter, $message_id); + try { + $borrower = Koha::Patrons->cast($notice->{cardnumber}); + } catch { + if (blessed($_)) { + $_->rethrow(); + } + else { + die $_; + } + }; + + $letter = { + title => $notice->{subject} || '', + content => $notice->{content}, + content_type => $notice->{content_type}, + letter_code => $notice->{letter_code}, + }; + $message_id = C4::Letters::EnqueueLetter({ + letter => $letter, + borrowernumber => $borrower->borrowernumber, + message_transport_type => $notice->{message_transport_type}, + to_address => $notice->{to_address}, + from_address => $notice->{from_address}, + }); + + #return the persisted MessageQueue with linked objects referenced + $notice = C4::Letters::GetMessage($message_id); + $notice->{borrower} = $borrower; + + return $notice; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($class, $object, $hashKey) = @_; + $class->SUPER::validateAndPopulateDefaultValues($object, $hashKey); + + unless ($object->{cardnumber}) { + Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> 'cardnumber' is a mandatory parameter!"); + } + unless ($object->{from_address}) { + Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> 'from_address' is a mandatory parameter!"); + } + + # Other required fields + $object->{subject} = "Hello world" unless defined $object->{subject}; + $object->{message_transport_type} = 'email' unless defined $object->{message_transport_type}; + $object->{content} = "Example message content" unless defined $object->{content}; +} + +=head deleteTestGroup +@OVERLOADED + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($prefs); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($class, $messages) = @_; + + my $schema = Koha::Database->new_schema(); + while( my ($key, $msg) = each %$messages) { + if ($schema->resultset('MessageQueue')->find({"message_id" => $msg->{message_id}})) { + $schema->resultset('MessageQueue')->find({"message_id" => $msg->{message_id}})->delete(); + } + } +} + +1; diff --git a/t/lib/TestObjects/ObjectFactory.pm b/t/lib/TestObjects/ObjectFactory.pm new file mode 100644 index 0000000..8bb7ce7 --- /dev/null +++ b/t/lib/TestObjects/ObjectFactory.pm @@ -0,0 +1,405 @@ +package t::lib::TestObjects::ObjectFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use Scalar::Util qw(blessed); +use Koha::Exception::BadParameter; +use Koha::Exception::UnknownObject; + +=head createTestGroup( $data [, $hashKey, $testContexts...] ) + + my $factory = t::lib::TestObjects::ObjectFactory->new(); + my $objects = $factory->createTestGroup([ + #Imagine if using the PatronFactory + {firstname => 'Olli-Antti', + surname => 'Kivi', + cardnumber => '11A001', + branchcode => 'CPL', + ... + }, + #Or if using the ItemFactory + {biblionumber => 123413, + barcode => '11N002', + homebranch => 'FPL', + ... + }, + ], $hashKey, $testContext1, $testContext2, $testContext3); + + #Do test stuff... + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); + +The HASH is keyed with the given $hashKey or the default hash key accessed with +getDefaultHashKey() +See the createTestGroup() documentation in the implementing Factory-class for how +the table columns need to be given. + +@PARAM1 ARRAYRef of HASHRefs of desired Object constructor parameters + or + HASHRef of desired Object constructor parameters +@PARAM2 koha.-column which is used as the test context HASH key to find individual Objects, + usually defaults to to one of the UNIQUE database keys. +@PARAM3-5 HASHRef of test contexts. You can save the given Objects to multiple + test contexts. Usually one is enough. These test contexts are + used to help tear down DB changes. +@RETURNS HASHRef of $hashKey => Objects, eg. + { $hashKey => {#borrower1 HASH}, + $hashKey => {#borrower2 HASH}, + } + or + Object, single object reference if the constructors parameters were given as a HASHRef instead +=cut + +sub createTestGroup { + my ($class, $objects, $hashKey, $featureStash, $scenarioStash, $stepStash) = @_; + my $stashes = [$featureStash, $scenarioStash, $stepStash]; + $class->_validateStashes(@$stashes); + $hashKey = $class->getDefaultHashKey() unless $hashKey; + + my $retType = 'HASHRef'; + unless (ref($objects) eq 'ARRAY') { + $objects = [$objects]; + $retType = 'SCALAR'; + } + + my %objects; + foreach my $o (@$objects) { + $class->validateAndPopulateDefaultValues($o, $hashKey, $stashes); + + my $addedObject = $class->handleTestObject($o, $stashes); + if (not($addedObject) || + (blessed($addedObject) && not($addedObject->isa($class->getObjectType()))) || + not(ref($addedObject) eq $class->getObjectType() ) + ) { + Koha::Exception::UnknownObject->throw(error => __PACKAGE__."->createTestGroup():> Subroutine '$class->handleTestObject()' must return a HASH or a Koha::Object"); + } + + my $key = $class->getHashKey($addedObject, undef, $hashKey); + $objects{$key} = $addedObject; + } + + $class->_persistToStashes(\%objects, $class->getHashGroupName(), @$stashes); + + if ($retType eq 'HASHRef') { + return \%objects; + } + else { + foreach my $key (keys %objects) { + return $objects{$key}; + } + } +} + +=head getHashGroupName +@OVERRIDABLE + +@RETURNS String, the test context/stash key under which all of these test objects are put. + The key is calculated by default from the last components of the Object package, + but it is possible to override this method from the subclass to force another key. + Eg. 't::lib::PageObject::Acquisition::Bookseller::ContactFactory' becomes + acquisition-bookseller-contact +=cut + +sub getHashGroupName { + my ($class) = @_; + + my $excludedPackageStart = 't::lib::TestObjects'; + unless ($class =~ m/^${excludedPackageStart}::(.+?)Factory/i) { + Koha::Exception::BadParameter->throw(error => + "$class->getHashGroupName():> Couldn't parse the class name to the default test stash group name. Your class is badly named. Expected format '${excludedPackageStart}::[::Submodule]::Factory'"); + } + my @e = split('::', lc($1)); + return join('-', @e); +} + +sub handleTestObject {} #OVERLOAD THIS FROM SUBCLASS +sub deleteTestGroup {} #OVERLOAD THIS FROM SUBCLASS + +=head tearDownTestContext + +Given a testContext stash populated using one of the TestObjectFactory implementations createTestGroup()-subroutines, +Removes all the persisted objects in the stash. + +TestObjectFactories must be lazy loaded here to make it possible for them to subclass this. +=cut + +sub tearDownTestContext { + my ($self, $stash) = @_; + unless (ref($stash) eq 'HASH') { + Koha::Exception::BadParameter->throw(error => "Parameter '\$stash' is not a HASHref. You must call this subroutine with -> instead of ::"); + } + + ##You should introduce tearDowns in such an order that to not provoke FOREIGN KEY issues. + if ($stash->{'file'}) { + require t::lib::TestObjects::FileFactory; + t::lib::TestObjects::FileFactory->deleteTestGroup($stash->{'file'}); + delete $stash->{'file'}; + } + if ($stash->{'serial-subscription'}) { + require t::lib::TestObjects::Serial::SubscriptionFactory; + t::lib::TestObjects::Serial::SubscriptionFactory->deleteTestGroup($stash->{'serial-subscription'}); + delete $stash->{'serial-subscription'}; + } + if ($stash->{'acquisition-bookseller-contact'}) { + require t::lib::TestObjects::Acquisition::Bookseller::ContactFactory; + t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->deleteTestGroup($stash->{'acquisition-bookseller-contact'}); + delete $stash->{'acquisition-bookseller-contact'}; + } + if ($stash->{'acquisition-bookseller'}) { + require t::lib::TestObjects::Acquisition::BooksellerFactory; + t::lib::TestObjects::Acquisition::BooksellerFactory->deleteTestGroup($stash->{'acquisition-bookseller'}); + delete $stash->{'acquisition-bookseller'}; + } + if ($stash->{'labels-sheet'}) { + require t::lib::TestObjects::Labels::SheetFactory; + t::lib::TestObjects::Labels::SheetFactory->deleteTestGroup($stash->{'labels-sheet'}); + delete $stash->{'labels-sheet'}; + } + if ($stash->{checkout}) { + require t::lib::TestObjects::CheckoutFactory; + t::lib::TestObjects::CheckoutFactory->deleteTestGroup($stash->{checkout}); + delete $stash->{checkout}; + } + if ($stash->{item}) { + require t::lib::TestObjects::ItemFactory; + t::lib::TestObjects::ItemFactory->deleteTestGroup($stash->{item}); + delete $stash->{item}; + } + if ($stash->{biblio}) { + require t::lib::TestObjects::BiblioFactory; + t::lib::TestObjects::BiblioFactory->deleteTestGroup($stash->{biblio}); + delete $stash->{biblio}; + } + if ($stash->{atomicupdate}) { + require t::lib::TestObjects::AtomicUpdateFactory; + t::lib::TestObjects::AtomicUpdateFactory->deleteTestGroup($stash->{atomicupdate}); + delete $stash->{atomicupdate}; + } + if ($stash->{patron}) { + require t::lib::TestObjects::PatronFactory; + t::lib::TestObjects::PatronFactory->deleteTestGroup($stash->{patron}); + delete $stash->{patron}; + } + if ($stash->{hold}) { + require t::lib::TestObjects::HoldFactory; + t::lib::TestObjects::HoldFactory->deleteTestGroup($stash->{hold}); + delete $stash->{hold}; + } + if ($stash->{lettertemplate}) { + require t::lib::TestObjects::LetterTemplateFactory; + t::lib::TestObjects::LetterTemplateFactory->deleteTestGroup($stash->{lettertemplate}); + delete $stash->{letterTemplate}; + } + if ($stash->{systempreference}) { + require t::lib::TestObjects::SystemPreferenceFactory; + t::lib::TestObjects::SystemPreferenceFactory->deleteTestGroup($stash->{systempreference}); + delete $stash->{systempreference}; + } + if ($stash->{matcher}) { + require t::lib::TestObjects::MatcherFactory; + t::lib::TestObjects::MatcherFactory->deleteTestGroup($stash->{matcher}); + delete $stash->{matcher}; + } + if ($stash->{messagequeue}) { + require t::lib::TestObjects::MessageQueueFactory; + t::lib::TestObjects::MessageQueueFactory->deleteTestGroup($stash->{messagequeue}); + delete $stash->{messagequeue}; + } + if ($stash->{fines}) { + require t::lib::TestObjects::FinesFactory; + t::lib::TestObjects::FinesFactory->deleteTestGroup($stash->{fines}); + delete $stash->{fines}; + } +} + +=head getHashKey +@OVERLOADABLE + +@RETURNS String, The test context/stash HASH key to differentiate this object + from all other such test objects. +=cut + +sub getHashKey { + my ($class, $object, $primaryKey, $hashKeys) = @_; + + my @collectedHashKeys; + $hashKeys = $class->getDefaultHashKey unless $hashKeys; + $hashKeys = [$hashKeys] unless ref($hashKeys) eq 'ARRAY'; + foreach my $hashKey (@$hashKeys) { + if (ref($object) eq 'HASH') { + if ($hashKey && not($object->{$hashKey})) { + croak $class."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'."; + } + push @collectedHashKeys, $object->{$hashKey}; + } + else { + my $key = $object->{$hashKey}; + eval { + $key = $object->$hashKey(); + } unless $key; + if ($hashKey && not($key)) { + croak $class."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'. ".($@) ? $@ : ''; + } + push @collectedHashKeys, $key; + } + } + return join('-', @collectedHashKeys); +} + +=head + +=cut + +sub addToContext { + my ($class, $objects, $hashKeys, $featureStash, $scenarioStash, $stepStash) = @_; + my @stashes = ($featureStash, $scenarioStash, $stepStash); + + if (ref($objects) eq 'ARRAY') { + foreach my $object (@$objects) { + $class->addToContext($object, $hashKeys, @stashes); + } + return undef; #End recursion + } + elsif (ref($objects) eq 'HASH') { + #Apparently we get a HASH of keyed objects. + $class->_persistToStashes($objects, $class->getHashGroupName(), @stashes); + return undef; #End recursion + } + else { + #Here $objects is verified to be a single object, instead of a group of objects. + #We create a hash key for it and append it to the stashes. + my $hash = { $class->getHashKey($objects, undef, $class->getDefaultHashKey) => $objects}; + $class->_persistToStashes($hash, $class->getHashGroupName(), @stashes); + } +} + +=head validateAndPopulateDefaultValues +@INTERFACE + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +You must overload this in the subclassing factory if you want to validate and check the given parameters +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $object, $hashKeys) = @_; + + $hashKeys = [$hashKeys] unless ref($hashKeys) eq 'ARRAY'; + foreach my $hashKey (@$hashKeys) { + unless ($object->{$hashKey}) { + 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."); + } + } +} + +=head validateObjectType + + try { + $object = $class->validateObjectType($object); + } catch { + ... + } + +Validates if the given Object matches the expected type of the subclassing TestObjectFactory. +@PARAM1 Object that needs to be validated. +@THROWS Koha::Exception::UnknownObject, if the given object is not of the same type that the object factory creates. + +=cut + +sub validateObjectType { + my ($class, $object) = @_; + + my $invalid = 0; + if (blessed($object)) { + unless ($object->isa( $class->getObjectType() )) { + $invalid = 1; + } + } + else { + unless (ref($object) eq $class->getObjectType()) { + $invalid = 1; + } + } + + Koha::Exception::UnknownObject->throw( + error => "$class->validateObjectType():> Given object '$object' isn't a '".$class->getObjectType()."'-object." + ) if $invalid; + + return $object; +} + +=head getObjectType +@OVERLOAD +Get the type of objects this factory creates. +@RETURN String, the object package this factory creates. eg. Koha::Patron +=cut + +sub getObjectType { + my ($class) = @_; + die "You must overload 'validateObjectType()' in the implementing ObjectFactory subclass '$class'."; + return 'Koha::Object derivative or other Object'; +} + +=head _validateStashes + + _validateStashes($featureStash, $scenarioStash, $stepStash); + +Validates that the given stahses are what they are supposed to be... , HASHrefs. +@THROWS Koha::Exception::BadParameter, if validation failed. +=cut + +sub _validateStashes { + my ($self, $featureStash, $scenarioStash, $stepStash) = @_; + + if ($featureStash && not(ref($featureStash) eq 'HASH')) { + Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$featureStash' is not a HASHRef! Leave it 'undef' if you don't want to use it."); + } + if ($scenarioStash && not(ref($scenarioStash) eq 'HASH')) { + Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$scenarioStash' is not a HASHRef! Leave it 'undef' if you don't want to use it."); + } + if ($stepStash && not(ref($stepStash) eq 'HASH')) { + Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$stepStash' is not a HASHRef! Leave it 'undef' if you don't want to use it."); + } +} + +=head _persistToStashes + + _persistToStashes($objects, $stashKey, $featureStash, $scenarioStash, $stepStash); + +Saves the given HASH to the given stashes using the given stash key. +=cut + +sub _persistToStashes { + my ($class, $objects, $stashKey, $featureStash, $scenarioStash, $stepStash) = @_; + + if ($featureStash || $scenarioStash || $stepStash) { + while( my ($key, $object) = each %$objects) { + $class->validateObjectType($object); #Make sure we put in what we are expected to + $featureStash->{$stashKey}->{ $key } = $object if $featureStash; + $scenarioStash->{$stashKey}->{ $key } = $object if $scenarioStash; + $stepStash->{$stashKey}->{ $key } = $object if $stepStash; + } + } +} + +1; diff --git a/t/lib/TestObjects/PatronFactory.pm b/t/lib/TestObjects/PatronFactory.pm new file mode 100644 index 0000000..d0610fa --- /dev/null +++ b/t/lib/TestObjects/PatronFactory.pm @@ -0,0 +1,178 @@ +package t::lib::TestObjects::PatronFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use Scalar::Util qw(blessed); +use Encode; + +use C4::Members; +use Koha::Patrons; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return 'cardnumber'; +} +sub getObjectType { + return 'Koha::Patron'; +} + +=head createTestGroup( $data [, $hashKey, $testContexts...] ) +@OVERLOADED + + my $borrowerFactory = t::lib::TestObjects::PatronFactory->new(); + my $borrowers = $borrowerFactory->createTestGroup([ + {firstname => 'Olli-Antti', + surname => 'Kivi', + cardnumber => '11A001', + branchcode => 'CPL', + }, + {firstname => 'Olli-Antti2', + surname => 'Kivi2', + cardnumber => '11A002', + branchcode => 'FPL', + }, + ], undef, $testContext1, $testContext2, $testContext3); + + #Do test stuff... + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); + +The HASH is keyed with the given $hashKey or 'koha.borrowers.cardnumber' +See C4::Members::AddMember() for how the table columns need to be given. + +@PARAM1 ARRAYRef of HASHRefs of C4::Members::AddMember()-parameters. +@PARAM2 koha.borrower-column which is used as the test context borrowers HASH key, + defaults to the most best option cardnumber. +@PARAM3-5 HASHRef of test contexts. You can save the given borrowers to multiple + test contexts. Usually one is enough. These test contexts are + used to help tear down DB changes. +@RETURNS HASHRef of $hashKey => $borrower-objects: + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $object, $stashes) = @_; + + my $borrower; + eval { + $borrower = Koha::Patrons->cast($object); #Try getting the patron first + }; + + my $borrowernumber; + unless ($borrower) { + #Try to add the Patron, but it might fail because of the barcode or other UNIQUE constraint. + #Catch the error and try looking for the Patron if we suspect it is present in the DB. + eval { + $borrowernumber = C4::Members::AddMember(%$object); + }; + if ($@) { + if (blessed($@) && $@->isa('DBIx::Class::Exception') && + $@->{msg} =~ /Duplicate entry '.+?' for key 'cardnumber'/) { #DBIx should throw other types of exceptions instead of this general type :( + #This exception type is OK, we ignore this and try fetching the existing Object next. + warn "Recovering from duplicate exception.\n"; + } + else { + die $@; + } + } + #If adding failed, we still get some strange borrowernumber result. + #Check for sure by finding the real patron. + $borrower = Koha::Patrons->cast( $borrowernumber || $object ); + } + + unless ($borrower) { + carp "PatronFactory:> No borrower for cardnumber '".$object->{cardnumber}."'"; + return(); + } + + return $borrower; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $borrower, $hashKey) = @_; + $self->SUPER::validateAndPopulateDefaultValues($borrower, $hashKey); + + $borrower->{firstname} = 'Maija' unless $borrower->{firstname}; + $borrower->{surname} = Encode::decode('UTF-8', 'Meikäläinen') unless $borrower->{surname}; + $borrower->{cardnumber} = '167A000001TEST' unless $borrower->{cardnumber}; + $borrower->{categorycode} = 'PT' unless $borrower->{categorycode}; + $borrower->{branchcode} = 'CPL' unless $borrower->{branchcode}; + $borrower->{dateofbirth} = '1985-10-12' unless $borrower->{dateofbirth}; +} + +=head deleteTestGroup +@OVERLOADED + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $objects) = @_; + + my $schema = Koha::Database->new_schema(); + while( my ($key, $object) = each %$objects) { + my $borrower = Koha::Patrons->cast($object); + eval { + $borrower->delete(); + }; + if ($@) { + if (blessed($@) && $@->isa('DBIx::Class::Exception') && + #Trying to recover. Delete all Checkouts for the Patron to be able to delete. + $@->{msg} =~ /a foreign key constraint fails.+?issues_ibfk_1/) { #DBIx should throw other types of exceptions instead of this general type :( + + my @checkouts = Koha::Checkouts->search({borrowernumber => $borrower->borrowernumber}); + foreach my $c (@checkouts) { $c->delete(); } + $borrower->delete(); + warn "Recovering from foreign key exception.\n"; + } + else { + die $@; + } + } + + } +} + +1; diff --git a/t/lib/TestObjects/Serial/FrequencyFactory.pm b/t/lib/TestObjects/Serial/FrequencyFactory.pm new file mode 100644 index 0000000..09889d3 --- /dev/null +++ b/t/lib/TestObjects/Serial/FrequencyFactory.pm @@ -0,0 +1,152 @@ +package t::lib::TestObjects::Serial::FrequencyFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use Scalar::Util qw(blessed); + +use Koha::Serial::Subscription::Frequency; +use Koha::Serial::Subscription::Frequencies; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return 'description'; +} +sub getObjectType { + return 'Koha::Serial::Subscription::Frequency'; +} + +=head createTestGroup( $data [, $hashKey, $testContexts...] ) +@OVERLOADED + + my $frequencies = t::lib::TestObjects::Serial::FrequencyFactory->createTestGroup([ + {acqprimary => 1, #DEFAULT + claimissues => 1, #DEFAULT + claimacquisition => 1, #DEFAULT + serialsprimary => 1, #DEFAULT + position => 'Boss', #DEFAULT + phone => '+358700123123', #DEFAULT + notes => 'Noted', #DEFAULT + name => "Julius Augustus Caesar", #DEFAULT + fax => '+358700123123', #DEFAULT + email => 'vendor@example.com', #DEFAULT + booksellerid => 12124 #MANDATORY to link to Bookseller + #id => #Don't use id, since we are just adding a new one + }, + {...}, + ], undef, $testContext1, $testContext2, $testContext3); + + #Do test stuff... + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); + +The HASH is keyed with the given $hashKey or 'koha.subscription_frequencies.description' + +@PARAM1 ARRAYRef of HASHRefs +@PARAM2 koha.subscription_frequencies-column which is used as the test context HASH key, + defaults to the most best option 'description'. +@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple + test contexts. Usually one is enough. These test contexts are + used to help tear down DB changes. +@RETURNS HASHRef of $hashKey => object: + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $object, $stashes) = @_; + + my $contact = Koha::Acquisition::Bookseller::Contact->new(); + $contact->set($object); + $contact->store(); + #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. + my @contacts = Koha::Acquisition::Bookseller::Contacts->search($object); + if (scalar(@contacts)) { + $contact = $contacts[0]; + } + else { + die "No Contact added to DB. Fix me to autorecover from this error!"; + } + + return $contact; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $object, $hashKey) = @_; + + $object->{acqprimary} = 1 unless $object->{acqprimary}; + $object->{claimissues} = 1 unless $object->{claimissues}; + $object->{claimacquisition} = 1 unless $object->{claimacquisition}; + $object->{serialsprimary} = 1 unless $object->{serialsprimary}; + $object->{position} = 'Boss' unless $object->{position}; + $object->{phone} = '+358700123123' unless $object->{phone}; + $object->{notes} = 'Noted' unless $object->{notes}; + $object->{name} = "Julius Augustus Caesar" unless $object->{name}; + $object->{fax} = '+358700123123' unless $object->{fax}; + $object->{email} = 'vendor@example.com' unless $object->{email}; + $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); +} + +=head deleteTestGroup +@OVERLOADED + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $objects) = @_; + + while( my ($key, $object) = each %$objects) { + my $contact = Koha::Acquisition::Bookseller::Contacts->cast($object); + eval { + #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them. + my @contacts = Koha::Acquisition::Bookseller::Contacts->search({name => $contact->name}); + foreach my $c (@contacts) { + $c->delete(); + } + }; + if ($@) { + die $@; + } + } +} + +1; diff --git a/t/lib/TestObjects/Serial/SubscriptionFactory.pm b/t/lib/TestObjects/Serial/SubscriptionFactory.pm new file mode 100644 index 0000000..2482103 --- /dev/null +++ b/t/lib/TestObjects/Serial/SubscriptionFactory.pm @@ -0,0 +1,312 @@ +package t::lib::TestObjects::Serial::SubscriptionFactory; + +# Copyright KohaSuomi 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use Scalar::Util qw(blessed); +use DateTime; + +use C4::Context; +use C4::Serials; + +use t::lib::TestObjects::PatronFactory; +use Koha::Patrons; +use t::lib::TestObjects::Acquisition::BooksellerFactory; +use Koha::Acquisition::Booksellers; +use t::lib::TestObjects::BiblioFactory; +use Koha::Biblios; +use t::lib::TestObjects::ItemFactory; +use Koha::Items; + +use Koha::Subscriptions; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub getDefaultHashKey { + return 'internalnotes'; +} +sub getObjectType { + return 'Koha::Subscription'; +} + +=head createTestGroup( $data [, $hashKey, $testContexts...] ) + + my $subscriptions = t::lib::TestObjects::Serial::SubscriptionFactory->createTestGroup([ + { + internalnotes => 'MagazineName-CPL-1', #MANDATORY! Used as the hash-key + receiveSerials => 3, #DEFAULT undef, receives this many serials using the default values. + librarian => 12 || Koha::Patron, #DEFAULT creates a "Subscription Master" Patron + branchcode => 'CPL', #DEFAULT + aqbookseller => 54 || Koha::Acquisition::Bookseller, #DEFAULT creates a 'Bookselling Vendor'. + cost => undef, #DEFAULT + aqbudgetid => undef, #DEFAULT + biblio => 21 || Koha::Biblio, #DEFAULT creates a "Serial magazine" Record + startdate => '2015-01-01', #DEFAULTs to 1.1 this year, so the subscription is active by default. + periodicity => 2 || Koha::Serial::Subscription::Frequency, #DEFAULTS to a Frequency of 1/week. + numberlength => 12, #DEFAULT one year subscription, only one of ['numberlength', 'weeklength', 'monthlength'] is needed + weeklength => 52, #DEFAULT one year subscription + monthlength => 12, #DEFAULT one year subscription + lastvalue1 => 2015, #DEFAULT this year + innerloop1 => undef, #DEFAULT + lastvalue2 => 1, #DEFAULT + innerloop2 => undef, #DEFAULT + lastvalue3 => 1, #DEFAULT + innerloop3 => undef, #DEFAULT + status => 1, #DEFAULT + notes => 'Public note', #DEFAULT + letter => 'RLIST', #DEFAULT + firstacquidate => '2015-01-01', #DEFAULT, same as startdate + irregularity => undef, #DEFAULT + numberpattern => 2 || Koha::Serial::Numberpattern, #DEFAULT 2, which is 'Volume, Number, Issue' + locale => undef, #DEFAULT + callnumber => MAG 10.2 AZ, #DEFAULT + manualhistory => 0, #DEFAULT + serialsadditems => 1, #DEFAULT + staffdisplaycount => 20, #DEFAULT + opacdisplaycount => 20, #DEFAULT + graceperiod => 2, #DEFAULT + location => 'DISPLAY', #DEFAULT + enddate => undef, #DEFAULT, calculated + skip_serialseq => 1, #DEFAULT + }, + {... + }, + ], undef, $testContext1, $testContext2, $testContext3); + + #Do test stuff... + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); + +The HASH is keyed with the given $hashKey or 'koha.subscription.internalnotes' +We default to internalnotes because there is really no unique identifier +to describe the created subscription which wouldn't change across different test runs. + +See C4::Serials::NewSubscription() for how the table columns need to be given. + +@PARAM1 ARRAYRef of HASHRefs +@PARAM2 koha.subscription-column which is used as the test context HASH key, +@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple + test contexts. Usually one is enough. These test contexts are + used to help tear down DB changes. +@RETURNS HASHRef of $hashKey => $borrower-objects: + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $o, $stashes) = @_; + + my $subscriptionid; + eval { + $subscriptionid = C4::Serials::NewSubscription( + $o->{librarian}->id, + $o->{branchcode}, + $o->{aqbookseller}->id, + $o->{cost}, + $o->{aqbudgetid}, + $o->{biblio}->{biblionumber} || $o->{biblio}->biblionumber, + $o->{startdate}, + $o->{periodicity}, + $o->{numberlength}, + $o->{weeklength}, + $o->{monthlength}, + $o->{lastvalue1}, + $o->{innerloop1}, + $o->{lastvalue2}, + $o->{innerloop2}, + $o->{lastvalue3}, + $o->{innerloop3}, + $o->{status}, + $o->{notes}, + $o->{letter}, + $o->{firstacquidate}, + $o->{irregularity} || '', + $o->{numberpattern}, + $o->{locale}, + $o->{callnumber}, + $o->{manualhistory}, + $o->{internalnotes}, + $o->{serialsadditems}, + $o->{staffdisplaycount}, + $o->{opacdisplaycount}, + $o->{graceperiod}, + $o->{location}, + $o->{enddate}, + $o->{skip_serialseq} + ); + }; + if ($@) { + die $@; + } + + my $subscription = Koha::Subscriptions->cast( $subscriptionid ); + $subscription->periodicity($o->{periodicity}); + $subscription->numberpattern($o->{numberpattern}); + + $class->receiveDefaultSerials($subscription, $o->{receiveSerials}); + + return $subscription; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $object, $hashKey, $stashes) = @_; + + #Get this year so we can use it to populate always active Objects. + my $now = DateTime->now(time_zone => C4::Context->tz()); + my $year = $now->year(); + + if ($object->{librarian}) { + $object->{librarian} = Koha::Patrons->cast($object->{librarian}); + } + else { + $object->{librarian} = t::lib::TestObjects::PatronFactory->createTestGroup([ + {cardnumber => 'SERIAL420KILLER', + firstname => 'Subscription', + surname => 'Master'}], undef, @$stashes) + ->{SERIAL420KILLER}; + } + if ($object->{aqbookseller}) { + $object->{aqbookseller} = Koha::Acquisition::Booksellers->cast($object->{aqbookseller}); + } + else { + $object->{aqbookseller} = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([ + {}], undef, @$stashes) + ->{'Bookselling Vendor'}; + } + if ($object->{biblio}) { + $object->{biblio} = Koha::Biblios->cast($object->{biblio}); + } + else { + $object->{biblio} = t::lib::TestObjects::BiblioFactory->createTestGroup([ + {'biblio.title' => 'Serial magazine', + 'biblio.author' => 'Pertti Kurikka', + 'biblio.copyrightdate' => $year, + 'biblioitems.isbn' => 'isbnisnotsocoolnowadays!', + 'biblioitems.itemtype' => 'CR', + }, + ], undef, @$stashes) + ->{'isbnisnotsocoolnowadays!'}; + } + unless ($object->{internalnotes}) { + croak __PACKAGE__.":> Mandatory parameter 'internalnotes' missing. This is used as the returning hash-key!"; + } + + $object->{periodicity} = 4 unless $object->{periodicity}; + $object->{numberpattern} = 2 unless $object->{numberpattern}; + $object->{branchcode} = 'CPL' unless $object->{branchcode}; + $object->{cost} = undef unless $object->{cost}; + $object->{aqbudgetid} = undef unless $object->{aqbudgetid}; + $object->{startdate} = "$year-01-01" unless $object->{startdate}; + $object->{numberlength} = undef unless $object->{numberlength}; + $object->{weeklength} = undef unless $object->{weeklength} || $object->{numberlength}; + $object->{monthlength} = 12 unless $object->{monthlength} || $object->{weeklength} || $object->{numberlength}; + $object->{lastvalue1} = $year unless $object->{lastvalue1}; + $object->{innerloop1} = undef unless $object->{innerloop1}; + $object->{lastvalue2} = 1 unless $object->{lastvalue2}; + $object->{innerloop2} = undef unless $object->{innerloop2}; + $object->{lastvalue3} = 1 unless $object->{lastvalue3}; + $object->{innerloop3} = undef unless $object->{innerloop3}; + $object->{status} = 1 unless $object->{status}; + $object->{notes} = 'Public note' unless $object->{notes}; + $object->{letter} = 'RLIST' unless $object->{letter}; + $object->{firstacquidate} = "$year-01-01" unless $object->{firstacquidate}; + $object->{irregularity} = undef unless $object->{irregularity}; + $object->{locale} = undef unless $object->{locale}; + $object->{callnumber} = 'MAG 10.2 AZ' unless $object->{callnumber}; + $object->{manualhistory} = 0 unless $object->{manualhistory}; + $object->{serialsadditems} = 1 unless $object->{serialsadditems}; + $object->{staffdisplaycount} = 20 unless $object->{staffdisplaycount}; + $object->{opacdisplaycount} = 20 unless $object->{opacdisplaycount}; + $object->{graceperiod} = 2 unless $object->{graceperiod}; + $object->{location} = 'DISPLAY' unless $object->{location}; + $object->{enddate} = undef unless $object->{enddate}; + $object->{skip_serialseq} = 1 unless $object->{skip_serialseq}; +} + +sub receiveDefaultSerials { + my ($class, $subscription, $receiveSerials, $stashes) = @_; + return unless $receiveSerials; + + foreach (1..$receiveSerials) { + my ($totalIssues, $waitingSerial) = C4::Serials::GetSerials($subscription->subscriptionid); + C4::Serials::ModSerialStatus($waitingSerial->{serialid}, + $waitingSerial->{serialseq}, + Koha::DateUtils::dt_from_string($waitingSerial->{planneddate})->ymd('-'), + Koha::DateUtils::dt_from_string($waitingSerial->{publisheddate})->ymd('-'), + Koha::DateUtils::dt_from_string($waitingSerial->{publisheddate})->ymd('-'), + 2, #Status => 2 == Received + $waitingSerial->{notes}, + ); + my $item = t::lib::TestObjects::ItemFactory->createTestGroup({ barcode => $waitingSerial->{serialid}."-".Koha::DateUtils::dt_from_string($waitingSerial->{publisheddate})->ymd('-'), + enumchron => $waitingSerial->{serialseq}, + biblionumber => $subscription->biblionumber, + homebranch => $subscription->branchcode, + location => $subscription->location, + }, undef, @$stashes); + C4::Serials::AddItem2Serial( $waitingSerial->{serialid}, + $item->itemnumber, ); + } +} + +=head deleteTestGroup +@OVERLOADED + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. +Also removes all attached serialitems and serials + +=cut + +sub deleteTestGroup { + my ($self, $objects) = @_; + + my $schema = Koha::Database->new_schema(); + while( my ($key, $object) = each %$objects) { + my $subscription = Koha::Subscriptions->cast($object); + eval { + my @serials = $schema->resultset('Serial')->search({subscriptionid => $subscription->subscriptionid}); + + ##Because serialitems-table doesn't have a primary key, resorting to a DBI hack. + my $dbh = C4::Context->dbh(); + my $sth_delete_serialitems = $dbh->prepare("DELETE FROM serialitems WHERE serialid = ?"); + + foreach my $s (@serials) { + $sth_delete_serialitems->execute($s->serialid); + $s->delete(); + } + $subscription->delete(); + }; + if ($@) { + die $@; + } + } +} + +1; diff --git a/t/lib/TestObjects/SystemPreferenceFactory.pm b/t/lib/TestObjects/SystemPreferenceFactory.pm new file mode 100644 index 0000000..60720ef --- /dev/null +++ b/t/lib/TestObjects/SystemPreferenceFactory.pm @@ -0,0 +1,128 @@ +package t::lib::TestObjects::SystemPreferenceFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use Scalar::Util qw(blessed); + +use base qw(t::lib::TestObjects::ObjectFactory); + +use Koha::Exception::ObjectExists; + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return 'preference'; +} +sub getObjectType { + return 'HASH'; +} + +=head createTestGroup( $data [, $hashKey, $testContexts...] ) +@OVERLOADED + + my $preferences = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([ + {preference => 'ValidateEmailAddress', + value => 1, + }, + {preference => 'ValidatePhoneNumber', + value => 'OFF', + }, + ], undef, $testContext1, $testContext2, $testContext3); + + #Do test stuff... + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $pref, $stashes) = @_; + + my $preference = $pref->{preference}; + + # Check if preference is already stored, so we wont lose the original preference + my $alreadyStored; + my $stashablePref = $pref; + foreach my $stash (@$stashes) { + if (exists $stash->{systempreference}->{$preference}) { + $alreadyStored = 1; + $stashablePref = $stash->{systempreference}->{$preference}; + last(); + } + } + $stashablePref->{old_value} = C4::Context->preference($pref->{preference}) unless ($alreadyStored); + + C4::Context->set_preference($pref->{preference}, $pref->{value}); + + $stashablePref->{value} = $pref->{value}; + + return $stashablePref; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($class, $preference, $hashKey) = @_; + $class->SUPER::validateAndPopulateDefaultValues($preference, $hashKey); + + if (not(defined(C4::Context->preference($preference->{preference})))) { + croak __PACKAGE__.":> Preference '".$preference->{preference}."' not found."; + next; + } + unless (exists($preference->{value})) { + croak __PACKAGE__.":> Mandatory parameter 'value' not found."; + } +} + +=head deleteTestGroup +@OVERLOADED + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($prefs); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($class, $preferences) = @_; + + while( my ($key, $pref) = each %$preferences) { + C4::Context->set_preference($pref->{preference}, $pref->{old_value}); + } +} + +1; diff --git a/t/lib/TestObjects/t/biblioItemFactory.t b/t/lib/TestObjects/t/biblioItemFactory.t new file mode 100644 index 0000000..8cb8f8b --- /dev/null +++ b/t/lib/TestObjects/t/biblioItemFactory.t @@ -0,0 +1,160 @@ +#!/usr/bin/perl + +# Copyright KohaSuomi 2016 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Test::More; + +use t::lib::TestObjects::ItemFactory; +use Koha::Items; +use t::lib::TestObjects::BiblioFactory; +use Koha::Biblios; +use C4::Biblio; + +my $marcxml = < + 00510cam a22002054a 4500 + 300841 + KYYTI + 20150216235917.0 + 1988 xxk|||||||||| ||||1|eng|c + + 0233982213 + NID. + + + eng + vie + + + 85.25 + ykl + + + THE WISHING TREE / + USHA BAHL. + + + 1990 + + + BK + 1996-05-01 00:00:00 + + +RECORD + +my $subtestContext = {}; +subtest "Create biblios from db columns", \&createBibliosFromDBColumns; +sub createBibliosFromDBColumns { + ##Create and Delete. Add one + my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([ + {'biblio.title' => 'I wish I met your mother', + 'biblio.author' => 'Pertti Kurikka', + 'biblio.copyrightdate' => '1960', + 'biblioitems.isbn' => '9519671580', + 'biblioitems.itemtype' => 'BK', + }, + ], 'biblioitems.isbn', $subtestContext); + my $objects = t::lib::TestObjects::ItemFactory->createTestGroup([ + {biblionumber => $biblios->{9519671580}->{biblionumber}, + barcode => '167Nabe0001', + homebranch => 'CPL', + holdingbranch => 'CPL', + price => '0.50', + replacementprice => '0.50', + itype => 'BK', + biblioisbn => '9519671580', + itemcallnumber => 'PK 84.2', + }, + ], 'barcode', $subtestContext); + + is($objects->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001'."); + ##Add one more to test incrementing the subtestContext. + $objects = t::lib::TestObjects::ItemFactory->createTestGroup([ + {biblionumber => $biblios->{9519671580}->{biblionumber}, + barcode => '167Nabe0002', + homebranch => 'CPL', + holdingbranch => 'FFL', + price => '3.50', + replacementprice => '3.50', + itype => 'BK', + biblioisbn => '9519671580', + itemcallnumber => 'JK 84.2', + }, + ], 'barcode', $subtestContext); + + is($subtestContext->{item}->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001' from \$subtestContext."); + is($objects->{'167Nabe0002'}->holdingbranch, 'FFL', "Item '167Nabe0002'."); + is(ref($biblios->{9519671580}), 'MARC::Record', "Biblio 'I wish I met your mother'."); + + ##Delete objects + t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + my $object1 = Koha::Items->find({barcode => '167Nabe0001'}); + ok (not($object1), "Item '167Nabe0001' deleted"); + my $object2 = Koha::Items->find({barcode => '167Nabe0002'}); + ok (not($object2), "Item '167Nabe0002' deleted"); + my $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"}); + ok (not($object2), "Biblio 'I wish I met your mother' deleted"); +} + + +subtest "Create biblios from MARCXML", \&createBibliosFromMARCXML; +sub createBibliosFromMARCXML { + my ($record, $biblio); + + ##Create from a HASH with a reference to MARCXML + $record = t::lib::TestObjects::BiblioFactory->createTestGroup( + {record => $marcxml}, 'biblioitems.isbn', $subtestContext); + + $biblio = C4::Biblio::GetBiblioData($record->{biblionumber}); + is($biblio->{title}, + 'THE WISHING TREE /', + 'Title ok'); + is($biblio->{copyrightdate}, + '1990', + 'Copyrightdate ok'); + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + + $biblio = C4::Biblio::GetBiblioData($record->{biblionumber}); + ok(not($biblio), + 'Biblio deleted'); + + + ##Create from a MARCXML scalar + $record = t::lib::TestObjects::BiblioFactory->createTestGroup( + $marcxml, 'biblioitems.isbn', $subtestContext); + + $biblio = C4::Biblio::GetBiblioData($record->{biblionumber}); + is($biblio->{title}, + 'THE WISHING TREE /', + 'Title ok'); + is($biblio->{copyrightdate}, + '1990', + 'Copyrightdate ok'); + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + + $biblio = C4::Biblio::GetBiblioData($record->{biblionumber}); + ok(not($biblio), + 'Biblio deleted'); +} + +done_testing(); diff --git a/t/lib/TestObjects/t/checkoutFactory.t b/t/lib/TestObjects/t/checkoutFactory.t new file mode 100644 index 0000000..4752b37 --- /dev/null +++ b/t/lib/TestObjects/t/checkoutFactory.t @@ -0,0 +1,102 @@ +#!/usr/bin/perl + +# Copyright KohaSuomi 2016 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; + +use Test::More; +use DateTime; + +use t::lib::TestObjects::ItemFactory; +use Koha::Items; +use t::lib::TestObjects::BiblioFactory; +use Koha::Biblios; +use t::lib::TestObjects::CheckoutFactory; +use Koha::Checkouts; + +my $subtestContext = {}; +##Create and Delete using dependencies in the $testContext instantiated in previous subtests. +my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([ + {'biblio.title' => 'I wish I met your mother', + 'biblio.author' => 'Pertti Kurikka', + 'biblio.copyrightdate' => '1960', + 'biblioitems.isbn' => '9519671580', + 'biblioitems.itemtype' => 'BK', + }, + ], 'biblioitems.isbn', $subtestContext); +my $items = t::lib::TestObjects::ItemFactory->createTestGroup([ + {biblionumber => $biblios->{9519671580}->{biblionumber}, + barcode => '167Nabe0001', + homebranch => 'CPL', + holdingbranch => 'CPL', + price => '0.50', + replacementprice => '0.50', + itype => 'BK', + biblioisbn => '9519671580', + itemcallnumber => 'PK 84.2', + }, + {biblionumber => $biblios->{9519671580}->{biblionumber}, + barcode => '167Nabe0002', + homebranch => 'CPL', + holdingbranch => 'FFL', + price => '3.50', + replacementprice => '3.50', + itype => 'BK', + biblioisbn => '9519671580', + itemcallnumber => 'JK 84.2', + }, + ], 'barcode', $subtestContext); +my $objects = t::lib::TestObjects::CheckoutFactory->createTestGroup([ + { + cardnumber => '11A001', + barcode => '167Nabe0001', + daysOverdue => 7, + daysAgoCheckedout => 28, + }, + { + cardnumber => '11A002', + barcode => '167Nabe0002', + daysOverdue => -7, + daysAgoCheckedout => 14, + checkoutBranchRule => 'holdingbranch', + }, + ], undef, $subtestContext); + +is($objects->{'11A001-167Nabe0001'}->branchcode, + 'CPL', + "Checkout '11A001-167Nabe0001' checked out from the default context branch 'CPL'."); +is($objects->{'11A002-167Nabe0002'}->branchcode, + 'FFL', + "Checkout '11A002-167Nabe0002' checked out from the holdingbranch 'FFL'."); +is(Koha::DateUtils::dt_from_string($objects->{'11A001-167Nabe0001'}->issuedate)->day(), + DateTime->now(time_zone => C4::Context->tz())->subtract(days => '28')->day() + , "Checkout '11A001-167Nabe0001', adjusted issuedates match."); +is(Koha::DateUtils::dt_from_string($objects->{'11A002-167Nabe0002'}->date_due)->day(), + DateTime->now(time_zone => C4::Context->tz())->subtract(days => '-7')->day() + , "Checkout '11A002-167Nabe0002', adjusted date_dues match."); + +t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); +my $object1 = Koha::Checkouts->find({borrowernumber => $objects->{'11A001-167Nabe0001'}->borrowernumber, + itemnumber => $objects->{'11A001-167Nabe0001'}->itemnumber}); +ok (not($object1), "Checkout '11A001-167Nabe0001' deleted"); +my $object2 = Koha::Checkouts->find({borrowernumber => $objects->{'11A002-167Nabe0002'}->borrowernumber, + itemnumber => $objects->{'11A002-167Nabe0002'}->itemnumber}); +ok (not($object2), "Checkout '11A002-167Nabe0002' deleted"); + +done_testing(); diff --git a/t/lib/TestObjects/t/fileFactory.t b/t/lib/TestObjects/t/fileFactory.t new file mode 100644 index 0000000..22ebf56 --- /dev/null +++ b/t/lib/TestObjects/t/fileFactory.t @@ -0,0 +1,75 @@ +#!/usr/bin/perl + +# Copyright KohaSuomi 2016 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Test::More; + +use t::lib::TestObjects::FileFactory; +use File::Slurp; +use File::Fu::File; + +my ($files); +my $subtestContext = {}; + +$files = t::lib::TestObjects::FileFactory->createTestGroup([ + {'filepath' => 'atomicupdate', + 'filename' => '#30-RabiesIsMyDog.pl', + 'content' => 'print "Mermaids are my only love\nI never let them down";', + }, + {'filepath' => 'atomicupdate', + 'filename' => '#31-FrogsArePeopleToo.pl', + 'content' => 'print "Listen to the Maker!";', + }, + {'filepath' => 'atomicupdate', + 'filename' => '#32-AnimalLover.pl', + 'content' => "print 'Do not hurt them!;", + }, + ], undef, $subtestContext); + +my $file30content = File::Slurp::read_file( $files->{'#30-RabiesIsMyDog.pl'}->absolutely ); +ok($file30content =~ m/Mermaids are my only love/, + "'#30-RabiesIsMyDog.pl' created and content matches"); +my $file31content = File::Slurp::read_file( $files->{'#31-FrogsArePeopleToo.pl'}->absolutely ); +ok($file31content =~ m/Listen to the Maker!/, + "'#31-FrogsArePeopleToo.pl' created and content matches"); +my $file32content = File::Slurp::read_file( $files->{'#32-AnimalLover.pl'}->absolutely ); +ok($file32content =~ m/Do not hurt them!/, + "'#32-AnimalLover.pl' created and content matches"); + +##addToContext() test, create new file +my $dir = $files->{'#32-AnimalLover.pl'}->dirname(); +my $file = File::Fu::File->new("$dir/addToContext.txt"); +$file->touch; +t::lib::TestObjects::FileFactory->addToContext($file, undef, $subtestContext); +ok($file->e, + "'addToContext.txt' created"); + +t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + +ok(not(-e $files->{'#30-RabiesIsMyDog.pl'}->absolutely), + "'#30-RabiesIsMyDog.pl' deleted"); +ok(not(-e $files->{'#31-FrogsArePeopleToo.pl'}->absolutely), + "'#31-FrogsArePeopleToo.pl' deleted"); +ok(not(-e $files->{'#32-AnimalLover.pl'}->absolutely), + "'#32-AnimalLover.pl' deleted"); +ok(not(-e $file->absolutely), + "'addToContext.txt' deleted"); + +done_testing(); diff --git a/t/lib/TestObjects/t/finesFactory.t b/t/lib/TestObjects/t/finesFactory.t new file mode 100644 index 0000000..4f5d38b --- /dev/null +++ b/t/lib/TestObjects/t/finesFactory.t @@ -0,0 +1,76 @@ +#!/usr/bin/perl + +# Copyright KohaSuomi 2016 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Test::More; + +use Koha::Patrons; +use t::lib::TestObjects::FinesFactory; +use C4::Members; + +my $subtestContext = {}; + +#Check if the precondition Patron exists, it shouldn't +my $borrower = Koha::Patrons->find({cardnumber => '1A23' }); +ok(not(defined($borrower)), "Fines borrower not defined"); + +#Create the Fine +my $finesfactory = t::lib::TestObjects::FinesFactory->createTestGroup([{ + amount => 10.0, + cardnumber => '1A23', + accounttype => 'FU', + note => 'unique identifier', +}, + + ], undef, $subtestContext); + +#Check if the previously non-existent Patron is now autogenerated? +$borrower = Koha::Patrons->find({cardnumber => '1A23' }); +ok($borrower && ref($borrower) eq 'Koha::Patron', "Fines borrower autogenerated"); + +# check that the fine exists in accountlines +my ($total,$fines,undef) = C4::Members::GetMemberAccountRecords($borrower->borrowernumber); + +my $found_testFine = 0; +foreach my $fine (@$fines){ + if ($fine->{note} eq 'unique identifier'){ + $found_testFine = 1; + last; + } +} + +ok($found_testFine, 'Fine \'unique identifier\', accountlines match.'); + +# delete the fine +t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + +# confirm the deletion +($total,$fines,undef) = C4::Members::GetMemberAccountRecords($borrower->borrowernumber); + +$found_testFine = 0; +foreach my $fine (@$fines){ + if ($fine->{note} eq 'unique identifier'){ + $found_testFine = 1; + last; + } +} +is($found_testFine, 0, 'Fine \'unique identifier\', deleted.'); + +done_testing(); diff --git a/t/lib/TestObjects/t/holdFactory.t b/t/lib/TestObjects/t/holdFactory.t new file mode 100644 index 0000000..900b239 --- /dev/null +++ b/t/lib/TestObjects/t/holdFactory.t @@ -0,0 +1,76 @@ +#!/usr/bin/perl + +# Copyright KohaSuomi 2016 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Test::More; + +use C4::Reserves; +use t::lib::TestObjects::HoldFactory; + +my $subtestContext = {}; +##Create and Delete using dependencies in the $testContext instantiated in previous subtests. +my $hold = t::lib::TestObjects::HoldFactory->createTestGroup( + {cardnumber => '1A01', + isbn => '971', + barcode => '1N01', + branchcode => 'CPL', + waitingdate => '2015-01-15', + }, + ['cardnumber','isbn','barcode'], $subtestContext); + +is($hold->{branchcode}, + 'CPL', + "Hold '1A01-971-1N01' pickup location is 'CPL'."); +is($hold->{waitingdate}, + '2015-01-15', + "Hold '1A01-971-1N01' waiting date is '2015-01-15'."); + +#using the default test hold identifier reservenotes to distinguish hard-to-identify holds. +my $holds2 = t::lib::TestObjects::HoldFactory->createTestGroup([ + {cardnumber => '1A01', + isbn => '971', + barcode => '1N02', + branchcode => 'CPL', + reservenotes => 'nice hold', + }, + {cardnumber => '1A01', + barcode => '1N03', + isbn => '971', + branchcode => 'CPL', + reservenotes => 'better hold', + }, + ], undef, $subtestContext); + +is($holds2->{'nice hold'}->{branchcode}, + 'CPL', + "Hold 'nice hold' pickup location is 'CPL'."); +is($holds2->{'nice hold'}->{borrower}->cardnumber, + '1A01', + "Hold 'nice hold' cardnumber is '1A01'."); +is($holds2->{'better hold'}->{isbn}, + '971', + "Hold 'better hold' isbn '971'."); + +t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + +my $holds_deleted = Koha::Holds->search({biblionumber => $hold->{biblio}->{biblionumber}}); +ok (not($holds_deleted->count), "Holds deleted"); + +done_testing(); diff --git a/t/lib/TestObjects/t/letterTemplateFactory.t b/t/lib/TestObjects/t/letterTemplateFactory.t new file mode 100644 index 0000000..a42520e --- /dev/null +++ b/t/lib/TestObjects/t/letterTemplateFactory.t @@ -0,0 +1,56 @@ +#!/usr/bin/perl + +# Copyright KohaSuomi 2016 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Test::More; + +use t::lib::TestObjects::LetterTemplateFactory; +use Koha::Notice::Templates; + +my $testContext = {}; #Gather all created Objects here so we can finally remove them all. +my $now = DateTime->now(time_zone => C4::Context->tz()); +my $year = $now->year(); + +my $subtestContext = {}; +##Create and Delete using dependencies in the $testContext instantiated in previous subtests. +my $f = t::lib::TestObjects::LetterTemplateFactory->new(); +my $hashLT = {letter_id => 'circulation-ODUE1-CPL-print', + module => 'circulation', + code => 'ODUE1', + branchcode => 'CPL', + name => 'Notice1', + is_html => undef, + title => 'Notice1', + message_transport_type => 'print', + content => 'Barcode: <>, bring it back!', + }; +my $objects = $f->createTestGroup([ + $hashLT, + ], undef, $subtestContext); + +my $letterTemplate = Koha::Notice::Templates->find($hashLT); +is($objects->{'circulation-ODUE1-CPL-print'}->name, $letterTemplate->name, "LetterTemplate 'circulation-ODUE1-CPL-print'"); + +#Delete them +t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); +$letterTemplate = Koha::Notice::Templates->find($hashLT); +ok(not(defined($letterTemplate)), "LetterTemplate 'circulation-ODUE1-CPL-print' deleted"); + +done_testing(); diff --git a/t/lib/TestObjects/t/matcherFactory.t b/t/lib/TestObjects/t/matcherFactory.t new file mode 100644 index 0000000..88687b1 --- /dev/null +++ b/t/lib/TestObjects/t/matcherFactory.t @@ -0,0 +1,146 @@ +#!/usr/bin/perl + +# Copyright KohaSuomi 2016 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Test::More; + +use t::lib::TestObjects::MatcherFactory; + +my ($matchers, $matcher, $mp1, $mp2, $reqCheck); +my $subtestContext = {}; +##Create and Delete using dependencies in the $testContext instantiated in previous subtests. +$matchers = t::lib::TestObjects::MatcherFactory->createTestGroup([ + { + code => 'MATCHLORD', + description => 'I am lord', + threshold => 1001, + matchpoints => [ + { + index => 'title', + score => 500, + components => [{ + tag => '130', + subfields => 'a', + offset => 0, + length => 0, + norms => ['hello'], + }] + }, + { + index => 'isbn', + score => 500, + components => [{ + tag => '020', + subfields => 'a', + offset => 0, + length => 0, + norms => ['isbn'], + }] + } + ], + required_checks => [{ + source => [{ + tag => '049', + subfields => 'c', + offset => 0, + length => 0, + norms => ['copy'], + }], + target => [{ + tag => '521', + subfields => 'a', + offset => 0, + length => 0, + norms => ['paste'], + }], + }], + }, + {} #One with defauĺts + ], undef, $subtestContext); +################# +## MATCHERLORD ## +is($matchers->{MATCHLORD}->code, + 'MATCHLORD', + 'MATCHLORD'); +is($matchers->{MATCHLORD}->threshold, + 1001, + 'threshold 1001'); +$mp1 = $matchers->{MATCHLORD}->{matchpoints}->[0]; +is($mp1->{components}->[0]->{tag}, + '130', + 'matchpoint 130'); +is($mp1->{components}->[0]->{norms}->[0], + 'hello', + 'matchpoint hello'); +$mp2 = $matchers->{MATCHLORD}->{matchpoints}->[1]; +is($mp2->{components}->[0]->{tag}, + '020', + 'matchpoint 020'); +is($mp2->{components}->[0]->{norms}->[0], + 'isbn', + 'matchpoint isbn'); +$reqCheck = $matchers->{MATCHLORD}->{'required_checks'}->[0]; +is($reqCheck->{source_matchpoint}->{components}->[0]->{tag}, + '049', + 'required checks source matchpoint tag 049'); +is($reqCheck->{target_matchpoint}->{components}->[0]->{tag}, + '521', + 'required checks target matchpoint tag 521'); + + +############# +## MATCHER ## +is($matchers->{MATCHER}->code, + 'MATCHER', + 'MATCHER'); +is($matchers->{MATCHER}->threshold, + 1000, + 'threshold 1000'); +$mp1 = $matchers->{MATCHER}->{matchpoints}->[0]; +is($mp1->{components}->[0]->{tag}, + '245', + 'matchpoint 245'); +is($mp1->{components}->[0]->{offset}, + '0', + 'matchpoint 0'); +$mp2 = $matchers->{MATCHER}->{matchpoints}->[1]; +is($mp2->{components}->[0]->{tag}, + '100', + 'matchpoint 020'); +is($mp2->{components}->[0]->{norms}->[0], + '', + 'matchpoint ""'); +$reqCheck = $matchers->{MATCHER}->{'required_checks'}->[0]; +is($reqCheck->{source_matchpoint}->{components}->[0]->{tag}, + '020', + 'required checks source matchpoint tag 020'); +is($reqCheck->{target_matchpoint}->{components}->[0]->{tag}, + '024', + 'required checks target matchpoint tag 024'); + + +t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + +$matcher = C4::Matcher->fetch( $matchers->{MATCHER}->{id} ); +ok(not($matcher), "Matcher MATCHER deleted"); +$matcher = C4::Matcher->fetch( $matchers->{MATCHLORD}->{id} ); +ok(not($matcher), "Matcher MATCHLORD deleted"); + +done_testing(); diff --git a/t/lib/TestObjects/t/messageQueueFactory.t b/t/lib/TestObjects/t/messageQueueFactory.t new file mode 100644 index 0000000..5084c4e --- /dev/null +++ b/t/lib/TestObjects/t/messageQueueFactory.t @@ -0,0 +1,79 @@ +#!/usr/bin/perl + +# Copyright KohaSuomi 2016 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Test::More; + +use Koha::Patrons; +use t::lib::TestObjects::MessageQueueFactory; +use C4::Letters; + +my $subtestContext = {}; + +my $f = t::lib::TestObjects::PatronFactory->new(); +my $objects = $f->createTestGroup([ + {firstname => 'Olli-Antti', + surname => 'Kivi', + cardnumber => '1A23', + branchcode => 'CPL', + }, + ], undef, $subtestContext); + +#Create the MessageQueue +my $messages = t::lib::TestObjects::MessageQueueFactory->createTestGroup([{ + subject => "The quick brown fox", + content => "Jumps over the lazy dog.", + cardnumber => '1A23', + message_transport_type => 'sms', + from_address => '11A001@example.com', +}, + + ], undef, $subtestContext); + +# check that the message exists in queue +my $queued_messages = C4::Letters->_get_unsent_messages(); + +my $found_testMessage = 0; +foreach my $message (@$queued_messages){ + if ($message->{from_address} eq '11A001@example.com'){ + $found_testMessage = 1; + last; + } +} + +ok($found_testMessage, 'MessageQueue \'11A001@example.com\', message_queue match.'); + +# delete the queued message +t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + +# confirm the deletion +$queued_messages = C4::Letters->_get_unsent_messages(); + +$found_testMessage = 0; +foreach my $message (@$queued_messages){ + if ($message->{from_address} eq '11A001@example.com'){ + $found_testMessage = 1; + last; + } +} + +is($found_testMessage, 0, 'MessageQueue \'11A001@example.com\', deleted.'); + +done_testing(); diff --git a/t/lib/TestObjects/t/objectFactories.t b/t/lib/TestObjects/t/objectFactories.t new file mode 100644 index 0000000..16c123e --- /dev/null +++ b/t/lib/TestObjects/t/objectFactories.t @@ -0,0 +1,575 @@ +#!/usr/bin/perl + +# Copyright KohaSuomi 2016 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; + +use Test::More; + +=head + +This is the old objectFactories.t which was split to pieces. +Put each TestObjectFactory's tests to its own separate file. + +=cut + +use DateTime; + +use Koha::DateUtils; + +use t::lib::TestObjects::ObjectFactory; +use t::lib::TestObjects::Serial::SubscriptionFactory; +use Koha::Serials; +use Koha::Subscriptions; +use t::lib::TestObjects::PatronFactory; +use Koha::Patrons; +use t::lib::TestObjects::ItemFactory; +use Koha::Items; +use t::lib::TestObjects::BiblioFactory; +use Koha::Biblios; +use t::lib::TestObjects::CheckoutFactory; +use Koha::Checkouts; +use t::lib::TestObjects::LetterTemplateFactory; +use Koha::Notice::Templates; +use t::lib::TestObjects::FileFactory; +use File::Slurp; +use File::Fu::File; +use t::lib::TestObjects::SystemPreferenceFactory; +use t::lib::TestObjects::MessageQueueFactory; +use C4::Letters; +use t::lib::TestObjects::HoldFactory; +use C4::Context; + + +my $testContext = {}; #Gather all created Objects here so we can finally remove them all. +my $now = DateTime->now(time_zone => C4::Context->tz()); +my $year = $now->year(); + + +########## SubscriptionFactory subtests ########## +subtest "t::lib::TestObjects::SubscriptionFactory" => \&testSubscriptionFactory; +sub testSubscriptionFactory { + my $subtestContext = {}; + my $biblionumber; #Get the biblionumber the test Subscription is for. + + eval { + my $subscription = t::lib::TestObjects::Serial::SubscriptionFactory->createTestGroup( + {internalnotes => 'TSUB1', + receiveSerials => 5, + staffdisplaycount => 10, + opacdisplaycount => 15, + }, + undef, $subtestContext); + $biblionumber = $subscription->biblionumber; + + C4::Context->interface('opac'); + is($subscription->opacdisplaycount, + 15, + "Get opacdisplaycount."); + C4::Context->interface('opac'); + is($subscription->staffdisplaycount, + 10, + "Get staffdisplaycount."); + + my $serials = Koha::Serials->search({ + subscriptionid => $subscription->subscriptionid + })->as_list; + ok($serials->[0]->serialseq_x == $year && + $serials->[0]->serialseq_y == 1 && + $serials->[0]->serialseq_z == 1, + "Patterns x,y,z set for the first serial."); + ok($serials->[2]->serialseq_x == $year && + $serials->[2]->serialseq_y == 1 && + $serials->[2]->serialseq_z == 3, + "Patterns x,y,z set for the third serial."); + ok($serials->[4]->serialseq_x == $year && + $serials->[4]->serialseq_y == 2 && + $serials->[4]->serialseq_z == 1, + "Patterns x,y,z set for the fifth serial."); + + my @items = Koha::Items->search({biblionumber => $biblionumber}); + is(scalar(@items), 5, "Created Items while receiving Serials"); + }; + if ($@) { + ok(0, "Subtest crashed with error:\n$@\n"); + } + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + + my @items = Koha::Items->search({biblionumber => $biblionumber}); + is(scalar(@items), 0, "Created Items torn down"); +} + + + +########## HoldFactory subtests ########## +subtest 't::lib::TestObjects::HoldFactory' => \&testHoldFactory; +sub testHoldFactory { + my $subtestContext = {}; + ##Create and Delete using dependencies in the $testContext instantiated in previous subtests. + my $hold = t::lib::TestObjects::HoldFactory->createTestGroup( + {cardnumber => '1A01', + isbn => '971', + barcode => '1N01', + branchcode => 'CPL', + waitingdate => '2015-01-15', + }, + ['cardnumber','isbn','barcode'], $subtestContext); + + is($hold->{branchcode}, + 'CPL', + "Hold '1A01-971-1N01' pickup location is 'CPL'."); + is($hold->{waitingdate}, + '2015-01-15', + "Hold '1A01-971-1N01' waiting date is '2015-01-15'."); + + #using the default test hold identifier reservenotes to distinguish hard-to-identify holds. + my $holds2 = t::lib::TestObjects::HoldFactory->createTestGroup([ + {cardnumber => '1A01', + isbn => '971', + barcode => '1N02', + branchcode => 'CPL', + reservenotes => 'nice hold', + }, + {cardnumber => '1A01', + barcode => '1N03', + isbn => '971', + branchcode => 'CPL', + reservenotes => 'better hold', + }, + ], undef, $subtestContext); + + is($holds2->{'nice hold'}->{branchcode}, + 'CPL', + "Hold 'nice hold' pickup location is 'CPL'."); + is($holds2->{'nice hold'}->{borrower}->cardnumber, + '1A01', + "Hold 'nice hold' cardnumber is '1A01'."); + is($holds2->{'better hold'}->{isbn}, + '971', + "Hold 'better hold' isbn '971'."); + + t::lib::TestObjects::HoldFactory->deleteTestGroup($subtestContext->{hold}); + + my $holds_deleted = Koha::Holds->search({biblionumber => $hold->{biblio}->{biblionumber}}); + ok (not($holds_deleted->count), "Holds deleted"); +}; + + + +########## FileFactory subtests ########## +subtest 't::lib::TestObjects::FileFactory' => \&testFileFactory; +sub testFileFactory { + my ($files); + my $subtestContext = {}; + + $files = t::lib::TestObjects::FileFactory->createTestGroup([ + {'filepath' => 'atomicupdate', + 'filename' => '#30-RabiesIsMyDog.pl', + 'content' => 'print "Mermaids are my only love\nI never let them down";', + }, + {'filepath' => 'atomicupdate', + 'filename' => '#31-FrogsArePeopleToo.pl', + 'content' => 'print "Listen to the Maker!";', + }, + {'filepath' => 'atomicupdate', + 'filename' => '#32-AnimalLover.pl', + 'content' => "print 'Do not hurt them!;", + }, + ], undef, $subtestContext); + + my $file30content = File::Slurp::read_file( $files->{'#30-RabiesIsMyDog.pl'}->absolutely ); + ok($file30content =~ m/Mermaids are my only love/, + "'#30-RabiesIsMyDog.pl' created and content matches"); + my $file31content = File::Slurp::read_file( $files->{'#31-FrogsArePeopleToo.pl'}->absolutely ); + ok($file31content =~ m/Listen to the Maker!/, + "'#31-FrogsArePeopleToo.pl' created and content matches"); + my $file32content = File::Slurp::read_file( $files->{'#32-AnimalLover.pl'}->absolutely ); + ok($file32content =~ m/Do not hurt them!/, + "'#32-AnimalLover.pl' created and content matches"); + + ##addToContext() test, create new file + my $dir = $files->{'#32-AnimalLover.pl'}->dirname(); + my $file = File::Fu::File->new("$dir/addToContext.txt"); + $file->touch; + t::lib::TestObjects::FileFactory->addToContext($file, undef, $subtestContext); + ok($file->e, + "'addToContext.txt' created"); + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + + ok(not(-e $files->{'#30-RabiesIsMyDog.pl'}->absolutely), + "'#30-RabiesIsMyDog.pl' deleted"); + ok(not(-e $files->{'#31-FrogsArePeopleToo.pl'}->absolutely), + "'#31-FrogsArePeopleToo.pl' deleted"); + ok(not(-e $files->{'#32-AnimalLover.pl'}->absolutely), + "'#32-AnimalLover.pl' deleted"); + ok(not(-e $file->absolutely), + "'addToContext.txt' deleted"); +}; + + + +########## PatronFactory subtests ########## +subtest 't::lib::TestObjects::PatronFactory' => \&testPatronFactory; +sub testPatronFactory { + my $subtestContext = {}; + ##Create and Delete. Add one + my $f = t::lib::TestObjects::PatronFactory->new(); + my $objects = $f->createTestGroup([ + {firstname => 'Olli-Antti', + surname => 'Kivi', + cardnumber => '11A001', + branchcode => 'CPL', + }, + ], undef, $subtestContext, undef, $testContext); + is($objects->{'11A001'}->cardnumber, '11A001', "Patron '11A001'."); + ##Add one more to test incrementing the subtestContext. + $objects = $f->createTestGroup([ + {firstname => 'Olli-Antti2', + surname => 'Kivi2', + cardnumber => '11A002', + branchcode => 'FFL', + }, + ], undef, $subtestContext, undef, $testContext); + is($subtestContext->{patron}->{'11A001'}->cardnumber, '11A001', "Patron '11A001' from \$subtestContext."); #From subtestContext + is($objects->{'11A002'}->branchcode, 'FFL', "Patron '11A002'."); #from just created hash. + + ##Delete objects + t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + foreach my $cn (('11A001', '11A002')) { + ok (not(Koha::Patrons->find({cardnumber => $cn})), + "Patron '11A001' deleted"); + } + + #Prepare for global autoremoval. + $objects = $f->createTestGroup([ + {firstname => 'Olli-Antti', + surname => 'Kivi', + cardnumber => '11A001', + branchcode => 'CPL', + }, + {firstname => 'Olli-Antti2', + surname => 'Kivi2', + cardnumber => '11A002', + branchcode => 'FFL', + }, + ], undef, undef, undef, $testContext); +}; + + + +########## BiblioFactory and ItemFactory subtests ########## +subtest 't::lib::TestObjects::BiblioFactory and ::ItemFactory' => \&testBiblioItemFactories; +sub testBiblioItemFactories { + my $subtestContext = {}; + ##Create and Delete. Add one + my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([ + {'biblio.title' => 'I wish I met your mother', + 'biblio.author' => 'Pertti Kurikka', + 'biblio.copyrightdate' => '1960', + 'biblioitems.isbn' => '9519671580', + 'biblioitems.itemtype' => 'BK', + }, + ], 'biblioitems.isbn', $subtestContext, undef, $testContext); + my $objects = t::lib::TestObjects::ItemFactory->createTestGroup([ + {biblionumber => $biblios->{9519671580}->{biblionumber}, + barcode => '167Nabe0001', + homebranch => 'CPL', + holdingbranch => 'CPL', + price => '0.50', + replacementprice => '0.50', + itype => 'BK', + biblioisbn => '9519671580', + itemcallnumber => 'PK 84.2', + }, + ], 'barcode', $subtestContext, undef, $testContext); + + is($objects->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001'."); + ##Add one more to test incrementing the subtestContext. + $objects = t::lib::TestObjects::ItemFactory->createTestGroup([ + {biblionumber => $biblios->{9519671580}->{biblionumber}, + barcode => '167Nabe0002', + homebranch => 'CPL', + holdingbranch => 'FFL', + price => '3.50', + replacementprice => '3.50', + itype => 'BK', + biblioisbn => '9519671580', + itemcallnumber => 'JK 84.2', + }, + ], 'barcode', $subtestContext, undef, $testContext); + + is($subtestContext->{item}->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001' from \$subtestContext."); + is($objects->{'167Nabe0002'}->holdingbranch, 'FFL', "Item '167Nabe0002'."); + is(ref($biblios->{9519671580}), 'MARC::Record', "Biblio 'I wish I met your mother'."); + + ##Delete objects + t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + my $object1 = Koha::Items->find({barcode => '167Nabe0001'}); + ok (not($object1), "Item '167Nabe0001' deleted"); + my $object2 = Koha::Items->find({barcode => '167Nabe0002'}); + ok (not($object2), "Item '167Nabe0002' deleted"); + my $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"}); + ok (not($object2), "Biblio 'I wish I met your mother' deleted"); +}; + + + +########## CheckoutFactory subtests ########## +subtest 't::lib::TestObjects::CheckoutFactory' => \&testCheckoutFactory; +sub testCheckoutFactory { + my $subtestContext = {}; + ##Create and Delete using dependencies in the $testContext instantiated in previous subtests. + my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([ + {'biblio.title' => 'I wish I met your mother', + 'biblio.author' => 'Pertti Kurikka', + 'biblio.copyrightdate' => '1960', + 'biblioitems.isbn' => '9519671580', + 'biblioitems.itemtype' => 'BK', + }, + ], 'biblioitems.isbn', undef, undef, $subtestContext); + my $items = t::lib::TestObjects::ItemFactory->createTestGroup([ + {biblionumber => $biblios->{9519671580}->{biblionumber}, + barcode => '167Nabe0001', + homebranch => 'CPL', + holdingbranch => 'CPL', + price => '0.50', + replacementprice => '0.50', + itype => 'BK', + biblioisbn => '9519671580', + itemcallnumber => 'PK 84.2', + }, + {biblionumber => $biblios->{9519671580}->{biblionumber}, + barcode => '167Nabe0002', + homebranch => 'CPL', + holdingbranch => 'FFL', + price => '3.50', + replacementprice => '3.50', + itype => 'BK', + biblioisbn => '9519671580', + itemcallnumber => 'JK 84.2', + }, + ], 'barcode', undef, undef, $subtestContext); + my $objects = t::lib::TestObjects::CheckoutFactory->createTestGroup([ + { + cardnumber => '11A001', + barcode => '167Nabe0001', + daysOverdue => 7, + daysAgoCheckedout => 28, + }, + { + cardnumber => '11A002', + barcode => '167Nabe0002', + daysOverdue => -7, + daysAgoCheckedout => 14, + checkoutBranchRule => 'holdingbranch', + }, + ], undef, undef, undef, undef); + + is($objects->{'11A001-167Nabe0001'}->branchcode, + 'CPL', + "Checkout '11A001-167Nabe0001' checked out from the default context branch 'CPL'."); + is($objects->{'11A002-167Nabe0002'}->branchcode, + 'FFL', + "Checkout '11A002-167Nabe0002' checked out from the holdingbranch 'FFL'."); + is(Koha::DateUtils::dt_from_string($objects->{'11A001-167Nabe0001'}->issuedate)->day(), + DateTime->now(time_zone => C4::Context->tz())->subtract(days => '28')->day() + , "Checkout '11A001-167Nabe0001', adjusted issuedates match."); + is(Koha::DateUtils::dt_from_string($objects->{'11A002-167Nabe0002'}->date_due)->day(), + DateTime->now(time_zone => C4::Context->tz())->subtract(days => '-7')->day() + , "Checkout '11A002-167Nabe0002', adjusted date_dues match."); + + t::lib::TestObjects::CheckoutFactory->deleteTestGroup($objects); + my $object1 = Koha::Checkouts->find({borrowernumber => $objects->{'11A001-167Nabe0001'}->borrowernumber, + itemnumber => $objects->{'11A001-167Nabe0001'}->itemnumber}); + ok (not($object1), "Checkout '11A001-167Nabe0001' deleted"); + my $object2 = Koha::Checkouts->find({borrowernumber => $objects->{'11A002-167Nabe0002'}->borrowernumber, + itemnumber => $objects->{'11A002-167Nabe0002'}->itemnumber}); + ok (not($object2), "Checkout '11A002-167Nabe0002' deleted"); +}; + + + +########## LetterTemplateFactory subtests ########## +subtest 't::lib::TestObjects::LetterTemplateFactory' => \&testLetterTemplateFactory; +sub testLetterTemplateFactory { + my $subtestContext = {}; + ##Create and Delete using dependencies in the $testContext instantiated in previous subtests. + my $f = t::lib::TestObjects::LetterTemplateFactory->new(); + my $hashLT = {letter_id => 'circulation-ODUE1-CPL-print', + module => 'circulation', + code => 'ODUE1', + branchcode => 'CPL', + name => 'Notice1', + is_html => undef, + title => 'Notice1', + message_transport_type => 'print', + content => 'Barcode: <>, bring it back!', + }; + my $objects = $f->createTestGroup([ + $hashLT, + ], undef, undef, undef, undef); + + my $letterTemplate = Koha::Notice::Templates->find($hashLT); + is($objects->{'circulation-ODUE1-CPL-print'}->name, $letterTemplate->name, "LetterTemplate 'circulation-ODUE1-CPL-print'"); + + #Delete them + $f->deleteTestGroup($objects); + $letterTemplate = Koha::Notice::Templates->find($hashLT); + ok(not(defined($letterTemplate)), "LetterTemplate 'circulation-ODUE1-CPL-print' deleted"); +}; + + + +########## SystemPreferenceFactory subtests ########## +subtest 't::lib::TestObjects::SystemPreferenceFactory' => \&testSystemPreferenceFactory; +sub testSystemPreferenceFactory { + my $subtestContext = {}; + + # take syspref 'opacuserlogin' and save its current value + my $current_pref_value = C4::Context->preference("opacuserlogin"); + + is($current_pref_value, $current_pref_value, "System Preference 'opacuserlogin' original value '".(($current_pref_value) ? $current_pref_value : 0)."'"); + + # reverse the value for testing + my $pref_new_value = !$current_pref_value || 0; + + my $objects = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([ + {preference => 'opacuserlogin', + value => $pref_new_value # set the reversed value + }, + ], undef, $subtestContext, undef, undef); + + is(C4::Context->preference("opacuserlogin"), $pref_new_value, "System Preference opacuserlogin reversed to '".(($pref_new_value) ? $pref_new_value:0)."'"); + + # let's change it again to test that only the original preference value is saved + $objects = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([ + {preference => 'opacuserlogin', + value => 2 # set the reversed value + }, + ], undef, $subtestContext, undef, undef); + + is(C4::Context->preference("opacuserlogin"), 2, "System Preference opacuserlogin set to '2'"); + + #Delete them + t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + is(C4::Context->preference("opacuserlogin"), $current_pref_value, "System Preference opacuserlogin restored to '".(($current_pref_value) ? $current_pref_value:0)."' after test group deletion"); +}; + + + +########## MessageQueueFactory subtests ########## +subtest 't::lib::TestObjects::MessageQueueFactory' => \&testMessageQueueFactory; +sub testMessageQueueFactory { + my $subtestContext = {}; + + #Check if the precondition Patron exists, it shouldn't + my $f = t::lib::TestObjects::PatronFactory->new(); + my $objects = $f->createTestGroup([ + {firstname => 'Olli-Antti', + surname => 'Kivi', + cardnumber => '1A23', + branchcode => 'CPL', + }, + ], undef, $subtestContext, undef, $testContext); + + #Create the MessageQueue + my $messages = t::lib::TestObjects::MessageQueueFactory->createTestGroup([{ + subject => "The quick brown fox", + content => "Jumps over the lazy dog.", + cardnumber => '1A23', + message_transport_type => 'sms', + from_address => '11A001@example.com', + }, + + ], undef, $subtestContext); + + # check that the message exists in queue + my $queued_messages = C4::Letters->_get_unsent_messages(); + + my $found_testMessage = 0; + foreach my $message (@$queued_messages){ + if ($message->{from_address} eq '11A001@example.com'){ + $found_testMessage = 1; + last; + } + } + + ok($found_testMessage, 'MessageQueue \'11A001@example.com\', message_queue match.'); + + # delete the queued message + t::lib::TestObjects::MessageQueueFactory->deleteTestGroup($messages); + + # confirm the deletion + $queued_messages = C4::Letters->_get_unsent_messages(); + + $found_testMessage = 0; + foreach my $message (@$queued_messages){ + if ($message->{from_address} eq '11A001@example.com'){ + $found_testMessage = 1; + last; + } + } + + is($found_testMessage, 0, 'MessageQueue \'11A001@example.com\', deleted.'); + + #Delete them + t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); +}; + + + +########## Global test context subtests ########## +subtest 't::lib::TestObjects::ObjectFactory clearing global test context' => \&testGlobalSubtestContext; +sub testGlobalSubtestContext { + my $object11A001 = Koha::Patrons->find({cardnumber => '11A001'}); + ok ($object11A001, "Global Patron '11A001' exists"); + my $object11A002 = Koha::Patrons->find({cardnumber => '11A002'}); + ok ($object11A002, "Global Patron '11A002' exists"); + + my $object1 = Koha::Items->find({barcode => '167Nabe0001'}); + ok ($object1, "Global Item '167Nabe0001' exists"); + my $object2 = Koha::Items->find({barcode => '167Nabe0002'}); + ok ($object2, "Global Item '167Nabe0002' exists"); + my $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"}); + ok ($object2, "Global Biblio 'I wish I met your mother' exists"); + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext); + + $object11A001 = Koha::Patrons->find({cardnumber => '11A001'}); + ok (not($object11A001), "Global Patron '11A001' deleted"); + $object11A002 = Koha::Patrons->find({cardnumber => '11A002'}); + ok (not($object11A002), "Global Patron '11A002' deleted"); + + $object1 = Koha::Items->find({barcode => '167Nabe0001'}); + ok (not($object1), "Global Item '167Nabe0001' deleted"); + $object2 = Koha::Items->find({barcode => '167Nabe0002'}); + ok (not($object2), "Global Item '167Nabe0002' deleted"); + $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"}); + ok (not($object2), "Global Biblio 'I wish I met your mother' deleted"); +}; + + + +done_testing(); +=cut + +ok(1,"TODO:: Write test context interaction tests"); +done_testing(); diff --git a/t/lib/TestObjects/t/patronFactory.t b/t/lib/TestObjects/t/patronFactory.t new file mode 100644 index 0000000..1c572bf --- /dev/null +++ b/t/lib/TestObjects/t/patronFactory.t @@ -0,0 +1,56 @@ +#!/usr/bin/perl + +# Copyright KohaSuomi 2016 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Test::More; + +use t::lib::TestObjects::PatronFactory; +use Koha::Patrons; + +my $subtestContext = {}; +##Create and Delete. Add one +my $f = t::lib::TestObjects::PatronFactory->new(); +my $objects = $f->createTestGroup([ + {firstname => 'Olli-Antti', + surname => 'Kivi', + cardnumber => '11A001', + branchcode => 'CPL', + }, + ], undef, $subtestContext); +is($objects->{'11A001'}->cardnumber, '11A001', "Patron '11A001'."); +##Add one more to test incrementing the subtestContext. +$objects = $f->createTestGroup([ + {firstname => 'Olli-Antti2', + surname => 'Kivi2', + cardnumber => '11A002', + branchcode => 'FFL', + }, + ], undef, $subtestContext); +is($subtestContext->{patron}->{'11A001'}->cardnumber, '11A001', "Patron '11A001' from \$subtestContext."); #From subtestContext +is($objects->{'11A002'}->branchcode, 'FFL', "Patron '11A002'."); #from just created hash. + +##Delete objects +t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); +foreach my $cn (('11A001', '11A002')) { + ok (not(Koha::Patrons->find({cardnumber => $cn})), + "Patron '11A001' deleted"); +} + +done_testing(); diff --git a/t/lib/TestObjects/t/systemPreferenceFactory.t b/t/lib/TestObjects/t/systemPreferenceFactory.t new file mode 100644 index 0000000..295c94d --- /dev/null +++ b/t/lib/TestObjects/t/systemPreferenceFactory.t @@ -0,0 +1,58 @@ +#!/usr/bin/perl + +# Copyright KohaSuomi 2016 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Test::More; + +use t::lib::TestObjects::SystemPreferenceFactory; +use C4::Context; + +my $subtestContext = {}; + +# take syspref 'opacuserlogin' and save its current value +my $current_pref_value = C4::Context->preference("opacuserlogin"); + +is($current_pref_value, $current_pref_value, "System Preference 'opacuserlogin' original value '".(($current_pref_value) ? $current_pref_value : 0)."'"); + +# reverse the value for testing +my $pref_new_value = !$current_pref_value || 0; + +my $objects = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([ + {preference => 'opacuserlogin', + value => $pref_new_value # set the reversed value + }, + ], undef, $subtestContext, undef, undef); + +is(C4::Context->preference("opacuserlogin"), $pref_new_value, "System Preference opacuserlogin reversed to '".(($pref_new_value) ? $pref_new_value:0)."'"); + +# let's change it again to test that only the original preference value is saved +$objects = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([ + {preference => 'opacuserlogin', + value => 2 # set the reversed value + }, + ], undef, $subtestContext, undef, undef); + +is(C4::Context->preference("opacuserlogin"), 2, "System Preference opacuserlogin set to '2'"); + +#Delete them +t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); +is(C4::Context->preference("opacuserlogin"), $current_pref_value, "System Preference opacuserlogin restored to '".(($current_pref_value) ? $current_pref_value:0)."' after test group deletion"); + +done_testing(); -- 2.7.4