t/db_dependent/Circulation.t

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   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.
   9 #
  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.
  14 #
  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>.
  17
  18 use Modern::Perl;
  19
  20 use DateTime;
  21 use C4::Biblio;
  22 use C4::Branch;
  23 use C4::Items;
  24 use C4::Members;
  25 use C4::Reserves;
  26 use Koha::DateUtils;
  27 use Koha::Database;
  28
  29 use Test::More tests => 51;
  30
  31 BEGIN {
  32     use_ok('C4::Circulation');
  33 }
  34
  35 my $dbh = C4::Context->dbh;
  36 my $schema = Koha::Database->new()->schema();
  37
  38 # Start transaction
  39 $dbh->{AutoCommit} = 0;
  40 $dbh->{RaiseError} = 1;
  41
  42 # Start with a clean slate
  43 $dbh->do('DELETE FROM issues');
  44
  45 my $CircControl = C4::Context->preference('CircControl');
  46 my $HomeOrHoldingBranch = C4::Context->preference('HomeOrHoldingBranch');
  47
  48 my $item = {
  49     homebranch => 'MPL',
  50     holdingbranch => 'MPL'
  51 };
  52
  53 my $borrower = {
  54     branchcode => 'MPL'
  55 };
  56
  57 # No userenv, PickupLibrary
  58 C4::Context->set_preference('CircControl', 'PickupLibrary');
  59 is(
  60     C4::Context->preference('CircControl'),
  61     'PickupLibrary',
  62     'CircControl changed to PickupLibrary'
  63 );
  64 is(
  65     C4::Circulation::_GetCircControlBranch($item, $borrower),
  66     $item->{$HomeOrHoldingBranch},
  67     '_GetCircControlBranch returned item branch (no userenv defined)'
  68 );
  69
  70 # No userenv, PatronLibrary
  71 C4::Context->set_preference('CircControl', 'PatronLibrary');
  72 is(
  73     C4::Context->preference('CircControl'),
  74     'PatronLibrary',
  75     'CircControl changed to PatronLibrary'
  76 );
  77 is(
  78     C4::Circulation::_GetCircControlBranch($item, $borrower),
  79     $borrower->{branchcode},
  80     '_GetCircControlBranch returned borrower branch'
  81 );
  82
  83 # No userenv, ItemHomeLibrary
  84 C4::Context->set_preference('CircControl', 'ItemHomeLibrary');
  85 is(
  86     C4::Context->preference('CircControl'),
  87     'ItemHomeLibrary',
  88     'CircControl changed to ItemHomeLibrary'
  89 );
  90 is(
  91     $item->{$HomeOrHoldingBranch},
  92     C4::Circulation::_GetCircControlBranch($item, $borrower),
  93     '_GetCircControlBranch returned item branch'
  94 );
  95
  96 # Now, set a userenv
  97 C4::Context->_new_userenv('xxx');
  98 C4::Context::set_userenv(0,0,0,'firstname','surname', 'MPL', 'Midway Public Library', '', '', '');
  99 is(C4::Context->userenv->{branch}, 'MPL', 'userenv set');
 100
 101 # Userenv set, PickupLibrary
 102 C4::Context->set_preference('CircControl', 'PickupLibrary');
 103 is(
 104     C4::Context->preference('CircControl'),
 105     'PickupLibrary',
 106     'CircControl changed to PickupLibrary'
 107 );
 108 is(
 109     C4::Circulation::_GetCircControlBranch($item, $borrower),
 110     'MPL',
 111     '_GetCircControlBranch returned current branch'
 112 );
 113
 114 # Userenv set, PatronLibrary
 115 C4::Context->set_preference('CircControl', 'PatronLibrary');
 116 is(
 117     C4::Context->preference('CircControl'),
 118     'PatronLibrary',
 119     'CircControl changed to PatronLibrary'
 120 );
 121 is(
 122     C4::Circulation::_GetCircControlBranch($item, $borrower),
 123     $borrower->{branchcode},
 124     '_GetCircControlBranch returned borrower branch'
 125 );
 126
 127 # Userenv set, ItemHomeLibrary
 128 C4::Context->set_preference('CircControl', 'ItemHomeLibrary');
 129 is(
 130     C4::Context->preference('CircControl'),
 131     'ItemHomeLibrary',
 132     'CircControl changed to ItemHomeLibrary'
 133 );
 134 is(
 135     C4::Circulation::_GetCircControlBranch($item, $borrower),
 136     $item->{$HomeOrHoldingBranch},
 137     '_GetCircControlBranch returned item branch'
 138 );
 139
 140 # Reset initial configuration
 141 C4::Context->set_preference('CircControl', $CircControl);
 142 is(
 143     C4::Context->preference('CircControl'),
 144     $CircControl,
 145     'CircControl reset to its initial value'
 146 );
 147
 148 # Set a simple circ policy
 149 $dbh->do('DELETE FROM issuingrules');
 150 $dbh->do(
 151     q{INSERT INTO issuingrules (categorycode, branchcode, itemtype, reservesallowed,
 152                                 maxissueqty, issuelength, lengthunit,
 153                                 renewalsallowed, renewalperiod,
 154                                 fine, chargeperiod)
 155       VALUES (?, ?, ?, ?,
 156               ?, ?, ?,
 157               ?, ?,
 158               ?, ?
 159              )
 160     },
 161     {},
 162     '*', '*', '*', 25,
 163     20, 14, 'days',
 164     1, 7,
 165     .10, 1
 166 );
 167
 168 # Test C4::Circulation::ProcessOfflinePayment
 169 my $sth = C4::Context->dbh->prepare("SELECT COUNT(*) FROM accountlines WHERE amount = '-123.45' AND accounttype = 'Pay'");
 170 $sth->execute();
 171 my ( $original_count ) = $sth->fetchrow_array();
 172
 173 C4::Context->dbh->do("INSERT INTO borrowers ( cardnumber, surname, firstname, categorycode, branchcode ) VALUES ( '99999999999', 'Hall', 'Kyle', 'S', 'MPL' )");
 174
 175 C4::Circulation::ProcessOfflinePayment({ cardnumber => '99999999999', amount => '123.45' });
 176
 177 $sth->execute();
 178 my ( $new_count ) = $sth->fetchrow_array();
 179
 180 ok( $new_count == $original_count  + 1, 'ProcessOfflinePayment makes payment correctly' );
 181
 182 C4::Context->dbh->do("DELETE FROM accountlines WHERE borrowernumber IN ( SELECT borrowernumber FROM borrowers WHERE cardnumber = '99999999999' )");
 183 C4::Context->dbh->do("DELETE FROM borrowers WHERE cardnumber = '99999999999'");
 184 C4::Context->dbh->do("DELETE FROM accountlines");
 185 {
 186 # CanBookBeRenewed tests
 187
 188     # Generate test biblio
 189     my $biblio = MARC::Record->new();
 190     my $title = 'Silence in the library';
 191     $biblio->append_fields(
 192         MARC::Field->new('100', ' ', ' ', a => 'Moffat, Steven'),
 193         MARC::Field->new('245', ' ', ' ', a => $title),
 194     );
 195
 196     my ($biblionumber, $biblioitemnumber) = AddBiblio($biblio, '');
 197
 198     my $barcode = 'R00000342';
 199     my $branch = 'MPL';
 200
 201     my ( $item_bibnum, $item_bibitemnum, $itemnumber ) = AddItem(
 202         {
 203             homebranch       => $branch,
 204             holdingbranch    => $branch,
 205             barcode          => $barcode,
 206             replacementprice => 12.00
 207         },
 208         $biblionumber
 209     );
 210
 211     my $barcode2 = 'R00000343';
 212     my ( $item_bibnum2, $item_bibitemnum2, $itemnumber2 ) = AddItem(
 213         {
 214             homebranch       => $branch,
 215             holdingbranch    => $branch,
 216             barcode          => $barcode2,
 217             replacementprice => 23.00
 218         },
 219         $biblionumber
 220     );
 221
 222     my $barcode3 = 'R00000346';
 223     my ( $item_bibnum3, $item_bibitemnum3, $itemnumber3 ) = AddItem(
 224         {
 225             homebranch       => $branch,
 226             holdingbranch    => $branch,
 227             barcode          => $barcode3,
 228             replacementprice => 23.00
 229         },
 230         $biblionumber
 231     );
 232
 233     # Create 2 borrowers
 234     my %renewing_borrower_data = (
 235         firstname =>  'John',
 236         surname => 'Renewal',
 237         categorycode => 'S',
 238         branchcode => $branch,
 239     );
 240
 241     my %reserving_borrower_data = (
 242         firstname =>  'Katrin',
 243         surname => 'Reservation',
 244         categorycode => 'S',
 245         branchcode => $branch,
 246     );
 247
 248     my $renewing_borrowernumber = AddMember(%renewing_borrower_data);
 249     my $reserving_borrowernumber = AddMember(%reserving_borrower_data);
 250
 251     my $renewing_borrower = GetMember( borrowernumber => $renewing_borrowernumber );
 252
 253     my $constraint     = 'a';
 254     my $bibitems       = '';
 255     my $priority       = '1';
 256     my $resdate        = undef;
 257     my $expdate        = undef;
 258     my $notes          = '';
 259     my $checkitem      = undef;
 260     my $found          = undef;
 261
 262     my $datedue = AddIssue( $renewing_borrower, $barcode);
 263     is (defined $datedue, 1, "Item 1 checked out, due date: $datedue");
 264
 265     my $datedue2 = AddIssue( $renewing_borrower, $barcode2);
 266     is (defined $datedue2, 1, "Item 2 checked out, due date: $datedue2");
 267
 268     my $borrowing_borrowernumber = GetItemIssue($itemnumber)->{borrowernumber};
 269     is ($borrowing_borrowernumber, $renewing_borrowernumber, "Item checked out to $renewing_borrower->{firstname} $renewing_borrower->{surname}");
 270
 271     my ( $renewokay, $error ) = CanBookBeRenewed($renewing_borrowernumber, $itemnumber, 1);
 272     is( $renewokay, 1, 'Can renew, no holds for this title or item');
 273
 274
 275     # Biblio-level hold, renewal test
 276     AddReserve(
 277         $branch, $reserving_borrowernumber, $biblionumber,
 278         $constraint, $bibitems,  $priority, $resdate, $expdate, $notes,
 279         $title, $checkitem, $found
 280     );
 281
 282     ( $renewokay, $error ) = CanBookBeRenewed($renewing_borrowernumber, $itemnumber);
 283     is( $renewokay, 0, '(Bug 10663) Cannot renew, reserved');
 284     is( $error, 'on_reserve', '(Bug 10663) Cannot renew, reserved (returned error is on_reserve)');
 285
 286     ( $renewokay, $error ) = CanBookBeRenewed($renewing_borrowernumber, $itemnumber2);
 287     is( $renewokay, 0, '(Bug 10663) Cannot renew, reserved');
 288     is( $error, 'on_reserve', '(Bug 10663) Cannot renew, reserved (returned error is on_reserve)');
 289
 290     my $reserveid = C4::Reserves::GetReserveId({ biblionumber => $biblionumber, borrowernumber => $reserving_borrowernumber});
 291     my $reserving_borrower = GetMember( borrowernumber => $reserving_borrowernumber );
 292     AddIssue($reserving_borrower, $barcode3);
 293     my $reserve = $dbh->selectrow_hashref(
 294         'SELECT * FROM old_reserves WHERE reserve_id = ?',
 295         { Slice => {} },
 296         $reserveid
 297     );
 298     is($reserve->{found}, 'F', 'hold marked completed when checking out item that fills it');
 299
 300     # Item-level hold, renewal test
 301     AddReserve(
 302         $branch, $reserving_borrowernumber, $biblionumber,
 303         $constraint, $bibitems,  $priority, $resdate, $expdate, $notes,
 304         $title, $itemnumber, $found
 305     );
 306
 307     ( $renewokay, $error ) = CanBookBeRenewed($renewing_borrowernumber, $itemnumber, 1);
 308     is( $renewokay, 0, '(Bug 10663) Cannot renew, item reserved');
 309     is( $error, 'on_reserve', '(Bug 10663) Cannot renew, item reserved (returned error is on_reserve)');
 310
 311     ( $renewokay, $error ) = CanBookBeRenewed($renewing_borrowernumber, $itemnumber2, 1);
 312     is( $renewokay, 1, 'Can renew item 2, item-level hold is on item 1');
 313
 314
 315     # Items can't fill hold for reasons
 316     ModItem({ notforloan => 1 }, $biblionumber, $itemnumber);
 317     ( $renewokay, $error ) = CanBookBeRenewed($renewing_borrowernumber, $itemnumber, 1);
 318     is( $renewokay, 1, 'Can renew, item is marked not for loan, hold does not block');
 319     ModItem({ notforloan => 0, itype => '' }, $biblionumber, $itemnumber,1);
 320
 321     # FIXME: Add more for itemtype not for loan etc.
 322
 323     $reserveid = C4::Reserves::GetReserveId({ biblionumber => $biblionumber, itemnumber => $itemnumber, borrowernumber => $reserving_borrowernumber});
 324     CancelReserve({ reserve_id => $reserveid });
 325
 326     # set policy to require that loans cannot be
 327     # renewed until seven days prior to the due date
 328     $dbh->do('UPDATE issuingrules SET norenewalbefore = 7');
 329     ( $renewokay, $error ) = CanBookBeRenewed($renewing_borrowernumber, $itemnumber);
 330     is( $renewokay, 0, 'Cannot renew, renewal is premature');
 331     is( $error, 'too_soon', 'Cannot renew, renewal is premature (returned code is too_soon)');
 332     is(
 333         GetSoonestRenewDate($renewing_borrowernumber, $itemnumber),
 334         $datedue->clone->add(days => -7),
 335         'renewals permitted 7 days before due date, as expected',
 336     );
 337
 338     # Too many renewals
 339
 340     # set policy to forbid renewals
 341     $dbh->do('UPDATE issuingrules SET norenewalbefore = NULL, renewalsallowed = 0');
 342
 343     ( $renewokay, $error ) = CanBookBeRenewed($renewing_borrowernumber, $itemnumber);
 344     is( $renewokay, 0, 'Cannot renew, 0 renewals allowed');
 345     is( $error, 'too_many', 'Cannot renew, 0 renewals allowed (returned code is too_many)');
 346
 347     # Test WhenLostForgiveFine and WhenLostChargeReplacementFee
 348     C4::Context->set_preference('WhenLostForgiveFine','1');
 349     C4::Context->set_preference('WhenLostChargeReplacementFee','1');
 350
 351     C4::Overdues::UpdateFine( $itemnumber, $renewing_borrower->{borrowernumber},
 352         15.00, q{}, Koha::DateUtils::output_pref($datedue) );
 353
 354     LostItem( $itemnumber, 1 );
 355
 356     my $item = $schema->resultset('Item')->find( $itemnumber );
 357     ok( !$item->onloan(), "Lost item marked as returned has false onloan value" );
 358
 359     my $total_due = $dbh->selectrow_array(
 360         'SELECT SUM( amountoutstanding ) FROM accountlines WHERE borrowernumber = ?',
 361         undef, $renewing_borrower->{borrowernumber}
 362     );
 363
 364     ok( $total_due == 12, 'Borrower only charged replacement fee with both WhenLostForgiveFine and WhenLostChargeReplacementFee enabled' );
 365
 366     C4::Context->dbh->do("DELETE FROM accountlines");
 367
 368     C4::Context->set_preference('WhenLostForgiveFine','0');
 369     C4::Context->set_preference('WhenLostChargeReplacementFee','0');
 370
 371     C4::Overdues::UpdateFine( $itemnumber2, $renewing_borrower->{borrowernumber},
 372         15.00, q{}, Koha::DateUtils::output_pref($datedue) );
 373
 374     LostItem( $itemnumber2, 0 );
 375
 376     my $item2 = $schema->resultset('Item')->find( $itemnumber2 );
 377     ok( $item2->onloan(), "Lost item *not* marked as returned has true onloan value" );
 378
 379     $total_due = $dbh->selectrow_array(
 380         'SELECT SUM( amountoutstanding ) FROM accountlines WHERE borrowernumber = ?',
 381         undef, $renewing_borrower->{borrowernumber}
 382     );
 383
 384     ok( $total_due == 15, 'Borrower only charged fine with both WhenLostForgiveFine and WhenLostChargeReplacementFee disabled' );
 385
 386     my $now = dt_from_string();
 387     my $future = dt_from_string();
 388     $future->add( days => 7 );
 389     my $units = C4::Overdues::_get_chargeable_units('days', $future, $now, 'MPL');
 390     ok( $units == 0, '_get_chargeable_units returns 0 for items not past due date (Bug 12596)' );
 391 }
 392
 393 {
 394     # GetUpcomingDueIssues tests
 395     my $barcode  = 'R00000342';
 396     my $barcode2 = 'R00000343';
 397     my $barcode3 = 'R00000344';
 398     my $branch   = 'MPL';
 399
 400     #Create another record
 401     my $biblio2 = MARC::Record->new();
 402     my $title2 = 'Something is worng here';
 403     $biblio2->append_fields(
 404         MARC::Field->new('100', ' ', ' ', a => 'Anonymous'),
 405         MARC::Field->new('245', ' ', ' ', a => $title2),
 406     );
 407     my ($biblionumber2, $biblioitemnumber2) = AddBiblio($biblio2, '');
 408
 409     #Create third item
 410     AddItem(
 411         {
 412             homebranch       => $branch,
 413             holdingbranch    => $branch,
 414             barcode          => $barcode3
 415         },
 416         $biblionumber2
 417     );
 418
 419     # Create a borrower
 420     my %a_borrower_data = (
 421         firstname =>  'Fridolyn',
 422         surname => 'SOMERS',
 423         categorycode => 'S',
 424         branchcode => $branch,
 425     );
 426
 427     my $a_borrower_borrowernumber = AddMember(%a_borrower_data);
 428     my $a_borrower = GetMember( borrowernumber => $a_borrower_borrowernumber );
 429
 430     my $yesterday = DateTime->today(time_zone => C4::Context->tz())->add( days => -1 );
 431     my $two_days_ahead = DateTime->today(time_zone => C4::Context->tz())->add( days => 2 );
 432     my $today = DateTime->today(time_zone => C4::Context->tz());
 433
 434     my $datedue  = AddIssue( $a_borrower, $barcode, $yesterday );
 435     my $datedue2 = AddIssue( $a_borrower, $barcode2, $two_days_ahead );
 436
 437     my $upcoming_dues;
 438
 439     # GetUpcomingDueIssues tests
 440     for my $i(0..1) {
 441         $upcoming_dues = C4::Circulation::GetUpcomingDueIssues( { days_in_advance => $i } );
 442         is ( scalar( @$upcoming_dues ), 0, "No items due in less than one day ($i days in advance)" );
 443     }
 444
 445     #days_in_advance needs to be inclusive, so 1 matches items due tomorrow, 0 items due today etc.
 446     $upcoming_dues = C4::Circulation::GetUpcomingDueIssues( { days_in_advance => 2 } );
 447     is ( scalar ( @$upcoming_dues), 1, "Only one item due in 2 days or less" );
 448
 449     for my $i(3..5) {
 450         $upcoming_dues = C4::Circulation::GetUpcomingDueIssues( { days_in_advance => $i } );
 451         is ( scalar( @$upcoming_dues ), 1,
 452             "Bug 9362: Only one item due in more than 2 days ($i days in advance)" );
 453     }
 454
 455     # Bug 11218 - Due notices not generated - GetUpcomingDueIssues needs to select due today items as well
 456
 457     my $datedue3 = AddIssue( $a_borrower, $barcode3, $today );
 458
 459     $upcoming_dues = C4::Circulation::GetUpcomingDueIssues( { days_in_advance => -1 } );
 460     is ( scalar ( @$upcoming_dues), 0, "Overdues can not be selected" );
 461
 462     $upcoming_dues = C4::Circulation::GetUpcomingDueIssues( { days_in_advance => 0 } );
 463     is ( scalar ( @$upcoming_dues), 1, "1 item is due today" );
 464
 465     $upcoming_dues = C4::Circulation::GetUpcomingDueIssues( { days_in_advance => 1 } );
 466     is ( scalar ( @$upcoming_dues), 1, "1 item is due today, none tomorrow" );
 467
 468     $upcoming_dues = C4::Circulation::GetUpcomingDueIssues( { days_in_advance => 2 }  );
 469     is ( scalar ( @$upcoming_dues), 2, "2 items are due withing 2 days" );
 470
 471     $upcoming_dues = C4::Circulation::GetUpcomingDueIssues( { days_in_advance => 3 } );
 472     is ( scalar ( @$upcoming_dues), 2, "2 items are due withing 2 days" );
 473
 474     $upcoming_dues = C4::Circulation::GetUpcomingDueIssues();
 475     is ( scalar ( @$upcoming_dues), 2, "days_in_advance is 7 in GetUpcomingDueIssues if not provided" );
 476
 477 }
 478
 479 $dbh->rollback;
 480
 481 1;