3 # This file is part of Koha.
5 # Koha is free software; you can redistribute it and/or modify it
6 # under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 3 of the License, or
8 # (at your option) any later version.
10 # Koha is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
20 use Test
::More tests
=> 5;
25 use t
::lib
::TestBuilder
;
32 use Koha
::Account
::Lines
;
40 # Mock userenv, used by AddIssue
42 my $context = Test
::MockModule
->new('C4::Context');
43 $context->mock( 'userenv', sub {
44 return { branch
=> $branch }
47 my $schema = Koha
::Database
->schema;
48 $schema->storage->txn_begin;
50 my $builder = t
::lib
::TestBuilder
->new();
51 Koha
::IssuingRules
->search->delete;
52 my $rule = Koha
::IssuingRule
->new(
62 subtest
"InProcessingToShelvingCart tests" => sub {
66 $branch = $builder->build({ source
=> 'Branch' })->{ branchcode
};
67 my $permanent_location = 'TEST';
68 my $location = 'PROC';
70 # Create a biblio record with biblio-level itemtype
71 my $record = MARC
::Record
->new();
72 my ( $biblionumber, $biblioitemnumber ) = AddBiblio
( $record, '' );
73 my $built_item = $builder->build({
76 biblionumber
=> $biblionumber,
77 homebranch
=> $branch,
78 holdingbranch
=> $branch,
79 location
=> $location,
80 permanent_location
=> $permanent_location
83 my $barcode = $built_item->{ barcode
};
84 my $itemnumber = $built_item->{ itemnumber
};
87 t
::lib
::Mocks
::mock_preference
( "InProcessingToShelvingCart", 1 );
88 AddReturn
( $barcode, $branch );
89 $item = Koha
::Items
->find( $itemnumber );
90 is
( $item->location, 'CART',
91 "InProcessingToShelvingCart functions as intended" );
93 ModItem
( {location
=> $location}, undef, $itemnumber );
95 t
::lib
::Mocks
::mock_preference
( "InProcessingToShelvingCart", 0 );
96 AddReturn
( $barcode, $branch );
97 $item = Koha
::Items
->find( $itemnumber );
98 is
( $item->location, $permanent_location,
99 "InProcessingToShelvingCart functions as intended" );
103 subtest
"AddReturn logging on statistics table (item-level_itypes=1)" => sub {
107 # Set item-level item types
108 t
::lib
::Mocks
::mock_preference
( "item-level_itypes", 1 );
110 # Make sure logging is enabled
111 t
::lib
::Mocks
::mock_preference
( "IssueLog", 1 );
112 t
::lib
::Mocks
::mock_preference
( "ReturnLog", 1 );
114 # Create an itemtype for biblio-level item type
115 my $blevel_itemtype = $builder->build({ source
=> 'Itemtype' })->{ itemtype
};
116 # Create an itemtype for item-level item type
117 my $ilevel_itemtype = $builder->build({ source
=> 'Itemtype' })->{ itemtype
};
119 $branch = $builder->build({ source
=> 'Branch' })->{ branchcode
};
121 my $borrowernumber = $builder->build({
122 source
=> 'Borrower',
123 value
=> { branchcode
=> $branch }
124 })->{ borrowernumber
};
125 # Look for the defined MARC field for biblio-level itemtype
126 my $rs = $schema->resultset('MarcSubfieldStructure')->search({
128 kohafield
=> 'biblioitems.itemtype'
130 my $tagfield = $rs->first->tagfield;
131 my $tagsubfield = $rs->first->tagsubfield;
133 # Create a biblio record with biblio-level itemtype
134 my $record = MARC
::Record
->new();
135 $record->append_fields(
136 MARC
::Field
->new($tagfield,'','', $tagsubfield => $blevel_itemtype )
138 my ( $biblionumber, $biblioitemnumber ) = AddBiblio
( $record, '' );
139 my $item_with_itemtype = $builder->build(
143 biblionumber
=> $biblionumber,
144 biblioitemnumber
=> $biblioitemnumber,
145 homebranch
=> $branch,
146 holdingbranch
=> $branch,
147 itype
=> $ilevel_itemtype
151 my $item_without_itemtype = $builder->build(
155 biblionumber
=> $biblionumber,
156 biblioitemnumber
=> $biblioitemnumber,
157 homebranch
=> $branch,
158 holdingbranch
=> $branch,
164 my $borrower = Koha
::Patrons
->find( $borrowernumber )->unblessed;
165 AddIssue
( $borrower, $item_with_itemtype->{ barcode
} );
166 AddReturn
( $item_with_itemtype->{ barcode
}, $branch );
167 # Test item-level itemtype was recorded on the 'statistics' table
168 my $stat = $schema->resultset('Statistic')->search({
171 itemnumber
=> $item_with_itemtype->{ itemnumber
}
172 }, { order_by
=> { -asc
=> 'datetime' } })->next();
174 is
( $stat->itemtype, $ilevel_itemtype,
175 "item-level itype recorded on statistics for return");
176 warning_like
{ AddIssue
( $borrower, $item_without_itemtype->{ barcode
} ) }
177 [qr/^item-level_itypes set but no itemtype set for item/,
178 qr/^item-level_itypes set but no itemtype set for item/,
179 qr/^item-level_itypes set but no itemtype set for item/,
180 qr/^item-level_itypes set but no itemtype set for item/],
181 'Item without itemtype set raises warning on AddIssue';
182 warning_like
{ AddReturn
( $item_without_itemtype->{ barcode
}, $branch ) }
183 qr/^item-level_itypes set but no itemtype set for item/,
184 'Item without itemtype set raises warning on AddReturn';
185 # Test biblio-level itemtype was recorded on the 'statistics' table
186 $stat = $schema->resultset('Statistic')->search({
189 itemnumber
=> $item_without_itemtype->{ itemnumber
}
190 }, { order_by
=> { -asc
=> 'datetime' } })->next();
192 is
( $stat->itemtype, $blevel_itemtype,
193 "biblio-level itype recorded on statistics for return as a fallback for null item-level itype");
197 subtest
"AddReturn logging on statistics table (item-level_itypes=0)" => sub {
201 # Make sure logging is enabled
202 t
::lib
::Mocks
::mock_preference
( "IssueLog", 1 );
203 t
::lib
::Mocks
::mock_preference
( "ReturnLog", 1 );
205 # Set biblio level item types
206 t
::lib
::Mocks
::mock_preference
( "item-level_itypes", 0 );
208 # Create an itemtype for biblio-level item type
209 my $blevel_itemtype = $builder->build({ source
=> 'Itemtype' })->{ itemtype
};
210 # Create an itemtype for item-level item type
211 my $ilevel_itemtype = $builder->build({ source
=> 'Itemtype' })->{ itemtype
};
213 $branch = $builder->build({ source
=> 'Branch' })->{ branchcode
};
215 my $borrowernumber = $builder->build({
216 source
=> 'Borrower',
217 value
=> { branchcode
=> $branch }
218 })->{ borrowernumber
};
219 # Look for the defined MARC field for biblio-level itemtype
220 my $rs = $schema->resultset('MarcSubfieldStructure')->search({
222 kohafield
=> 'biblioitems.itemtype'
224 my $tagfield = $rs->first->tagfield;
225 my $tagsubfield = $rs->first->tagsubfield;
227 # Create a biblio record with biblio-level itemtype
228 my $record = MARC
::Record
->new();
229 $record->append_fields(
230 MARC
::Field
->new($tagfield,'','', $tagsubfield => $blevel_itemtype )
232 my ( $biblionumber, $biblioitemnumber ) = AddBiblio
( $record, '' );
233 my $item_with_itemtype = $builder->build({
236 biblionumber
=> $biblionumber,
237 biblioitemnumber
=> $biblioitemnumber,
238 homebranch
=> $branch,
239 holdingbranch
=> $branch,
240 itype
=> $ilevel_itemtype
243 my $item_without_itemtype = $builder->build({
246 biblionumber
=> $biblionumber,
247 biblioitemnumber
=> $biblioitemnumber,
248 homebranch
=> $branch,
249 holdingbranch
=> $branch,
254 my $borrower = Koha
::Patrons
->find( $borrowernumber )->unblessed;
256 AddIssue
( $borrower, $item_with_itemtype->{ barcode
} );
257 AddReturn
( $item_with_itemtype->{ barcode
}, $branch );
258 # Test item-level itemtype was recorded on the 'statistics' table
259 my $stat = $schema->resultset('Statistic')->search({
262 itemnumber
=> $item_with_itemtype->{ itemnumber
}
263 }, { order_by
=> { -asc
=> 'datetime' } })->next();
265 is
( $stat->itemtype, $blevel_itemtype,
266 "biblio-level itype recorded on statistics for return");
268 AddIssue
( $borrower, $item_without_itemtype->{ barcode
} );
269 AddReturn
( $item_without_itemtype->{ barcode
}, $branch );
270 # Test biblio-level itemtype was recorded on the 'statistics' table
271 $stat = $schema->resultset('Statistic')->search({
274 itemnumber
=> $item_without_itemtype->{ itemnumber
}
275 }, { order_by
=> { -asc
=> 'datetime' } })->next();
277 is
( $stat->itemtype, $blevel_itemtype,
278 "biblio-level itype recorded on statistics for return");
281 subtest
'Handle ids duplication' => sub {
284 t
::lib
::Mocks
::mock_preference
( 'item-level_itypes', 1 );
285 t
::lib
::Mocks
::mock_preference
( 'CalculateFinesOnReturn', 1 );
286 t
::lib
::Mocks
::mock_preference
( 'finesMode', 'production' );
287 Koha
::IssuingRules
->search->update({ chargeperiod
=> 1, fine
=> 1, firstremind
=> 1, });
289 my $biblio = $builder->build( { source
=> 'Biblio' } );
290 my $itemtype = $builder->build( { source
=> 'Itemtype', value
=> { rentalcharge
=> 5 } } );
291 my $item = $builder->build(
295 biblionumber
=> $biblio->{biblionumber
},
299 itype
=> $itemtype->{itemtype
},
303 my $patron = $builder->build({source
=> 'Borrower'});
304 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
306 my $original_checkout = AddIssue
( $patron->unblessed, $item->{barcode
}, dt_from_string
->subtract( days
=> 50 ) );
307 my $issue_id = $original_checkout->issue_id;
308 my $account_lines = Koha
::Account
::Lines
->search({ borrowernumber
=> $patron->borrowernumber, issue_id
=> $issue_id });
309 is
( $account_lines->count, 1, '1 account line should exist for this issue_id' );
310 is
( $account_lines->next->description, 'Rental', 'patron has been charged the rentalcharge' );
311 $account_lines->delete;
313 # Create an existing entry in old_issue
314 $builder->build({ source
=> 'OldIssue', value
=> { issue_id
=> $issue_id } });
316 my $old_checkout = Koha
::Old
::Checkouts
->find( $issue_id );
318 my ($doreturn, $messages, $new_checkout, $borrower);
320 ( $doreturn, $messages, $new_checkout, $borrower ) =
321 AddReturn
( $item->{barcode
}, undef, undef, undef, dt_from_string
);
324 qr{.*DBD::mysql::st execute failed: Duplicate entry.*},
325 { carped
=> qr{The checkin for the following issue failed.*Duplicate ID.*} }
327 'DBD should have raised an error about dup primary key';
329 is
( $doreturn, 0, 'Return should not have been done' );
330 is
( $messages->{WasReturned
}, 0, 'messages should have the WasReturned flag set to 0' );
331 is
( $messages->{DataCorrupted
}, 1, 'messages should have the DataCorrupted flag set to 1' );
333 $account_lines = Koha
::Account
::Lines
->search({ borrowernumber
=> $patron->borrowernumber, issue_id
=> $issue_id });
334 is
( $account_lines->count, 0, 'No account lines should exist for this issue_id, patron should not have been charged' );
336 is
( Koha
::Checkouts
->find( $issue_id )->issue_id, $issue_id, 'The issues entry should not have been removed' );
339 subtest
'BlockReturnOfLostItems' => sub {
341 my $biblio = $builder->build_object( { class => 'Koha::Biblios' } );
342 my $item = $builder->build_object(
344 class => 'Koha::Items',
346 biblionumber
=> $biblio->biblionumber,
353 my $patron = $builder->build_object({class => 'Koha::Patrons'});
354 my $checkout = AddIssue
( $patron->unblessed, $item->barcode );
356 # Mark the item as lost
357 ModItem
({itemlost
=> 1}, $biblio->biblionumber, $item->itemnumber);
359 t
::lib
::Mocks
::mock_preference
('BlockReturnOfLostItems', 1);
360 my ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode);
361 is
( $doreturn, 0, "With BlockReturnOfLostItems, a checkin of a lost item should be blocked");
362 is
( $messages->{WasLost
}, 1, "... and the WasLost flag should be set");
364 $item->discard_changes;
365 is
( $item->itemlost, 1, "Item remains lost" );
367 t
::lib
::Mocks
::mock_preference
('BlockReturnOfLostItems', 0);
368 ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode);
369 is
( $doreturn, 1, "Without BlockReturnOfLostItems, a checkin of a lost item should not be blocked");