Bugzilla – Attachment 41531 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), 101.56 KB, created by
Olli-Antti Kivilahti
on 2015-08-17 11:59:50 UTC
(
hide
)
Description:
Bug 13906 - TestObjectFactory(ies) for Koha objects. Enable easy Test object creation/deletion from HASHes.
Filename:
MIME Type:
Creator:
Olli-Antti Kivilahti
Created:
2015-08-17 11:59:50 UTC
Size:
101.56 KB
patch
obsolete
>From bbf5a8d00d0c5027ddf47aad5cca9867c10811ca Mon Sep 17 00:00:00 2001 >From: Olli-Antti Kivilahti <olli-antti.kivilahti@jns.fi> >Date: Wed, 25 Mar 2015 15:53:07 +0200 >Subject: [PATCH] Bug 13906 - TestObjectFactory(ies) for Koha objects. Enable > easy Test object creation/deletion from HASHes. > >Doing tests should be easy. >One biggest hindrance in doing tests is the difficulty of doing so in Koha. >We use a lot of hard-coded SQL, which occasionally requires quite a bit of >fiddling to get it right. Satisfying complex object dependency chains is hard. >For example, testing Overdue notice sending, one must create >-letters >-overuderules >-circulationrules >-borrowers >-biblios >-items >-issues (checkouts) >... > >Also one must take care to clean up the database modifications afterward to make >encapsulated tests which don't leak over other tests. This is especially so for >front-end testing. > >TestObjectFactories significantly alleviate this pain. >They try to recover from errors, like when the previous test crashed and left >testing objects into the DB, preventing adding them again. >Also they store what object they created to 3 different levels of stashes to >facilitate complex test configurations, and they have the dignity to clean-up >the test contexts after testing has happened (if the script doesn't crash)! > >UNIT TESTS included! > >USAGE: > >use t::db_dependent::TestObjects::Borrowers::BorrowerFactory; > >%#Setting up the test context >my $testContext = {}; > >my $password = '1234'; >my $borrowerFactory = t::db_dependent::TestObjects::Borrowers::BorrowerFactory->new(); >my $borrowers = $borrowerFactory->createTestGroup([ > {firstname => 'Olli-Antti', > surname => 'Kivi', > cardnumber => '1A01', > branchcode => 'CPL', > flags => '1', #superlibrarian, not exactly a very good way of doing permission testing? > userid => 'mini_admin', > password => $password, > }, > ], undef, $testContext); > >%#Test context set, starting testing: >eval { > ... #Run your tests here >}; >if ($@) { #Catch all leaking errors and gracefully terminate. > warn $@; > tearDown(); > exit 1; >} > >%#All tests done, tear down test context >tearDown(); >done_testing; > >sub tearDown { > t::db_dependent::TestObjects::ObjectFactory->tearDownTestContext($testContext); >} >--- > .../Acquisition/Bookseller/ContactFactory.pm | 150 +++++++ > t/lib/TestObjects/Acquisition/BooksellerFactory.pm | 173 ++++++++ > t/lib/TestObjects/BiblioFactory.pm | 151 +++++++ > t/lib/TestObjects/BorrowerFactory.pm | 172 ++++++++ > t/lib/TestObjects/CheckoutFactory.pm | 197 +++++++++ > t/lib/TestObjects/ItemFactory.pm | 137 ++++++ > t/lib/TestObjects/LetterTemplateFactory.pm | 96 +++++ > t/lib/TestObjects/ObjectFactory.pm | 269 ++++++++++++ > t/lib/TestObjects/Serial/FrequencyFactory.pm | 149 +++++++ > t/lib/TestObjects/Serial/SubscriptionFactory.pm | 300 +++++++++++++ > t/lib/TestObjects/SystemPreferenceFactory.pm | 128 ++++++ > t/lib/TestObjects/objectFactories.t | 478 +++++++++++++++++++++ > 12 files changed, 2400 insertions(+) > create mode 100644 t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm > create mode 100644 t/lib/TestObjects/Acquisition/BooksellerFactory.pm > create mode 100644 t/lib/TestObjects/BiblioFactory.pm > create mode 100644 t/lib/TestObjects/BorrowerFactory.pm > create mode 100644 t/lib/TestObjects/CheckoutFactory.pm > create mode 100644 t/lib/TestObjects/ItemFactory.pm > create mode 100644 t/lib/TestObjects/LetterTemplateFactory.pm > create mode 100644 t/lib/TestObjects/ObjectFactory.pm > create mode 100644 t/lib/TestObjects/Serial/FrequencyFactory.pm > create mode 100644 t/lib/TestObjects/Serial/SubscriptionFactory.pm > create mode 100644 t/lib/TestObjects/SystemPreferenceFactory.pm > create mode 100644 t/lib/TestObjects/objectFactories.t > >diff --git a/t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm b/t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm >new file mode 100644 >index 0000000..ed117ef >--- /dev/null >+++ b/t/lib/TestObjects/Acquisition/Bookseller/ContactFactory.pm >@@ -0,0 +1,150 @@ >+package t::lib::TestObjects::Acquisition::Bookseller::ContactFactory; >+ >+# Copyright Vaara-kirjastot 2015 >+# >+# This file is part of Koha. >+# >+# Koha is free software; you can redistribute it and/or modify it under the >+# terms of the GNU General Public License as published by the Free Software >+# Foundation; either version 3 of the License, or (at your option) any later >+# version. >+# >+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY >+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR >+# A PARTICULAR PURPOSE. See the GNU General Public License for more details. >+# >+# You should have received a copy of the GNU General Public License along >+# with Koha; if not, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+# >+ >+use Modern::Perl; >+use Carp; >+use Scalar::Util qw(blessed); >+ >+use Koha::Acquisition::Bookseller::Contacts; >+use Koha::Acquisition::Bookseller::Contact; >+ >+use base qw(t::lib::TestObjects::ObjectFactory); >+ >+sub new { >+ my ($class) = @_; >+ >+ my $self = {}; >+ bless($self, $class); >+ return $self; >+} >+ >+sub getDefaultHashKey { >+ return 'name'; >+} >+ >+=head createTestGroup( $data [, $hashKey, $testContexts...] ) >+@OVERLOADED >+ >+ my $contacts = t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->createTestGroup([ >+ {acqprimary => 1, #DEFAULT >+ claimissues => 1, #DEFAULT >+ claimacquisition => 1, #DEFAULT >+ serialsprimary => 1, #DEFAULT >+ position => 'Boss', #DEFAULT >+ phone => '+358700123123', #DEFAULT >+ notes => 'Noted', #DEFAULT >+ name => "Julius Augustus Caesar", #DEFAULT >+ fax => '+358700123123', #DEFAULT >+ email => 'vendor@example.com', #DEFAULT >+ booksellerid => 12124 #MANDATORY to link to Bookseller >+ #id => #Don't use id, since we are just adding a new one >+ }, >+ {...}, >+ ], undef, $testContext1, $testContext2, $testContext3); >+ >+ #Do test stuff... >+ >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); >+ >+The HASH is keyed with the given $hashKey or 'koha.aqcontacts.name' >+See C4::Bookseller::Contact->new() for how the table columns need to be given. >+ >+@PARAM1 ARRAYRef of HASHRefs of VendorContact parameters. >+@PARAM2 koha.aqcontacs-column which is used as the test context HASH key, >+ defaults to the most best option 'name'. >+@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple >+ test contexts. Usually one is enough. These test contexts are >+ used to help tear down DB changes. >+@RETURNS HASHRef of $hashKey => object: >+ >+See t::lib::TestObjects::ObjectFactory for more documentation >+=cut >+ >+sub handleTestObject { >+ my ($class, $object, $stashes) = @_; >+ >+ my $contact = Koha::Acquisition::Bookseller::Contact->new(); >+ $contact->set($object); >+ $contact->store(); >+ #Refresh from DB the contact we just made, since there is no UNIQUE identifier aside from PK, we cannot know if there are many objects like this. >+ my @contacts = Koha::Acquisition::Bookseller::Contacts->search($object); >+ if (scalar(@contacts)) { >+ $contact = $contacts[0]; >+ } >+ else { >+ die "No Contact added to DB. Fix me to autorecover from this error!"; >+ } >+ >+ return $contact; >+} >+ >+=head validateAndPopulateDefaultValues >+@OVERLOAD >+ >+Validates given Object parameters and makes sure that critical fields are given >+and populates defaults for missing values. >+=cut >+ >+sub validateAndPopulateDefaultValues { >+ my ($self, $object, $hashKey) = @_; >+ >+ $object->{acqprimary} = 1 unless $object->{acqprimary}; >+ $object->{claimissues} = 1 unless $object->{claimissues}; >+ $object->{claimacquisition} = 1 unless $object->{claimacquisition}; >+ $object->{serialsprimary} = 1 unless $object->{serialsprimary}; >+ $object->{position} = 'Boss' unless $object->{position}; >+ $object->{phone} = '+358700123123' unless $object->{phone}; >+ $object->{notes} = 'Noted' unless $object->{notes}; >+ $object->{name} = "Julius Augustus Caesar" unless $object->{name}; >+ $object->{fax} = '+358700123123' unless $object->{fax}; >+ $object->{email} = 'vendor@example.com' unless $object->{email}; >+ $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); >+} >+ >+=head deleteTestGroup >+@OVERLOADED >+ >+ my $records = createTestGroup(); >+ ##Do funky stuff >+ deleteTestGroup($records); >+ >+Removes the given test group from the DB. >+ >+=cut >+ >+sub deleteTestGroup { >+ my ($self, $objects) = @_; >+ >+ while( my ($key, $object) = each %$objects) { >+ my $contact = Koha::Acquisition::Bookseller::Contacts->cast($object); >+ eval { >+ #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them. >+ my @contacts = Koha::Acquisition::Bookseller::Contacts->search({name => $contact->name}); >+ foreach my $c (@contacts) { >+ $c->delete(); >+ } >+ }; >+ if ($@) { >+ die $@; >+ } >+ } >+} >+ >+1; >diff --git a/t/lib/TestObjects/Acquisition/BooksellerFactory.pm b/t/lib/TestObjects/Acquisition/BooksellerFactory.pm >new file mode 100644 >index 0000000..ecdb298 >--- /dev/null >+++ b/t/lib/TestObjects/Acquisition/BooksellerFactory.pm >@@ -0,0 +1,173 @@ >+package t::lib::TestObjects::Acquisition::BooksellerFactory; >+ >+# Copyright Vaara-kirjastot 2015 >+# >+# This file is part of Koha. >+# >+# Koha is free software; you can redistribute it and/or modify it under the >+# terms of the GNU General Public License as published by the Free Software >+# Foundation; either version 3 of the License, or (at your option) any later >+# version. >+# >+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY >+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR >+# A PARTICULAR PURPOSE. See the GNU General Public License for more details. >+# >+# You should have received a copy of the GNU General Public License along >+# with Koha; if not, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+# >+ >+use Modern::Perl; >+use Scalar::Util qw(blessed); >+ >+use t::lib::TestObjects::Acquisition::Bookseller::ContactFactory; >+use Koha::Acquisition::Bookseller2; >+use Koha::Acquisition::Booksellers; >+ >+use base qw(t::lib::TestObjects::ObjectFactory); >+ >+sub new { >+ my ($class) = @_; >+ >+ my $self = {}; >+ bless($self, $class); >+ return $self; >+} >+ >+sub getDefaultHashKey { >+ return 'name'; >+} >+ >+=head createTestGroup( $data [, $hashKey, $testContexts...] ) >+@OVERLOADED >+ >+ my $booksellers = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([ >+ {url => 'www.muscle.com', >+ name => 'Bookselling Vendor', >+ postal => 'post', >+ phone => '+358700123123', >+ notes => 'Notes', >+ listprice => 'EUR', >+ listincgst => 0, >+ invoiceprice => 'EUR', >+ invoiceincgst => 0, >+ gstreg => 1, >+ gstrate => 0, >+ fax => '+358700123123', >+ discount => 10, >+ deliverytime => 2, >+ address1 => 'Where I am', >+ active => 1, >+ accountnumber => 'IBAN 123456789 FI', >+ contacts => [{#Parameters for Koha::Acquisition::Bookseller}, >+ {#DEFAULT is to use ContactFactory's default values}], >+ }, >+ {...}, >+ ], undef, $testContext1, $testContext2, $testContext3); >+ >+ #Do test stuff... >+ >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); >+ >+The HASH is keyed with the given $hashKey or 'koha.aqbookseller.name' >+ >+@PARAM1 ARRAYRef of HASHRefs >+@PARAM2 koha.aqbookseller-column which is used as the test context HASH key, >+ defaults to the most best option 'name'. >+@PARAM3-5 HASHRef of test contexts. You can save the given borrowers to multiple >+ test contexts. Usually one is enough. These test contexts are >+ used to help tear down DB changes. >+@RETURNS HASHRef of $hashKey => Objects: >+ >+See t::lib::TestObjects::ObjectFactory for more documentation >+=cut >+ >+sub handleTestObject { >+ my ($class, $object, $stashes) = @_; >+ >+ my $contacts = $object->{contacts}; >+ delete $object->{contacts}; >+ >+ my $bookseller = Koha::Acquisition::Bookseller2->new(); >+ $bookseller->set($object); >+ $bookseller->store(); >+ #Refresh from DB the object we just made, since there is no UNIQUE identifier aside from PK, we cannot know if there are many objects like this. >+ my @booksellers = Koha::Acquisition::Booksellers->search($object); >+ if (scalar(@booksellers)) { >+ $bookseller = $booksellers[0]; >+ } >+ else { >+ die "No Bookseller added to DB. Fix me to autorecover from this error!"; >+ } >+ >+ foreach my $c (@$contacts) { >+ $c->{booksellerid} = $bookseller->id; >+ } >+ $bookseller->{contacts} = t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->createTestGroup($contacts, undef, @$stashes); >+ >+ return $bookseller; >+} >+ >+=head validateAndPopulateDefaultValues >+@OVERLOAD >+ >+Validates given Object parameters and makes sure that critical fields are given >+and populates defaults for missing values. >+=cut >+ >+sub validateAndPopulateDefaultValues { >+ my ($self, $object, $hashKey) = @_; >+ >+ $object->{url} = 'www.muscle.com' unless $object->{url}; >+ $object->{postal} = 'post' unless $object->{postal}; >+ $object->{phone} = '+358700123123' unless $object->{phone}; >+ $object->{notes} = 'Notes' unless $object->{notes}; >+ $object->{name} = 'Bookselling Vendor' unless $object->{name}; >+ $object->{listprice} = 'EUR' unless $object->{listprice}; >+ $object->{listincgst} = 0 unless $object->{listincgst}; >+ $object->{invoiceprice} = 'EUR' unless $object->{invoiceprice}; >+ $object->{invoiceincgst} = 0 unless $object->{invoiceincgst}; >+ $object->{gstreg} = 1 unless $object->{gstreg}; >+ $object->{gstrate} = 0 unless $object->{gstrate}; >+ $object->{fax} = '+358700123123' unless $object->{fax}; >+ $object->{discount} = 10 unless $object->{discount}; >+ $object->{deliverytime} = 2 unless $object->{deliverytime}; >+ $object->{address1} = 'Where I am' unless $object->{address1}; >+ $object->{active} = 1 unless $object->{active}; >+ $object->{accountnumber} = 'IBAN 123456789 FI' unless $object->{accountnumber}; >+ $object->{contacts} = [{}] unless $object->{contacts}; #Prepare to create one default contact. >+ >+ $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); >+} >+ >+=head deleteTestGroup >+@OVERLOADED >+ >+ my $records = createTestGroup(); >+ ##Do funky stuff >+ deleteTestGroup($records); >+ >+Removes the given test group from the DB. >+ >+=cut >+ >+sub deleteTestGroup { >+ my ($self, $objects) = @_; >+ >+ while( my ($key, $object) = each %$objects) { >+ my $bookseller = Koha::Acquisition::Booksellers->cast($object); >+ eval { >+ #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them. >+ my @booksellers = Koha::Acquisition::Booksellers->search({name => $bookseller->name}); >+ foreach my $b (@booksellers) { >+ $b->delete(); >+ } >+ }; >+ if ($@) { >+ die $@; >+ } >+ } >+} >+ >+1; >diff --git a/t/lib/TestObjects/BiblioFactory.pm b/t/lib/TestObjects/BiblioFactory.pm >new file mode 100644 >index 0000000..b96cf4e >--- /dev/null >+++ b/t/lib/TestObjects/BiblioFactory.pm >@@ -0,0 +1,151 @@ >+package t::lib::TestObjects::BiblioFactory; >+ >+# Copyright Vaara-kirjastot 2015 >+# >+# This file is part of Koha. >+# >+# Koha is free software; you can redistribute it and/or modify it under the >+# terms of the GNU General Public License as published by the Free Software >+# Foundation; either version 3 of the License, or (at your option) any later >+# version. >+# >+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY >+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR >+# A PARTICULAR PURPOSE. See the GNU General Public License for more details. >+# >+# You should have received a copy of the GNU General Public License along >+# with Koha; if not, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+# >+ >+use Modern::Perl; >+use Carp; >+ >+use C4::Biblio; >+ >+use Koha::Exception::BadParameter; >+ >+use base qw(t::lib::TestObjects::ObjectFactory); >+ >+sub getDefaultHashKey { >+ return 'biblioitems.isbn'; >+} >+ >+=head t::lib::TestObjects::createTestGroup >+ >+ my $records = t::lib::TestObjects::BiblioFactory->createTestGroup([ >+ {'biblio.title' => 'I wish I met your mother', >+ 'biblio.author' => 'Pertti Kurikka', >+ 'biblio.copyrightdate' => '1960', >+ 'biblioitems.isbn' => '9519671580', >+ 'biblioitems.itemtype' => 'BK', >+ }, >+ ], undef, $testContext1, $testContext2, $testContext3); >+ >+Calls C4::Biblio::TransformKohaToMarc() to make a MARC::Record and add it to >+the DB. Returns a HASH of MARC::Records. >+The HASH is keyed with the 'biblioitems.isbn', or the given $hashKey. Using for example >+'biblioitems.isbn' is very much recommended to make linking objects more easy in test cases. >+The biblionumber is injected to the MARC::Record-object to be easily accessable, >+so we can get it like this: >+ $records->{$key}->{biblionumber}; >+ >+See C4::Biblio::TransformKohaToMarc() for how the biblio- or biblioitem-tables' >+columns need to be given. >+ >+@RETURNS HASHRef of MARC::Record-objects >+ >+See t::lib::TestObjects::ObjectFactory for more documentation >+=cut >+ >+sub handleTestObject { >+ my ($class, $object, $stashes) = @_; >+ >+ my $record = C4::Biblio::TransformKohaToMarc($object); >+ my ($biblionumber, $biblioitemnumber) = C4::Biblio::AddBiblio($record,''); >+ >+ #Clone all the parameters of $object to $record >+ foreach my $key (keys(%$object)) { >+ $record->{$key} = $object->{$key}; >+ } >+ $record->{biblionumber} = $biblionumber; >+ >+ return $record; >+} >+ >+=head getHashKey >+@OVERLOADS >+=cut >+ >+sub getHashKey { >+ my ($class, $object, $primaryKey, $hashKeys) = @_; >+ >+ my @collectedHashKeys; >+ $hashKeys = [$hashKeys] unless ref($hashKeys) eq 'ARRAY'; >+ foreach my $hashKey (@$hashKeys) { >+ if (not($hashKey) || >+ (not($object->{$hashKey}) && not($object->$hashKey())) >+ ) { >+ croak $class."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'."; >+ } >+ push @collectedHashKeys, $object->{$hashKey} || $object->$hashKey(); >+ } >+ return join('-', @collectedHashKeys); >+} >+ >+=head validateAndPopulateDefaultValues >+@OVERLOAD >+ >+Validates given Object parameters and makes sure that critical fields are given >+and populates defaults for missing values. >+=cut >+ >+sub validateAndPopulateDefaultValues { >+ my ($self, $object, $hashKey) = @_; >+ >+ unless (ref($object) eq 'HASH' && scalar(%$object)) { >+ Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> Given \$object is empty. You must provide some minimum data to build a Biblio, preferably with somekind of a unique identifier."); >+ } >+ unless ($object->{'biblio.title'}) { >+ Koha::Exception::BadParameter->throw(error => __PACKAGE__."->createTestGroup():> 'biblio.title' is a mandatory parameter!"); >+ } >+ $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); >+} >+ >+=head >+ >+ my $records = createTestGroup(); >+ ##Do funky stuff >+ deleteTestGroup($records); >+ >+Removes the given test group from the DB. >+ >+=cut >+ >+sub deleteTestGroup { >+ my ($class, $records) = @_; >+ >+ my ( $biblionumberFieldCode, $biblionumberSubfieldCode ) = >+ C4::Biblio::GetMarcFromKohaField( "biblio.biblionumber", '' ); >+ >+ my $schema = Koha::Database->new_schema(); >+ while( my ($key, $record) = each %$records) { >+ my $biblionumber = $record->subfield($biblionumberFieldCode, $biblionumberSubfieldCode); >+ my @biblios = $schema->resultset('Biblio')->search({"-or" => [{biblionumber => $biblionumber}, >+ {title => $record->title}]}); >+ foreach my $b (@biblios) { >+ $b->delete(); >+ } >+ } >+} >+sub _deleteTestGroupFromIdentifiers { >+ my ($class, $testGroupIdentifiers) = @_; >+ >+ my $schema = Koha::Database->new_schema(); >+ foreach my $isbn (@$testGroupIdentifiers) { >+ $schema->resultset('Biblio')->search({"biblioitems.isbn" => $isbn},{join => 'biblioitems'})->delete(); >+ $schema->resultset('Biblioitem')->search({isbn => $isbn})->delete(); >+ } >+} >+ >+1; >diff --git a/t/lib/TestObjects/BorrowerFactory.pm b/t/lib/TestObjects/BorrowerFactory.pm >new file mode 100644 >index 0000000..1d8da41 >--- /dev/null >+++ b/t/lib/TestObjects/BorrowerFactory.pm >@@ -0,0 +1,172 @@ >+package t::lib::TestObjects::BorrowerFactory; >+ >+# Copyright Vaara-kirjastot 2015 >+# >+# This file is part of Koha. >+# >+# Koha is free software; you can redistribute it and/or modify it under the >+# terms of the GNU General Public License as published by the Free Software >+# Foundation; either version 3 of the License, or (at your option) any later >+# version. >+# >+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY >+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR >+# A PARTICULAR PURPOSE. See the GNU General Public License for more details. >+# >+# You should have received a copy of the GNU General Public License along >+# with Koha; if not, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+# >+ >+use Modern::Perl; >+use Carp; >+use Scalar::Util qw(blessed); >+ >+use C4::Members; >+use Koha::Borrowers; >+ >+use base qw(t::lib::TestObjects::ObjectFactory); >+ >+sub new { >+ my ($class) = @_; >+ >+ my $self = {}; >+ bless($self, $class); >+ return $self; >+} >+ >+sub getDefaultHashKey { >+ return 'cardnumber'; >+} >+ >+=head createTestGroup( $data [, $hashKey, $testContexts...] ) >+@OVERLOADED >+ >+ my $borrowerFactory = t::lib::TestObjects::BorrowerFactory->new(); >+ my $borrowers = $borrowerFactory->createTestGroup([ >+ {firstname => 'Olli-Antti', >+ surname => 'Kivi', >+ cardnumber => '11A001', >+ branchcode => 'CPL', >+ }, >+ {firstname => 'Olli-Antti2', >+ surname => 'Kivi2', >+ cardnumber => '11A002', >+ branchcode => 'FPL', >+ }, >+ ], undef, $testContext1, $testContext2, $testContext3); >+ >+ #Do test stuff... >+ >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1); >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2); >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); >+ >+The HASH is keyed with the given $hashKey or 'koha.borrowers.cardnumber' >+See C4::Members::AddMember() for how the table columns need to be given. >+ >+@PARAM1 ARRAYRef of HASHRefs of C4::Members::AddMember()-parameters. >+@PARAM2 koha.borrower-column which is used as the test context borrowers HASH key, >+ defaults to the most best option cardnumber. >+@PARAM3-5 HASHRef of test contexts. You can save the given borrowers to multiple >+ test contexts. Usually one is enough. These test contexts are >+ used to help tear down DB changes. >+@RETURNS HASHRef of $hashKey => $borrower-objects: >+ >+See t::lib::TestObjects::ObjectFactory for more documentation >+=cut >+ >+sub handleTestObject { >+ my ($class, $object, $stashes) = @_; >+ >+ #Try to add the Borrower, but it might fail because of the barcode or other UNIQUE constraint. >+ #Catch the error and try looking for the Borrower if we suspect it is present in the DB. >+ my $borrowernumber; >+ eval { >+ $borrowernumber = C4::Members::AddMember(%$object); >+ }; >+ if ($@) { >+ if (blessed($@) && $@->isa('DBIx::Class::Exception') && >+ $@->{msg} =~ /Duplicate entry '.+?' for key 'cardnumber'/) { #DBIx should throw other types of exceptions instead of this general type :( >+ #This exception type is OK, we ignore this and try fetching the existing Object next. >+ warn "Recovering from duplicate exception.\n"; >+ } >+ else { >+ die $@; >+ } >+ } >+ >+ #If adding failed, we still get some strange borrowernumber result. >+ #Check for sure by finding the real borrower. >+ my $borrower = Koha::Borrowers->cast( $borrowernumber || $object ); >+ unless ($borrower) { >+ carp "BorrowerFactory:> No borrower for cardnumber '".$object->{cardnumber}."'"; >+ return(); >+ } >+ >+ return $borrower; >+} >+ >+=head validateAndPopulateDefaultValues >+@OVERLOAD >+ >+Validates given Object parameters and makes sure that critical fields are given >+and populates defaults for missing values. >+=cut >+ >+sub validateAndPopulateDefaultValues { >+ my ($self, $borrower, $hashKey) = @_; >+ $self->SUPER::validateAndPopulateDefaultValues($borrower, $hashKey); >+ >+ $borrower->{categorycode} = 'PT' unless $borrower->{categorycode}; >+ $borrower->{branchcode} = 'CPL' unless $borrower->{branchcode}; >+ $borrower->{dateofbirth} = '1985-10-12' unless $borrower->{dateofbirth}; >+} >+ >+=head deleteTestGroup >+@OVERLOADED >+ >+ my $records = createTestGroup(); >+ ##Do funky stuff >+ deleteTestGroup($records); >+ >+Removes the given test group from the DB. >+ >+=cut >+ >+sub deleteTestGroup { >+ my ($self, $objects) = @_; >+ >+ my $schema = Koha::Database->new_schema(); >+ while( my ($key, $object) = each %$objects) { >+ my $borrower = Koha::Borrowers->cast($object); >+ eval { >+ $borrower->delete(); >+ }; >+ if ($@) { >+ if (blessed($@) && $@->isa('DBIx::Class::Exception') && >+ #Trying to recover. Delete all Checkouts for the Borrower to be able to delete. >+ $@->{msg} =~ /a foreign key constraint fails.+?issues_ibfk_1/) { #DBIx should throw other types of exceptions instead of this general type :( >+ >+ my @checkouts = Koha::Checkouts->search({borrowernumber => $borrower->borrowernumber}); >+ foreach my $c (@checkouts) { $c->delete(); } >+ $borrower->delete(); >+ warn "Recovering from foreign key exception.\n"; >+ } >+ else { >+ die $@; >+ } >+ } >+ >+ } >+} >+sub _deleteTestGroupFromIdentifiers { >+ my ($self, $testGroupIdentifiers) = @_; >+ >+ my $schema = Koha::Database->new_schema(); >+ foreach my $key (@$testGroupIdentifiers) { >+ $schema->resultset('Borrower')->find({"cardnumber" => $key})->delete(); >+ } >+} >+ >+1; >diff --git a/t/lib/TestObjects/CheckoutFactory.pm b/t/lib/TestObjects/CheckoutFactory.pm >new file mode 100644 >index 0000000..bb9a2d1 >--- /dev/null >+++ b/t/lib/TestObjects/CheckoutFactory.pm >@@ -0,0 +1,197 @@ >+package t::lib::TestObjects::CheckoutFactory; >+ >+# Copyright Vaara-kirjastot 2015 >+# >+# This file is part of Koha. >+# >+# Koha is free software; you can redistribute it and/or modify it under the >+# terms of the GNU General Public License as published by the Free Software >+# Foundation; either version 3 of the License, or (at your option) any later >+# version. >+# >+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY >+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR >+# A PARTICULAR PURPOSE. See the GNU General Public License for more details. >+# >+# You should have received a copy of the GNU General Public License along >+# with Koha; if not, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+# >+ >+use Modern::Perl; >+use Carp; >+use DateTime; >+ >+use C4::Circulation; >+use C4::Members; >+use C4::Items; >+use Koha::Borrowers; >+use Koha::Items; >+ >+use base qw(t::lib::TestObjects::ObjectFactory); >+ >+sub new { >+ my ($class) = @_; >+ >+ my $self = {}; >+ bless($self, $class); >+ return $self; >+} >+ >+sub getDefaultHashKey { >+ return ['cardnumber', 'barcode']; >+} >+ >+=head t::lib::TestObjects::CheckoutFactory::createTestGroup( $data [, $hashKey], @stashes ) >+ >+ my $checkoutFactory = t::lib::TestObjects::CheckoutFactory->new(); >+ my $checkouts = $checkoutFactory->createTestGroup([ >+ {#Checkout params >+ }, >+ {#More checkout params >+ }, >+ ], undef, $testContext1, $testContext2, $testContext3); >+ >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1); >+ >+@PARAM1, ARRAY of HASHes. >+ [ { >+ cardnumber => '167Azava0001', >+ barcode => '167Nfafa0010', >+ daysOverdue => 7, #This Checkout's duedate was 7 days ago. If undef, then uses today as the checkout day. >+ daysAgoCheckedout => 28, #This Checkout hapened 28 days ago. If undef, then uses today. >+ checkoutBranchRule => 'homebranch' || 'holdingbranch' #From which branch this item is checked out from. >+ }, >+ { >+ ... >+ } >+ ] >+@PARAM2, String, the HASH-element to use as the returning HASHes key. >+@PARAM3, String, the rule on where to check these Issues out: >+ 'homebranch', uses the Item's homebranch as the checkout branch >+ 'holdingbranch', uses the Item's holdingbranch as the checkout branch >+ undef, uses the current Environment branch >+ '<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 => $checkout-objects. >+ The HASH is keyed with <cardnumber>-<barcode>, or the given $hashKey. >+ Example: { >+ '11A001-167N0212' => { >+ cardnumber => <cardnumber>, >+ barcode => <barcode>, >+ ...other Checkout-object columns... >+ }, >+ ... >+} >+=cut >+ >+sub handleTestObject { >+ my ($class, $checkoutParams, $stashes) = @_; >+ >+ #If running this test factory from unit tests or bare script, the context might not have been initialized. >+ unless (C4::Context->userenv()) { >+ C4::Context->_new_userenv('testGroupsTest'); >+ C4::Context->set_userenv(undef, undef, undef, >+ undef, undef, >+ 'CPL', undef, undef, >+ undef, undef, undef); >+ } >+ my $oldContextBranch = C4::Context->userenv()->{branch}; >+ >+ my $borrower = Koha::Borrowers->cast($checkoutParams->{cardnumber}); >+ my $item = Koha::Items->cast($checkoutParams->{barcode}); >+ >+ my $duedate = DateTime->now(time_zone => C4::Context->tz()); >+ if ($checkoutParams->{daysOverdue}) { >+ $duedate->subtract(days => $checkoutParams->{daysOverdue} ); >+ } >+ >+ my $checkoutdate = DateTime->now(time_zone => C4::Context->tz()); >+ if ($checkoutParams->{daysAgoCheckedout}) { >+ $checkoutdate->subtract(days => $checkoutParams->{daysAgoCheckedout} ); >+ } >+ >+ #Set the checkout branch >+ my $checkoutBranch; >+ my $checkoutBranchRule = $checkoutParams->{checkoutBranchRule}; >+ if (not($checkoutBranchRule)) { >+ #Use the existing userenv()->{branch} >+ } >+ elsif ($checkoutBranchRule eq 'homebranch') { >+ $checkoutBranch = $item->homebranch; >+ } >+ elsif ($checkoutBranchRule eq 'holdingbranch') { >+ $checkoutBranch = $item->holdingbranch; >+ } >+ elsif ($checkoutBranchRule) { >+ $checkoutBranch = $checkoutBranchRule; >+ } >+ C4::Context->userenv()->{branch} = $checkoutBranch if $checkoutBranch; >+ >+ my $datedue = C4::Circulation::AddIssue( $borrower->unblessed, $checkoutParams->{barcode}, $duedate, undef, $checkoutdate ); >+ #We want the issue_id as well. >+ my $checkout = Koha::Checkouts->find({ borrowernumber => $borrower->borrowernumber, itemnumber => $item->itemnumber }); >+ unless ($checkout) { >+ carp "CheckoutFactory:> No checkout for cardnumber '".$checkoutParams->{cardnumber}."' and barcode '".$checkoutParams->{barcode}."'"; >+ return; >+ } >+ >+ return $checkout; >+} >+ >+=head validateAndPopulateDefaultValues >+@OVERLOAD >+ >+Validates given Object parameters and makes sure that critical fields are given >+and populates defaults for missing values. >+=cut >+ >+sub validateAndPopulateDefaultValues { >+ my ($self, $object, $hashKey) = @_; >+ $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); >+ >+ unless ($object->{cardnumber}) { >+ croak __PACKAGE__.":> Mandatory parameter 'cardnumber' missing."; >+ } >+ $object->{borrower} = Koha::Borrowers->cast($object->{cardnumber}); >+ >+ unless ($object->{barcode}) { >+ croak __PACKAGE__.":> Mandatory parameter 'barcode' missing."; >+ } >+ $object->{item} = Koha::Items->cast($object->{barcode}); >+ >+ if ($object->{checkoutBranchRule} && not($object->{checkoutBranchRule} =~ m/(homebranch)|(holdingbranch)/)) { >+ croak __PACKAGE__.":> Optional parameter 'checkoutBranchRule' must be one of these: homebranch, holdingbranch"; >+ } >+} >+ >+=head >+ >+ my $objects = createTestGroup(); >+ ##Do funky stuff >+ deleteTestGroup($records); >+ >+Removes the given test group from the DB. >+ >+=cut >+ >+sub deleteTestGroup { >+ my ($self, $objects) = @_; >+ >+ while( my ($key, $object) = each %$objects) { >+ my $checkout = Koha::Checkouts->cast($object); >+ $checkout->delete(); >+ } >+} >+sub _deleteTestGroupFromIdentifiers { >+ my ($self, $testGroupIdentifiers) = @_; >+ >+ my $schema = Koha::Database->new_schema(); >+ foreach my $key (@$testGroupIdentifiers) { >+ $schema->resultset('Issue')->find({"issue_id" => $key})->delete(); >+ } >+} >+ >+1; >diff --git a/t/lib/TestObjects/ItemFactory.pm b/t/lib/TestObjects/ItemFactory.pm >new file mode 100644 >index 0000000..ab33802 >--- /dev/null >+++ b/t/lib/TestObjects/ItemFactory.pm >@@ -0,0 +1,137 @@ >+package t::lib::TestObjects::ItemFactory; >+ >+# Copyright Vaara-kirjastot 2015 >+# >+# This file is part of Koha. >+# >+# Koha is free software; you can redistribute it and/or modify it under the >+# terms of the GNU General Public License as published by the Free Software >+# Foundation; either version 3 of the License, or (at your option) any later >+# version. >+# >+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY >+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR >+# A PARTICULAR PURPOSE. See the GNU General Public License for more details. >+# >+# You should have received a copy of the GNU General Public License along >+# with Koha; if not, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+# >+ >+use Modern::Perl; >+use Carp; >+ >+use C4::Items; >+use Koha::Items; >+use Koha::Checkouts; >+ >+use base qw(t::lib::TestObjects::ObjectFactory); >+ >+sub new { >+ my ($class) = @_; >+ >+ my $self = {}; >+ bless($self, $class); >+ return $self; >+} >+ >+sub getDefaultHashKey { >+ return 'barcode'; >+} >+ >+=head t::lib::TestObjects::ItemFactory::createTestGroup( $data [, $hashKey] ) >+@OVERLOADED >+ >+Returns a HASH of objects. >+Each Item is expected to contain the biblionumber of the Biblio they are added into. >+ eg. $item->{biblionumber} = 550242; >+ >+The HASH is keyed with the 'barcode', or the given $hashKey. >+ >+See C4::Items::AddItem() for how the table columns need to be given. >+ >+See t::lib::TestObjects::ObjectFactory for more documentation >+=cut >+ >+sub handleTestObject { >+ my ($class, $object, $stashes) = @_; >+ >+ my ($biblionumber, $biblioitemnumber, $itemnumber); >+ eval { >+ ($biblionumber, $biblioitemnumber, $itemnumber) = C4::Items::AddItem($object, $object->{biblionumber}); >+ }; >+ if ($@) { >+ if (blessed($@) && $@->isa('DBIx::Class::Exception') && >+ $@->{msg} =~ /Duplicate entry '.+?' for key 'itembarcodeidx'/) { #DBIx should throw other types of exceptions instead of this general type :( >+ #This exception type is OK, we ignore this and try fetching the existing Object next. >+ warn "Recovering from duplicate exception.\n"; >+ } >+ else { >+ die $@; >+ } >+ } >+ my $item = Koha::Items->cast($itemnumber || $object); >+ unless ($item) { >+ carp "ItemFactory:> No item for barcode '".$object->{barcode}."'"; >+ next(); >+ } >+ >+ return $item; >+} >+ >+=head validateAndPopulateDefaultValues >+@OVERLOAD >+ >+Validates given Object parameters and makes sure that critical fields are given >+and populates defaults for missing values. >+=cut >+ >+sub validateAndPopulateDefaultValues { >+ my ($self, $item, $hashKey) = @_; >+ $self->SUPER::validateAndPopulateDefaultValues($item, $hashKey); >+ >+ $item->{homebranch} = 'CPL' unless $item->{homebranch}; >+ $item->{holdingbranch} = 'CPL' unless $item->{holdingbranch}; >+ $item->{itemcallnumber} = 'PRE 84.FAN POST' unless $item->{itemcallnumber}; >+} >+ >+=head >+@OVERLOADED >+ >+ my $objects = createTestGroup(); >+ ##Do funky stuff >+ deleteTestGroup($records); >+ >+Removes the given test group from the DB. >+ >+=cut >+ >+sub deleteTestGroup { >+ my ($self, $objects) = @_; >+ >+ while( my ($key, $object) = each %$objects) { >+ my $item = Koha::Items->cast($object); >+ >+ #Delete all attached checkouts >+ my @checkouts = Koha::Checkouts->search({itemnumber => $item->itemnumber}); >+ foreach my $c (@checkouts) { >+ $c->delete; >+ } >+ >+ $item->delete(); >+ } >+} >+sub _deleteTestGroupFromIdentifiers { >+ my ($self, $testGroupIdentifiers) = @_; >+ >+ foreach my $key (@$testGroupIdentifiers) { >+ my $item = Koha::Items->cast($key); >+ my @checkouts = Koha::Checkouts->search({itemnumber => $item->itemnumber}); >+ foreach my $c (@checkouts) { >+ $c->delete; >+ } >+ $item->delete(); >+ } >+} >+ >+1; >diff --git a/t/lib/TestObjects/LetterTemplateFactory.pm b/t/lib/TestObjects/LetterTemplateFactory.pm >new file mode 100644 >index 0000000..6a6d4fd >--- /dev/null >+++ b/t/lib/TestObjects/LetterTemplateFactory.pm >@@ -0,0 +1,96 @@ >+package t::lib::TestObjects::LetterTemplateFactory; >+ >+# Copyright Vaara-kirjastot 2015 >+# >+# This file is part of Koha. >+# >+# Koha is free software; you can redistribute it and/or modify it under the >+# terms of the GNU General Public License as published by the Free Software >+# Foundation; either version 3 of the License, or (at your option) any later >+# version. >+# >+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY >+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR >+# A PARTICULAR PURPOSE. See the GNU General Public License for more details. >+# >+# You should have received a copy of the GNU General Public License along >+# with Koha; if not, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+# >+ >+use Modern::Perl; >+use Carp; >+ >+use C4::Letters; >+use Koha::LetterTemplates; >+ >+use base qw(t::lib::TestObjects::ObjectFactory); >+ >+sub new { >+ my ($class) = @_; >+ >+ my $self = {}; >+ bless($self, $class); >+ return $self; >+} >+ >+sub getDefaultHashKey { >+ return ['module', 'code', 'branchcode', 'message_transport_type']; >+} >+ >+=head t::lib::TestObjects::LetterTemplateFactory->createTestGroup >+Returns a HASH of Koha::LetterTemplate-objects >+The HASH is keyed with the PRIMARY KEYS eg. 'circulation-ODUE2-CPL-print', or the given $hashKey. >+=cut >+ >+#Incredibly the Letters-module has absolutely no Create or Update-component to operate on Letter templates? >+#Tests like these are brittttle. :( >+sub handleTestObject { >+ my ($class, $object, $stashes) = @_; >+ >+ my $schema = Koha::Database->new->schema(); >+ my $rs = $schema->resultset('Letter'); >+ my $result = $rs->update_or_create({ >+ module => $object->{module}, >+ code => $object->{code}, >+ branchcode => ($object->{branchcode}) ? $object->{branchcode} : '', >+ name => $object->{name}, >+ is_html => $object->{is_html}, >+ title => $object->{title}, >+ message_transport_type => $object->{message_transport_type}, >+ content => $object->{content}, >+ }); >+ >+ return Koha::LetterTemplates->cast($result); >+} >+ >+=head >+ >+Removes the given test group from the DB. >+ >+=cut >+ >+sub deleteTestGroup { >+ my ($self, $letterTemplates) = @_; >+ >+ my $schema = Koha::Database->new_schema(); >+ while( my ($key, $letterTemplate) = each %$letterTemplates ) { >+ $letterTemplate->delete(); >+ } >+} >+ >+sub _deleteTestGroupFromIdentifiers { >+ my $testGroupIdentifiers = shift; >+ >+ my $schema = Koha::Database->new_schema(); >+ foreach my $key (@$testGroupIdentifiers) { >+ my ($module, $code, $branchcode, $mtt) = split('-',$key); >+ $schema->resultset('Letter')->find({module => $module, >+ code => $code, >+ branchcode => $branchcode, >+ message_transport_type => $mtt, >+ })->delete(); >+ } >+} >+ >+1; >diff --git a/t/lib/TestObjects/ObjectFactory.pm b/t/lib/TestObjects/ObjectFactory.pm >new file mode 100644 >index 0000000..34cb90d >--- /dev/null >+++ b/t/lib/TestObjects/ObjectFactory.pm >@@ -0,0 +1,269 @@ >+package t::lib::TestObjects::ObjectFactory; >+ >+# Copyright Vaara-kirjastot 2015 >+# >+# This file is part of Koha. >+# >+# Koha is free software; you can redistribute it and/or modify it under the >+# terms of the GNU General Public License as published by the Free Software >+# Foundation; either version 3 of the License, or (at your option) any later >+# version. >+# >+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY >+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR >+# A PARTICULAR PURPOSE. See the GNU General Public License for more details. >+# >+# You should have received a copy of the GNU General Public License along >+# with Koha; if not, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+# >+ >+use Modern::Perl; >+use Carp; >+use Scalar::Util qw(blessed); >+use Koha::Exception::BadParameter; >+use Koha::Exception::UnknownObject; >+ >+=head createTestGroup( $data [, $hashKey, $testContexts...] ) >+ >+ my $factory = t::lib::TestObjects::ObjectFactory->new(); >+ my $objects = $factory->createTestGroup([ >+ #Imagine if using the BorrowerFactory >+ {firstname => 'Olli-Antti', >+ surname => 'Kivi', >+ cardnumber => '11A001', >+ branchcode => 'CPL', >+ ... >+ }, >+ #Or if using the ItemFactory >+ {biblionumber => 123413, >+ barcode => '11N002', >+ homebranch => 'FPL', >+ ... >+ }, >+ ], $hashKey, $testContext1, $testContext2, $testContext3); >+ >+ #Do test stuff... >+ >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1); >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2); >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); >+ >+The HASH is keyed with the given $hashKey or the default hash key accessed with >+getDefaultHashKey() >+See the createTestGroup() documentation in the implementing Factory-class for how >+the table columns need to be given. >+ >+@PARAM1 ARRAYRef of HASHRefs of desired Object constructor parameters >+@PARAM2 koha.<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}, >+ } >+=cut >+ >+sub createTestGroup { >+ my ($class, $objects, $hashKey, $featureStash, $scenarioStash, $stepStash) = @_; >+ my $stashes = [$featureStash, $scenarioStash, $stepStash]; >+ $class->_validateStashes(@$stashes); >+ $hashKey = $class->getDefaultHashKey() unless $hashKey; >+ >+ $objects = [$objects] unless ref($objects) eq 'ARRAY'; >+ my %objects; >+ foreach my $o (@$objects) { >+ $class->validateAndPopulateDefaultValues($o, $hashKey, $stashes); >+ >+ my $addedObject = $class->handleTestObject($o, $stashes); >+ if (not($addedObject) || >+ not(ref($addedObject) eq 'HASH' || $addedObject->isa('Koha::Object') || $addedObject->isa('MARC::Record') ) >+ ) { >+ Koha::Exception::UnknownObject->throw(error => __PACKAGE__."->createTestGroup():> Subroutine '$class->handleTestObject()' must return a HASH or a Koha::Object"); >+ } >+ >+ my $key = $class->getHashKey($addedObject, undef, $hashKey); >+ $objects{$key} = $addedObject; >+ } >+ >+ $class->_persistToStashes(\%objects, $class->getHashGroupName(), @$stashes); >+ >+ return \%objects; >+} >+ >+=head getHashGroupName >+@OVERRIDABLE >+ >+@RETURNS String, the test context/stash key under which all of these test objects are put. >+ The key is calculated by default from the last components of the Object package, >+ but it is possible to override this method from the subclass to force another key. >+ Eg. 't::lib::PageObject::Acquisition::Bookseller::ContactFactory' becomes >+ acquisition-bookseller-contact >+=cut >+ >+sub getHashGroupName { >+ my ($class) = @_; >+ >+ my $excludedPackageStart = 't::lib::TestObjects'; >+ unless ($class =~ m/^${excludedPackageStart}::(.+?)Factory/i) { >+ Koha::Exception::BadParameter->throw(error => >+ "$class->getHashGroupName():> Couldn't parse the class name to the default test stash group name. Your class is badly named. Expected format '${excludedPackageStart}::<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) = @_; >+ >+ ##You should introduce tearDowns in such an order that to not provoke FOREIGN KEY issues. >+ if ($stash->{'serial-subscription'}) { >+ require t::lib::TestObjects::Serial::SubscriptionFactory; >+ t::lib::TestObjects::Serial::SubscriptionFactory->deleteTestGroup($stash->{'serial-subscription'}); >+ delete $stash->{'serial-subscription'}; >+ } >+ if ($stash->{'acquisition-bookseller-contact'}) { >+ require t::lib::TestObjects::Acquisition::Bookseller::ContactFactory; >+ t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->deleteTestGroup($stash->{'acquisition-bookseller-contact'}); >+ delete $stash->{'acquisition-bookseller-contact'}; >+ } >+ if ($stash->{'acquisition-bookseller'}) { >+ require t::lib::TestObjects::Acquisition::BooksellerFactory; >+ t::lib::TestObjects::Acquisition::BooksellerFactory->deleteTestGroup($stash->{'acquisition-bookseller'}); >+ delete $stash->{'acquisition-bookseller'}; >+ } >+ if ($stash->{checkout}) { >+ require t::lib::TestObjects::CheckoutFactory; >+ t::lib::TestObjects::CheckoutFactory->deleteTestGroup($stash->{checkout}); >+ delete $stash->{checkout}; >+ } >+ if ($stash->{item}) { >+ require t::lib::TestObjects::ItemFactory; >+ t::lib::TestObjects::ItemFactory->deleteTestGroup($stash->{item}); >+ delete $stash->{item}; >+ } >+ if ($stash->{biblio}) { >+ require t::lib::TestObjects::BiblioFactory; >+ t::lib::TestObjects::BiblioFactory->deleteTestGroup($stash->{biblio}); >+ delete $stash->{biblio}; >+ } >+ if ($stash->{borrower}) { >+ require t::lib::TestObjects::BorrowerFactory; >+ t::lib::TestObjects::BorrowerFactory->deleteTestGroup($stash->{borrower}); >+ delete $stash->{borrower}; >+ } >+ if ($stash->{letterTemplate}) { >+ require t::lib::TestObjects::LetterTemplateFactory; >+ t::lib::TestObjects::LetterTemplateFactory->deleteTestGroup($stash->{letterTemplate}); >+ delete $stash->{letterTemplate}; >+ } >+ if ($stash->{systempreference}) { >+ require t::lib::TestObjects::SystemPreferenceFactory; >+ t::lib::TestObjects::SystemPreferenceFactory->deleteTestGroup($stash->{systempreference}); >+ delete $stash->{systempreference}; >+ } >+} >+ >+=head getHashKey >+@OVERLOADABLE >+ >+@RETURNS String, The test context/stash HASH key to differentiate this object >+ from all other such test objects. >+=cut >+ >+sub getHashKey { >+ my ($class, $object, $primaryKey, $hashKeys) = @_; >+ >+ my @collectedHashKeys; >+ $hashKeys = [$hashKeys] unless ref($hashKeys) eq 'ARRAY'; >+ foreach my $hashKey (@$hashKeys) { >+ if (ref($object) eq 'HASH') { >+ if ($hashKey && not($object->{$hashKey})) { >+ croak $class."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'."; >+ } >+ push @collectedHashKeys, $object->{$hashKey}; >+ } >+ else { >+ if ($hashKey && not($object->$hashKey())) { >+ croak $class."->getHashKey($object, $primaryKey, $hashKey):> Given ".ref($object)." has no \$hashKey '$hashKey'."; >+ } >+ push @collectedHashKeys, $object->$hashKey(); >+ } >+ } >+ return join('-', @collectedHashKeys); >+} >+ >+=head validateAndPopulateDefaultValues >+@INTERFACE >+ >+Validates given Object parameters and makes sure that critical fields are given >+and populates defaults for missing values. >+You must overload this in the subclassing factory if you want to validate and check the given parameters >+=cut >+ >+sub validateAndPopulateDefaultValues { >+ my ($self, $object, $hashKeys) = @_; >+ >+ $hashKeys = [$hashKeys] unless ref($hashKeys) eq 'ARRAY'; >+ foreach my $hashKey (@$hashKeys) { >+ unless ($object->{$hashKey}) { >+ Koha::Exception::BadParameter->throw(error => ref($self)."():> You want to access test Objects using hashKey '$hashKey', but you haven't supplied it as a Object parameter. ObjectFactories need a unique identifier to function properly."); >+ } >+ } >+} >+ >+=head _validateStashes >+ >+ _validateStashes($featureStash, $scenarioStash, $stepStash); >+ >+Validates that the given stahses are what they are supposed to be... , HASHrefs. >+@THROWS Koha::Exception::BadParameter, if validation failed. >+=cut >+ >+sub _validateStashes { >+ my ($self, $featureStash, $scenarioStash, $stepStash) = @_; >+ >+ if ($featureStash && not(ref($featureStash) eq 'HASH')) { >+ Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$featureStash' is not a HASHRef! Leave it 'undef' if you don't want to use it."); >+ } >+ if ($scenarioStash && not(ref($scenarioStash) eq 'HASH')) { >+ Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$scenarioStash' is not a HASHRef! Leave it 'undef' if you don't want to use it."); >+ } >+ if ($stepStash && not(ref($stepStash) eq 'HASH')) { >+ Koha::Exception::BadParameter->throw(error => __PACKAGE__."->_validateStashes():> Stash '\$stepStash' is not a HASHRef! Leave it 'undef' if you don't want to use it."); >+ } >+} >+ >+=head _persistToStashes >+ >+ _persistToStashes($objects, $stashKey, $featureStash, $scenarioStash, $stepStash); >+ >+Saves the given HASH to the given stashes using the given stash key. >+=cut >+ >+sub _persistToStashes { >+ my ($self, $objects, $stashKey, $featureStash, $scenarioStash, $stepStash) = @_; >+ >+ if ($featureStash || $scenarioStash || $stepStash) { >+ while( my ($key, $biblio) = each %$objects) { >+ $featureStash->{$stashKey}->{ $key } = $biblio if $featureStash; >+ $scenarioStash->{$stashKey}->{ $key } = $biblio if $scenarioStash; >+ $stepStash->{$stashKey}->{ $key } = $biblio if $stepStash; >+ } >+ } >+} >+ >+1; >\ No newline at end of file >diff --git a/t/lib/TestObjects/Serial/FrequencyFactory.pm b/t/lib/TestObjects/Serial/FrequencyFactory.pm >new file mode 100644 >index 0000000..da48246 >--- /dev/null >+++ b/t/lib/TestObjects/Serial/FrequencyFactory.pm >@@ -0,0 +1,149 @@ >+package t::lib::TestObjects::Serial::FrequencyFactory; >+ >+# Copyright Vaara-kirjastot 2015 >+# >+# This file is part of Koha. >+# >+# Koha is free software; you can redistribute it and/or modify it under the >+# terms of the GNU General Public License as published by the Free Software >+# Foundation; either version 3 of the License, or (at your option) any later >+# version. >+# >+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY >+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR >+# A PARTICULAR PURPOSE. See the GNU General Public License for more details. >+# >+# You should have received a copy of the GNU General Public License along >+# with Koha; if not, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+# >+ >+use Modern::Perl; >+use Carp; >+use Scalar::Util qw(blessed); >+ >+use Koha::Serial::Subscription::Frequency; >+use Koha::Serial::Subscription::Frequencies; >+ >+use base qw(t::lib::TestObjects::ObjectFactory); >+ >+sub new { >+ my ($class) = @_; >+ >+ my $self = {}; >+ bless($self, $class); >+ return $self; >+} >+ >+sub getDefaultHashKey { >+ return 'description'; >+} >+ >+=head createTestGroup( $data [, $hashKey, $testContexts...] ) >+@OVERLOADED >+ >+ my $frequencies = t::lib::TestObjects::Serial::FrequencyFactory->createTestGroup([ >+ {acqprimary => 1, #DEFAULT >+ claimissues => 1, #DEFAULT >+ claimacquisition => 1, #DEFAULT >+ serialsprimary => 1, #DEFAULT >+ position => 'Boss', #DEFAULT >+ phone => '+358700123123', #DEFAULT >+ notes => 'Noted', #DEFAULT >+ name => "Julius Augustus Caesar", #DEFAULT >+ fax => '+358700123123', #DEFAULT >+ email => 'vendor@example.com', #DEFAULT >+ booksellerid => 12124 #MANDATORY to link to Bookseller >+ #id => #Don't use id, since we are just adding a new one >+ }, >+ {...}, >+ ], undef, $testContext1, $testContext2, $testContext3); >+ >+ #Do test stuff... >+ >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); >+ >+The HASH is keyed with the given $hashKey or 'koha.subscription_frequencies.description' >+ >+@PARAM1 ARRAYRef of HASHRefs >+@PARAM2 koha.subscription_frequencies-column which is used as the test context HASH key, >+ defaults to the most best option 'description'. >+@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple >+ test contexts. Usually one is enough. These test contexts are >+ used to help tear down DB changes. >+@RETURNS HASHRef of $hashKey => object: >+ >+See t::lib::TestObjects::ObjectFactory for more documentation >+=cut >+ >+sub handleTestObject { >+ my ($class, $object, $stashes) = @_; >+ >+ my $contact = Koha::Acquisition::Bookseller::Contact->new(); >+ $contact->set($object); >+ $contact->store(); >+ #Refresh from DB the contact we just made, since there is no UNIQUE identifier aside from PK, we cannot know if there are many objects like this. >+ my @contacts = Koha::Acquisition::Bookseller::Contacts->search($object); >+ if (scalar(@contacts)) { >+ $contact = $contacts[0]; >+ } >+ else { >+ die "No Contact added to DB. Fix me to autorecover from this error!"; >+ } >+ >+ return $contact; >+} >+ >+=head validateAndPopulateDefaultValues >+@OVERLOAD >+ >+Validates given Object parameters and makes sure that critical fields are given >+and populates defaults for missing values. >+=cut >+ >+sub validateAndPopulateDefaultValues { >+ my ($self, $object, $hashKey) = @_; >+ >+ $object->{acqprimary} = 1 unless $object->{acqprimary}; >+ $object->{claimissues} = 1 unless $object->{claimissues}; >+ $object->{claimacquisition} = 1 unless $object->{claimacquisition}; >+ $object->{serialsprimary} = 1 unless $object->{serialsprimary}; >+ $object->{position} = 'Boss' unless $object->{position}; >+ $object->{phone} = '+358700123123' unless $object->{phone}; >+ $object->{notes} = 'Noted' unless $object->{notes}; >+ $object->{name} = "Julius Augustus Caesar" unless $object->{name}; >+ $object->{fax} = '+358700123123' unless $object->{fax}; >+ $object->{email} = 'vendor@example.com' unless $object->{email}; >+ $self->SUPER::validateAndPopulateDefaultValues($object, $hashKey); >+} >+ >+=head deleteTestGroup >+@OVERLOADED >+ >+ my $records = createTestGroup(); >+ ##Do funky stuff >+ deleteTestGroup($records); >+ >+Removes the given test group from the DB. >+ >+=cut >+ >+sub deleteTestGroup { >+ my ($self, $objects) = @_; >+ >+ while( my ($key, $object) = each %$objects) { >+ my $contact = Koha::Acquisition::Bookseller::Contacts->cast($object); >+ eval { >+ #Since there is no UNIQUE constraint for Contacts, we might end up with several exactly the same Contacts, so clean up all of them. >+ my @contacts = Koha::Acquisition::Bookseller::Contacts->search({name => $contact->name}); >+ foreach my $c (@contacts) { >+ $c->delete(); >+ } >+ }; >+ if ($@) { >+ die $@; >+ } >+ } >+} >+ >+1; >diff --git a/t/lib/TestObjects/Serial/SubscriptionFactory.pm b/t/lib/TestObjects/Serial/SubscriptionFactory.pm >new file mode 100644 >index 0000000..f09514b >--- /dev/null >+++ b/t/lib/TestObjects/Serial/SubscriptionFactory.pm >@@ -0,0 +1,300 @@ >+package t::lib::TestObjects::Serial::SubscriptionFactory; >+ >+# Copyright KohaSuomi 2015 >+# >+# This file is part of Koha. >+# >+# Koha is free software; you can redistribute it and/or modify it under the >+# terms of the GNU General Public License as published by the Free Software >+# Foundation; either version 3 of the License, or (at your option) any later >+# version. >+# >+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY >+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR >+# A PARTICULAR PURPOSE. See the GNU General Public License for more details. >+# >+# You should have received a copy of the GNU General Public License along >+# with Koha; if not, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+# >+ >+use Modern::Perl; >+use Carp; >+use Scalar::Util qw(blessed); >+ >+use C4::Serials; >+ >+use t::lib::TestObjects::BorrowerFactory; >+use Koha::Borrowers; >+use t::lib::TestObjects::Acquisition::BooksellerFactory; >+use Koha::Acquisition::Booksellers; >+use t::lib::TestObjects::BiblioFactory; >+use Koha::Biblios; >+use t::lib::TestObjects::ItemFactory; >+use Koha::Items; >+ >+use Koha::Serial::Subscriptions; >+ >+use base qw(t::lib::TestObjects::ObjectFactory); >+ >+sub getDefaultHashKey { >+ return 'internalnotes'; >+} >+ >+=head createTestGroup( $data [, $hashKey, $testContexts...] ) >+ >+ my $subscriptions = t::lib::TestObjects::Serial::SubscriptionFactory->createTestGroup([ >+ { >+ internalnotes => 'MagazineName-CPL-1', #MANDATORY! Used as the hash-key >+ receiveSerials => 3, #DEFAULT undef, receives this many serials using the default values. >+ librarian => 12 || Koha::Borrower, #DEFAULT creates a "Subscription Master" Borrower >+ branchcode => 'CPL', #DEFAULT >+ aqbookseller => 54 || Koha::Acquisition::Bookseller, #DEFAULT creates a 'Bookselling Vendor'. >+ cost => undef, #DEFAULT >+ aqbudgetid => undef, #DEFAULT >+ biblio => 21 || Koha::Biblio, #DEFAULT creates a "Serial magazine" Record >+ startdate => '2015-01-01', #DEFAULTs to 1.1 this year, so the subscription is active by default. >+ periodicity => 7 || Koha::Serial::Subscription::Frequency, #DEFAULTS to a Frequency of 1/month. >+ numberlength => 12, #DEFAULT one year subscription, only one of ['numberlength', 'weeklength', 'monthlength'] is needed >+ weeklength => 52, #DEFAULT one year subscription >+ monthlength => 12, #DEFAULT one year subscription >+ lastvalue1 => 2015, #DEFAULT this year >+ innerloop1 => undef, #DEFAULT >+ lastvalue2 => 1, #DEFAULT >+ innerloop2 => undef, #DEFAULT >+ lastvalue3 => 1, #DEFAULT >+ innerloop3 => undef, #DEFAULT >+ status => 1, #DEFAULT >+ notes => 'Public note', #DEFAULT >+ letter => 'RLIST', #DEFAULT >+ firstacquidate => '2015-01-01', #DEFAULT, same as startdate >+ irregularity => undef, #DEFAULT >+ numberpattern => 2 || Koha::Serial::Numberpattern, #DEFAULT 2, which is 'Volume, Number, Issue' >+ locale => undef, #DEFAULT >+ callnumber => MAG 10.2 AZ, #DEFAULT >+ manualhistory => 0, #DEFAULT >+ serialsadditems => 1, #DEFAULT >+ staffdisplaycount => 20, #DEFAULT >+ opacdisplaycount => 20, #DEFAULT >+ graceperiod => 2, #DEFAULT >+ location => 'DISPLAY', #DEFAULT >+ enddate => undef, #DEFAULT, calculated >+ skip_serialseq => 1, #DEFAULT >+ }, >+ {... >+ }, >+ ], undef, $testContext1, $testContext2, $testContext3); >+ >+ #Do test stuff... >+ >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); >+ >+The HASH is keyed with the given $hashKey or 'koha.subscription.internalnotes' >+We default to internalnotes because there is really no unique identifier >+to describe the created subscription which wouldn't change across different test runs. >+ >+See C4::Serials::NewSubscription() for how the table columns need to be given. >+ >+@PARAM1 ARRAYRef of HASHRefs >+@PARAM2 koha.subscription-column which is used as the test context HASH key, >+@PARAM3-5 HASHRef of test contexts. You can save the given objects to multiple >+ test contexts. Usually one is enough. These test contexts are >+ used to help tear down DB changes. >+@RETURNS HASHRef of $hashKey => $borrower-objects: >+ >+See t::lib::TestObjects::ObjectFactory for more documentation >+=cut >+ >+sub handleTestObject { >+ my ($class, $o, $stashes) = @_; >+ >+ my $subscriptionid; >+ eval { >+ $subscriptionid = C4::Serials::NewSubscription( >+ $o->{librarian}->id, >+ $o->{branchcode}, >+ $o->{aqbookseller}->id, >+ $o->{cost}, >+ $o->{aqbudgetid}, >+ $o->{biblio}->{biblionumber} || $o->{biblio}->biblionumber, >+ $o->{startdate}, >+ $o->{periodicity}, >+ $o->{numberlength}, >+ $o->{weeklength}, >+ $o->{monthlength}, >+ $o->{lastvalue1}, >+ $o->{innerloop1}, >+ $o->{lastvalue2}, >+ $o->{innerloop2}, >+ $o->{lastvalue3}, >+ $o->{innerloop3}, >+ $o->{status}, >+ $o->{notes}, >+ $o->{letter}, >+ $o->{firstacquidate}, >+ $o->{irregularity}, >+ $o->{numberpattern}, >+ $o->{locale}, >+ $o->{callnumber}, >+ $o->{manualhistory}, >+ $o->{internalnotes}, >+ $o->{serialsadditems}, >+ $o->{staffdisplaycount}, >+ $o->{opacdisplaycount}, >+ $o->{graceperiod}, >+ $o->{location}, >+ $o->{enddate}, >+ $o->{skip_serialseq} >+ ); >+ }; >+ if ($@) { >+ die $@; >+ } >+ >+ my $subscription = Koha::Serial::Subscriptions->cast( $subscriptionid ); >+ $subscription->periodicity($o->{periodicity}); >+ $subscription->numberpattern($o->{numberpattern}); >+ >+ $class->receiveDefaultSerials($subscription, $o->{receiveSerials}); >+ >+ return $subscription; >+} >+ >+=head validateAndPopulateDefaultValues >+@OVERLOAD >+ >+Validates given Object parameters and makes sure that critical fields are given >+and populates defaults for missing values. >+=cut >+ >+sub validateAndPopulateDefaultValues { >+ my ($self, $object, $hashKey, $stashes) = @_; >+ >+ if ($object->{librarian}) { >+ $object->{librarian} = Koha::Borrowers->cast($object->{librarian}); >+ } >+ else { >+ $object->{librarian} = t::lib::TestObjects::BorrowerFactory->createTestGroup([ >+ {cardnumber => 'SERIAL420KILLER', >+ firstname => 'Subscription', >+ surname => 'Master'}], undef, @$stashes) >+ ->{SERIAL420KILLER}; >+ } >+ if ($object->{aqbookseller}) { >+ $object->{aqbookseller} = Koha::Acquisition::Booksellers->cast($object->{aqbookseller}); >+ } >+ else { >+ $object->{aqbookseller} = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([ >+ {}], undef, @$stashes) >+ ->{'Bookselling Vendor'}; >+ } >+ if ($object->{biblio}) { >+ $object->{biblio} = Koha::Biblios->cast($object->{biblio}); >+ } >+ else { >+ $object->{biblio} = t::lib::TestObjects::BiblioFactory->createTestGroup([ >+ {'biblio.title' => 'Serial magazine', >+ 'biblio.author' => 'Pertti Kurikka', >+ 'biblio.copyrightdate' => '2015', >+ 'biblioitems.isbn' => 'isbnisnotsocoolnowadays!', >+ 'biblioitems.itemtype' => 'CR', >+ }, >+ ], undef, @$stashes) >+ ->{'isbnisnotsocoolnowadays!'}; >+ } >+ >+ unless ($object->{internalnotes}) { >+ croak __PACKAGE__.":> Mandatory parameter 'internalnotes' missing. This is used as the returning hash-key!"; >+ } >+ $object->{periodicity} = 7 unless $object->{periodicity}; >+ $object->{numberpattern} = 2 unless $object->{numberpattern}; >+ $object->{branchcode} = 'CPL' unless $object->{branchcode}; >+ $object->{cost} = undef unless $object->{cost}; >+ $object->{aqbudgetid} = undef unless $object->{aqbudgetid}; >+ $object->{startdate} = '2015-01-01' unless $object->{startdate}; >+ $object->{numberlength} = undef unless $object->{numberlength}; >+ $object->{weeklength} = undef unless $object->{weeklength} || $object->{numberlength}; >+ $object->{monthlength} = 12 unless $object->{monthlength} || $object->{weeklength} || $object->{numberlength}; >+ $object->{lastvalue1} = 2015 unless $object->{lastvalue1}; >+ $object->{innerloop1} = undef unless $object->{innerloop1}; >+ $object->{lastvalue2} = 1 unless $object->{lastvalue2}; >+ $object->{innerloop2} = undef unless $object->{innerloop2}; >+ $object->{lastvalue3} = 1 unless $object->{lastvalue3}; >+ $object->{innerloop3} = undef unless $object->{innerloop3}; >+ $object->{status} = 1 unless $object->{status}; >+ $object->{notes} = 'Public note' unless $object->{notes}; >+ $object->{letter} = 'RLIST' unless $object->{letter}; >+ $object->{firstacquidate} = '2015-01-01' unless $object->{firstacquidate}; >+ $object->{irregularity} = undef unless $object->{irregularity}; >+ $object->{locale} = undef unless $object->{locale}; >+ $object->{callnumber} = 'MAG 10.2 AZ' unless $object->{callnumber}; >+ $object->{manualhistory} = 0 unless $object->{manualhistory}; >+ $object->{serialsadditems} = 1 unless $object->{serialsadditems}; >+ $object->{staffdisplaycount} = 20 unless $object->{staffdisplaycount}; >+ $object->{opacdisplaycount} = 20 unless $object->{opacdisplaycount}; >+ $object->{graceperiod} = 2 unless $object->{graceperiod}; >+ $object->{location} = 'DISPLAY' unless $object->{location}; >+ $object->{enddate} = undef unless $object->{enddate}; >+ $object->{skip_serialseq} = 1 unless $object->{skip_serialseq}; >+} >+ >+sub receiveDefaultSerials { >+ my ($class, $subscription, $receiveSerials, $stashes) = @_; >+ return unless $receiveSerials; >+ >+ foreach (1..$receiveSerials) { >+ my ($totalIssues, $waitingSerial) = C4::Serials::GetSerials($subscription->subscriptionid); >+ C4::Serials::ModSerialStatus($waitingSerial->{serialid}, >+ $waitingSerial->{serialseq}, >+ Koha::DateUtils::dt_from_string($waitingSerial->{planneddate})->ymd('-'), >+ Koha::DateUtils::dt_from_string($waitingSerial->{publisheddate})->ymd('-'), >+ 2, #Status => 2 == Received >+ $waitingSerial->{notes}, >+ ); >+ my $items = t::lib::TestObjects::ItemFactory->createTestGroup({barcode => $waitingSerial->{serialid}."-".Koha::DateUtils::dt_from_string($waitingSerial->{publisheddate})->ymd('-'), >+ enumchron => $waitingSerial->{serialseq}, >+ biblionumber => $subscription->biblionumber, >+ }, undef, @$stashes); >+ C4::Serials::AddItem2Serial( $waitingSerial->{serialid}, >+ $items->{ shift([values(%$items)])->barcode }->itemnumber, ); #Perl is wonderful :) >+ } >+} >+ >+=head deleteTestGroup >+@OVERLOADED >+ >+ my $records = createTestGroup(); >+ ##Do funky stuff >+ deleteTestGroup($records); >+ >+Removes the given test group from the DB. >+Also removes all attached serialitems and serials >+ >+=cut >+ >+sub deleteTestGroup { >+ my ($self, $objects) = @_; >+ >+ my $schema = Koha::Database->new_schema(); >+ while( my ($key, $object) = each %$objects) { >+ my $subscription = Koha::Serial::Subscriptions->cast($object); >+ eval { >+ my @serials = $schema->resultset('Serial')->search({subscriptionid => $subscription->subscriptionid}); >+ >+ ##Because serialitems-table doesn't have a primery key, resorting to a DBI hack. >+ my $dbh = C4::Context->dbh(); >+ my $sth_delete_serialitems = $dbh->prepare("DELETE FROM serialitems WHERE serialid = ?"); >+ >+ foreach my $s (@serials) { >+ $sth_delete_serialitems->execute($s->serialid); >+ $s->delete(); >+ } >+ $subscription->delete(); >+ }; >+ if ($@) { >+ die $@; >+ } >+ } >+} >+ >+1; >diff --git a/t/lib/TestObjects/SystemPreferenceFactory.pm b/t/lib/TestObjects/SystemPreferenceFactory.pm >new file mode 100644 >index 0000000..8b58eba >--- /dev/null >+++ b/t/lib/TestObjects/SystemPreferenceFactory.pm >@@ -0,0 +1,128 @@ >+package t::lib::TestObjects::SystemPreferenceFactory; >+ >+# Copyright Vaara-kirjastot 2015 >+# >+# This file is part of Koha. >+# >+# Koha is free software; you can redistribute it and/or modify it under the >+# terms of the GNU General Public License as published by the Free Software >+# Foundation; either version 3 of the License, or (at your option) any later >+# version. >+# >+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY >+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR >+# A PARTICULAR PURPOSE. See the GNU General Public License for more details. >+# >+# You should have received a copy of the GNU General Public License along >+# with Koha; if not, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+# >+ >+use Modern::Perl; >+use Carp; >+use Scalar::Util qw(blessed); >+ >+use C4::Members; >+use Koha::Borrowers; >+ >+use base qw(t::lib::TestObjects::ObjectFactory); >+ >+use Koha::Exception::ObjectExists; >+ >+sub new { >+ my ($class) = @_; >+ >+ my $self = {}; >+ bless($self, $class); >+ return $self; >+} >+ >+sub getDefaultHashKey { >+ return 'preference'; >+} >+ >+=head createTestGroup( $data [, $hashKey, $testContexts...] ) >+@OVERLOADED >+ >+ my $preferences = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([ >+ {preference => 'ValidateEmailAddress', >+ value => 1, >+ }, >+ {preference => 'ValidatePhoneNumber', >+ value => 'OFF', >+ }, >+ ], undef, $testContext1, $testContext2, $testContext3); >+ >+ #Do test stuff... >+ >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext1); >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext2); >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext3); >+ >+See t::lib::TestObjects::ObjectFactory for more documentation >+=cut >+ >+sub handleTestObject { >+ my ($class, $pref, $stashes) = @_; >+ >+ my $preference = $pref->{preference}; >+ >+ # Check if preference is already stored, so we wont lose the original preference >+ my $alreadyStored; >+ my $stashablePref = $pref; >+ foreach my $stash (@$stashes) { >+ if (exists $stash->{systempreference}->{$preference}) { >+ $alreadyStored = 1; >+ $stashablePref = $stash->{systempreference}->{$preference}; >+ last(); >+ } >+ } >+ $stashablePref->{old_value} = C4::Context->preference($pref->{preference}) unless ($alreadyStored); >+ >+ C4::Context->set_preference($pref->{preference}, $pref->{value}); >+ >+ $stashablePref->{value} = $pref->{value}; >+ >+ return $stashablePref; >+} >+ >+=head validateAndPopulateDefaultValues >+@OVERLOAD >+ >+Validates given Object parameters and makes sure that critical fields are given >+and populates defaults for missing values. >+=cut >+ >+sub validateAndPopulateDefaultValues { >+ my ($class, $preference, $hashKey) = @_; >+ $class->SUPER::validateAndPopulateDefaultValues($preference, $hashKey); >+ >+ if (not(defined(C4::Context->preference($preference->{preference})))) { >+ croak __PACKAGE__.":> Preference '".$preference->{preference}."' not found."; >+ next; >+ } >+ unless (exists($preference->{value})) { >+ croak __PACKAGE__.":> Mandatory parameter 'value' not found."; >+ } >+} >+ >+=head deleteTestGroup >+@OVERLOADED >+ >+ my $records = createTestGroup(); >+ ##Do funky stuff >+ deleteTestGroup($prefs); >+ >+Removes the given test group from the DB. >+ >+=cut >+ >+sub deleteTestGroup { >+ my ($class, $preferences) = @_; >+ >+ while( my ($key, $pref) = each %$preferences) { >+ C4::Context->set_preference($pref->{preference}, $pref->{old_value}); >+ } >+} >+ >+1; >diff --git a/t/lib/TestObjects/objectFactories.t b/t/lib/TestObjects/objectFactories.t >new file mode 100644 >index 0000000..62646db >--- /dev/null >+++ b/t/lib/TestObjects/objectFactories.t >@@ -0,0 +1,478 @@ >+#!/usr/bin/perl >+ >+# Copyright Vaara-kirjastot 2015 >+# >+# This file is part of Koha. >+# >+# Koha is free software; you can redistribute it and/or modify it under the >+# terms of the GNU General Public License as published by the Free Software >+# Foundation; either version 3 of the License, or (at your option) any later >+# version. >+# >+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY >+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR >+# A PARTICULAR PURPOSE. See the GNU General Public License for more details. >+# >+# You should have received a copy of the GNU General Public License along >+# with Koha; if not, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+# >+ >+use Modern::Perl; >+ >+use Test::More; >+use DateTime; >+ >+use Koha::DateUtils; >+ >+use t::lib::TestObjects::ObjectFactory; >+use t::lib::TestObjects::BorrowerFactory; >+use Koha::Borrowers; >+use t::lib::TestObjects::ItemFactory; >+use Koha::Items; >+use t::lib::TestObjects::BiblioFactory; >+use Koha::Biblios; >+use t::lib::TestObjects::CheckoutFactory; >+use Koha::Checkouts; >+use t::lib::TestObjects::LetterTemplateFactory; >+use Koha::LetterTemplates; >+use t::lib::TestObjects::Acquisition::Bookseller::ContactFactory; >+use Koha::Acquisition::Bookseller::Contacts; >+use t::lib::TestObjects::Acquisition::BooksellerFactory; >+use Koha::Acquisition::Booksellers; >+use t::lib::TestObjects::Serial::SubscriptionFactory; >+use Koha::Serial::Subscriptions; >+use Koha::Serial::Subscription::Frequencies; >+use Koha::Serial::Subscription::Numberpatterns; >+use Koha::Serial::Serials; >+use t::lib::TestObjects::SystemPreferenceFactory; >+use C4::Context; >+ >+ >+my $testContext = {}; #Gather all created Objects here so we can finally remove them all. >+ >+ >+ >+########## Serial subtests ########## >+subtest 't::lib::TestObjects::Serial' => sub { >+ my ($subscriptions, $subscription, $frequency, $numberpattern, $biblio, $borrower, $bookseller, $items, $serials); >+ my $subtestContext = {}; >+ my $dontDeleteTestContext = {}; >+ ##Create and delete >+ $subscriptions = t::lib::TestObjects::Serial::SubscriptionFactory->createTestGroup([ >+ {internalnotes => 'TESTDEFAULTS', >+ receiveSerials => 3}, >+ ], undef, $subtestContext); >+ $subscription = Koha::Serial::Subscriptions->find( $subscriptions->{'TESTDEFAULTS'}->subscriptionid ); >+ $frequency = $subscription->periodicity(); >+ $numberpattern = $subscription->numberpattern(); >+ $biblio = $subscription->biblio(); >+ $borrower = $subscription->borrower(); >+ $bookseller = $subscription->bookseller(); >+ $items = $subscription->items(); >+ $serials = $subscription->serials(); >+ ok(($subscriptions->{'TESTDEFAULTS'}->callnumber eq $subscription->callnumber && >+ $subscriptions->{'TESTDEFAULTS'}->subscriptionid eq $subscription->subscriptionid), >+ "Default Subscription created."); >+ ok($subscriptions->{'TESTDEFAULTS'}->numberpattern->label eq $numberpattern->label, >+ "Default Numberpattern '".$numberpattern->label."' used."); >+ ok($subscriptions->{'TESTDEFAULTS'}->periodicity->description eq $frequency->description, >+ "Default Periodicity '".$frequency->description."' used."); >+ ok($subscriptions->{'TESTDEFAULTS'}->biblio->title eq $biblio->title, >+ "Default Biblio '".$biblio->title."' created."); >+ ok($subscriptions->{'TESTDEFAULTS'}->bookseller->name eq $bookseller->name, >+ "Default Bookseller '".$bookseller->name."' created."); >+ ok($serials->[0]->isa('Koha::Serial::Serial') && $serials->[0]->serialseq eq 'Vol. 2015, Number 1, Issue 1' && >+ $serials->[1]->isa('Koha::Serial::Serial') && $serials->[1]->serialseq eq 'Vol. 2015, Number 1, Issue 2' && >+ $serials->[2]->isa('Koha::Serial::Serial') && $serials->[2]->serialseq eq 'Vol. 2015, Number 1, Issue 3' && >+ $serials->[3]->isa('Koha::Serial::Serial') && $serials->[3]->serialseq eq 'Vol. 2015, Number 1, Issue 4' >+ , "Got 4 default Serials"); >+ ok($items->[0]->isa('Koha::Item') && $items->[0]->enumchron eq 'Vol. 2015, Number 1, Issue 1' && >+ $items->[1]->isa('Koha::Item') && $items->[1]->enumchron eq 'Vol. 2015, Number 1, Issue 2' && >+ $items->[2]->isa('Koha::Item') && $items->[2]->enumchron eq 'Vol. 2015, Number 1, Issue 3' >+ , "Received 3 default Serial Items"); >+ >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); >+ $subscription = Koha::Serial::Subscriptions->find( $subscriptions->{'TESTDEFAULTS'}->subscriptionid ); >+ ok(not(defined($subscription)), "Default Subscription deleted."); >+ $biblio = Koha::Biblios->find( $biblio->id ); >+ ok(not(defined($biblio)), "Default Biblio deleted."); >+ $borrower = Koha::Borrowers->find( $borrower->id ); >+ ok(not(defined($borrower)), "Default Borrower deleted."); >+ $bookseller = Koha::Acquisition::Booksellers->find( $bookseller->id ); >+ ok(not(defined($bookseller)), "Default Bookseller deleted."); >+ $frequency = Koha::Serial::Subscription::Frequencies->find( $frequency->id ); >+ ok($frequency, "Attached Frequency not deleted."); >+ $numberpattern = Koha::Serial::Subscription::Numberpatterns->find( $numberpattern->id ); >+ ok($numberpattern, "Attached Numbering Pattern not deleted."); >+ $serials = [Koha::Serial::Serials->search({ subscriptionid => $serials->[0]->subscriptionid})]; >+ $items = [Koha::Items->search({"-or" => [{itemnumber => $items->[0]->itemnumber}, >+ {itemnumber => $items->[1]->itemnumber}, >+ {itemnumber => $items->[2]->itemnumber}, >+ ]})]; >+ ok(not($serials->[0] && >+ $serials->[1] && >+ $serials->[2] && >+ $serials->[3]) >+ , "4 default Serials deleted."); >+ ok(not($items->[0] && >+ $items->[1] && >+ $items->[2]) >+ , "3 default Serial Items deleted"); >+ >+ ### TESTING NOT DELETING A GIVEN BIBLIO OR BORROWER ### >+ my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([ >+ {'biblio.title' => 'I wish I met your mother', >+ 'biblio.author' => 'Pertti Kurikka', >+ 'biblio.copyrightdate' => '1960', >+ 'biblioitems.isbn' => '9519671580', >+ 'biblioitems.itemtype' => 'BK', >+ }, >+ ], 'biblioitems.isbn', $dontDeleteTestContext); >+ my $borrowers = t::lib::TestObjects::BorrowerFactory->createTestGroup([ >+ {firstname => 'Olli-Antti', >+ surname => 'Kivi', >+ cardnumber => '11A001', >+ branchcode => 'CPL', >+ }, >+ ], undef, $dontDeleteTestContext); >+ my $booksellers = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([{ >+ name => "Undeletable Magazine vendor"}], >+ undef, $dontDeleteTestContext); >+ $subscriptions = t::lib::TestObjects::Serial::SubscriptionFactory->createTestGroup([ >+ {internalnotes => 'TESTDEFAULTS', >+ biblio => $biblios->{'9519671580'}->{biblionumber}, >+ librarian => $borrowers->{'11A001'}, >+ aqbookseller => $booksellers->{"Undeletable Magazine vendor"}, >+ }, >+ ], undef, $subtestContext); >+ $subscription = Koha::Serial::Subscriptions->find( $subscriptions->{'TESTDEFAULTS'}->subscriptionid ); >+ $biblio = $subscription->biblio(); >+ $borrower = $subscription->borrower(); >+ $bookseller = $subscription->bookseller(); >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); >+ $biblio = Koha::Biblios->find( $biblio->id ); >+ ok(defined($biblio), "Attached Biblio not deleted."); >+ $borrower = Koha::Borrowers->find( $borrower->id ); >+ ok(defined($borrower), "Attached Borrower not deleted."); >+ $bookseller = Koha::Acquisition::Booksellers->find( $bookseller->id ); >+ ok(defined($bookseller), "Attached Bookseller not deleted."); >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($dontDeleteTestContext); >+}; >+ >+ >+ >+########## Acquisition subtests ########## >+subtest 't::lib::TestObjects::Acquisition' => sub { >+ my ($booksellers, $bookseller, $contacts, $contact); >+ my $subtestContext = {}; >+ ##Create and delete >+ $booksellers = t::lib::TestObjects::Acquisition::BooksellerFactory->createTestGroup([{}], undef, $subtestContext); >+ $bookseller = Koha::Acquisition::Booksellers->find({name => 'Bookselling Vendor'}); >+ $contact = Koha::Acquisition::Bookseller::Contacts->find({name => 'Julius Augustus Caesar'}); >+ ok(($booksellers->{'Bookselling Vendor'}->name eq 'Bookselling Vendor' && >+ $bookseller->name eq 'Bookselling Vendor'), >+ "Default Bookseller 'Bookselling Vendor' created."); >+ ok(($booksellers->{'Bookselling Vendor'}->{contacts}->{'Julius Augustus Caesar'}->name eq 'Julius Augustus Caesar' && >+ $contact->name eq 'Julius Augustus Caesar'), >+ "Default Contact 'Julius Augustus Caesar' created."); >+ >+ $contacts = t::lib::TestObjects::Acquisition::Bookseller::ContactFactory->createTestGroup([ >+ {name => 'Hippocrates', >+ booksellerid => $booksellers->{'Bookselling Vendor'}->id}] >+ , undef, $subtestContext); >+ $contact = Koha::Acquisition::Bookseller::Contacts->find({name => 'Hippocrates'}); >+ ok(($contacts->{'Hippocrates'}->name, 'Hippocrates' && >+ $contact->name eq 'Hippocrates'), >+ "Contact 'Hippocrates' created."); >+ >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); >+ $contact = Koha::Acquisition::Bookseller::Contacts->find({name => 'Julius Augustus Caesar'}); >+ ok(not(defined($contact)), "Contact 'Julius Augustus Caesar' deleted."); >+ $contact = Koha::Acquisition::Bookseller::Contacts->find({name => 'Hippocrates'}); >+ ok(not(defined($contact)), "Contact 'Hippocrates' deleted."); >+ $bookseller = Koha::Acquisition::Booksellers->find({name => 'Bookselling Vendor'}); >+ ok(not(defined($bookseller)), "Bookseller 'Bookselling Vendor' deleted."); >+}; >+ >+ >+ >+########## BorrowerFactory subtests ########## >+subtest 't::lib::TestObjects::BorrowerFactory' => sub { >+ my $subtestContext = {}; >+ ##Create and Delete. Add one >+ my $f = t::lib::TestObjects::BorrowerFactory->new(); >+ my $objects = $f->createTestGroup([ >+ {firstname => 'Olli-Antti', >+ surname => 'Kivi', >+ cardnumber => '11A001', >+ branchcode => 'CPL', >+ }, >+ ], undef, $subtestContext, undef, $testContext); >+ is($objects->{'11A001'}->cardnumber, '11A001', "Borrower '11A001'."); >+ ##Add one more to test incrementing the subtestContext. >+ $objects = $f->createTestGroup([ >+ {firstname => 'Olli-Antti2', >+ surname => 'Kivi2', >+ cardnumber => '11A002', >+ branchcode => 'FFL', >+ }, >+ ], undef, $subtestContext, undef, $testContext); >+ is($subtestContext->{borrower}->{'11A001'}->cardnumber, '11A001', "Borrower '11A001' from \$subtestContext."); #From subtestContext >+ is($objects->{'11A002'}->branchcode, 'FFL', "Borrower '11A002'."); #from just created hash. >+ >+ ##Delete objects >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); >+ my $object11A001 = Koha::Borrowers->find({cardnumber => '11A001'}); >+ ok (not($object11A001), "Borrower '11A001' deleted"); >+ my $object11A002 = Koha::Borrowers->find({cardnumber => '11A002'}); >+ ok (not($object11A002), "Borrower '11A002' deleted"); >+ >+ #Prepare for global autoremoval. >+ $objects = $f->createTestGroup([ >+ {firstname => 'Olli-Antti', >+ surname => 'Kivi', >+ cardnumber => '11A001', >+ branchcode => 'CPL', >+ }, >+ {firstname => 'Olli-Antti2', >+ surname => 'Kivi2', >+ cardnumber => '11A002', >+ branchcode => 'FFL', >+ }, >+ ], undef, undef, undef, $testContext); >+}; >+ >+ >+ >+########## BiblioFactory and ItemFactory subtests ########## >+subtest 't::lib::TestObjects::BiblioFactory and ::ItemFactory' => sub { >+ my $subtestContext = {}; >+ ##Create and Delete. Add one >+ my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([ >+ {'biblio.title' => 'I wish I met your mother', >+ 'biblio.author' => 'Pertti Kurikka', >+ 'biblio.copyrightdate' => '1960', >+ 'biblioitems.isbn' => '9519671580', >+ 'biblioitems.itemtype' => 'BK', >+ }, >+ ], 'biblioitems.isbn', $subtestContext, undef, $testContext); >+ my $objects = t::lib::TestObjects::ItemFactory->createTestGroup([ >+ {biblionumber => $biblios->{9519671580}->{biblionumber}, >+ barcode => '167Nabe0001', >+ homebranch => 'CPL', >+ holdingbranch => 'CPL', >+ price => '0.50', >+ replacementprice => '0.50', >+ itype => 'BK', >+ biblioisbn => '9519671580', >+ itemcallnumber => 'PK 84.2', >+ }, >+ ], 'barcode', $subtestContext, undef, $testContext); >+ >+ is($objects->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001'."); >+ ##Add one more to test incrementing the subtestContext. >+ $objects = t::lib::TestObjects::ItemFactory->createTestGroup([ >+ {biblionumber => $biblios->{9519671580}->{biblionumber}, >+ barcode => '167Nabe0002', >+ homebranch => 'CPL', >+ holdingbranch => 'FFL', >+ price => '3.50', >+ replacementprice => '3.50', >+ itype => 'BK', >+ biblioisbn => '9519671580', >+ itemcallnumber => 'JK 84.2', >+ }, >+ ], 'barcode', $subtestContext, undef, $testContext); >+ >+ is($subtestContext->{item}->{'167Nabe0001'}->barcode, '167Nabe0001', "Item '167Nabe0001' from \$subtestContext."); >+ is($objects->{'167Nabe0002'}->holdingbranch, 'FFL', "Item '167Nabe0002'."); >+ is(ref($biblios->{9519671580}), 'MARC::Record', "Biblio 'I wish I met your mother'."); >+ >+ ##Delete objects >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); >+ my $object1 = Koha::Items->find({barcode => '167Nabe0001'}); >+ ok (not($object1), "Item '167Nabe0001' deleted"); >+ my $object2 = Koha::Items->find({barcode => '167Nabe0002'}); >+ ok (not($object2), "Item '167Nabe0002' deleted"); >+ my $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"}); >+ ok (not($object2), "Biblio 'I wish I met your mother' deleted"); >+}; >+ >+ >+ >+########## CheckoutFactory subtests ########## >+subtest 't::lib::TestObjects::CheckoutFactory' => sub { >+ my $subtestContext = {}; >+ ##Create and Delete using dependencies in the $testContext instantiated in previous subtests. >+ my $biblios = t::lib::TestObjects::BiblioFactory->createTestGroup([ >+ {'biblio.title' => 'I wish I met your mother', >+ 'biblio.author' => 'Pertti Kurikka', >+ 'biblio.copyrightdate' => '1960', >+ 'biblioitems.isbn' => '9519671580', >+ 'biblioitems.itemtype' => 'BK', >+ }, >+ ], 'biblioitems.isbn', undef, undef, $subtestContext); >+ my $items = t::lib::TestObjects::ItemFactory->createTestGroup([ >+ {biblionumber => $biblios->{9519671580}->{biblionumber}, >+ barcode => '167Nabe0001', >+ homebranch => 'CPL', >+ holdingbranch => 'CPL', >+ price => '0.50', >+ replacementprice => '0.50', >+ itype => 'BK', >+ biblioisbn => '9519671580', >+ itemcallnumber => 'PK 84.2', >+ }, >+ {biblionumber => $biblios->{9519671580}->{biblionumber}, >+ barcode => '167Nabe0002', >+ homebranch => 'CPL', >+ holdingbranch => 'FFL', >+ price => '3.50', >+ replacementprice => '3.50', >+ itype => 'BK', >+ biblioisbn => '9519671580', >+ itemcallnumber => 'JK 84.2', >+ }, >+ ], 'barcode', undef, undef, $subtestContext); >+ my $objects = t::lib::TestObjects::CheckoutFactory->createTestGroup([ >+ { >+ cardnumber => '11A001', >+ barcode => '167Nabe0001', >+ daysOverdue => 7, >+ daysAgoCheckedout => 28, >+ }, >+ { >+ cardnumber => '11A002', >+ barcode => '167Nabe0002', >+ daysOverdue => -7, >+ daysAgoCheckedout => 14, >+ checkoutBranchRule => 'holdingbranch', >+ }, >+ ], undef, undef, undef, undef); >+ >+ is($objects->{'11A001-167Nabe0001'}->branchcode, >+ 'CPL', >+ "Checkout '11A001-167Nabe0001' checked out from the default context branch 'CPL'."); >+ is($objects->{'11A002-167Nabe0002'}->branchcode, >+ 'FFL', >+ "Checkout '11A002-167Nabe0002' checked out from the holdingbranch 'FFL'."); >+ is(Koha::DateUtils::dt_from_string($objects->{'11A001-167Nabe0001'}->issuedate)->day(), >+ DateTime->now(time_zone => C4::Context->tz())->subtract(days => '28')->day() >+ , "Checkout '11A001-167Nabe0001', adjusted issuedates match."); >+ is(Koha::DateUtils::dt_from_string($objects->{'11A002-167Nabe0002'}->date_due)->day(), >+ DateTime->now(time_zone => C4::Context->tz())->subtract(days => '-7')->day() >+ , "Checkout '11A002-167Nabe0002', adjusted date_dues match."); >+ >+ t::lib::TestObjects::CheckoutFactory->deleteTestGroup($objects); >+ my $object1 = Koha::Checkouts->find({borrowernumber => $objects->{'11A001-167Nabe0001'}->borrowernumber, >+ itemnumber => $objects->{'11A001-167Nabe0001'}->itemnumber}); >+ ok (not($object1), "Checkout '11A001-167Nabe0001' deleted"); >+ my $object2 = Koha::Checkouts->find({borrowernumber => $objects->{'11A002-167Nabe0002'}->borrowernumber, >+ itemnumber => $objects->{'11A002-167Nabe0002'}->itemnumber}); >+ ok (not($object2), "Checkout '11A002-167Nabe0002' deleted"); >+}; >+ >+ >+ >+########## LetterTemplateFactory subtests ########## >+subtest 't::lib::TestObjects::LetterTemplateFactory' => sub { >+ my $subtestContext = {}; >+ ##Create and Delete using dependencies in the $testContext instantiated in previous subtests. >+ my $f = t::lib::TestObjects::LetterTemplateFactory->new(); >+ my $hashLT = {letter_id => 'circulation-ODUE1-CPL-print', >+ module => 'circulation', >+ code => 'ODUE1', >+ branchcode => 'CPL', >+ name => 'Notice1', >+ is_html => undef, >+ title => 'Notice1', >+ message_transport_type => 'print', >+ content => '<item>Barcode: <<items.barcode>>, bring it back!</item>', >+ }; >+ my $objects = $f->createTestGroup([ >+ $hashLT, >+ ], undef, undef, undef, undef); >+ >+ my $letterTemplate = Koha::LetterTemplates->find($hashLT); >+ is($objects->{'circulation-ODUE1-CPL-print'}->name, $letterTemplate->name, "LetterTemplate 'circulation-ODUE1-CPL-print'"); >+ >+ #Delete them >+ $f->deleteTestGroup($objects); >+ $letterTemplate = Koha::LetterTemplates->find($hashLT); >+ ok(not(defined($letterTemplate)), "LetterTemplate 'circulation-ODUE1-CPL-print' deleted"); >+}; >+ >+ >+ >+########## SystemPreferenceFactory subtests ########## >+subtest 't::lib::TestObjects::SystemPreferenceFactory' => sub { >+ my $subtestContext = {}; >+ >+ # take syspref 'opacuserlogin' and save its current value >+ my $current_pref_value = C4::Context->preference("opacuserlogin"); >+ >+ is($current_pref_value, $current_pref_value, "System Preference 'opacuserlogin' original value '".(($current_pref_value) ? $current_pref_value : 0)."'"); >+ >+ # reverse the value for testing >+ my $pref_new_value = !$current_pref_value; >+ >+ >+ my $objects = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([ >+ {preference => 'opacuserlogin', >+ value => $pref_new_value # set the reversed value >+ }, >+ ], undef, $subtestContext, undef, undef); >+ >+ is(C4::Context->preference("opacuserlogin"), $pref_new_value, "System Preference opacuserlogin reversed to '".(($pref_new_value) ? $pref_new_value:0)."'"); >+ >+ # let's change it again to test that only the original preference value is saved >+ $objects = t::lib::TestObjects::SystemPreferenceFactory->createTestGroup([ >+ {preference => 'opacuserlogin', >+ value => 2 # set the reversed value >+ }, >+ ], undef, $subtestContext, undef, undef); >+ >+ is(C4::Context->preference("opacuserlogin"), 2, "System Preference opacuserlogin set to '2'"); >+ >+ #Delete them >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($subtestContext); >+ is(C4::Context->preference("opacuserlogin"), $current_pref_value, "System Preference opacuserlogin restored to '".(($current_pref_value) ? $current_pref_value:0)."' after test group deletion"); >+}; >+ >+ >+ >+########## Global test context subtests ########## >+subtest 't::lib::TestObjects::ObjectFactory clearing global test context' => sub { >+ my $object11A001 = Koha::Borrowers->find({cardnumber => '11A001'}); >+ ok ($object11A001, "Global Borrower '11A001' exists"); >+ my $object11A002 = Koha::Borrowers->find({cardnumber => '11A002'}); >+ ok ($object11A002, "Global Borrower '11A002' exists"); >+ >+ my $object1 = Koha::Items->find({barcode => '167Nabe0001'}); >+ ok ($object1, "Global Item '167Nabe0001' exists"); >+ my $object2 = Koha::Items->find({barcode => '167Nabe0002'}); >+ ok ($object2, "Global Item '167Nabe0002' exists"); >+ my $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"}); >+ ok ($object2, "Global Biblio 'I wish I met your mother' exists"); >+ >+ t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext); >+ >+ $object11A001 = Koha::Borrowers->find({cardnumber => '11A001'}); >+ ok (not($object11A001), "Global Borrower '11A001' deleted"); >+ $object11A002 = Koha::Borrowers->find({cardnumber => '11A002'}); >+ ok (not($object11A002), "Global Borrower '11A002' deleted"); >+ >+ $object1 = Koha::Items->find({barcode => '167Nabe0001'}); >+ ok (not($object1), "Global Item '167Nabe0001' deleted"); >+ $object2 = Koha::Items->find({barcode => '167Nabe0002'}); >+ ok (not($object2), "Global Item '167Nabe0002' deleted"); >+ $object3 = Koha::Biblios->find({title => 'I wish I met your mother', author => "Pertti Kurikka"}); >+ ok (not($object2), "Global Biblio 'I wish I met your mother' deleted"); >+}; >+ >+ >+ >+done_testing(); >+ >+1; >-- >1.9.1
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