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