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