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_sample_item(
109 biblionumber
=> $biblionumber,
111 itype
=> $ilevel_itemtype
114 my $item_without_itemtype = $builder->build_sample_item(
116 biblionumber
=> $biblionumber,
119 )->_result->update({ itype
=> undef });
121 my $borrower = Koha
::Patrons
->find( $borrowernumber )->unblessed;
122 AddIssue
( $borrower, $item_with_itemtype->barcode );
123 AddReturn
( $item_with_itemtype->barcode, $branch );
124 # Test item-level itemtype was recorded on the 'statistics' table
125 my $stat = $schema->resultset('Statistic')->search({
128 itemnumber
=> $item_with_itemtype->itemnumber
129 }, { order_by
=> { -asc
=> 'datetime' } })->next();
131 is
( $stat->itemtype, $ilevel_itemtype,
132 "item-level itype recorded on statistics for return");
133 warning_like
{ AddIssue
( $borrower, $item_without_itemtype->barcode ) }
134 [qr/^item-level_itypes set but no itemtype set for item/,
135 qr/^item-level_itypes set but no itemtype set for item/],
136 'Item without itemtype set raises warning on AddIssue';
137 AddReturn
( $item_without_itemtype->barcode, $branch );
138 # Test biblio-level itemtype was recorded on the 'statistics' table
139 $stat = $schema->resultset('Statistic')->search({
142 itemnumber
=> $item_without_itemtype->itemnumber
143 }, { order_by
=> { -asc
=> 'datetime' } })->next();
145 is
( $stat->itemtype, $blevel_itemtype,
146 "biblio-level itype recorded on statistics for return as a fallback for null item-level itype");
150 subtest
"AddReturn logging on statistics table (item-level_itypes=0)" => sub {
154 # Make sure logging is enabled
155 t
::lib
::Mocks
::mock_preference
( "IssueLog", 1 );
156 t
::lib
::Mocks
::mock_preference
( "ReturnLog", 1 );
158 # Set biblio level item types
159 t
::lib
::Mocks
::mock_preference
( "item-level_itypes", 0 );
161 # Create an itemtype for biblio-level item type
162 my $blevel_itemtype = $builder->build({ source
=> 'Itemtype' })->{ itemtype
};
163 # Create an itemtype for item-level item type
164 my $ilevel_itemtype = $builder->build({ source
=> 'Itemtype' })->{ itemtype
};
166 $branch = $builder->build({ source
=> 'Branch' })->{ branchcode
};
168 my $borrowernumber = $builder->build({
169 source
=> 'Borrower',
170 value
=> { branchcode
=> $branch }
171 })->{ borrowernumber
};
172 # Look for the defined MARC field for biblio-level itemtype
173 my $rs = $schema->resultset('MarcSubfieldStructure')->search({
175 kohafield
=> 'biblioitems.itemtype'
177 my $tagfield = $rs->first->tagfield;
178 my $tagsubfield = $rs->first->tagsubfield;
180 # Create a biblio record with biblio-level itemtype
181 my $record = MARC
::Record
->new();
182 $record->append_fields(
183 MARC
::Field
->new($tagfield,'','', $tagsubfield => $blevel_itemtype )
185 my ( $biblionumber, $biblioitemnumber ) = AddBiblio
( $record, '' );
186 my $item_with_itemtype = $builder->build_sample_item(
188 biblionumber
=> $biblionumber,
190 itype
=> $ilevel_itemtype
193 my $item_without_itemtype = $builder->build_sample_item(
195 biblionumber
=> $biblionumber,
201 my $borrower = Koha
::Patrons
->find( $borrowernumber )->unblessed;
203 AddIssue
( $borrower, $item_with_itemtype->barcode );
204 AddReturn
( $item_with_itemtype->barcode, $branch );
205 # Test item-level itemtype was recorded on the 'statistics' table
206 my $stat = $schema->resultset('Statistic')->search({
209 itemnumber
=> $item_with_itemtype->itemnumber
210 }, { order_by
=> { -asc
=> 'datetime' } })->next();
212 is
( $stat->itemtype, $blevel_itemtype,
213 "biblio-level itype recorded on statistics for return");
215 AddIssue
( $borrower, $item_without_itemtype->barcode );
216 AddReturn
( $item_without_itemtype->barcode, $branch );
217 # Test biblio-level itemtype was recorded on the 'statistics' table
218 $stat = $schema->resultset('Statistic')->search({
221 itemnumber
=> $item_without_itemtype->itemnumber
222 }, { order_by
=> { -asc
=> 'datetime' } })->next();
224 is
( $stat->itemtype, $blevel_itemtype,
225 "biblio-level itype recorded on statistics for return");
228 subtest
'Handle ids duplication' => sub {
231 t
::lib
::Mocks
::mock_preference
( 'item-level_itypes', 1 );
232 t
::lib
::Mocks
::mock_preference
( 'CalculateFinesOnReturn', 1 );
233 t
::lib
::Mocks
::mock_preference
( 'finesMode', 'production' );
234 Koha
::CirculationRules
->set_rules(
236 categorycode
=> undef,
247 my $itemtype = $builder->build( { source
=> 'Itemtype', value
=> { rentalcharge
=> 5 } } );
248 my $item = $builder->build_sample_item(
250 itype
=> $itemtype->{itemtype
},
253 my $patron = $builder->build({source
=> 'Borrower'});
254 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
256 my $original_checkout = AddIssue
( $patron->unblessed, $item->barcode, dt_from_string
->subtract( days
=> 50 ) );
257 my $issue_id = $original_checkout->issue_id;
258 my $account_lines = Koha
::Account
::Lines
->search({ borrowernumber
=> $patron->borrowernumber, issue_id
=> $issue_id });
259 is
( $account_lines->count, 1, '1 account line should exist for this issue_id' );
260 is
( $account_lines->next->debit_type_code, 'RENT', 'patron has been charged the rentalcharge' );
261 $account_lines->delete;
263 # Create an existing entry in old_issue
264 $builder->build({ source
=> 'OldIssue', value
=> { issue_id
=> $issue_id } });
266 my $old_checkout = Koha
::Old
::Checkouts
->find( $issue_id );
268 my ($doreturn, $messages, $new_checkout, $borrower);
270 ( $doreturn, $messages, $new_checkout, $borrower ) =
271 AddReturn
( $item->barcode, undef, undef, undef, dt_from_string
);
274 qr{.*DBD::mysql::st execute failed: Duplicate entry.*},
275 { carped
=> qr{The checkin for the following issue failed.*Duplicate ID.*} }
277 'DBD should have raised an error about dup primary key';
279 is
( $doreturn, 0, 'Return should not have been done' );
280 is
( $messages->{WasReturned
}, 0, 'messages should have the WasReturned flag set to 0' );
281 is
( $messages->{DataCorrupted
}, 1, 'messages should have the DataCorrupted flag set to 1' );
283 $account_lines = Koha
::Account
::Lines
->search({ borrowernumber
=> $patron->borrowernumber, issue_id
=> $issue_id });
284 is
( $account_lines->count, 0, 'No account lines should exist for this issue_id, patron should not have been charged' );
286 is
( Koha
::Checkouts
->find( $issue_id )->issue_id, $issue_id, 'The issues entry should not have been removed' );
289 subtest
'BlockReturnOfLostItems' => sub {
291 my $item = $builder->build_sample_item;
292 my $patron = $builder->build_object({class => 'Koha::Patrons'});
293 my $checkout = AddIssue
( $patron->unblessed, $item->barcode );
295 # Mark the item as lost
296 $item->itemlost(1)->store;
298 t
::lib
::Mocks
::mock_preference
('BlockReturnOfLostItems', 1);
299 my ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode);
300 is
( $doreturn, 0, "With BlockReturnOfLostItems, a checkin of a lost item should be blocked");
301 is
( $messages->{WasLost
}, 1, "... and the WasLost flag should be set");
303 $item->discard_changes;
304 is
( $item->itemlost, 1, "Item remains lost" );
306 t
::lib
::Mocks
::mock_preference
('BlockReturnOfLostItems', 0);
307 ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode);
308 is
( $doreturn, 1, "Without BlockReturnOfLostItems, a checkin of a lost item should not be blocked");
311 subtest
'Checkin of an item claimed as returned should generate a message' => sub {
314 t
::lib
::Mocks
::mock_preference
('ClaimReturnedLostValue', 1);
315 my $item = $builder->build_sample_item;
316 my $patron = $builder->build_object({class => 'Koha::Patrons'});
317 my $checkout = AddIssue
( $patron->unblessed, $item->barcode );
319 $checkout->claim_returned({ created_by
=> $patron->id });
321 my ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode);
322 ok
( $messages->{ReturnClaims
}, "ReturnClaims is in messages for return of a claimed as returned itm" );
325 subtest
'BranchTransferLimitsType' => sub {
328 t
::lib
::Mocks
::mock_preference
('AutomaticItemReturn', 0);
329 t
::lib
::Mocks
::mock_preference
('UseBranchTransferLimits', 1);
330 t
::lib
::Mocks
::mock_preference
('BranchTransferLimitsType', 'ccode');
332 my $item = $builder->build_sample_item;
333 my $patron = $builder->build_object({class => 'Koha::Patrons'});
334 my $checkout = AddIssue
( $patron->unblessed, $item->barcode );
335 my ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode);
336 is
( $doreturn, 1, 'AddReturn should have checkin the item if BranchTransferLimitsType=ccode');
338 t
::lib
::Mocks
::mock_preference
('BranchTransferLimitsType', 'itemtype');
339 $checkout = AddIssue
( $patron->unblessed, $item->barcode );
340 ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode);
341 is
( $doreturn, 1, 'AddReturn should have checkin the item if BranchTransferLimitsType=itemtype');
344 subtest
'Backdated returns should reduce fine if needed' => sub {
347 t
::lib
::Mocks
::mock_preference
( "CalculateFinesOnReturn", 0 );
348 t
::lib
::Mocks
::mock_preference
( "CalculateFinesOnBackdate", 1 );
350 my $biblio = $builder->build_object( { class => 'Koha::Biblios' } );
351 my $item = $builder->build_sample_item;
352 my $patron = $builder->build_object({class => 'Koha::Patrons'});
353 my $checkout = AddIssue
( $patron->unblessed, $item->barcode );
354 my $fine = Koha
::Account
::Line
->new({
355 issue_id
=> $checkout->id,
356 borrowernumber
=> $patron->id,
357 itemnumber
=> $item->id,
358 date
=> dt_from_string
(),
360 amountoutstanding
=> 100,
361 debit_type_code
=> 'OVERDUE',
362 status
=> 'UNRETURNED',
363 timestamp
=> dt_from_string
(),
366 branchcode
=> $patron->branchcode,
369 my $account = $patron->account;
370 is
( $account->balance+0, 100, "Account balance before return is 100");
372 my ( $doreturn, $messages, $issue ) = AddReturn
($item->barcode, undef, undef, dt_from_string
('1999-01-01') );
373 is
( $account->balance+0, 0, "Account balance after return is 0");
375 $fine = $fine->get_from_storage;
376 is
( $fine, undef, "Fine was removed correctly with a backdated return" );
379 $schema->storage->txn_rollback;