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
=> 53;
23 use DateTime
::Duration
;
36 use_ok
('C4::Reserves');
39 # a very minimal mack of userenv for use by the test of DelItemCheck
40 *C4
::Context
::userenv
= sub {
44 my $dbh = C4
::Context
->dbh;
47 $dbh->{AutoCommit
} = 0;
48 $dbh->{RaiseError
} = 1;
50 # Somewhat arbitrary field chosen for age restriction unit tests. Must be added to db before the framework is cached
51 $dbh->do("update marc_subfield_structure set kohafield='biblioitems.agerestriction' where tagfield='521' and tagsubfield='a'");
53 # Setup Test------------------------
55 # Add branches if not existing
56 foreach my $addbra ('CPL', 'FPL', 'RPL') {
57 $dbh->do("INSERT INTO branches (branchcode,branchname) VALUES (?,?)", undef, ($addbra,"$addbra branch")) unless GetBranchName
($addbra);
60 # Add categories if not existing
61 foreach my $addcat ('S', 'PT') {
62 $dbh->do("INSERT INTO categories (categorycode,hidelostitems,category_type) VALUES (?,?,?)",undef,($addcat, 0, $addcat eq 'S'?
'S': 'A')) unless GetBorrowercategory
($addcat);
65 # Create a helper biblio
66 my $bib = MARC
::Record
->new();
67 my $title = 'Silence in the library';
68 if( C4
::Context
->preference('marcflavour') eq 'UNIMARC' ) {
70 MARC
::Field
->new('600', '', '1', a
=> 'Moffat, Steven'),
71 MARC
::Field
->new('200', '', '', a
=> $title),
76 MARC
::Field
->new('100', '', '', a
=> 'Moffat, Steven'),
77 MARC
::Field
->new('245', '', '', a
=> $title),
80 my ($bibnum, $bibitemnum);
81 ($bibnum, $title, $bibitemnum) = AddBiblio
($bib, '');
83 # Create a helper item instance for testing
84 my ($item_bibnum, $item_bibitemnum, $itemnumber) = AddItem
({ homebranch
=> 'CPL', holdingbranch
=> 'CPL' } , $bibnum);
86 # Modify item; setting barcode.
87 my $testbarcode = '97531';
88 ModItem
({ barcode
=> $testbarcode }, $bibnum, $itemnumber);
92 firstname
=> 'my firstname',
93 surname
=> 'my surname',
97 my $borrowernumber = AddMember
(%data);
98 my $borrower = GetMember
( borrowernumber
=> $borrowernumber );
99 my $biblionumber = $bibnum;
100 my $barcode = $testbarcode;
102 my $constraint = 'a';
108 my $checkitem = undef;
111 my @branches = GetBranchesLoop
();
112 my $branch = $branches[0][0]{value
};
114 AddReserve
($branch, $borrowernumber, $biblionumber,
115 $constraint, $bibitems, $priority, $resdate, $expdate, $notes,
116 $title, $checkitem, $found);
118 my ($status, $reserve, $all_reserves) = CheckReserves
($itemnumber, $barcode);
120 is
($status, "Reserved", "CheckReserves Test 1");
122 ok
(exists($reserve->{reserve_id
}), 'CheckReserves() include reserve_id in its response');
124 ($status, $reserve, $all_reserves) = CheckReserves
($itemnumber);
125 is
($status, "Reserved", "CheckReserves Test 2");
127 ($status, $reserve, $all_reserves) = CheckReserves
(undef, $barcode);
128 is
($status, "Reserved", "CheckReserves Test 3");
130 my $ReservesControlBranch = C4
::Context
->preference('ReservesControlBranch');
131 C4
::Context
->set_preference( 'ReservesControlBranch', 'ItemHomeLibrary' );
133 'ItemHomeLib' eq GetReservesControlBranch
(
134 { homebranch
=> 'ItemHomeLib' },
135 { branchcode
=> 'PatronHomeLib' }
136 ), "GetReservesControlBranch returns item home branch when set to ItemHomeLibrary"
138 C4
::Context
->set_preference( 'ReservesControlBranch', 'PatronLibrary' );
140 'PatronHomeLib' eq GetReservesControlBranch
(
141 { homebranch
=> 'ItemHomeLib' },
142 { branchcode
=> 'PatronHomeLib' }
143 ), "GetReservesControlBranch returns patron home branch when set to PatronLibrary"
145 C4
::Context
->set_preference( 'ReservesControlBranch', $ReservesControlBranch );
148 ### Regression test for bug 10272
151 $requesters{'CPL'} = AddMember
(
153 categorycode
=> 'PT',
154 surname
=> 'borrower from CPL',
156 $requesters{'FPL'} = AddMember
(
158 categorycode
=> 'PT',
159 surname
=> 'borrower from FPL',
161 $requesters{'RPL'} = AddMember
(
163 categorycode
=> 'PT',
164 surname
=> 'borrower from RPL',
167 # Configure rules so that CPL allows only CPL patrons
168 # to request its items, while FPL will allow its items
169 # to fill holds from anywhere.
171 $dbh->do('DELETE FROM issuingrules');
172 $dbh->do('DELETE FROM branch_item_rules');
173 $dbh->do('DELETE FROM branch_borrower_circ_rules');
174 $dbh->do('DELETE FROM default_borrower_circ_rules');
175 $dbh->do('DELETE FROM default_branch_item_rules');
176 $dbh->do('DELETE FROM default_branch_circ_rules');
177 $dbh->do('DELETE FROM default_circ_rules');
179 q{INSERT INTO issuingrules (categorycode, branchcode, itemtype, reservesallowed)
180 VALUES (?, ?, ?, ?)},
185 # CPL allows only its own patrons to request its items
187 q{INSERT INTO default_branch_circ_rules (branchcode, maxissueqty, holdallowed, returnbranch)
188 VALUES (?, ?, ?, ?)},
190 'CPL', 10, 1, 'homebranch',
193 # ... while FPL allows anybody to request its items
195 q{INSERT INTO default_branch_circ_rules (branchcode, maxissueqty, holdallowed, returnbranch)
196 VALUES (?, ?, ?, ?)},
198 'FPL', 10, 2, 'homebranch',
201 # helper biblio for the bug 10272 regression test
202 my $bib2 = MARC
::Record
->new();
203 $bib2->append_fields(
204 MARC
::Field
->new('100', ' ', ' ', a
=> 'Moffat, Steven'),
205 MARC
::Field
->new('245', ' ', ' ', a
=> $title),
208 # create one item belonging to FPL and one belonging to CPL
209 my ($bibnum2, $bibitemnum2) = AddBiblio
($bib, '');
210 my ($itemnum_cpl, $itemnum_fpl);
211 (undef, undef, $itemnum_cpl) = AddItem
({
213 holdingbranch
=> 'CPL',
214 barcode
=> 'bug10272_CPL'
216 (undef, undef, $itemnum_fpl) = AddItem
({
218 holdingbranch
=> 'FPL',
219 barcode
=> 'bug10272_FPL'
222 # Ensure that priorities are numbered correcly when a hold is moved to waiting
224 $dbh->do("DELETE FROM reserves WHERE biblionumber=?",undef,($bibnum2));
225 AddReserve
('RPL', $requesters{'RPL'}, $bibnum2,
226 $constraint, $bibitems, 1, $resdate, $expdate, $notes,
227 $title, $checkitem, $found);
228 AddReserve
('FPL', $requesters{'FPL'}, $bibnum2,
229 $constraint, $bibitems, 2, $resdate, $expdate, $notes,
230 $title, $checkitem, $found);
231 AddReserve
('CPL', $requesters{'CPL'}, $bibnum2,
232 $constraint, $bibitems, 3, $resdate, $expdate, $notes,
233 $title, $checkitem, $found);
234 ModReserveAffect
($itemnum_cpl, $requesters{'RPL'}, 0);
236 # Now it should have different priorities.
237 my $title_reserves = GetReservesFromBiblionumber
({biblionumber
=> $bibnum2});
238 # Sort by reserve number in case the database gives us oddly ordered results
239 my @reserves = sort { $a->{reserve_id
} <=> $b->{reserve_id
} } @
$title_reserves;
240 is
($reserves[0]{priority
}, 0, 'Item is correctly waiting');
241 is
($reserves[1]{priority
}, 1, 'Item is correctly priority 1');
242 is
($reserves[2]{priority
}, 2, 'Item is correctly priority 2');
245 $dbh->do("DELETE FROM reserves WHERE biblionumber=?",undef,($bibnum2));
246 AddReserve
('RPL', $requesters{'RPL'}, $bibnum2,
247 $constraint, $bibitems, 1, $resdate, $expdate, $notes,
248 $title, $checkitem, $found);
249 AddReserve
('FPL', $requesters{'FPL'}, $bibnum2,
250 $constraint, $bibitems, 2, $resdate, $expdate, $notes,
251 $title, $checkitem, $found);
252 AddReserve
('CPL', $requesters{'CPL'}, $bibnum2,
253 $constraint, $bibitems, 3, $resdate, $expdate, $notes,
254 $title, $checkitem, $found);
256 # Ensure that the item's home library controls hold policy lookup
257 C4
::Context
->set_preference( 'ReservesControlBranch', 'ItemHomeLibrary' );
260 # Return the CPL item at FPL. The hold that should be triggered is
261 # the one placed by the CPL patron, as the other two patron's hold
262 # requests cannot be filled by that item per policy.
263 (undef, $messages, undef, undef) = AddReturn
('bug10272_CPL', 'FPL');
264 is
( $messages->{ResFound
}->{borrowernumber
},
266 'restrictive library\'s items only fill requests by own patrons (bug 10272)');
268 # Return the FPL item at FPL. The hold that should be triggered is
269 # the one placed by the RPL patron, as that patron is first in line
270 # and RPL imposes no restrictions on whose holds its items can fill.
271 (undef, $messages, undef, undef) = AddReturn
('bug10272_FPL', 'FPL');
272 is
( $messages->{ResFound
}->{borrowernumber
},
274 'for generous library, its items fill first hold request in line (bug 10272)');
276 my $reserves = GetReservesFromBiblionumber
({biblionumber
=> $biblionumber});
277 isa_ok
($reserves, 'ARRAY');
278 is
(scalar @
$reserves, 1, "Only one reserves for this biblio");
279 my $reserve_id = $reserves->[0]->{reserve_id
};
281 $reserve = GetReserve
($reserve_id);
282 isa_ok
($reserve, 'HASH', "GetReserve return");
283 is
($reserve->{biblionumber
}, $biblionumber);
285 $reserve = CancelReserve
({reserve_id
=> $reserve_id});
286 isa_ok
($reserve, 'HASH', "CancelReserve return");
287 is
($reserve->{biblionumber
}, $biblionumber);
289 $reserve = GetReserve
($reserve_id);
290 is
($reserve, undef, "GetReserve returns undef after deletion");
292 $reserve = CancelReserve
({reserve_id
=> $reserve_id});
293 is
($reserve, undef, "CancelReserve return undef if reserve does not exist");
296 # Tests for bug 9761 (ConfirmFutureHolds): new CheckReserves lookahead parameter, and corresponding change in AddReturn
297 # Note that CheckReserve uses its lookahead parameter and does not check ConfirmFutureHolds pref (it should be passed if needed like AddReturn does)
298 # Test 9761a: Add a reserve without date, CheckReserve should return it
299 $resdate= undef; #defaults to today in AddReserve
300 $expdate= undef; #no expdate
301 $dbh->do("DELETE FROM reserves WHERE biblionumber=?",undef,($bibnum));
302 AddReserve
('CPL', $requesters{'CPL'}, $bibnum,
303 $constraint, $bibitems, 1, $resdate, $expdate, $notes,
304 $title, $checkitem, $found);
305 ($status)=CheckReserves
($itemnumber,undef,undef);
306 is
( $status, 'Reserved', 'CheckReserves returns reserve without lookahead');
307 ($status)=CheckReserves
($itemnumber,undef,7);
308 is
( $status, 'Reserved', 'CheckReserves also returns reserve with lookahead');
310 # Test 9761b: Add a reserve with future date, CheckReserve should not return it
311 $dbh->do("DELETE FROM reserves WHERE biblionumber=?",undef,($bibnum));
312 C4
::Context
->set_preference('AllowHoldDateInFuture', 1);
313 $resdate= dt_from_string
();
314 $resdate->add_duration(DateTime
::Duration
->new(days
=> 4));
315 $resdate=output_pref
($resdate);
316 $expdate= undef; #no expdate
317 AddReserve
('CPL', $requesters{'CPL'}, $bibnum,
318 $constraint, $bibitems, 1, $resdate, $expdate, $notes,
319 $title, $checkitem, $found);
320 ($status)=CheckReserves
($itemnumber,undef,undef);
321 is
( $status, '', 'CheckReserves returns no future reserve without lookahead');
323 # Test 9761c: Add a reserve with future date, CheckReserve should return it if lookahead is high enough
324 ($status)=CheckReserves
($itemnumber,undef,3);
325 is
( $status, '', 'CheckReserves returns no future reserve with insufficient lookahead');
326 ($status)=CheckReserves
($itemnumber,undef,4);
327 is
( $status, 'Reserved', 'CheckReserves returns future reserve with sufficient lookahead');
329 # Test 9761d: Check ResFound message of AddReturn for future hold
330 # Note that AddReturn is in Circulation.pm, but this test really pertains to reserves; AddReturn uses the ConfirmFutureHolds pref when calling CheckReserves
331 # In this test we do not need an issued item; it is just a 'checkin'
332 C4
::Context
->set_preference('ConfirmFutureHolds', 0);
333 (my $doreturn, $messages)= AddReturn
('97531','CPL');
334 is
($messages->{ResFound
}//'', '', 'AddReturn does not care about future reserve when ConfirmFutureHolds is off');
335 C4
::Context
->set_preference('ConfirmFutureHolds', 3);
336 ($doreturn, $messages)= AddReturn
('97531','CPL');
337 is
(exists $messages->{ResFound
}?
1:0, 0, 'AddReturn ignores future reserve beyond ConfirmFutureHolds days');
338 C4
::Context
->set_preference('ConfirmFutureHolds', 7);
339 ($doreturn, $messages)= AddReturn
('97531','CPL');
340 is
(exists $messages->{ResFound
}?
1:0, 1, 'AddReturn considers future reserve within ConfirmFutureHolds days');
342 # End of tests for bug 9761 (ConfirmFutureHolds)
344 # test marking a hold as captured
345 my $hold_notice_count = count_hold_print_messages
();
346 ModReserveAffect
($itemnumber, $requesters{'CPL'}, 0);
347 my $new_count = count_hold_print_messages
();
348 is
($new_count, $hold_notice_count + 1, 'patron notified when item set to waiting');
350 # test that duplicate notices aren't generated
351 ModReserveAffect
($itemnumber, $requesters{'CPL'}, 0);
352 $new_count = count_hold_print_messages
();
353 is
($new_count, $hold_notice_count + 1, 'patron not notified a second time (bug 11445)');
355 # avoiding the not_same_branch error
356 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
358 DelItemCheck
($dbh, $bibnum, $itemnumber),
360 'item that is captured to fill a hold cannot be deleted',
363 my $letter = ReserveSlip
('CPL', $requesters{'CPL'}, $bibnum);
364 ok
(defined($letter), 'can successfully generate hold slip (bug 10949)');
366 # Tests for bug 9788: Does GetReservesFromItemnumber return a future wait?
367 # 9788a: GetReservesFromItemnumber does not return future next available hold
368 $dbh->do("DELETE FROM reserves WHERE biblionumber=?",undef,($bibnum));
369 C4
::Context
->set_preference('ConfirmFutureHolds', 2);
370 C4
::Context
->set_preference('AllowHoldDateInFuture', 1);
371 $resdate= dt_from_string
();
372 $resdate->add_duration(DateTime
::Duration
->new(days
=> 2));
373 $resdate=output_pref
($resdate);
374 AddReserve
('CPL', $requesters{'CPL'}, $bibnum,
375 $constraint, $bibitems, 1, $resdate, $expdate, $notes,
376 $title, $checkitem, $found);
377 my @results= GetReservesFromItemnumber
($itemnumber);
378 is
(defined $results[3]?
1:0, 0, 'GetReservesFromItemnumber does not return a future next available hold');
379 # 9788b: GetReservesFromItemnumber does not return future item level hold
380 $dbh->do("DELETE FROM reserves WHERE biblionumber=?",undef,($bibnum));
381 AddReserve
('CPL', $requesters{'CPL'}, $bibnum,
382 $constraint, $bibitems, 1, $resdate, $expdate, $notes,
383 $title, $itemnumber, $found); #item level hold
384 @results= GetReservesFromItemnumber
($itemnumber);
385 is
(defined $results[3]?
1:0, 0, 'GetReservesFromItemnumber does not return a future item level hold');
386 # 9788c: GetReservesFromItemnumber returns future wait (confirmed future hold)
387 ModReserveAffect
( $itemnumber, $requesters{'CPL'} , 0); #confirm hold
388 @results= GetReservesFromItemnumber
($itemnumber);
389 is
(defined $results[3]?
1:0, 1, 'GetReservesFromItemnumber returns a future wait (confirmed future hold)');
390 # End of tests for bug 9788
392 # Tests for CalculatePriority (bug 8918)
393 my $p = C4
::Reserves
::CalculatePriority
($bibnum2);
394 is
($p, 4, 'CalculatePriority should now return priority 4');
396 AddReserve
('CPL', $requesters{'CPL'}, $bibnum2,
397 $constraint, $bibitems, $p, $resdate, $expdate, $notes,
398 $title, $checkitem, $found);
399 $p = C4
::Reserves
::CalculatePriority
($bibnum2);
400 is
($p, 5, 'CalculatePriority should now return priority 5');
401 #some tests on bibnum
402 $dbh->do("DELETE FROM reserves WHERE biblionumber=?",undef,($bibnum));
403 $p = C4
::Reserves
::CalculatePriority
($bibnum);
404 is
($p, 1, 'CalculatePriority should now return priority 1');
405 #add a new reserve and confirm it to waiting
406 AddReserve
('CPL', $requesters{'CPL'}, $bibnum,
407 $constraint, $bibitems, $p, $resdate, $expdate, $notes,
408 $title, $itemnumber, $found);
409 $p = C4
::Reserves
::CalculatePriority
($bibnum);
410 is
($p, 2, 'CalculatePriority should now return priority 2');
411 ModReserveAffect
( $itemnumber, $requesters{'CPL'} , 0);
412 $p = C4
::Reserves
::CalculatePriority
($bibnum);
413 is
($p, 1, 'CalculatePriority should now return priority 1');
414 #add another biblio hold, no resdate
415 AddReserve
('CPL', $requesters{'CPL'}, $bibnum,
416 $constraint, $bibitems, $p, $resdate, $expdate, $notes,
417 $title, $checkitem, $found);
418 $p = C4
::Reserves
::CalculatePriority
($bibnum);
419 is
($p, 2, 'CalculatePriority should now return priority 2');
420 #add another future hold
421 C4
::Context
->set_preference('AllowHoldDateInFuture', 1);
422 $resdate= dt_from_string
();
423 $resdate->add_duration(DateTime
::Duration
->new(days
=> 1));
424 AddReserve
('CPL', $requesters{'CPL'}, $bibnum,
425 $constraint, $bibitems, $p, output_pref
($resdate), $expdate, $notes,
426 $title, $checkitem, $found);
427 $p = C4
::Reserves
::CalculatePriority
($bibnum);
428 is
($p, 2, 'CalculatePriority should now still return priority 2');
429 #calc priority with future resdate
430 $p = C4
::Reserves
::CalculatePriority
($bibnum, $resdate);
431 is
($p, 3, 'CalculatePriority should now return priority 3');
432 # End of tests for bug 8918
434 # Tests for cancel reserves by users from OPAC.
435 $dbh->do('DELETE FROM reserves', undef, ($bibnum));
436 AddReserve
('CPL', $requesters{'CPL'}, $item_bibnum,
437 $constraint, $bibitems, 1, undef, $expdate, $notes,
438 $title, $checkitem, '');
439 my (undef, $canres, undef) = CheckReserves
($itemnumber);
441 is
( CanReserveBeCanceledFromOpac
(), undef,
442 'CanReserveBeCanceledFromOpac should return undef if called without any parameter'
445 CanReserveBeCanceledFromOpac
( $canres->{resserve_id
} ),
447 'CanReserveBeCanceledFromOpac should return undef if called without the reserve_id'
450 CanReserveBeCanceledFromOpac
( undef, $requesters{CPL
} ),
452 'CanReserveBeCanceledFromOpac should return undef if called without borrowernumber'
455 my $cancancel = CanReserveBeCanceledFromOpac
($canres->{reserve_id
}, $requesters{'CPL'});
456 is
($cancancel, 1, 'Can user cancel its own reserve');
458 $cancancel = CanReserveBeCanceledFromOpac
($canres->{reserve_id
}, $requesters{'FPL'});
459 is
($cancancel, 0, 'Other user cant cancel reserve');
461 ModReserveAffect
($itemnumber, $requesters{'CPL'}, 1);
462 $cancancel = CanReserveBeCanceledFromOpac
($canres->{reserve_id
}, $requesters{'CPL'});
463 is
($cancancel, 0, 'Reserve in transfer status cant be canceled');
465 $dbh->do('DELETE FROM reserves', undef, ($bibnum));
466 AddReserve
('CPL', $requesters{'CPL'}, $item_bibnum,
467 $constraint, $bibitems, 1, undef, $expdate, $notes,
468 $title, $checkitem, '');
469 (undef, $canres, undef) = CheckReserves
($itemnumber);
471 ModReserveAffect
($itemnumber, $requesters{'CPL'}, 0);
472 $cancancel = CanReserveBeCanceledFromOpac
($canres->{reserve_id
}, $requesters{'CPL'});
473 is
($cancancel, 0, 'Reserve in waiting status cant be canceled');
475 # End of tests for bug 12876
478 ####### Testing Bug 13113 - Prevent juvenile/children from reserving ageRestricted material >>>
481 C4
::Context
->set_preference( 'AgeRestrictionMarker', 'FSK|PEGI|Age|K' );
483 #Reserving an not-agerestricted Biblio by a Borrower with no dateofbirth is tested previously.
485 #Set the ageRestriction for the Biblio
486 my $record = GetMarcBiblio
( $bibnum );
487 my ( $ageres_tagid, $ageres_subfieldid ) = GetMarcFromKohaField
( "biblioitems.agerestriction" );
488 $record->append_fields( MARC
::Field
->new($ageres_tagid, '', '', $ageres_subfieldid => 'PEGI 16') );
489 C4
::Biblio
::ModBiblio
( $record, $bibnum, '' );
491 is
( C4
::Reserves
::CanBookBeReserved
($borrowernumber, $biblionumber) , 'OK', "Reserving an ageRestricted Biblio without a borrower dateofbirth succeeds" );
493 #Set the dateofbirth for the Borrower making him "too young".
494 my $now = DateTime
->now();
495 C4
::Members
::SetAge
( $borrower, '0015-00-00' );
496 C4
::Members
::ModMember
( borrowernumber
=> $borrowernumber, dateofbirth
=> $borrower->{dateofbirth
} );
498 is
( C4
::Reserves
::CanBookBeReserved
($borrowernumber, $biblionumber) , 'ageRestricted', "Reserving a 'PEGI 16' Biblio by a 15 year old borrower fails");
500 #Set the dateofbirth for the Borrower making him "too old".
501 C4
::Members
::SetAge
( $borrower, '0030-00-00' );
502 C4
::Members
::ModMember
( borrowernumber
=> $borrowernumber, dateofbirth
=> $borrower->{dateofbirth
} );
504 is
( C4
::Reserves
::CanBookBeReserved
($borrowernumber, $biblionumber) , 'OK', "Reserving a 'PEGI 16' Biblio by a 30 year old borrower succeeds");
506 ####### EO Bug 13113 <<<
511 sub count_hold_print_messages
{
512 my $message_count = $dbh->selectall_arrayref(q{
515 WHERE letter_code = 'HOLD'
516 AND message_transport_type = 'print'
518 return $message_count->[0]->[0];