@@ -, +, @@ easy Test object creation/deletion from HASHes. -letters -overuderules -circulationrules -borrowers -biblios -items -issues (checkouts) {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); ... #Run your tests here warn $@; tearDown(); exit 1; 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 --- a/t/lib/TestContext.pm +++ a/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; --- a/t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm +++ a/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; --- a/t/lib/TestObjects/Acquisition/BooksellerFactory.pm +++ a/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; --- a/t/lib/TestObjects/BiblioFactory.pm +++ a/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; --- a/t/lib/TestObjects/CheckoutFactory.pm +++ a/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; --- a/t/lib/TestObjects/FileFactory.pm +++ a/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; --- a/t/lib/TestObjects/FinesFactory.pm +++ a/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; --- a/t/lib/TestObjects/HoldFactory.pm +++ a/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; --- a/t/lib/TestObjects/ItemFactory.pm +++ a/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; --- a/t/lib/TestObjects/LetterTemplateFactory.pm +++ a/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; --- a/t/lib/TestObjects/MatcherFactory.pm +++ a/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; --- a/t/lib/TestObjects/MessageQueueFactory.pm +++ a/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; --- a/t/lib/TestObjects/ObjectFactory.pm +++ a/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; --- a/t/lib/TestObjects/PatronFactory.pm +++ a/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; --- a/t/lib/TestObjects/Serial/FrequencyFactory.pm +++ a/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; --- a/t/lib/TestObjects/Serial/SubscriptionFactory.pm +++ a/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; --- a/t/lib/TestObjects/SystemPreferenceFactory.pm +++ a/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; --- a/t/lib/TestObjects/t/biblioItemFactory.t +++ a/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(); --- a/t/lib/TestObjects/t/checkoutFactory.t +++ a/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(); --- a/t/lib/TestObjects/t/fileFactory.t +++ a/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(); --- a/t/lib/TestObjects/t/finesFactory.t +++ a/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(); --- a/t/lib/TestObjects/t/holdFactory.t +++ a/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(); --- a/t/lib/TestObjects/t/letterTemplateFactory.t +++ a/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(); --- a/t/lib/TestObjects/t/matcherFactory.t +++ a/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(); --- a/t/lib/TestObjects/t/messageQueueFactory.t +++ a/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(); --- a/t/lib/TestObjects/t/objectFactories.t +++ a/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(); --- a/t/lib/TestObjects/t/patronFactory.t +++ a/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(); --- a/t/lib/TestObjects/t/systemPreferenceFactory.t +++ a/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(); --