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
=> 7;
25 use t
::lib
::TestBuilder
;
32 use Koha
::Account
::Lines
;
40 # Mock userenv, used by AddIssue
43 my $context = Test
::MockModule
->new('C4::Context');
49 number
=> $manager_id,
56 my $schema = Koha
::Database
->schema;
57 $schema->storage->txn_begin;
59 my $builder = t
::lib
::TestBuilder
->new();
60 Koha
::CirculationRules
->search->delete;
61 Koha
::CirculationRules
->set_rule(
63 categorycode
=> undef,
66 rule_name
=> 'issuelength',
71 subtest
"AddReturn logging on statistics table (item-level_itypes=1)" => sub {
75 # Set item-level item types
76 t
::lib
::Mocks
::mock_preference
( "item-level_itypes", 1 );
78 # Make sure logging is enabled
79 t
::lib
::Mocks
::mock_preference
( "IssueLog", 1 );
80 t
::lib
::Mocks
::mock_preference
( "ReturnLog", 1 );
82 # Create an itemtype for biblio-level item type
83 my $blevel_itemtype = $builder->build({ source
=> 'Itemtype' })->{ itemtype
};
84 # Create an itemtype for item-level item type
85 my $ilevel_itemtype = $builder->build({ source
=> 'Itemtype' })->{ itemtype
};
87 $branch = $builder->build({ source
=> 'Branch' })->{ branchcode
};
89 my $borrowernumber = $builder->build({
91 value
=> { branchcode
=> $branch }
92 })->{ borrowernumber
};
93 # Look for the defined MARC field for biblio-level itemtype
94 my $rs = $schema->resultset('MarcSubfieldStructure')->search({
96 kohafield
=> 'biblioitems.itemtype'
98 my $tagfield = $rs->first->tagfield;
99 my $tagsubfield = $rs->first->tagsubfield;
101 # Create a biblio record with biblio-level itemtype
102 my $record = MARC
::Record
->new();
103 $record->append_fields(
104 MARC
::Field
->new($tagfield,'','', $tagsubfield => $blevel_itemtype )
106 my ( $biblionumber, $biblioitemnumber ) = AddBiblio
( $record, '' );
107 my $item_with_itemtype = $builder->build(
111 biblionumber
=> $biblionumber,
112 biblioitemnumber
=> $biblioitemnumber,
113 homebranch
=> $branch,
114 holdingbranch
=> $branch,
115 itype
=> $ilevel_itemtype
119 my $item_without_itemtype = $builder->build(
123 biblionumber
=> $biblionumber,
124 biblioitemnumber
=> $biblioitemnumber,
125 homebranch
=> $branch,
126 holdingbranch
=> $branch,
132 my $borrower = Koha
::Patrons
->find( $borrowernumber )->unblessed;
133 AddIssue
( $borrower, $item_with_itemtype->{ barcode
} );
134 AddReturn
( $item_with_itemtype->{ barcode
}, $branch );
135 # Test item-level itemtype was recorded on the 'statistics' table
136 my $stat = $schema->resultset('Statistic')->search({
139 itemnumber
=> $item_with_itemtype->{ itemnumber
}
140 }, { order_by
=> { -asc
=> 'datetime' } })->next();
142 is
( $stat->itemtype, $ilevel_itemtype,
143 "item-level itype recorded on statistics for return");
144 warning_like
{ AddIssue
( $borrower, $item_without_itemtype->{ barcode
} ) }
145 [qr/^item-level_itypes set but no itemtype set for item/,
146 qr/^item-level_itypes set but no itemtype set for item/],
147 'Item without itemtype set raises warning on AddIssue';
148 AddReturn
( $item_without_itemtype->{ barcode
}, $branch );
149 # Test biblio-level itemtype was recorded on the 'statistics' table
150 $stat = $schema->resultset('Statistic')->search({
153 itemnumber
=> $item_without_itemtype->{ itemnumber
}
154 }, { order_by
=> { -asc
=> 'datetime' } })->next();
156 is
( $stat->itemtype, $blevel_itemtype,
157 "biblio-level itype recorded on statistics for return as a fallback for null item-level itype");
161 subtest
"AddReturn logging on statistics table (item-level_itypes=0)" => sub {
165 # Make sure logging is enabled
166 t
::lib
::Mocks
::mock_preference
( "IssueLog", 1 );
167 t
::lib
::Mocks
::mock_preference
( "ReturnLog", 1 );
169 # Set biblio level item types
170 t
::lib
::Mocks
::mock_preference
( "item-level_itypes", 0 );
172 # Create an itemtype for biblio-level item type
173 my $blevel_itemtype = $builder->build({ source
=> 'Itemtype' })->{ itemtype
};
174 # Create an itemtype for item-level item type
175 my $ilevel_itemtype = $builder->build({ source
=> 'Itemtype' })->{ itemtype
};
177 $branch = $builder->build({ source
=> 'Branch' })->{ branchcode
};
179 my $borrowernumber = $builder->build({
180 source
=> 'Borrower',
181 value
=> { branchcode
=> $branch }
182 })->{ borrowernumber
};
183 # Look for the defined MARC field for biblio-level itemtype
184 my $rs = $schema->resultset('MarcSubfieldStructure')->search({
186 kohafield
=> 'biblioitems.itemtype'
188 my $tagfield = $rs->first->tagfield;
189 my $tagsubfield = $rs->first->tagsubfield;
191 # Create a biblio record with biblio-level itemtype
192 my $record = MARC
::Record
->new();
193 $record->append_fields(
194 MARC
::Field
->new($tagfield,'','', $tagsubfield => $blevel_itemtype )
196 my ( $biblionumber, $biblioitemnumber ) = AddBiblio
( $record, '' );
197 my $item_with_itemtype = $builder->build({
200 biblionumber
=> $biblionumber,
201 biblioitemnumber
=> $biblioitemnumber,
202 homebranch
=> $branch,
203 holdingbranch
=> $branch,
204 itype
=> $ilevel_itemtype
207 my $item_without_itemtype = $builder->build({
210 biblionumber
=> $biblionumber,
211 biblioitemnumber
=> $biblioitemnumber,
212 homebranch
=> $branch,
213 holdingbranch
=> $branch,
218 my $borrower = Koha
::Patrons
->find( $borrowernumber )->unblessed;
220 AddIssue
( $borrower, $item_with_itemtype->{ barcode
} );
221 AddReturn
( $item_with_itemtype->{ barcode
}, $branch );
222 # Test item-level itemtype was recorded on the 'statistics' table
223 my $stat = $schema->resultset('Statistic')->search({
226 itemnumber
=> $item_with_itemtype->{ itemnumber
}
227 }, { order_by
=> { -asc
=> 'datetime' } })->next();
229 is
( $stat->itemtype, $blevel_itemtype,
230 "biblio-level itype recorded on statistics for return");
232 AddIssue
( $borrower, $item_without_itemtype->{ barcode
} );
233 AddReturn
( $item_without_itemtype->{ barcode
}, $branch );
234 # Test biblio-level itemtype was recorded on the 'statistics' table
235 $stat = $schema->resultset('Statistic')->search({
238 itemnumber
=> $item_without_itemtype->{ itemnumber
}
239 }, { order_by
=> { -asc
=> 'datetime' } })->next();
241 is
( $stat->itemtype, $blevel_itemtype,
242 "biblio-level itype recorded on statistics for return");
245 subtest
'Handle ids duplication' => sub {
248 t
::lib
::Mocks
::mock_preference
( 'item-level_itypes', 1 );
249 t
::lib
::Mocks
::mock_preference
( 'CalculateFinesOnReturn', 1 );
250 t
::lib
::Mocks
::mock_preference
( 'finesMode', 'production' );
251 Koha
::CirculationRules
->set_rules(
253 categorycode
=> undef,
264 my $biblio = $builder->build( { source
=> 'Biblio' } );
265 my $itemtype = $builder->build( { source
=> 'Itemtype', value
=> { rentalcharge
=> 5 } } );
266 my $item = $builder->build(
270 biblionumber
=> $biblio->{biblionumber
},
274 itype
=> $itemtype->{itemtype
},
278 my $patron = $builder->build({source
=> 'Borrower'});
279 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
281 my $original_checkout = AddIssue
( $patron->unblessed, $item->{barcode
}, dt_from_string
->subtract( days
=> 50 ) );
282 my $issue_id = $original_checkout->issue_id;
283 my $account_lines = Koha
::Account
::Lines
->search({ borrowernumber
=> $patron->borrowernumber, issue_id
=> $issue_id });
284 is
( $account_lines->count, 1, '1 account line should exist for this issue_id' );
285 is
( $account_lines->next->debit_type_code, 'RENT', 'patron has been charged the rentalcharge' );
286 $account_lines->delete;
288 # Create an existing entry in old_issue
289 $builder->build({ source
=> 'OldIssue', value
=> { issue_id
=> $issue_id } });
291 my $old_checkout = Koha
::Old
::Checkouts
->find( $issue_id );
293 my ($doreturn, $messages, $new_checkout, $borrower);
295 ( $doreturn, $messages, $new_checkout, $borrower ) =
296 AddReturn
( $item->{barcode
}, undef, undef, undef, dt_from_string
);
299 qr{.*DBD::mysql::st execute failed: Duplicate entry.*},
300 { carped
=> qr{The checkin for the following issue failed.*Duplicate ID.*} }
302 'DBD should have raised an error about dup primary key';
304 is
( $doreturn, 0, 'Return should not have been done' );
305 is
( $messages->{WasReturned
}, 0, 'messages should have the WasReturned flag set to 0' );
306 is
( $messages->{DataCorrupted
}, 1, 'messages should have the DataCorrupted flag set to 1' );
308 $account_lines = Koha
::Account
::Lines
->search({ borrowernumber
=> $patron->borrowernumber, issue_id
=> $issue_id });
309 is
( $account_lines->count, 0, 'No account lines should exist for this issue_id, patron should not have been charged' );
311 is
( Koha
::Checkouts
->find( $issue_id )->issue_id, $issue_id, 'The issues entry should not have been removed' );
314 subtest
'BlockReturnOfLostItems' => sub {
316 my $biblio = $builder->build_object( { class => 'Koha::Biblios' } );
317 my $item = $builder->build_object(
319 class => 'Koha::Items',
321 biblionumber
=> $biblio->biblionumber,
328 my $patron = $builder->build_object({class => 'Koha::Patrons'});
329 my $checkout = AddIssue
( $patron->unblessed, $item->barcode );
331 # Mark the item as lost
332 $item->itemlost(1)->store;
334 t
::lib
::Mocks
::mock_preference
('BlockReturnOfLostItems', 1);
335 my ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode);
336 is
( $doreturn, 0, "With BlockReturnOfLostItems, a checkin of a lost item should be blocked");
337 is
( $messages->{WasLost
}, 1, "... and the WasLost flag should be set");
339 $item->discard_changes;
340 is
( $item->itemlost, 1, "Item remains lost" );
342 t
::lib
::Mocks
::mock_preference
('BlockReturnOfLostItems', 0);
343 ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode);
344 is
( $doreturn, 1, "Without BlockReturnOfLostItems, a checkin of a lost item should not be blocked");
347 subtest
'Checkin of an item claimed as returned should generate a message' => sub {
350 t
::lib
::Mocks
::mock_preference
('ClaimReturnedLostValue', 1);
351 my $biblio = $builder->build_object( { class => 'Koha::Biblios' } );
352 my $item = $builder->build_object(
354 class => 'Koha::Items',
356 biblionumber
=> $biblio->biblionumber,
363 my $patron = $builder->build_object({class => 'Koha::Patrons'});
364 my $checkout = AddIssue
( $patron->unblessed, $item->barcode );
366 $checkout->claim_returned({ created_by
=> $patron->id });
368 my ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode);
369 ok
( $messages->{ReturnClaims
}, "ReturnClaims is in messages for return of a claimed as returned itm" );
372 subtest
'BranchTransferLimitsType' => sub {
375 t
::lib
::Mocks
::mock_preference
('AutomaticItemReturn', 0);
376 t
::lib
::Mocks
::mock_preference
('UseBranchTransferLimits', 1);
377 t
::lib
::Mocks
::mock_preference
('BranchTransferLimitsType', 'ccode');
379 my $biblio = $builder->build_object( { class => 'Koha::Biblios' } );
380 my $item = $builder->build_object(
382 class => 'Koha::Items',
384 biblionumber
=> $biblio->biblionumber,
391 my $patron = $builder->build_object({class => 'Koha::Patrons'});
392 my $checkout = AddIssue
( $patron->unblessed, $item->barcode );
393 my ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode);
394 is
( $doreturn, 1, 'AddReturn should have checkin the item if BranchTransferLimitsType=ccode');
396 t
::lib
::Mocks
::mock_preference
('BranchTransferLimitsType', 'itemtype');
397 $checkout = AddIssue
( $patron->unblessed, $item->barcode );
398 ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode);
399 is
( $doreturn, 1, 'AddReturn should have checkin the item if BranchTransferLimitsType=itemtype');
402 subtest
'Backdated returns should reduce fine if needed' => sub {
405 t
::lib
::Mocks
::mock_preference
( "CalculateFinesOnReturn", 0 );
406 t
::lib
::Mocks
::mock_preference
( "CalculateFinesOnBackdate", 1 );
408 my $biblio = $builder->build_object( { class => 'Koha::Biblios' } );
409 my $item = $builder->build_object(
411 class => 'Koha::Items',
413 biblionumber
=> $biblio->biblionumber,
420 my $patron = $builder->build_object({class => 'Koha::Patrons'});
421 my $checkout = AddIssue
( $patron->unblessed, $item->barcode );
422 my $fine = Koha
::Account
::Line
->new({
423 issue_id
=> $checkout->id,
424 borrowernumber
=> $patron->id,
425 itemnumber
=> $item->id,
426 date
=> dt_from_string
(),
428 amountoutstanding
=> 100,
429 debit_type_code
=> 'OVERDUE',
430 status
=> 'UNRETURNED',
431 timestamp
=> dt_from_string
(),
434 branchcode
=> $patron->branchcode,
437 my $account = $patron->account;
438 is
( $account->balance+0, 100, "Account balance before return is 100");
440 my ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode, undef, undef, dt_from_string
('1999-01-01') );
441 is
( $account->balance+0, 0, "Account balance after return is 0");
443 $fine = $fine->get_from_storage;
444 is
( $fine, undef, "Fine was removed correctly with a backdated return" );
447 $schema->storage->txn_rollback;