t/db_dependent/Circulation.t

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