From bbf5a8d00d0c5027ddf47aad5cca9867c10811ca Mon Sep 17 00:00:00 2001 From: Olli-Antti Kivilahti Date: Wed, 25 Mar 2015 15:53:07 +0200 Subject: [PATCH] Bug 13906 - TestObjectFactory(ies) for Koha objects. Enable easy Test object creation/deletion from HASHes. Doing tests should be easy. One biggest hindrance in doing tests is the difficulty of doing so in Koha. We use a lot of hard-coded SQL, which occasionally requires quite a bit of fiddling to get it right. Satisfying complex object dependency chains is hard. For example, testing Overdue notice sending, one must create -letters -overuderules -circulationrules -borrowers -biblios -items -issues (checkouts) ... Also one must take care to clean up the database modifications afterward to make encapsulated tests which don't leak over other tests. This is especially so for front-end testing. TestObjectFactories significantly alleviate this pain. They try to recover from errors, like when the previous test crashed and left testing objects into the DB, preventing adding them again. Also they store what object they created to 3 different levels of stashes to facilitate complex test configurations, and they have the dignity to clean-up the test contexts after testing has happened (if the script doesn't crash)! UNIT TESTS included! USAGE: use t::db_dependent::TestObjects::Borrowers::BorrowerFactory; %#Setting up the test context my $testContext = {}; my $password = '1234'; my $borrowerFactory = t::db_dependent::TestObjects::Borrowers::BorrowerFactory->new(); my $borrowers = $borrowerFactory->createTestGroup([ {firstname => 'Olli-Antti', surname => 'Kivi', cardnumber => '1A01', branchcode => 'CPL', flags => '1', #superlibrarian, not exactly a very good way of doing permission testing? userid => 'mini_admin', password => $password, }, ], undef, $testContext); %#Test context set, starting testing: eval { ... #Run your tests here }; if ($@) { #Catch all leaking errors and gracefully terminate. warn $@; tearDown(); exit 1; } %#All tests done, tear down test context tearDown(); done_testing; sub tearDown { t::db_dependent::TestObjects::ObjectFactory->tearDownTestContext($testContext); } --- .../Acquisition/Bookseller/ContactFactory.pm | 150 +++++++ t/lib/TestObjects/Acquisition/BooksellerFactory.pm | 173 ++++++++ t/lib/TestObjects/BiblioFactory.pm | 151 +++++++ t/lib/TestObjects/BorrowerFactory.pm | 172 ++++++++ t/lib/TestObjects/CheckoutFactory.pm | 197 +++++++++ t/lib/TestObjects/ItemFactory.pm | 137 ++++++ t/lib/TestObjects/LetterTemplateFactory.pm | 96 +++++ t/lib/TestObjects/ObjectFactory.pm | 269 ++++++++++++ t/lib/TestObjects/Serial/FrequencyFactory.pm | 149 +++++++ t/lib/TestObjects/Serial/SubscriptionFactory.pm | 300 +++++++++++++ t/lib/TestObjects/SystemPreferenceFactory.pm | 128 ++++++ t/lib/TestObjects/objectFactories.t | 478 +++++++++++++++++++++ 12 files changed, 2400 insertions(+) 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/BorrowerFactory.pm create mode 100644 t/lib/TestObjects/CheckoutFactory.pm create mode 100644 t/lib/TestObjects/ItemFactory.pm create mode 100644 t/lib/TestObjects/LetterTemplateFactory.pm create mode 100644 t/lib/TestObjects/ObjectFactory.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/objectFactories.t diff --git a/t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm b/t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm new file mode 100644 index 0000000..ed117ef --- /dev/null +++ b/t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm @@ -0,0 +1,150 @@ +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'; +} + +=head createTestGroup( $data [, $hashKey, $testContexts...] ) +@OVERLOADED + + my $contacts = t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->createTestGroup([ + {acqprimary => 1, #DEFAULT + claimissues => 1, #DEFAULT + claimacquisition => 1, #DEFAULT + serialsprimary => 1, #DEFAULT + position => 'Boss', #DEFAULT + phone => '+358700123123', #DEFAULT + notes => 'Noted', #DEFAULT + name => "Julius Augustus Caesar", #DEFAULT + fax => '+358700123123', #DEFAULT + email => 'vendor@example.com', #DEFAULT + booksellerid => 12124 #MANDATORY to link to Bookseller + #id => #Don't use id, since we are just adding a new one + }, + {...}, + ], undef, $testContext1, $testContext2, $testContext3); + + #Do test stuff... + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); + +The HASH is keyed with the given $hashKey or 'koha.aqcontacts.name' +See C4::Bookseller::Contact->new() for how the table columns need to be given. + +@PARAM1 ARRAYRef of HASHRefs of VendorContact parameters. +@PARAM2 koha.aqcontacs-column which is used as the test context HASH key, + defaults to the most best option 'name'. +@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple + test contexts. Usually one is enough. These test contexts are + used to help tear down DB changes. +@RETURNS HASHRef of $hashKey => object: + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $object, $stashes) = @_; + + my $contact = Koha::Acquisition::Bookseller::Contact->new(); + $contact->set($object); + $contact->store(); + #Refresh from DB the contact we just made, since there is no UNIQUE identifier aside from PK, we cannot know if there are many objects like this. + my @contacts = Koha::Acquisition::Bookseller::Contacts->search($object); + if (scalar(@contacts)) { + $contact = $contacts[0]; + } + else { + die "No Contact added to DB. Fix me to autorecover from this error!"; + } + + return $contact; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $object, $hashKey) = @_; + + $object->{acqprimary} = 1 unless $object->{acqprimary}; + $object->{claimissues} = 1 unless $object->{claimissues}; + $object->{claimacquisition} = 1 unless $object->{claimacquisition}; + $object->{serialsprimary} = 1 unless $object->{serialsprimary}; + $object->{position} = 'Boss' unless $object->{position}; + $object->{phone} = '+358700123123' unless $object->{phone}; + $object->{notes} = 'Noted' unless $object->{notes}; + $object->{name} = "Julius Augustus Caesar" unless $object->{name}; + $object->{fax} = '+358700123123' unless $object->{fax}; + $object->{email} = 'vendor@example.com' unless $object->{email}; + $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); +} + +=head deleteTestGroup +@OVERLOADED + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $objects) = @_; + + while( my ($key, $object) = each %$objects) { + my $contact = Koha::Acquisition::Bookseller::Contacts->cast($object); + eval { + #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them. + my @contacts = Koha::Acquisition::Bookseller::Contacts->search({name => $contact->name}); + foreach my $c (@contacts) { + $c->delete(); + } + }; + if ($@) { + die $@; + } + } +} + +1; diff --git a/t/lib/TestObjects/Acquisition/BooksellerFactory.pm b/t/lib/TestObjects/Acquisition/BooksellerFactory.pm new file mode 100644 index 0000000..ecdb298 --- /dev/null +++ b/t/lib/TestObjects/Acquisition/BooksellerFactory.pm @@ -0,0 +1,173 @@ +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::Bookseller2; +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'; +} + +=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, + gstrate => 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::Bookseller2->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->{gstrate} = 0 unless $object->{gstrate}; + $object->{fax} = '+358700123123' unless $object->{fax}; + $object->{discount} = 10 unless $object->{discount}; + $object->{deliverytime} = 2 unless $object->{deliverytime}; + $object->{address1} = 'Where I am' unless $object->{address1}; + $object->{active} = 1 unless $object->{active}; + $object->{accountnumber} = 'IBAN 123456789 FI' unless $object->{accountnumber}; + $object->{contacts} = [{}] unless $object->{contacts}; #Prepare to create one default contact. + + $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); +} + +=head deleteTestGroup +@OVERLOADED + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $objects) = @_; + + while( my ($key, $object) = each %$objects) { + my $bookseller = Koha::Acquisition::Booksellers->cast($object); + eval { + #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them. + my @booksellers = Koha::Acquisition::Booksellers->search({name => $bookseller->name}); + foreach my $b (@booksellers) { + $b->delete(); + } + }; + if ($@) { + die $@; + } + } +} + +1; diff --git a/t/lib/TestObjects/BiblioFactory.pm b/t/lib/TestObjects/BiblioFactory.pm new file mode 100644 index 0000000..b96cf4e --- /dev/null +++ b/t/lib/TestObjects/BiblioFactory.pm @@ -0,0 +1,151 @@ +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 C4::Biblio; + +use Koha::Exception::BadParameter; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub getDefaultHashKey { + return 'biblioitems.isbn'; +} + +=head t::lib::TestObjects::createTestGroup + + my $records = 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', + }, + ], undef, $testContext1, $testContext2, $testContext3); + +Calls C4::Biblio::TransformKohaToMarc() to make a MARC::Record and add it to +the DB. Returns a HASH of MARC::Records. +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}; + +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 = C4::Biblio::TransformKohaToMarc($object); + my ($biblionumber, $biblioitemnumber) = C4::Biblio::AddBiblio($record,''); + + #Clone all the parameters of $object to $record + foreach my $key (keys(%$object)) { + $record->{$key} = $object->{$key}; + } + $record->{biblionumber} = $biblionumber; + + return $record; +} + +=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) = @_; + + 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!"); + } + $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); +} + +=head + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($class, $records) = @_; + + my ( $biblionumberFieldCode, $biblionumberSubfieldCode ) = + C4::Biblio::GetMarcFromKohaField( "biblio.biblionumber", '' ); + + my $schema = Koha::Database->new_schema(); + while( my ($key, $record) = each %$records) { + my $biblionumber = $record->subfield($biblionumberFieldCode, $biblionumberSubfieldCode); + my @biblios = $schema->resultset('Biblio')->search({"-or" => [{biblionumber => $biblionumber}, + {title => $record->title}]}); + foreach my $b (@biblios) { + $b->delete(); + } + } +} +sub _deleteTestGroupFromIdentifiers { + my ($class, $testGroupIdentifiers) = @_; + + my $schema = Koha::Database->new_schema(); + foreach my $isbn (@$testGroupIdentifiers) { + $schema->resultset('Biblio')->search({"biblioitems.isbn" => $isbn},{join => 'biblioitems'})->delete(); + $schema->resultset('Biblioitem')->search({isbn => $isbn})->delete(); + } +} + +1; diff --git a/t/lib/TestObjects/BorrowerFactory.pm b/t/lib/TestObjects/BorrowerFactory.pm new file mode 100644 index 0000000..1d8da41 --- /dev/null +++ b/t/lib/TestObjects/BorrowerFactory.pm @@ -0,0 +1,172 @@ +package t::lib::TestObjects::BorrowerFactory; + +# 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 C4::Members; +use Koha::Borrowers; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return 'cardnumber'; +} + +=head createTestGroup( $data [, $hashKey, $testContexts...] ) +@OVERLOADED + + my $borrowerFactory = t::lib::TestObjects::BorrowerFactory->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) = @_; + + #Try to add the Borrower, but it might fail because of the barcode or other UNIQUE constraint. + #Catch the error and try looking for the Borrower if we suspect it is present in the DB. + my $borrowernumber; + 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 borrower. + my $borrower = Koha::Borrowers->cast( $borrowernumber || $object ); + unless ($borrower) { + carp "BorrowerFactory:> 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->{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::Borrowers->cast($object); + eval { + $borrower->delete(); + }; + if ($@) { + if (blessed($@) && $@->isa('DBIx::Class::Exception') && + #Trying to recover. Delete all Checkouts for the Borrower 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 $@; + } + } + + } +} +sub _deleteTestGroupFromIdentifiers { + my ($self, $testGroupIdentifiers) = @_; + + my $schema = Koha::Database->new_schema(); + foreach my $key (@$testGroupIdentifiers) { + $schema->resultset('Borrower')->find({"cardnumber" => $key})->delete(); + } +} + +1; diff --git a/t/lib/TestObjects/CheckoutFactory.pm b/t/lib/TestObjects/CheckoutFactory.pm new file mode 100644 index 0000000..bb9a2d1 --- /dev/null +++ b/t/lib/TestObjects/CheckoutFactory.pm @@ -0,0 +1,197 @@ +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 C4::Members; +use C4::Items; +use Koha::Borrowers; +use Koha::Items; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return ['cardnumber', 'barcode']; +} + +=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 => $checkout-objects. + The HASH is keyed with -, or the given $hashKey. + Example: { + '11A001-167N0212' => { + cardnumber => , + barcode => , + ...other Checkout-object columns... + }, + ... +} +=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()) { + C4::Context->_new_userenv('testGroupsTest'); + C4::Context->set_userenv(undef, undef, undef, + undef, undef, + 'CPL', undef, undef, + undef, undef, undef); + } + my $oldContextBranch = C4::Context->userenv()->{branch}; + + my $borrower = Koha::Borrowers->cast($checkoutParams->{cardnumber}); + my $item = Koha::Items->cast($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; + } + + 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."; + } + $object->{borrower} = Koha::Borrowers->cast($object->{cardnumber}); + + unless ($object->{barcode}) { + croak __PACKAGE__.":> Mandatory parameter 'barcode' missing."; + } + $object->{item} = Koha::Items->cast($object->{barcode}); + + if ($object->{checkoutBranchRule} && not($object->{checkoutBranchRule} =~ m/(homebranch)|(holdingbranch)/)) { + croak __PACKAGE__.":> Optional parameter 'checkoutBranchRule' must be one of these: homebranch, holdingbranch"; + } +} + +=head + + my $objects = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $objects) = @_; + + while( my ($key, $object) = each %$objects) { + my $checkout = Koha::Checkouts->cast($object); + $checkout->delete(); + } +} +sub _deleteTestGroupFromIdentifiers { + my ($self, $testGroupIdentifiers) = @_; + + my $schema = Koha::Database->new_schema(); + foreach my $key (@$testGroupIdentifiers) { + $schema->resultset('Issue')->find({"issue_id" => $key})->delete(); + } +} + +1; diff --git a/t/lib/TestObjects/ItemFactory.pm b/t/lib/TestObjects/ItemFactory.pm new file mode 100644 index 0000000..ab33802 --- /dev/null +++ b/t/lib/TestObjects/ItemFactory.pm @@ -0,0 +1,137 @@ +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::Items; +use Koha::Checkouts; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub new { + my ($class) = @_; + + my $self = {}; + bless($self, $class); + return $self; +} + +sub getDefaultHashKey { + return 'barcode'; +} + +=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) = @_; + + my ($biblionumber, $biblioitemnumber, $itemnumber); + eval { + ($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 $@; + } + } + my $item = Koha::Items->cast($itemnumber || $object); + 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} = 'CPL' unless $item->{homebranch}; + $item->{holdingbranch} = 'CPL' unless $item->{holdingbranch}; + $item->{itemcallnumber} = 'PRE 84.FAN POST' unless $item->{itemcallnumber}; +} + +=head +@OVERLOADED + + my $objects = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $objects) = @_; + + while( my ($key, $object) = each %$objects) { + my $item = Koha::Items->cast($object); + + #Delete all attached checkouts + my @checkouts = Koha::Checkouts->search({itemnumber => $item->itemnumber}); + foreach my $c (@checkouts) { + $c->delete; + } + + $item->delete(); + } +} +sub _deleteTestGroupFromIdentifiers { + my ($self, $testGroupIdentifiers) = @_; + + foreach my $key (@$testGroupIdentifiers) { + my $item = Koha::Items->cast($key); + my @checkouts = Koha::Checkouts->search({itemnumber => $item->itemnumber}); + foreach my $c (@checkouts) { + $c->delete; + } + $item->delete(); + } +} + +1; diff --git a/t/lib/TestObjects/LetterTemplateFactory.pm b/t/lib/TestObjects/LetterTemplateFactory.pm new file mode 100644 index 0000000..6a6d4fd --- /dev/null +++ b/t/lib/TestObjects/LetterTemplateFactory.pm @@ -0,0 +1,96 @@ +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::LetterTemplates; + +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']; +} + +=head t::lib::TestObjects::LetterTemplateFactory->createTestGroup +Returns a HASH of Koha::LetterTemplate-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::LetterTemplates->cast($result); +} + +=head + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $letterTemplates) = @_; + + my $schema = Koha::Database->new_schema(); + while( my ($key, $letterTemplate) = each %$letterTemplates ) { + $letterTemplate->delete(); + } +} + +sub _deleteTestGroupFromIdentifiers { + my $testGroupIdentifiers = shift; + + my $schema = Koha::Database->new_schema(); + foreach my $key (@$testGroupIdentifiers) { + my ($module, $code, $branchcode, $mtt) = split('-',$key); + $schema->resultset('Letter')->find({module => $module, + code => $code, + branchcode => $branchcode, + message_transport_type => $mtt, + })->delete(); + } +} + +1; diff --git a/t/lib/TestObjects/ObjectFactory.pm b/t/lib/TestObjects/ObjectFactory.pm new file mode 100644 index 0000000..34cb90d --- /dev/null +++ b/t/lib/TestObjects/ObjectFactory.pm @@ -0,0 +1,269 @@ +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 BorrowerFactory + {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 +@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}, + } +=cut + +sub createTestGroup { + my ($class, $objects, $hashKey, $featureStash, $scenarioStash, $stepStash) = @_; + my $stashes = [$featureStash, $scenarioStash, $stepStash]; + $class->_validateStashes(@$stashes); + $hashKey = $class->getDefaultHashKey() unless $hashKey; + + $objects = [$objects] unless ref($objects) eq 'ARRAY'; + my %objects; + foreach my $o (@$objects) { + $class->validateAndPopulateDefaultValues($o, $hashKey, $stashes); + + my $addedObject = $class->handleTestObject($o, $stashes); + if (not($addedObject) || + not(ref($addedObject) eq 'HASH' || $addedObject->isa('Koha::Object') || $addedObject->isa('MARC::Record') ) + ) { + 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); + + return \%objects; +} + +=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) = @_; + + ##You should introduce tearDowns in such an order that to not provoke FOREIGN KEY issues. + 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->{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->{borrower}) { + require t::lib::TestObjects::BorrowerFactory; + t::lib::TestObjects::BorrowerFactory->deleteTestGroup($stash->{borrower}); + delete $stash->{borrower}; + } + 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}; + } +} + +=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 = [$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 { + if ($hashKey && not($object->$hashKey())) { + croak $class."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'."; + } + push @collectedHashKeys, $object->$hashKey(); + } + } + return join('-', @collectedHashKeys); +} + +=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 _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 ($self, $objects, $stashKey, $featureStash, $scenarioStash, $stepStash) = @_; + + if ($featureStash || $scenarioStash || $stepStash) { + while( my ($key, $biblio) = each %$objects) { + $featureStash->{$stashKey}->{ $key } = $biblio if $featureStash; + $scenarioStash->{$stashKey}->{ $key } = $biblio if $scenarioStash; + $stepStash->{$stashKey}->{ $key } = $biblio if $stepStash; + } + } +} + +1; \ No newline at end of file diff --git a/t/lib/TestObjects/Serial/FrequencyFactory.pm b/t/lib/TestObjects/Serial/FrequencyFactory.pm new file mode 100644 index 0000000..da48246 --- /dev/null +++ b/t/lib/TestObjects/Serial/FrequencyFactory.pm @@ -0,0 +1,149 @@ +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'; +} + +=head createTestGroup( $data [, $hashKey, $testContexts...] ) +@OVERLOADED + + my $frequencies = t::lib::TestObjects::Serial::FrequencyFactory->createTestGroup([ + {acqprimary => 1, #DEFAULT + claimissues => 1, #DEFAULT + claimacquisition => 1, #DEFAULT + serialsprimary => 1, #DEFAULT + position => 'Boss', #DEFAULT + phone => '+358700123123', #DEFAULT + notes => 'Noted', #DEFAULT + name => "Julius Augustus Caesar", #DEFAULT + fax => '+358700123123', #DEFAULT + email => 'vendor@example.com', #DEFAULT + booksellerid => 12124 #MANDATORY to link to Bookseller + #id => #Don't use id, since we are just adding a new one + }, + {...}, + ], undef, $testContext1, $testContext2, $testContext3); + + #Do test stuff... + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); + +The HASH is keyed with the given $hashKey or 'koha.subscription_frequencies.description' + +@PARAM1 ARRAYRef of HASHRefs +@PARAM2 koha.subscription_frequencies-column which is used as the test context HASH key, + defaults to the most best option 'description'. +@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple + test contexts. Usually one is enough. These test contexts are + used to help tear down DB changes. +@RETURNS HASHRef of $hashKey => object: + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $object, $stashes) = @_; + + my $contact = Koha::Acquisition::Bookseller::Contact->new(); + $contact->set($object); + $contact->store(); + #Refresh from DB the contact we just made, since there is no UNIQUE identifier aside from PK, we cannot know if there are many objects like this. + my @contacts = Koha::Acquisition::Bookseller::Contacts->search($object); + if (scalar(@contacts)) { + $contact = $contacts[0]; + } + else { + die "No Contact added to DB. Fix me to autorecover from this error!"; + } + + return $contact; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($self, $object, $hashKey) = @_; + + $object->{acqprimary} = 1 unless $object->{acqprimary}; + $object->{claimissues} = 1 unless $object->{claimissues}; + $object->{claimacquisition} = 1 unless $object->{claimacquisition}; + $object->{serialsprimary} = 1 unless $object->{serialsprimary}; + $object->{position} = 'Boss' unless $object->{position}; + $object->{phone} = '+358700123123' unless $object->{phone}; + $object->{notes} = 'Noted' unless $object->{notes}; + $object->{name} = "Julius Augustus Caesar" unless $object->{name}; + $object->{fax} = '+358700123123' unless $object->{fax}; + $object->{email} = 'vendor@example.com' unless $object->{email}; + $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); +} + +=head deleteTestGroup +@OVERLOADED + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($records); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($self, $objects) = @_; + + while( my ($key, $object) = each %$objects) { + my $contact = Koha::Acquisition::Bookseller::Contacts->cast($object); + eval { + #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them. + my @contacts = Koha::Acquisition::Bookseller::Contacts->search({name => $contact->name}); + foreach my $c (@contacts) { + $c->delete(); + } + }; + if ($@) { + die $@; + } + } +} + +1; diff --git a/t/lib/TestObjects/Serial/SubscriptionFactory.pm b/t/lib/TestObjects/Serial/SubscriptionFactory.pm new file mode 100644 index 0000000..f09514b --- /dev/null +++ b/t/lib/TestObjects/Serial/SubscriptionFactory.pm @@ -0,0 +1,300 @@ +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 C4::Serials; + +use t::lib::TestObjects::BorrowerFactory; +use Koha::Borrowers; +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::Serial::Subscriptions; + +use base qw(t::lib::TestObjects::ObjectFactory); + +sub getDefaultHashKey { + return 'internalnotes'; +} + +=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::Borrower, #DEFAULT creates a "Subscription Master" Borrower + 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 => 7 || Koha::Serial::Subscription::Frequency, #DEFAULTS to a Frequency of 1/month. + 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::Serial::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) = @_; + + if ($object->{librarian}) { + $object->{librarian} = Koha::Borrowers->cast($object->{librarian}); + } + else { + $object->{librarian} = t::lib::TestObjects::BorrowerFactory->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' => '2015', + '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} = 7 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} = '2015-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} = 2015 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} = '2015-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('-'), + 2, #Status => 2 == Received + $waitingSerial->{notes}, + ); + my $items = t::lib::TestObjects::ItemFactory->createTestGroup({barcode => $waitingSerial->{serialid}."-".Koha::DateUtils::dt_from_string($waitingSerial->{publisheddate})->ymd('-'), + enumchron => $waitingSerial->{serialseq}, + biblionumber => $subscription->biblionumber, + }, undef, @$stashes); + C4::Serials::AddItem2Serial( $waitingSerial->{serialid}, + $items->{ shift([values(%$items)])->barcode }->itemnumber, ); #Perl is wonderful :) + } +} + +=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::Serial::Subscriptions->cast($object); + eval { + my @serials = $schema->resultset('Serial')->search({subscriptionid => $subscription->subscriptionid}); + + ##Because serialitems-table doesn't have a primery key, resorting to a DBI hack. + my $dbh = C4::Context->dbh(); + my $sth_delete_serialitems = $dbh->prepare("DELETE FROM serialitems WHERE serialid = ?"); + + foreach my $s (@serials) { + $sth_delete_serialitems->execute($s->serialid); + $s->delete(); + } + $subscription->delete(); + }; + if ($@) { + die $@; + } + } +} + +1; diff --git a/t/lib/TestObjects/SystemPreferenceFactory.pm b/t/lib/TestObjects/SystemPreferenceFactory.pm new file mode 100644 index 0000000..8b58eba --- /dev/null +++ b/t/lib/TestObjects/SystemPreferenceFactory.pm @@ -0,0 +1,128 @@ +package t::lib::TestObjects::SystemPreferenceFactory; + +# Copyright Vaara-kirjastot 2015 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# + +use Modern::Perl; +use Carp; +use Scalar::Util qw(blessed); + +use C4::Members; +use Koha::Borrowers; + +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'; +} + +=head createTestGroup( $data [, $hashKey, $testContexts...] ) +@OVERLOADED + + my $preferences = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([ + {preference => 'ValidateEmailAddress', + value => 1, + }, + {preference => 'ValidatePhoneNumber', + value => 'OFF', + }, + ], undef, $testContext1, $testContext2, $testContext3); + + #Do test stuff... + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); + +See t::lib::TestObjects::ObjectFactory for more documentation +=cut + +sub handleTestObject { + my ($class, $pref, $stashes) = @_; + + my $preference = $pref->{preference}; + + # Check if preference is already stored, so we wont lose the original preference + my $alreadyStored; + my $stashablePref = $pref; + foreach my $stash (@$stashes) { + if (exists $stash->{systempreference}->{$preference}) { + $alreadyStored = 1; + $stashablePref = $stash->{systempreference}->{$preference}; + last(); + } + } + $stashablePref->{old_value} = C4::Context->preference($pref->{preference}) unless ($alreadyStored); + + C4::Context->set_preference($pref->{preference}, $pref->{value}); + + $stashablePref->{value} = $pref->{value}; + + return $stashablePref; +} + +=head validateAndPopulateDefaultValues +@OVERLOAD + +Validates given Object parameters and makes sure that critical fields are given +and populates defaults for missing values. +=cut + +sub validateAndPopulateDefaultValues { + my ($class, $preference, $hashKey) = @_; + $class->SUPER::validateAndPopulateDefaultValues($preference, $hashKey); + + if (not(defined(C4::Context->preference($preference->{preference})))) { + croak __PACKAGE__.":> Preference '".$preference->{preference}."' not found."; + next; + } + unless (exists($preference->{value})) { + croak __PACKAGE__.":> Mandatory parameter 'value' not found."; + } +} + +=head deleteTestGroup +@OVERLOADED + + my $records = createTestGroup(); + ##Do funky stuff + deleteTestGroup($prefs); + +Removes the given test group from the DB. + +=cut + +sub deleteTestGroup { + my ($class, $preferences) = @_; + + while( my ($key, $pref) = each %$preferences) { + C4::Context->set_preference($pref->{preference}, $pref->{old_value}); + } +} + +1; diff --git a/t/lib/TestObjects/objectFactories.t b/t/lib/TestObjects/objectFactories.t new file mode 100644 index 0000000..62646db --- /dev/null +++ b/t/lib/TestObjects/objectFactories.t @@ -0,0 +1,478 @@ +#!/usr/bin/perl + +# 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 Test::More; +use DateTime; + +use Koha::DateUtils; + +use t::lib::TestObjects::ObjectFactory; +use t::lib::TestObjects::BorrowerFactory; +use Koha::Borrowers; +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::LetterTemplates; +use t::lib::TestObjects::Acquisition::Bookseller::ContactFactory; +use Koha::Acquisition::Bookseller::Contacts; +use t::lib::TestObjects::Acquisition::BooksellerFactory; +use Koha::Acquisition::Booksellers; +use t::lib::TestObjects::Serial::SubscriptionFactory; +use Koha::Serial::Subscriptions; +use Koha::Serial::Subscription::Frequencies; +use Koha::Serial::Subscription::Numberpatterns; +use Koha::Serial::Serials; +use t::lib::TestObjects::SystemPreferenceFactory; +use C4::Context; + + +my $testContext = {}; #Gather all created Objects here so we can finally remove them all. + + + +########## Serial subtests ########## +subtest 't::lib::TestObjects::Serial' => sub { + my ($subscriptions, $subscription, $frequency, $numberpattern, $biblio, $borrower, $bookseller, $items, $serials); + my $subtestContext = {}; + my $dontDeleteTestContext = {}; + ##Create and delete + $subscriptions = t::lib::TestObjects::Serial::SubscriptionFactory->createTestGroup([ + {internalnotes => 'TESTDEFAULTS', + receiveSerials => 3}, + ], undef, $subtestContext); + $subscription = Koha::Serial::Subscriptions->find( $subscriptions->{'TESTDEFAULTS'}->subscriptionid ); + $frequency = $subscription->periodicity(); + $numberpattern = $subscription->numberpattern(); + $biblio = $subscription->biblio(); + $borrower = $subscription->borrower(); + $bookseller = $subscription->bookseller(); + $items = $subscription->items(); + $serials = $subscription->serials(); + ok(($subscriptions->{'TESTDEFAULTS'}->callnumber eq $subscription->callnumber && + $subscriptions->{'TESTDEFAULTS'}->subscriptionid eq $subscription->subscriptionid), + "Default Subscription created."); + ok($subscriptions->{'TESTDEFAULTS'}->numberpattern->label eq $numberpattern->label, + "Default Numberpattern '".$numberpattern->label."' used."); + ok($subscriptions->{'TESTDEFAULTS'}->periodicity->description eq $frequency->description, + "Default Periodicity '".$frequency->description."' used."); + ok($subscriptions->{'TESTDEFAULTS'}->biblio->title eq $biblio->title, + "Default Biblio '".$biblio->title."' created."); + ok($subscriptions->{'TESTDEFAULTS'}->bookseller->name eq $bookseller->name, + "Default Bookseller '".$bookseller->name."' created."); + ok($serials->[0]->isa('Koha::Serial::Serial') && $serials->[0]->serialseq eq 'Vol. 2015, Number 1, Issue 1' && + $serials->[1]->isa('Koha::Serial::Serial') && $serials->[1]->serialseq eq 'Vol. 2015, Number 1, Issue 2' && + $serials->[2]->isa('Koha::Serial::Serial') && $serials->[2]->serialseq eq 'Vol. 2015, Number 1, Issue 3' && + $serials->[3]->isa('Koha::Serial::Serial') && $serials->[3]->serialseq eq 'Vol. 2015, Number 1, Issue 4' + , "Got 4 default Serials"); + ok($items->[0]->isa('Koha::Item') && $items->[0]->enumchron eq 'Vol. 2015, Number 1, Issue 1' && + $items->[1]->isa('Koha::Item') && $items->[1]->enumchron eq 'Vol. 2015, Number 1, Issue 2' && + $items->[2]->isa('Koha::Item') && $items->[2]->enumchron eq 'Vol. 2015, Number 1, Issue 3' + , "Received 3 default Serial Items"); + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + $subscription = Koha::Serial::Subscriptions->find( $subscriptions->{'TESTDEFAULTS'}->subscriptionid ); + ok(not(defined($subscription)), "Default Subscription deleted."); + $biblio = Koha::Biblios->find( $biblio->id ); + ok(not(defined($biblio)), "Default Biblio deleted."); + $borrower = Koha::Borrowers->find( $borrower->id ); + ok(not(defined($borrower)), "Default Borrower deleted."); + $bookseller = Koha::Acquisition::Booksellers->find( $bookseller->id ); + ok(not(defined($bookseller)), "Default Bookseller deleted."); + $frequency = Koha::Serial::Subscription::Frequencies->find( $frequency->id ); + ok($frequency, "Attached Frequency not deleted."); + $numberpattern = Koha::Serial::Subscription::Numberpatterns->find( $numberpattern->id ); + ok($numberpattern, "Attached Numbering Pattern not deleted."); + $serials = [Koha::Serial::Serials->search({ subscriptionid => $serials->[0]->subscriptionid})]; + $items = [Koha::Items->search({"-or" => [{itemnumber => $items->[0]->itemnumber}, + {itemnumber => $items->[1]->itemnumber}, + {itemnumber => $items->[2]->itemnumber}, + ]})]; + ok(not($serials->[0] && + $serials->[1] && + $serials->[2] && + $serials->[3]) + , "4 default Serials deleted."); + ok(not($items->[0] && + $items->[1] && + $items->[2]) + , "3 default Serial Items deleted"); + + ### TESTING NOT DELETING A GIVEN BIBLIO OR BORROWER ### + 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', $dontDeleteTestContext); + my $borrowers = t::lib::TestObjects::BorrowerFactory->createTestGroup([ + {firstname => 'Olli-Antti', + surname => 'Kivi', + cardnumber => '11A001', + branchcode => 'CPL', + }, + ], undef, $dontDeleteTestContext); + my $booksellers = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([{ + name => "Undeletable Magazine vendor"}], + undef, $dontDeleteTestContext); + $subscriptions = t::lib::TestObjects::Serial::SubscriptionFactory->createTestGroup([ + {internalnotes => 'TESTDEFAULTS', + biblio => $biblios->{'9519671580'}->{biblionumber}, + librarian => $borrowers->{'11A001'}, + aqbookseller => $booksellers->{"Undeletable Magazine vendor"}, + }, + ], undef, $subtestContext); + $subscription = Koha::Serial::Subscriptions->find( $subscriptions->{'TESTDEFAULTS'}->subscriptionid ); + $biblio = $subscription->biblio(); + $borrower = $subscription->borrower(); + $bookseller = $subscription->bookseller(); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + $biblio = Koha::Biblios->find( $biblio->id ); + ok(defined($biblio), "Attached Biblio not deleted."); + $borrower = Koha::Borrowers->find( $borrower->id ); + ok(defined($borrower), "Attached Borrower not deleted."); + $bookseller = Koha::Acquisition::Booksellers->find( $bookseller->id ); + ok(defined($bookseller), "Attached Bookseller not deleted."); + t::lib::TestObjects::ObjectFactory->tearDownTestContext($dontDeleteTestContext); +}; + + + +########## Acquisition subtests ########## +subtest 't::lib::TestObjects::Acquisition' => sub { + my ($booksellers, $bookseller, $contacts, $contact); + my $subtestContext = {}; + ##Create and delete + $booksellers = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([{}], undef, $subtestContext); + $bookseller = Koha::Acquisition::Booksellers->find({name => 'Bookselling Vendor'}); + $contact = Koha::Acquisition::Bookseller::Contacts->find({name => 'Julius Augustus Caesar'}); + ok(($booksellers->{'Bookselling Vendor'}->name eq 'Bookselling Vendor' && + $bookseller->name eq 'Bookselling Vendor'), + "Default Bookseller 'Bookselling Vendor' created."); + ok(($booksellers->{'Bookselling Vendor'}->{contacts}->{'Julius Augustus Caesar'}->name eq 'Julius Augustus Caesar' && + $contact->name eq 'Julius Augustus Caesar'), + "Default Contact 'Julius Augustus Caesar' created."); + + $contacts = t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->createTestGroup([ + {name => 'Hippocrates', + booksellerid => $booksellers->{'Bookselling Vendor'}->id}] + , undef, $subtestContext); + $contact = Koha::Acquisition::Bookseller::Contacts->find({name => 'Hippocrates'}); + ok(($contacts->{'Hippocrates'}->name, 'Hippocrates' && + $contact->name eq 'Hippocrates'), + "Contact 'Hippocrates' created."); + + t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + $contact = Koha::Acquisition::Bookseller::Contacts->find({name => 'Julius Augustus Caesar'}); + ok(not(defined($contact)), "Contact 'Julius Augustus Caesar' deleted."); + $contact = Koha::Acquisition::Bookseller::Contacts->find({name => 'Hippocrates'}); + ok(not(defined($contact)), "Contact 'Hippocrates' deleted."); + $bookseller = Koha::Acquisition::Booksellers->find({name => 'Bookselling Vendor'}); + ok(not(defined($bookseller)), "Bookseller 'Bookselling Vendor' deleted."); +}; + + + +########## BorrowerFactory subtests ########## +subtest 't::lib::TestObjects::BorrowerFactory' => sub { + my $subtestContext = {}; + ##Create and Delete. Add one + my $f = t::lib::TestObjects::BorrowerFactory->new(); + my $objects = $f->createTestGroup([ + {firstname => 'Olli-Antti', + surname => 'Kivi', + cardnumber => '11A001', + branchcode => 'CPL', + }, + ], undef, $subtestContext, undef, $testContext); + is($objects->{'11A001'}->cardnumber, '11A001', "Borrower '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->{borrower}->{'11A001'}->cardnumber, '11A001', "Borrower '11A001' from \$subtestContext."); #From subtestContext + is($objects->{'11A002'}->branchcode, 'FFL', "Borrower '11A002'."); #from just created hash. + + ##Delete objects + t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); + my $object11A001 = Koha::Borrowers->find({cardnumber => '11A001'}); + ok (not($object11A001), "Borrower '11A001' deleted"); + my $object11A002 = Koha::Borrowers->find({cardnumber => '11A002'}); + ok (not($object11A002), "Borrower '11A002' 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' => sub { + 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' => sub { + 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' => sub { + 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::LetterTemplates->find($hashLT); + is($objects->{'circulation-ODUE1-CPL-print'}->name, $letterTemplate->name, "LetterTemplate 'circulation-ODUE1-CPL-print'"); + + #Delete them + $f->deleteTestGroup($objects); + $letterTemplate = Koha::LetterTemplates->find($hashLT); + ok(not(defined($letterTemplate)), "LetterTemplate 'circulation-ODUE1-CPL-print' deleted"); +}; + + + +########## SystemPreferenceFactory subtests ########## +subtest 't::lib::TestObjects::SystemPreferenceFactory' => sub { + 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; + + + 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"); +}; + + + +########## Global test context subtests ########## +subtest 't::lib::TestObjects::ObjectFactory clearing global test context' => sub { + my $object11A001 = Koha::Borrowers->find({cardnumber => '11A001'}); + ok ($object11A001, "Global Borrower '11A001' exists"); + my $object11A002 = Koha::Borrowers->find({cardnumber => '11A002'}); + ok ($object11A002, "Global Borrower '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::Borrowers->find({cardnumber => '11A001'}); + ok (not($object11A001), "Global Borrower '11A001' deleted"); + $object11A002 = Koha::Borrowers->find({cardnumber => '11A002'}); + ok (not($object11A002), "Global Borrower '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(); + +1; -- 1.9.1