C4/Circulation.pm

   1 package C4::Circulation;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 # copyright 2010 BibLibre
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21
  22 use strict;
  23 #use warnings; FIXME - Bug 2505
  24 use DateTime;
  25 use Koha::DateUtils;
  26 use C4::Context;
  27 use C4::Stats;
  28 use C4::Reserves;
  29 use C4::Biblio;
  30 use C4::Items;
  31 use C4::Members;
  32 use C4::Accounts;
  33 use C4::ItemCirculationAlertPreference;
  34 use C4::Message;
  35 use C4::Debug;
  36 use C4::Log; # logaction
  37 use C4::Koha qw(
  38     GetAuthorisedValueByCode
  39 );
  40 use C4::Overdues qw(CalcFine UpdateFine get_chargeable_units);
  41 use C4::RotatingCollections qw(GetCollectionItemBranches);
  42 use Algorithm::CheckDigits;
  43
  44 use Data::Dumper;
  45 use Koha::Account;
  46 use Koha::DateUtils;
  47 use Koha::Calendar;
  48 use Koha::Items;
  49 use Koha::Patrons;
  50 use Koha::Patron::Debarments;
  51 use Koha::Database;
  52 use Koha::Libraries;
  53 use Koha::Holds;
  54 use Koha::RefundLostItemFeeRule;
  55 use Koha::RefundLostItemFeeRules;
  56 use Carp;
  57 use List::MoreUtils qw( uniq );
  58 use Scalar::Util qw( looks_like_number );
  59 use Date::Calc qw(
  60   Today
  61   Today_and_Now
  62   Add_Delta_YM
  63   Add_Delta_DHMS
  64   Date_to_Days
  65   Day_of_Week
  66   Add_Delta_Days
  67 );
  68 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  69
  70 BEGIN {
  71         require Exporter;
  72         @ISA    = qw(Exporter);
  73
  74         # FIXME subs that should probably be elsewhere
  75         push @EXPORT, qw(
  76                 &barcodedecode
  77         &LostItem
  78         &ReturnLostItem
  79         &GetPendingOnSiteCheckouts
  80         );
  81
  82         # subs to deal with issuing a book
  83         push @EXPORT, qw(
  84                 &CanBookBeIssued
  85                 &CanBookBeRenewed
  86                 &AddIssue
  87                 &AddRenewal
  88                 &GetRenewCount
  89         &GetSoonestRenewDate
  90                 &GetItemIssue
  91                 &GetItemIssues
  92                 &GetIssuingCharges
  93                 &GetIssuingRule
  94         &GetBranchBorrowerCircRule
  95         &GetBranchItemRule
  96                 &GetBiblioIssues
  97                 &GetOpenIssue
  98                 &AnonymiseIssueHistory
  99         &CheckIfIssuedToPatron
 100         &IsItemIssued
 101         GetTopIssues
 102         );
 103
 104         # subs to deal with returns
 105         push @EXPORT, qw(
 106                 &AddReturn
 107         &MarkIssueReturned
 108         );
 109
 110         # subs to deal with transfers
 111         push @EXPORT, qw(
 112                 &transferbook
 113                 &GetTransfers
 114                 &GetTransfersFromTo
 115                 &updateWrongTransfer
 116                 &DeleteTransfer
 117                 &IsBranchTransferAllowed
 118                 &CreateBranchTransferLimit
 119                 &DeleteBranchTransferLimits
 120         &TransferSlip
 121         );
 122
 123     # subs to deal with offline circulation
 124     push @EXPORT, qw(
 125       &GetOfflineOperations
 126       &GetOfflineOperation
 127       &AddOfflineOperation
 128       &DeleteOfflineOperation
 129       &ProcessOfflineOperation
 130     );
 131 }
 132
 133 =head1 NAME
 134
 135 C4::Circulation - Koha circulation module
 136
 137 =head1 SYNOPSIS
 138
 139 use C4::Circulation;
 140
 141 =head1 DESCRIPTION
 142
 143 The functions in this module deal with circulation, issues, and
 144 returns, as well as general information about the library.
 145 Also deals with inventory.
 146
 147 =head1 FUNCTIONS
 148
 149 =head2 barcodedecode
 150
 151   $str = &barcodedecode($barcode, [$filter]);
 152
 153 Generic filter function for barcode string.
 154 Called on every circ if the System Pref itemBarcodeInputFilter is set.
 155 Will do some manipulation of the barcode for systems that deliver a barcode
 156 to circulation.pl that differs from the barcode stored for the item.
 157 For proper functioning of this filter, calling the function on the
 158 correct barcode string (items.barcode) should return an unaltered barcode.
 159
 160 The optional $filter argument is to allow for testing or explicit
 161 behavior that ignores the System Pref.  Valid values are the same as the
 162 System Pref options.
 163
 164 =cut
 165
 166 # FIXME -- the &decode fcn below should be wrapped into this one.
 167 # FIXME -- these plugins should be moved out of Circulation.pm
 168 #
 169 sub barcodedecode {
 170     my ($barcode, $filter) = @_;
 171     my $branch = C4::Context::mybranch();
 172     $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
 173     $filter or return $barcode;     # ensure filter is defined, else return untouched barcode
 174         if ($filter eq 'whitespace') {
 175                 $barcode =~ s/\s//g;
 176         } elsif ($filter eq 'cuecat') {
 177                 chomp($barcode);
 178             my @fields = split( /\./, $barcode );
 179             my @results = map( decode($_), @fields[ 1 .. $#fields ] );
 180             ($#results == 2) and return $results[2];
 181         } elsif ($filter eq 'T-prefix') {
 182                 if ($barcode =~ /^[Tt](\d)/) {
 183                         (defined($1) and $1 eq '0') and return $barcode;
 184             $barcode = substr($barcode, 2) + 0;     # FIXME: probably should be substr($barcode, 1)
 185                 }
 186         return sprintf("T%07d", $barcode);
 187         # FIXME: $barcode could be "T1", causing warning: substr outside of string
 188         # Why drop the nonzero digit after the T?
 189         # Why pass non-digits (or empty string) to "T%07d"?
 190         } elsif ($filter eq 'libsuite8') {
 191                 unless($barcode =~ m/^($branch)-/i){    #if barcode starts with branch code its in Koha style. Skip it.
 192                         if($barcode =~ m/^(\d)/i){      #Some barcodes even start with 0's & numbers and are assumed to have b as the item type in the libsuite8 software
 193                                 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
 194                         }else{
 195                                 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
 196                         }
 197                 }
 198     } elsif ($filter eq 'EAN13') {
 199         my $ean = CheckDigits('ean');
 200         if ( $ean->is_valid($barcode) ) {
 201             #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
 202             $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
 203         } else {
 204             warn "# [$barcode] not valid EAN-13/UPC-A\n";
 205         }
 206         }
 207     return $barcode;    # return barcode, modified or not
 208 }
 209
 210 =head2 decode
 211
 212   $str = &decode($chunk);
 213
 214 Decodes a segment of a string emitted by a CueCat barcode scanner and
 215 returns it.
 216
 217 FIXME: Should be replaced with Barcode::Cuecat from CPAN
 218 or Javascript based decoding on the client side.
 219
 220 =cut
 221
 222 sub decode {
 223     my ($encoded) = @_;
 224     my $seq =
 225       'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
 226     my @s = map { index( $seq, $_ ); } split( //, $encoded );
 227     my $l = ( $#s + 1 ) % 4;
 228     if ($l) {
 229         if ( $l == 1 ) {
 230             # warn "Error: Cuecat decode parsing failed!";
 231             return;
 232         }
 233         $l = 4 - $l;
 234         $#s += $l;
 235     }
 236     my $r = '';
 237     while ( $#s >= 0 ) {
 238         my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
 239         $r .=
 240             chr( ( $n >> 16 ) ^ 67 )
 241          .chr( ( $n >> 8 & 255 ) ^ 67 )
 242          .chr( ( $n & 255 ) ^ 67 );
 243         @s = @s[ 4 .. $#s ];
 244     }
 245     $r = substr( $r, 0, length($r) - $l );
 246     return $r;
 247 }
 248
 249 =head2 transferbook
 250
 251   ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
 252                                             $barcode, $ignore_reserves);
 253
 254 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
 255
 256 C<$newbranch> is the code for the branch to which the item should be transferred.
 257
 258 C<$barcode> is the barcode of the item to be transferred.
 259
 260 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
 261 Otherwise, if an item is reserved, the transfer fails.
 262
 263 Returns three values:
 264
 265 =over
 266
 267 =item $dotransfer
 268
 269 is true if the transfer was successful.
 270
 271 =item $messages
 272
 273 is a reference-to-hash which may have any of the following keys:
 274
 275 =over
 276
 277 =item C<BadBarcode>
 278
 279 There is no item in the catalog with the given barcode. The value is C<$barcode>.
 280
 281 =item C<IsPermanent>
 282
 283 The item's home branch is permanent. This doesn't prevent the item from being transferred, though. The value is the code of the item's home branch.
 284
 285 =item C<DestinationEqualsHolding>
 286
 287 The item is already at the branch to which it is being transferred. The transfer is nonetheless considered to have failed. The value should be ignored.
 288
 289 =item C<WasReturned>
 290
 291 The item was on loan, and C<&transferbook> automatically returned it before transferring it. The value is the borrower number of the patron who had the item.
 292
 293 =item C<ResFound>
 294
 295 The item was reserved. The value is a reference-to-hash whose keys are fields from the reserves table of the Koha database, and C<biblioitemnumber>. It also has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>.
 296
 297 =item C<WasTransferred>
 298
 299 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
 300
 301 =back
 302
 303 =back
 304
 305 =cut
 306
 307 sub transferbook {
 308     my ( $tbr, $barcode, $ignoreRs ) = @_;
 309     my $messages;
 310     my $dotransfer      = 1;
 311     my $itemnumber = GetItemnumberFromBarcode( $barcode );
 312     my $issue      = GetItemIssue($itemnumber);
 313     my $biblio = GetBiblioFromItemNumber($itemnumber);
 314
 315     # bad barcode..
 316     if ( not $itemnumber ) {
 317         $messages->{'BadBarcode'} = $barcode;
 318         $dotransfer = 0;
 319     }
 320
 321     # get branches of book...
 322     my $hbr = $biblio->{'homebranch'};
 323     my $fbr = $biblio->{'holdingbranch'};
 324
 325     # if using Branch Transfer Limits
 326     if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
 327         if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
 328             if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
 329                 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
 330                 $dotransfer = 0;
 331             }
 332         } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
 333             $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
 334             $dotransfer = 0;
 335         }
 336     }
 337
 338     # if is permanent...
 339     # FIXME Is this still used by someone?
 340     # See other FIXME in AddReturn
 341     my $library = Koha::Libraries->find($hbr);
 342     if ( $library and $library->get_categories->search({'me.categorycode' => 'PE'})->count ) {
 343         $messages->{'IsPermanent'} = $hbr;
 344         $dotransfer = 0;
 345     }
 346
 347     # can't transfer book if is already there....
 348     if ( $fbr eq $tbr ) {
 349         $messages->{'DestinationEqualsHolding'} = 1;
 350         $dotransfer = 0;
 351     }
 352
 353     # check if it is still issued to someone, return it...
 354     if ($issue->{borrowernumber}) {
 355         AddReturn( $barcode, $fbr );
 356         $messages->{'WasReturned'} = $issue->{borrowernumber};
 357     }
 358
 359     # find reserves.....
 360     # That'll save a database query.
 361     my ( $resfound, $resrec, undef ) =
 362       CheckReserves( $itemnumber );
 363     if ( $resfound and not $ignoreRs ) {
 364         $resrec->{'ResFound'} = $resfound;
 365
 366         #         $messages->{'ResFound'} = $resrec;
 367         $dotransfer = 1;
 368     }
 369
 370     #actually do the transfer....
 371     if ($dotransfer) {
 372         ModItemTransfer( $itemnumber, $fbr, $tbr );
 373
 374         # don't need to update MARC anymore, we do it in batch now
 375         $messages->{'WasTransfered'} = 1;
 376
 377     }
 378     ModDateLastSeen( $itemnumber );
 379     return ( $dotransfer, $messages, $biblio );
 380 }
 381
 382
 383 sub TooMany {
 384     my $borrower        = shift;
 385     my $biblionumber = shift;
 386         my $item                = shift;
 387     my $params = shift;
 388     my $onsite_checkout = $params->{onsite_checkout} || 0;
 389     my $switch_onsite_checkout = $params->{switch_onsite_checkout} || 0;
 390     my $cat_borrower    = $borrower->{'categorycode'};
 391     my $dbh             = C4::Context->dbh;
 392         my $branch;
 393         # Get which branchcode we need
 394         $branch = _GetCircControlBranch($item,$borrower);
 395         my $type = (C4::Context->preference('item-level_itypes'))
 396                         ? $item->{'itype'}         # item-level
 397                         : $item->{'itemtype'};     # biblio-level
 398
 399     # given branch, patron category, and item type, determine
 400     # applicable issuing rule
 401     my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
 402
 403     # if a rule is found and has a loan limit set, count
 404     # how many loans the patron already has that meet that
 405     # rule
 406     if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
 407         my @bind_params;
 408         my $count_query = q|
 409             SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
 410             FROM issues
 411             JOIN items USING (itemnumber)
 412         |;
 413
 414         my $rule_itemtype = $issuing_rule->{itemtype};
 415         if ($rule_itemtype eq "*") {
 416             # matching rule has the default item type, so count only
 417             # those existing loans that don't fall under a more
 418             # specific rule
 419             if (C4::Context->preference('item-level_itypes')) {
 420                 $count_query .= " WHERE items.itype NOT IN (
 421                                     SELECT itemtype FROM issuingrules
 422                                     WHERE branchcode = ?
 423                                     AND   (categorycode = ? OR categorycode = ?)
 424                                     AND   itemtype <> '*'
 425                                   ) ";
 426             } else {
 427                 $count_query .= " JOIN  biblioitems USING (biblionumber)
 428                                   WHERE biblioitems.itemtype NOT IN (
 429                                     SELECT itemtype FROM issuingrules
 430                                     WHERE branchcode = ?
 431                                     AND   (categorycode = ? OR categorycode = ?)
 432                                     AND   itemtype <> '*'
 433                                   ) ";
 434             }
 435             push @bind_params, $issuing_rule->{branchcode};
 436             push @bind_params, $issuing_rule->{categorycode};
 437             push @bind_params, $cat_borrower;
 438         } else {
 439             # rule has specific item type, so count loans of that
 440             # specific item type
 441             if (C4::Context->preference('item-level_itypes')) {
 442                 $count_query .= " WHERE items.itype = ? ";
 443             } else {
 444                 $count_query .= " JOIN  biblioitems USING (biblionumber)
 445                                   WHERE biblioitems.itemtype= ? ";
 446             }
 447             push @bind_params, $type;
 448         }
 449
 450         $count_query .= " AND borrowernumber = ? ";
 451         push @bind_params, $borrower->{'borrowernumber'};
 452         my $rule_branch = $issuing_rule->{branchcode};
 453         if ($rule_branch ne "*") {
 454             if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
 455                 $count_query .= " AND issues.branchcode = ? ";
 456                 push @bind_params, $branch;
 457             } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
 458                 ; # if branch is the patron's home branch, then count all loans by patron
 459             } else {
 460                 $count_query .= " AND items.homebranch = ? ";
 461                 push @bind_params, $branch;
 462             }
 463         }
 464
 465         my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $count_query, {}, @bind_params );
 466
 467         my $max_checkouts_allowed = $issuing_rule->{maxissueqty};
 468         my $max_onsite_checkouts_allowed = $issuing_rule->{maxonsiteissueqty};
 469
 470         if ( $onsite_checkout ) {
 471             if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed )  {
 472                 return {
 473                     reason => 'TOO_MANY_ONSITE_CHECKOUTS',
 474                     count => $onsite_checkout_count,
 475                     max_allowed => $max_onsite_checkouts_allowed,
 476                 }
 477             }
 478         }
 479         if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
 480             my $delta = $switch_onsite_checkout ? 1 : 0;
 481             if ( $checkout_count >= $max_checkouts_allowed + $delta ) {
 482                 return {
 483                     reason => 'TOO_MANY_CHECKOUTS',
 484                     count => $checkout_count,
 485                     max_allowed => $max_checkouts_allowed,
 486                 };
 487             }
 488         } elsif ( not $onsite_checkout ) {
 489             if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed )  {
 490                 return {
 491                     reason => 'TOO_MANY_CHECKOUTS',
 492                     count => $checkout_count - $onsite_checkout_count,
 493                     max_allowed => $max_checkouts_allowed,
 494                 };
 495             }
 496         }
 497     }
 498
 499     # Now count total loans against the limit for the branch
 500     my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
 501     if (defined($branch_borrower_circ_rule->{maxissueqty})) {
 502         my @bind_params = ();
 503         my $branch_count_query = q|
 504             SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
 505             FROM issues
 506             JOIN items USING (itemnumber)
 507             WHERE borrowernumber = ?
 508         |;
 509         push @bind_params, $borrower->{borrowernumber};
 510
 511         if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
 512             $branch_count_query .= " AND issues.branchcode = ? ";
 513             push @bind_params, $branch;
 514         } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
 515             ; # if branch is the patron's home branch, then count all loans by patron
 516         } else {
 517             $branch_count_query .= " AND items.homebranch = ? ";
 518             push @bind_params, $branch;
 519         }
 520         my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $branch_count_query, {}, @bind_params );
 521         my $max_checkouts_allowed = $branch_borrower_circ_rule->{maxissueqty};
 522         my $max_onsite_checkouts_allowed = $branch_borrower_circ_rule->{maxonsiteissueqty};
 523
 524         if ( $onsite_checkout ) {
 525             if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed )  {
 526                 return {
 527                     reason => 'TOO_MANY_ONSITE_CHECKOUTS',
 528                     count => $onsite_checkout_count,
 529                     max_allowed => $max_onsite_checkouts_allowed,
 530                 }
 531             }
 532         }
 533         if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
 534             my $delta = $switch_onsite_checkout ? 1 : 0;
 535             if ( $checkout_count >= $max_checkouts_allowed + $delta ) {
 536                 return {
 537                     reason => 'TOO_MANY_CHECKOUTS',
 538                     count => $checkout_count,
 539                     max_allowed => $max_checkouts_allowed,
 540                 };
 541             }
 542         } elsif ( not $onsite_checkout ) {
 543             if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed )  {
 544                 return {
 545                     reason => 'TOO_MANY_CHECKOUTS',
 546                     count => $checkout_count - $onsite_checkout_count,
 547                     max_allowed => $max_checkouts_allowed,
 548                 };
 549             }
 550         }
 551     }
 552
 553     # OK, the patron can issue !!!
 554     return;
 555 }
 556
 557 =head2 CanBookBeIssued
 558
 559   ( $issuingimpossible, $needsconfirmation ) =  CanBookBeIssued( $borrower,
 560                       $barcode, $duedate, $inprocess, $ignore_reserves, $params );
 561
 562 Check if a book can be issued.
 563
 564 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
 565
 566 =over 4
 567
 568 =item C<$borrower> hash with borrower informations (from GetMember or GetMemberDetails)
 569
 570 =item C<$barcode> is the bar code of the book being issued.
 571
 572 =item C<$duedates> is a DateTime object.
 573
 574 =item C<$inprocess> boolean switch
 575
 576 =item C<$ignore_reserves> boolean switch
 577
 578 =item C<$params> Hashref of additional parameters
 579
 580 Available keys:
 581     override_high_holds - Ignore high holds
 582     onsite_checkout     - Checkout is an onsite checkout that will not leave the library
 583
 584 =back
 585
 586 Returns :
 587
 588 =over 4
 589
 590 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
 591 Possible values are :
 592
 593 =back
 594
 595 =head3 INVALID_DATE
 596
 597 sticky due date is invalid
 598
 599 =head3 GNA
 600
 601 borrower gone with no address
 602
 603 =head3 CARD_LOST
 604
 605 borrower declared it's card lost
 606
 607 =head3 DEBARRED
 608
 609 borrower debarred
 610
 611 =head3 UNKNOWN_BARCODE
 612
 613 barcode unknown
 614
 615 =head3 NOT_FOR_LOAN
 616
 617 item is not for loan
 618
 619 =head3 WTHDRAWN
 620
 621 item withdrawn.
 622
 623 =head3 RESTRICTED
 624
 625 item is restricted (set by ??)
 626
 627 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
 628 could be prevented, but ones that can be overriden by the operator.
 629
 630 Possible values are :
 631
 632 =head3 DEBT
 633
 634 borrower has debts.
 635
 636 =head3 RENEW_ISSUE
 637
 638 renewing, not issuing
 639
 640 =head3 ISSUED_TO_ANOTHER
 641
 642 issued to someone else.
 643
 644 =head3 RESERVED
 645
 646 reserved for someone else.
 647
 648 =head3 INVALID_DATE
 649
 650 sticky due date is invalid or due date in the past
 651
 652 =head3 TOO_MANY
 653
 654 if the borrower borrows to much things
 655
 656 =cut
 657
 658 sub CanBookBeIssued {
 659     my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves, $params ) = @_;
 660     my %needsconfirmation;    # filled with problems that needs confirmations
 661     my %issuingimpossible;    # filled with problems that causes the issue to be IMPOSSIBLE
 662     my %alerts;               # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
 663     my %messages;             # filled with information messages that should be displayed.
 664
 665     my $onsite_checkout     = $params->{onsite_checkout}     || 0;
 666     my $override_high_holds = $params->{override_high_holds} || 0;
 667
 668     my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
 669     my $issue = GetItemIssue($item->{itemnumber});
 670         my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
 671         $item->{'itemtype'}=$item->{'itype'};
 672     my $dbh             = C4::Context->dbh;
 673
 674     # MANDATORY CHECKS - unless item exists, nothing else matters
 675     unless ( $item->{barcode} ) {
 676         $issuingimpossible{UNKNOWN_BARCODE} = 1;
 677     }
 678         return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
 679
 680     #
 681     # DUE DATE is OK ? -- should already have checked.
 682     #
 683     if ($duedate && ref $duedate ne 'DateTime') {
 684         $duedate = dt_from_string($duedate);
 685     }
 686     my $now = DateTime->now( time_zone => C4::Context->tz() );
 687     unless ( $duedate ) {
 688         my $issuedate = $now->clone();
 689
 690         my $branch = _GetCircControlBranch($item,$borrower);
 691         my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
 692         $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
 693
 694         # Offline circ calls AddIssue directly, doesn't run through here
 695         #  So issuingimpossible should be ok.
 696     }
 697     if ($duedate) {
 698         my $today = $now->clone();
 699         $today->truncate( to => 'minute');
 700         if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
 701             $needsconfirmation{INVALID_DATE} = output_pref($duedate);
 702         }
 703     } else {
 704             $issuingimpossible{INVALID_DATE} = output_pref($duedate);
 705     }
 706
 707     #
 708     # BORROWER STATUS
 709     #
 710     if ( $borrower->{'category_type'} eq 'X' && (  $item->{barcode}  )) {
 711         # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1  .
 712         &UpdateStats({
 713                      branch => C4::Context->userenv->{'branch'},
 714                      type => 'localuse',
 715                      itemnumber => $item->{'itemnumber'},
 716                      itemtype => $item->{'itemtype'},
 717                      borrowernumber => $borrower->{'borrowernumber'},
 718                      ccode => $item->{'ccode'}}
 719                     );
 720         ModDateLastSeen( $item->{'itemnumber'} );
 721         return( { STATS => 1 }, {});
 722     }
 723     if ( ref $borrower->{flags} ) {
 724         if ( $borrower->{flags}->{GNA} ) {
 725             $issuingimpossible{GNA} = 1;
 726         }
 727         if ( $borrower->{flags}->{'LOST'} ) {
 728             $issuingimpossible{CARD_LOST} = 1;
 729         }
 730         if ( $borrower->{flags}->{'DBARRED'} ) {
 731             $issuingimpossible{DEBARRED} = 1;
 732         }
 733     }
 734     if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
 735         $issuingimpossible{EXPIRED} = 1;
 736     } else {
 737         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'sql', 'floating' );
 738         $expiry_dt->truncate( to => 'day');
 739         my $today = $now->clone()->truncate(to => 'day');
 740         $today->set_time_zone( 'floating' );
 741         if ( DateTime->compare($today, $expiry_dt) == 1 ) {
 742             $issuingimpossible{EXPIRED} = 1;
 743         }
 744     }
 745
 746     #
 747     # BORROWER STATUS
 748     #
 749
 750     # DEBTS
 751     my ($balance, $non_issue_charges, $other_charges) =
 752       C4::Members::GetMemberAccountBalance( $borrower->{'borrowernumber'} );
 753
 754     my $amountlimit = C4::Context->preference("noissuescharge");
 755     my $allowfineoverride = C4::Context->preference("AllowFineOverride");
 756     my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
 757
 758     # Check the debt of this patrons guarantees
 759     my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
 760     $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
 761     if ( defined $no_issues_charge_guarantees ) {
 762         my $p = Koha::Patrons->find( $borrower->{borrowernumber} );
 763         my @guarantees = $p->guarantees();
 764         my $guarantees_non_issues_charges;
 765         foreach my $g ( @guarantees ) {
 766             my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
 767             $guarantees_non_issues_charges += $n;
 768         }
 769
 770         if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && !$allowfineoverride) {
 771             $issuingimpossible{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
 772         } elsif ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && $allowfineoverride) {
 773             $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
 774         } elsif ( $allfinesneedoverride && $guarantees_non_issues_charges > 0 && $guarantees_non_issues_charges <= $no_issues_charge_guarantees && !$inprocess ) {
 775             $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
 776         }
 777     }
 778
 779     if ( C4::Context->preference("IssuingInProcess") ) {
 780         if ( $non_issue_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
 781             $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
 782         } elsif ( $non_issue_charges > $amountlimit && !$inprocess && $allowfineoverride) {
 783             $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
 784         } elsif ( $allfinesneedoverride && $non_issue_charges > 0 && $non_issue_charges <= $amountlimit && !$inprocess ) {
 785             $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
 786         }
 787     }
 788     else {
 789         if ( $non_issue_charges > $amountlimit && $allowfineoverride ) {
 790             $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
 791         } elsif ( $non_issue_charges > $amountlimit && !$allowfineoverride) {
 792             $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
 793         } elsif ( $non_issue_charges > 0 && $allfinesneedoverride ) {
 794             $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
 795         }
 796     }
 797
 798     if ($balance > 0 && $other_charges > 0) {
 799         $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
 800     }
 801
 802     my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
 803     if ( my $debarred_date = $patron->is_debarred ) {
 804          # patron has accrued fine days or has a restriction. $count is a date
 805         if ($debarred_date eq '9999-12-31') {
 806             $issuingimpossible{USERBLOCKEDNOENDDATE} = $debarred_date;
 807         }
 808         else {
 809             $issuingimpossible{USERBLOCKEDWITHENDDATE} = $debarred_date;
 810         }
 811     } elsif ( my $num_overdues = $patron->has_overdues ) {
 812         ## patron has outstanding overdue loans
 813         if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
 814             $issuingimpossible{USERBLOCKEDOVERDUE} = $num_overdues;
 815         }
 816         elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
 817             $needsconfirmation{USERBLOCKEDOVERDUE} = $num_overdues;
 818         }
 819     }
 820
 821     # JB34 CHECKS IF BORROWERS DON'T HAVE ISSUE TOO MANY BOOKS
 822     #
 823     my $switch_onsite_checkout =
 824           C4::Context->preference('SwitchOnSiteCheckouts')
 825       and $issue->{onsite_checkout}
 826       and $issue
 827       and $issue->{borrowernumber} == $borrower->{'borrowernumber'} ? 1 : 0;
 828     my $toomany = TooMany( $borrower, $item->{biblionumber}, $item, { onsite_checkout => $onsite_checkout, switch_onsite_checkout => $switch_onsite_checkout, } );
 829     # if TooMany max_allowed returns 0 the user doesn't have permission to check out this book
 830     if ( $toomany ) {
 831         if ( $toomany->{max_allowed} == 0 ) {
 832             $needsconfirmation{PATRON_CANT} = 1;
 833         }
 834         if ( C4::Context->preference("AllowTooManyOverride") ) {
 835             $needsconfirmation{TOO_MANY} = $toomany->{reason};
 836             $needsconfirmation{current_loan_count} = $toomany->{count};
 837             $needsconfirmation{max_loans_allowed} = $toomany->{max_allowed};
 838         } else {
 839             $issuingimpossible{TOO_MANY} = $toomany->{reason};
 840             $issuingimpossible{current_loan_count} = $toomany->{count};
 841             $issuingimpossible{max_loans_allowed} = $toomany->{max_allowed};
 842         }
 843     }
 844
 845     #
 846     # CHECKPREVCHECKOUT: CHECK IF ITEM HAS EVER BEEN LENT TO PATRON
 847     #
 848     $patron = Koha::Patrons->find($borrower->{borrowernumber});
 849     my $wants_check = $patron->wants_check_for_previous_checkout;
 850     $needsconfirmation{PREVISSUE} = 1
 851         if ($wants_check and $patron->do_check_for_previous_checkout($item));
 852
 853     #
 854     # ITEM CHECKING
 855     #
 856     if ( $item->{'notforloan'} )
 857     {
 858         if(!C4::Context->preference("AllowNotForLoanOverride")){
 859             $issuingimpossible{NOT_FOR_LOAN} = 1;
 860             $issuingimpossible{item_notforloan} = $item->{'notforloan'};
 861         }else{
 862             $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 863             $needsconfirmation{item_notforloan} = $item->{'notforloan'};
 864         }
 865     }
 866     else {
 867         # we have to check itemtypes.notforloan also
 868         if (C4::Context->preference('item-level_itypes')){
 869             # this should probably be a subroutine
 870             my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
 871             $sth->execute($item->{'itemtype'});
 872             my $notforloan=$sth->fetchrow_hashref();
 873             if ($notforloan->{'notforloan'}) {
 874                 if (!C4::Context->preference("AllowNotForLoanOverride")) {
 875                     $issuingimpossible{NOT_FOR_LOAN} = 1;
 876                     $issuingimpossible{itemtype_notforloan} = $item->{'itype'};
 877                 } else {
 878                     $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 879                     $needsconfirmation{itemtype_notforloan} = $item->{'itype'};
 880                 }
 881             }
 882         }
 883         elsif ($biblioitem->{'notforloan'} == 1){
 884             if (!C4::Context->preference("AllowNotForLoanOverride")) {
 885                 $issuingimpossible{NOT_FOR_LOAN} = 1;
 886                 $issuingimpossible{itemtype_notforloan} = $biblioitem->{'itemtype'};
 887             } else {
 888                 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 889                 $needsconfirmation{itemtype_notforloan} = $biblioitem->{'itemtype'};
 890             }
 891         }
 892     }
 893     if ( $item->{'withdrawn'} && $item->{'withdrawn'} > 0 )
 894     {
 895         $issuingimpossible{WTHDRAWN} = 1;
 896     }
 897     if (   $item->{'restricted'}
 898         && $item->{'restricted'} == 1 )
 899     {
 900         $issuingimpossible{RESTRICTED} = 1;
 901     }
 902     if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
 903         my $code = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
 904         $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
 905         $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
 906     }
 907     if ( C4::Context->preference("IndependentBranches") ) {
 908         my $userenv = C4::Context->userenv;
 909         unless ( C4::Context->IsSuperLibrarian() ) {
 910             if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
 911                 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
 912                 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
 913             }
 914             $needsconfirmation{BORRNOTSAMEBRANCH} = $borrower->{'branchcode'}
 915               if ( $borrower->{'branchcode'} ne $userenv->{branch} );
 916         }
 917     }
 918     #
 919     # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
 920     #
 921     my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
 922
 923     if ( $rentalConfirmation ){
 924         my ($rentalCharge) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
 925         if ( $rentalCharge > 0 ){
 926             $rentalCharge = sprintf("%.02f", $rentalCharge);
 927             $needsconfirmation{RENTALCHARGE} = $rentalCharge;
 928         }
 929     }
 930
 931     #
 932     # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
 933     #
 934     if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} ){
 935
 936         # Already issued to current borrower.
 937         # If it is an on-site checkout if it can be switched to a normal checkout
 938         # or ask whether the loan should be renewed
 939
 940         if ( $issue->{onsite_checkout}
 941                 and C4::Context->preference('SwitchOnSiteCheckouts') ) {
 942             $messages{ONSITE_CHECKOUT_WILL_BE_SWITCHED} = 1;
 943         } else {
 944             my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
 945                 $borrower->{'borrowernumber'},
 946                 $item->{'itemnumber'},
 947             );
 948             if ( $CanBookBeRenewed == 0 ) {    # no more renewals allowed
 949                 if ( $renewerror eq 'onsite_checkout' ) {
 950                     $issuingimpossible{NO_RENEWAL_FOR_ONSITE_CHECKOUTS} = 1;
 951                 }
 952                 else {
 953                     $issuingimpossible{NO_MORE_RENEWALS} = 1;
 954                 }
 955             }
 956             else {
 957                 $needsconfirmation{RENEW_ISSUE} = 1;
 958             }
 959         }
 960     }
 961     elsif ($issue->{borrowernumber}) {
 962
 963         # issued to someone else
 964         my $currborinfo =    C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
 965
 966
 967         my ( $can_be_returned, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
 968
 969         unless ( $can_be_returned ) {
 970             $issuingimpossible{RETURN_IMPOSSIBLE} = 1;
 971             $issuingimpossible{branch_to_return} = $message;
 972         } else {
 973             $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
 974             $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
 975             $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
 976             $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
 977             $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
 978         }
 979     }
 980
 981     unless ( $ignore_reserves ) {
 982         # See if the item is on reserve.
 983         my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
 984         if ($restype) {
 985             my $resbor = $res->{'borrowernumber'};
 986             if ( $resbor ne $borrower->{'borrowernumber'} ) {
 987                 my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
 988                 if ( $restype eq "Waiting" )
 989                 {
 990                     # The item is on reserve and waiting, but has been
 991                     # reserved by some other patron.
 992                     $needsconfirmation{RESERVE_WAITING} = 1;
 993                     $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
 994                     $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
 995                     $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
 996                     $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
 997                     $needsconfirmation{'resbranchcode'} = $res->{branchcode};
 998                     $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
 999                 }
1000                 elsif ( $restype eq "Reserved" ) {
1001                     # The item is on reserve for someone else.
1002                     $needsconfirmation{RESERVED} = 1;
1003                     $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
1004                     $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
1005                     $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1006                     $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1007                     $needsconfirmation{'resbranchcode'} = $res->{branchcode};
1008                     $needsconfirmation{'resreservedate'} = $res->{'reservedate'};
1009                 }
1010             }
1011         }
1012     }
1013
1014     ## CHECK AGE RESTRICTION
1015     my $agerestriction  = $biblioitem->{'agerestriction'};
1016     my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
1017     if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1018         if ( C4::Context->preference('AgeRestrictionOverride') ) {
1019             $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1020         }
1021         else {
1022             $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1023         }
1024     }
1025
1026     ## check for high holds decreasing loan period
1027     if ( C4::Context->preference('decreaseLoanHighHolds') ) {
1028         my $check = checkHighHolds( $item, $borrower );
1029
1030         if ( $check->{exceeded} ) {
1031             if ($override_high_holds) {
1032                 $alerts{HIGHHOLDS} = {
1033                     num_holds  => $check->{outstanding},
1034                     duration   => $check->{duration},
1035                     returndate => output_pref( $check->{due_date} ),
1036                 };
1037             }
1038             else {
1039                 $needsconfirmation{HIGHHOLDS} = {
1040                     num_holds  => $check->{outstanding},
1041                     duration   => $check->{duration},
1042                     returndate => output_pref( $check->{due_date} ),
1043                 };
1044             }
1045         }
1046     }
1047
1048     if (
1049         !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1050         # don't do the multiple loans per bib check if we've
1051         # already determined that we've got a loan on the same item
1052         !$issuingimpossible{NO_MORE_RENEWALS} &&
1053         !$needsconfirmation{RENEW_ISSUE}
1054     ) {
1055         # Check if borrower has already issued an item from the same biblio
1056         # Only if it's not a subscription
1057         my $biblionumber = $item->{biblionumber};
1058         require C4::Serials;
1059         my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1060         unless ($is_a_subscription) {
1061             my $issues = GetIssues( {
1062                 borrowernumber => $borrower->{borrowernumber},
1063                 biblionumber   => $biblionumber,
1064             } );
1065             my @issues = $issues ? @$issues : ();
1066             # if we get here, we don't already have a loan on this item,
1067             # so if there are any loans on this bib, ask for confirmation
1068             if (scalar @issues > 0) {
1069                 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1070             }
1071         }
1072     }
1073
1074     return ( \%issuingimpossible, \%needsconfirmation, \%alerts, \%messages, );
1075 }
1076
1077 =head2 CanBookBeReturned
1078
1079   ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1080
1081 Check whether the item can be returned to the provided branch
1082
1083 =over 4
1084
1085 =item C<$item> is a hash of item information as returned from GetItem
1086
1087 =item C<$branch> is the branchcode where the return is taking place
1088
1089 =back
1090
1091 Returns:
1092
1093 =over 4
1094
1095 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1096
1097 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1098
1099 =back
1100
1101 =cut
1102
1103 sub CanBookBeReturned {
1104   my ($item, $branch) = @_;
1105   my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1106
1107   # assume return is allowed to start
1108   my $allowed = 1;
1109   my $message;
1110
1111   # identify all cases where return is forbidden
1112   if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1113      $allowed = 0;
1114      $message = $item->{'homebranch'};
1115   } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1116      $allowed = 0;
1117      $message = $item->{'holdingbranch'};
1118   } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1119      $allowed = 0;
1120      $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1121   }
1122
1123   return ($allowed, $message);
1124 }
1125
1126 =head2 CheckHighHolds
1127
1128     used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1129     decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1130     has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1131
1132 =cut
1133
1134 sub checkHighHolds {
1135     my ( $item, $borrower ) = @_;
1136     my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1137     my $branch = _GetCircControlBranch( $item, $borrower );
1138
1139     my $return_data = {
1140         exceeded    => 0,
1141         outstanding => 0,
1142         duration    => 0,
1143         due_date    => undef,
1144     };
1145
1146     my $holds = Koha::Holds->search( { biblionumber => $item->{'biblionumber'} } );
1147
1148     if ( $holds->count() ) {
1149         $return_data->{outstanding} = $holds->count();
1150
1151         my $decreaseLoanHighHoldsControl        = C4::Context->preference('decreaseLoanHighHoldsControl');
1152         my $decreaseLoanHighHoldsValue          = C4::Context->preference('decreaseLoanHighHoldsValue');
1153         my $decreaseLoanHighHoldsIgnoreStatuses = C4::Context->preference('decreaseLoanHighHoldsIgnoreStatuses');
1154
1155         my @decreaseLoanHighHoldsIgnoreStatuses = split( /,/, $decreaseLoanHighHoldsIgnoreStatuses );
1156
1157         if ( $decreaseLoanHighHoldsControl eq 'static' ) {
1158
1159             # static means just more than a given number of holds on the record
1160
1161             # If the number of holds is less than the threshold, we can stop here
1162             if ( $holds->count() < $decreaseLoanHighHoldsValue ) {
1163                 return $return_data;
1164             }
1165         }
1166         elsif ( $decreaseLoanHighHoldsControl eq 'dynamic' ) {
1167
1168             # dynamic means X more than the number of holdable items on the record
1169
1170             # let's get the items
1171             my @items = $holds->next()->biblio()->items();
1172
1173             # Remove any items with status defined to be ignored even if the would not make item unholdable
1174             foreach my $status (@decreaseLoanHighHoldsIgnoreStatuses) {
1175                 @items = grep { !$_->$status } @items;
1176             }
1177
1178             # Remove any items that are not holdable for this patron
1179             @items = grep { CanItemBeReserved( $borrower->{borrowernumber}, $_->itemnumber ) eq 'OK' } @items;
1180
1181             my $items_count = scalar @items;
1182
1183             my $threshold = $items_count + $decreaseLoanHighHoldsValue;
1184
1185             # If the number of holds is less than the count of items we have
1186             # plus the number of holds allowed above that count, we can stop here
1187             if ( $holds->count() <= $threshold ) {
1188                 return $return_data;
1189             }
1190         }
1191
1192         my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1193
1194         my $calendar = Koha::Calendar->new( branchcode => $branch );
1195
1196         my $itype =
1197           ( C4::Context->preference('item-level_itypes') )
1198           ? $biblio->{'itype'}
1199           : $biblio->{'itemtype'};
1200
1201         my $orig_due = C4::Circulation::CalcDateDue( $issuedate, $itype, $branch, $borrower );
1202
1203         my $decreaseLoanHighHoldsDuration = C4::Context->preference('decreaseLoanHighHoldsDuration');
1204
1205         my $reduced_datedue = $calendar->addDate( $issuedate, $decreaseLoanHighHoldsDuration );
1206
1207         if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1208             $return_data->{exceeded} = 1;
1209             $return_data->{duration} = $decreaseLoanHighHoldsDuration;
1210             $return_data->{due_date} = $reduced_datedue;
1211         }
1212     }
1213
1214     return $return_data;
1215 }
1216
1217 =head2 AddIssue
1218
1219   &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1220
1221 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1222
1223 =over 4
1224
1225 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).
1226
1227 =item C<$barcode> is the barcode of the item being issued.
1228
1229 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1230 Calculated if empty.
1231
1232 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1233
1234 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1235 Defaults to today.  Unlike C<$datedue>, NOT a DateTime object, unfortunately.
1236
1237 AddIssue does the following things :
1238
1239   - step 01: check that there is a borrowernumber & a barcode provided
1240   - check for RENEWAL (book issued & being issued to the same patron)
1241       - renewal YES = Calculate Charge & renew
1242       - renewal NO  =
1243           * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1244           * RESERVE PLACED ?
1245               - fill reserve if reserve to this patron
1246               - cancel reserve or not, otherwise
1247           * TRANSFERT PENDING ?
1248               - complete the transfert
1249           * ISSUE THE BOOK
1250
1251 =back
1252
1253 =cut
1254
1255 sub AddIssue {
1256     my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1257
1258     my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1259     my $switch_onsite_checkout = $params && $params->{switch_onsite_checkout};
1260     my $auto_renew = $params && $params->{auto_renew};
1261     my $dbh          = C4::Context->dbh;
1262     my $barcodecheck = CheckValidBarcode($barcode);
1263
1264     my $issue;
1265
1266     if ( $datedue && ref $datedue ne 'DateTime' ) {
1267         $datedue = dt_from_string($datedue);
1268     }
1269
1270     # $issuedate defaults to today.
1271     if ( !defined $issuedate ) {
1272         $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1273     }
1274     else {
1275         if ( ref $issuedate ne 'DateTime' ) {
1276             $issuedate = dt_from_string($issuedate);
1277
1278         }
1279     }
1280
1281     # Stop here if the patron or barcode doesn't exist
1282     if ( $borrower && $barcode && $barcodecheck ) {
1283         # find which item we issue
1284         my $item = GetItem( '', $barcode )
1285           or return;    # if we don't get an Item, abort.
1286
1287         my $branch = _GetCircControlBranch( $item, $borrower );
1288
1289         # get actual issuing if there is one
1290         my $actualissue = GetItemIssue( $item->{itemnumber} );
1291
1292         # get biblioinformation for this item
1293         my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1294
1295         # check if we just renew the issue.
1296         if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}
1297                 and not $switch_onsite_checkout ) {
1298             $datedue = AddRenewal(
1299                 $borrower->{'borrowernumber'},
1300                 $item->{'itemnumber'},
1301                 $branch,
1302                 $datedue,
1303                 $issuedate,    # here interpreted as the renewal date
1304             );
1305         }
1306         else {
1307             # it's NOT a renewal
1308             if ( $actualissue->{borrowernumber}
1309                     and not $switch_onsite_checkout ) {
1310                 # This book is currently on loan, but not to the person
1311                 # who wants to borrow it now. mark it returned before issuing to the new borrower
1312                 my ( $allowed, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
1313                 return unless $allowed;
1314                 AddReturn( $item->{'barcode'}, C4::Context->userenv->{'branch'} );
1315             }
1316
1317             MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1318
1319             # Starting process for transfer job (checking transfert and validate it if we have one)
1320             my ($datesent) = GetTransfers( $item->{'itemnumber'} );
1321             if ($datesent) {
1322                 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1323                 my $sth = $dbh->prepare(
1324                     "UPDATE branchtransfers
1325                         SET datearrived = now(),
1326                         tobranch = ?,
1327                         comments = 'Forced branchtransfer'
1328                     WHERE itemnumber= ? AND datearrived IS NULL"
1329                 );
1330                 $sth->execute( C4::Context->userenv->{'branch'},
1331                     $item->{'itemnumber'} );
1332             }
1333
1334             # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1335             unless ($auto_renew) {
1336                 my $issuingrule = GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branch );
1337                 $auto_renew = $issuingrule->{auto_renew};
1338             }
1339
1340             # Record in the database the fact that the book was issued.
1341             unless ($datedue) {
1342                 my $itype =
1343                   ( C4::Context->preference('item-level_itypes') )
1344                   ? $biblio->{'itype'}
1345                   : $biblio->{'itemtype'};
1346                 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1347
1348             }
1349             $datedue->truncate( to => 'minute' );
1350
1351             $issue = Koha::Database->new()->schema()->resultset('Issue')->update_or_create(
1352                 {
1353                     borrowernumber => $borrower->{'borrowernumber'},
1354                     itemnumber     => $item->{'itemnumber'},
1355                     issuedate      => $issuedate->strftime('%Y-%m-%d %H:%M:%S'),
1356                     date_due       => $datedue->strftime('%Y-%m-%d %H:%M:%S'),
1357                     branchcode     => C4::Context->userenv->{'branch'},
1358                     onsite_checkout => $onsite_checkout,
1359                     auto_renew      => $auto_renew ? 1 : 0
1360                 }
1361               );
1362
1363             if ( C4::Context->preference('ReturnToShelvingCart') ) {
1364                 # ReturnToShelvingCart is on, anything issued should be taken off the cart.
1365                 CartToShelf( $item->{'itemnumber'} );
1366             }
1367             $item->{'issues'}++;
1368             if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1369                 UpdateTotalIssues( $item->{'biblionumber'}, 1 );
1370             }
1371
1372             ## If item was lost, it has now been found, reverse any list item charges if necessary.
1373             if ( $item->{'itemlost'} ) {
1374                 if (
1375                     Koha::RefundLostItemFeeRules->should_refund(
1376                         {
1377                             current_branch      => C4::Context->userenv->{branch},
1378                             item_home_branch    => $item->{homebranch},
1379                             item_holding_branch => $item->{holdingbranch}
1380                         }
1381                     )
1382                   )
1383                 {
1384                     _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef,
1385                         $item->{'barcode'} );
1386                 }
1387             }
1388
1389             ModItem(
1390                 {
1391                     issues        => $item->{'issues'},
1392                     holdingbranch => C4::Context->userenv->{'branch'},
1393                     itemlost      => 0,
1394                     onloan        => $datedue->ymd(),
1395                     datelastborrowed => DateTime->now( time_zone => C4::Context->tz() )->ymd(),
1396                 },
1397                 $item->{'biblionumber'},
1398                 $item->{'itemnumber'}
1399             );
1400             ModDateLastSeen( $item->{'itemnumber'} );
1401
1402            # If it costs to borrow this book, charge it to the patron's account.
1403             my ( $charge, $itemtype ) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
1404             if ( $charge > 0 ) {
1405                 AddIssuingCharge( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge );
1406                 $item->{'charge'} = $charge;
1407             }
1408
1409             # Record the fact that this book was issued.
1410             &UpdateStats(
1411                 {
1412                     branch => C4::Context->userenv->{'branch'},
1413                     type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1414                     amount         => $charge,
1415                     other          => ( $sipmode ? "SIP-$sipmode" : '' ),
1416                     itemnumber     => $item->{'itemnumber'},
1417                     itemtype       => $item->{'itype'},
1418                     borrowernumber => $borrower->{'borrowernumber'},
1419                     ccode          => $item->{'ccode'}
1420                 }
1421             );
1422
1423             # Send a checkout slip.
1424             my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1425             my %conditions        = (
1426                 branchcode   => $branch,
1427                 categorycode => $borrower->{categorycode},
1428                 item_type    => $item->{itype},
1429                 notification => 'CHECKOUT',
1430             );
1431             if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
1432                 SendCirculationAlert(
1433                     {
1434                         type     => 'CHECKOUT',
1435                         item     => $item,
1436                         borrower => $borrower,
1437                         branch   => $branch,
1438                     }
1439                 );
1440             }
1441         }
1442
1443         logaction(
1444             "CIRCULATION", "ISSUE",
1445             $borrower->{'borrowernumber'},
1446             $biblio->{'itemnumber'}
1447         ) if C4::Context->preference("IssueLog");
1448     }
1449     return $issue;
1450 }
1451
1452 =head2 GetLoanLength
1453
1454   my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1455
1456 Get loan length for an itemtype, a borrower type and a branch
1457
1458 =cut
1459
1460 sub GetLoanLength {
1461     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1462     my $dbh = C4::Context->dbh;
1463     my $sth = $dbh->prepare(qq{
1464         SELECT issuelength, lengthunit, renewalperiod
1465         FROM issuingrules
1466         WHERE   categorycode=?
1467             AND itemtype=?
1468             AND branchcode=?
1469             AND issuelength IS NOT NULL
1470     });
1471
1472     # try to find issuelength & return the 1st available.
1473     # check with borrowertype, itemtype and branchcode, then without one of those parameters
1474     $sth->execute( $borrowertype, $itemtype, $branchcode );
1475     my $loanlength = $sth->fetchrow_hashref;
1476
1477     return $loanlength
1478       if defined($loanlength) && defined $loanlength->{issuelength};
1479
1480     $sth->execute( $borrowertype, '*', $branchcode );
1481     $loanlength = $sth->fetchrow_hashref;
1482     return $loanlength
1483       if defined($loanlength) && defined $loanlength->{issuelength};
1484
1485     $sth->execute( '*', $itemtype, $branchcode );
1486     $loanlength = $sth->fetchrow_hashref;
1487     return $loanlength
1488       if defined($loanlength) && defined $loanlength->{issuelength};
1489
1490     $sth->execute( '*', '*', $branchcode );
1491     $loanlength = $sth->fetchrow_hashref;
1492     return $loanlength
1493       if defined($loanlength) && defined $loanlength->{issuelength};
1494
1495     $sth->execute( $borrowertype, $itemtype, '*' );
1496     $loanlength = $sth->fetchrow_hashref;
1497     return $loanlength
1498       if defined($loanlength) && defined $loanlength->{issuelength};
1499
1500     $sth->execute( $borrowertype, '*', '*' );
1501     $loanlength = $sth->fetchrow_hashref;
1502     return $loanlength
1503       if defined($loanlength) && defined $loanlength->{issuelength};
1504
1505     $sth->execute( '*', $itemtype, '*' );
1506     $loanlength = $sth->fetchrow_hashref;
1507     return $loanlength
1508       if defined($loanlength) && defined $loanlength->{issuelength};
1509
1510     $sth->execute( '*', '*', '*' );
1511     $loanlength = $sth->fetchrow_hashref;
1512     return $loanlength
1513       if defined($loanlength) && defined $loanlength->{issuelength};
1514
1515     # if no rule is set => 0 day (hardcoded)
1516     return {
1517         issuelength => 0,
1518         renewalperiod => 0,
1519         lengthunit => 'days',
1520     };
1521
1522 }
1523
1524
1525 =head2 GetHardDueDate
1526
1527   my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1528
1529 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1530
1531 =cut
1532
1533 sub GetHardDueDate {
1534     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1535
1536     my $rule = GetIssuingRule( $borrowertype, $itemtype, $branchcode );
1537
1538     if ( defined( $rule ) ) {
1539         if ( $rule->{hardduedate} ) {
1540             return (dt_from_string($rule->{hardduedate}, 'iso'),$rule->{hardduedatecompare});
1541         } else {
1542             return (undef, undef);
1543         }
1544     }
1545 }
1546
1547 =head2 GetIssuingRule
1548
1549   my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1550
1551 FIXME - This is a copy-paste of GetLoanLength
1552 as a stop-gap.  Do not wish to change API for GetLoanLength
1553 this close to release.
1554
1555 Get the issuing rule for an itemtype, a borrower type and a branch
1556 Returns a hashref from the issuingrules table.
1557
1558 =cut
1559
1560 sub GetIssuingRule {
1561     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1562     my $dbh = C4::Context->dbh;
1563     my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=?"  );
1564     my $irule;
1565
1566     $sth->execute( $borrowertype, $itemtype, $branchcode );
1567     $irule = $sth->fetchrow_hashref;
1568     return $irule if defined($irule) ;
1569
1570     $sth->execute( $borrowertype, "*", $branchcode );
1571     $irule = $sth->fetchrow_hashref;
1572     return $irule if defined($irule) ;
1573
1574     $sth->execute( "*", $itemtype, $branchcode );
1575     $irule = $sth->fetchrow_hashref;
1576     return $irule if defined($irule) ;
1577
1578     $sth->execute( "*", "*", $branchcode );
1579     $irule = $sth->fetchrow_hashref;
1580     return $irule if defined($irule) ;
1581
1582     $sth->execute( $borrowertype, $itemtype, "*" );
1583     $irule = $sth->fetchrow_hashref;
1584     return $irule if defined($irule) ;
1585
1586     $sth->execute( $borrowertype, "*", "*" );
1587     $irule = $sth->fetchrow_hashref;
1588     return $irule if defined($irule) ;
1589
1590     $sth->execute( "*", $itemtype, "*" );
1591     $irule = $sth->fetchrow_hashref;
1592     return $irule if defined($irule) ;
1593
1594     $sth->execute( "*", "*", "*" );
1595     $irule = $sth->fetchrow_hashref;
1596     return $irule if defined($irule) ;
1597
1598     # if no rule matches,
1599     return;
1600 }
1601
1602 =head2 GetBranchBorrowerCircRule
1603
1604   my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1605
1606 Retrieves circulation rule attributes that apply to the given
1607 branch and patron category, regardless of item type.
1608 The return value is a hashref containing the following key:
1609
1610 maxissueqty - maximum number of loans that a
1611 patron of the given category can have at the given
1612 branch.  If the value is undef, no limit.
1613
1614 maxonsiteissueqty - maximum of on-site checkouts that a
1615 patron of the given category can have at the given
1616 branch.  If the value is undef, no limit.
1617
1618 This will first check for a specific branch and
1619 category match from branch_borrower_circ_rules.
1620
1621 If no rule is found, it will then check default_branch_circ_rules
1622 (same branch, default category).  If no rule is found,
1623 it will then check default_borrower_circ_rules (default
1624 branch, same category), then failing that, default_circ_rules
1625 (default branch, default category).
1626
1627 If no rule has been found in the database, it will default to
1628 the buillt in rule:
1629
1630 maxissueqty - undef
1631 maxonsiteissueqty - undef
1632
1633 C<$branchcode> and C<$categorycode> should contain the
1634 literal branch code and patron category code, respectively - no
1635 wildcards.
1636
1637 =cut
1638
1639 sub GetBranchBorrowerCircRule {
1640     my ( $branchcode, $categorycode ) = @_;
1641
1642     my $rules;
1643     my $dbh = C4::Context->dbh();
1644     $rules = $dbh->selectrow_hashref( q|
1645         SELECT maxissueqty, maxonsiteissueqty
1646         FROM branch_borrower_circ_rules
1647         WHERE branchcode = ?
1648         AND   categorycode = ?
1649     |, {}, $branchcode, $categorycode ) ;
1650     return $rules if $rules;
1651
1652     # try same branch, default borrower category
1653     $rules = $dbh->selectrow_hashref( q|
1654         SELECT maxissueqty, maxonsiteissueqty
1655         FROM default_branch_circ_rules
1656         WHERE branchcode = ?
1657     |, {}, $branchcode ) ;
1658     return $rules if $rules;
1659
1660     # try default branch, same borrower category
1661     $rules = $dbh->selectrow_hashref( q|
1662         SELECT maxissueqty, maxonsiteissueqty
1663         FROM default_borrower_circ_rules
1664         WHERE categorycode = ?
1665     |, {}, $categorycode ) ;
1666     return $rules if $rules;
1667
1668     # try default branch, default borrower category
1669     $rules = $dbh->selectrow_hashref( q|
1670         SELECT maxissueqty, maxonsiteissueqty
1671         FROM default_circ_rules
1672     |, {} );
1673     return $rules if $rules;
1674
1675     # built-in default circulation rule
1676     return {
1677         maxissueqty => undef,
1678         maxonsiteissueqty => undef,
1679     };
1680 }
1681
1682 =head2 GetBranchItemRule
1683
1684   my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1685
1686 Retrieves circulation rule attributes that apply to the given
1687 branch and item type, regardless of patron category.
1688
1689 The return value is a hashref containing the following keys:
1690
1691 holdallowed => Hold policy for this branch and itemtype. Possible values:
1692   0: No holds allowed.
1693   1: Holds allowed only by patrons that have the same homebranch as the item.
1694   2: Holds allowed from any patron.
1695
1696 returnbranch => branch to which to return item.  Possible values:
1697   noreturn: do not return, let item remain where checked in (floating collections)
1698   homebranch: return to item's home branch
1699   holdingbranch: return to issuer branch
1700
1701 This searches branchitemrules in the following order:
1702
1703   * Same branchcode and itemtype
1704   * Same branchcode, itemtype '*'
1705   * branchcode '*', same itemtype
1706   * branchcode and itemtype '*'
1707
1708 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1709
1710 =cut
1711
1712 sub GetBranchItemRule {
1713     my ( $branchcode, $itemtype ) = @_;
1714     my $dbh = C4::Context->dbh();
1715     my $result = {};
1716
1717     my @attempts = (
1718         ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1719             FROM branch_item_rules
1720             WHERE branchcode = ?
1721               AND itemtype = ?', $branchcode, $itemtype],
1722         ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1723             FROM default_branch_circ_rules
1724             WHERE branchcode = ?', $branchcode],
1725         ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1726             FROM default_branch_item_rules
1727             WHERE itemtype = ?', $itemtype],
1728         ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1729             FROM default_circ_rules'],
1730     );
1731
1732     foreach my $attempt (@attempts) {
1733         my ($query, @bind_params) = @{$attempt};
1734         my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1735           or next;
1736
1737         # Since branch/category and branch/itemtype use the same per-branch
1738         # defaults tables, we have to check that the key we want is set, not
1739         # just that a row was returned
1740         $result->{'holdallowed'}  = $search_result->{'holdallowed'}  unless ( defined $result->{'holdallowed'} );
1741         $result->{'hold_fulfillment_policy'} = $search_result->{'hold_fulfillment_policy'} unless ( defined $result->{'hold_fulfillment_policy'} );
1742         $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1743     }
1744
1745     # built-in default circulation rule
1746     $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1747     $result->{'hold_fulfillment_policy'} = 'any' unless ( defined $result->{'hold_fulfillment_policy'} );
1748     $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1749
1750     return $result;
1751 }
1752
1753 =head2 AddReturn
1754
1755   ($doreturn, $messages, $iteminformation, $borrower) =
1756       &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1757
1758 Returns a book.
1759
1760 =over 4
1761
1762 =item C<$barcode> is the bar code of the book being returned.
1763
1764 =item C<$branch> is the code of the branch where the book is being returned.
1765
1766 =item C<$exemptfine> indicates that overdue charges for the item will be
1767 removed. Optional.
1768
1769 =item C<$dropbox> indicates that the check-in date is assumed to be
1770 yesterday, or the last non-holiday as defined in C4::Calendar .  If
1771 overdue charges are applied and C<$dropbox> is true, the last charge
1772 will be removed.  This assumes that the fines accrual script has run
1773 for _today_. Optional.
1774
1775 =item C<$return_date> allows the default return date to be overridden
1776 by the given return date. Optional.
1777
1778 =back
1779
1780 C<&AddReturn> returns a list of four items:
1781
1782 C<$doreturn> is true iff the return succeeded.
1783
1784 C<$messages> is a reference-to-hash giving feedback on the operation.
1785 The keys of the hash are:
1786
1787 =over 4
1788
1789 =item C<BadBarcode>
1790
1791 No item with this barcode exists. The value is C<$barcode>.
1792
1793 =item C<NotIssued>
1794
1795 The book is not currently on loan. The value is C<$barcode>.
1796
1797 =item C<IsPermanent>
1798
1799 The book's home branch is a permanent collection. If you have borrowed
1800 this book, you are not allowed to return it. The value is the code for
1801 the book's home branch.
1802
1803 =item C<withdrawn>
1804
1805 This book has been withdrawn/cancelled. The value should be ignored.
1806
1807 =item C<Wrongbranch>
1808
1809 This book has was returned to the wrong branch.  The value is a hashref
1810 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1811 contain the branchcode of the incorrect and correct return library, respectively.
1812
1813 =item C<ResFound>
1814
1815 The item was reserved. The value is a reference-to-hash whose keys are
1816 fields from the reserves table of the Koha database, and
1817 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1818 either C<Waiting>, C<Reserved>, or 0.
1819
1820 =item C<WasReturned>
1821
1822 Value 1 if return is successful.
1823
1824 =item C<NeedsTransfer>
1825
1826 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
1827
1828 =back
1829
1830 C<$iteminformation> is a reference-to-hash, giving information about the
1831 returned item from the issues table.
1832
1833 C<$borrower> is a reference-to-hash, giving information about the
1834 patron who last borrowed the book.
1835
1836 =cut
1837
1838 sub AddReturn {
1839     my ( $barcode, $branch, $exemptfine, $dropbox, $return_date, $dropboxdate ) = @_;
1840
1841     if ($branch and not Koha::Libraries->find($branch)) {
1842         warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
1843         undef $branch;
1844     }
1845     $branch = C4::Context->userenv->{'branch'} unless $branch;  # we trust userenv to be a safe fallback/default
1846     my $messages;
1847     my $borrower;
1848     my $biblio;
1849     my $doreturn       = 1;
1850     my $validTransfert = 0;
1851     my $stat_type = 'return';
1852
1853     # get information on item
1854     my $itemnumber = GetItemnumberFromBarcode( $barcode );
1855     unless ($itemnumber) {
1856         return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower.  bail out.
1857     }
1858     my $issue  = GetItemIssue($itemnumber);
1859     if ($issue and $issue->{borrowernumber}) {
1860         $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1861             or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '$issue->{borrowernumber}'\n"
1862                 . Dumper($issue) . "\n";
1863     } else {
1864         $messages->{'NotIssued'} = $barcode;
1865         # even though item is not on loan, it may still be transferred;  therefore, get current branch info
1866         $doreturn = 0;
1867         # No issue, no borrowernumber.  ONLY if $doreturn, *might* you have a $borrower later.
1868         # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1869         if (C4::Context->preference("RecordLocalUseOnReturn")) {
1870            $messages->{'LocalUse'} = 1;
1871            $stat_type = 'localuse';
1872         }
1873     }
1874
1875     my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1876
1877     if ( $item->{'location'} eq 'PROC' ) {
1878         if ( C4::Context->preference("InProcessingToShelvingCart") ) {
1879             $item->{'location'} = 'CART';
1880         }
1881         else {
1882             $item->{location} = $item->{permanent_location};
1883         }
1884
1885         ModItem( $item, $item->{'biblionumber'}, $item->{'itemnumber'} );
1886     }
1887
1888         # full item data, but no borrowernumber or checkout info (no issue)
1889         # we know GetItem should work because GetItemnumberFromBarcode worked
1890     my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1891         # get the proper branch to which to return the item
1892     my $returnbranch = $item->{$hbr} || $branch ;
1893         # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1894
1895     my $borrowernumber = $borrower->{'borrowernumber'} || undef;    # we don't know if we had a borrower or not
1896
1897     my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1898     if ($yaml) {
1899         $yaml = "$yaml\n\n";  # YAML is anal on ending \n. Surplus does not hurt
1900         my $rules;
1901         eval { $rules = YAML::Load($yaml); };
1902         if ($@) {
1903             warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1904         }
1905         else {
1906             foreach my $key ( keys %$rules ) {
1907                 if ( $item->{notforloan} eq $key ) {
1908                     $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
1909                     ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
1910                     last;
1911                 }
1912             }
1913         }
1914     }
1915
1916
1917     # check if the book is in a permanent collection....
1918     # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
1919     if ( $returnbranch ) {
1920         my $library = Koha::Libraries->find($returnbranch);
1921         if ( $library and $library->get_categories->search({'me.categorycode' => 'PE'})->count ) {
1922             $messages->{'IsPermanent'} = $returnbranch;
1923         }
1924     }
1925
1926     # check if the return is allowed at this branch
1927     my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1928     unless ($returnallowed){
1929         $messages->{'Wrongbranch'} = {
1930             Wrongbranch => $branch,
1931             Rightbranch => $message
1932         };
1933         $doreturn = 0;
1934         return ( $doreturn, $messages, $issue, $borrower );
1935     }
1936
1937     if ( $item->{'withdrawn'} ) { # book has been cancelled
1938         $messages->{'withdrawn'} = 1;
1939         $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1940     }
1941
1942     # case of a return of document (deal with issues and holdingbranch)
1943     my $today = DateTime->now( time_zone => C4::Context->tz() );
1944
1945     if ($doreturn) {
1946         my $datedue = $issue->{date_due};
1947         $borrower or warn "AddReturn without current borrower";
1948                 my $circControlBranch;
1949         if ($dropbox) {
1950             # define circControlBranch only if dropbox mode is set
1951             # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1952             # FIXME: check issuedate > returndate, factoring in holidays
1953
1954             $circControlBranch = _GetCircControlBranch($item,$borrower);
1955             $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $dropboxdate ) == -1 ? 1 : 0;
1956         }
1957
1958         if ($borrowernumber) {
1959             if ( ( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'} ) || $return_date ) {
1960                 _CalculateAndUpdateFine( { issue => $issue, item => $item, borrower => $borrower, return_date => $return_date } );
1961             }
1962
1963             eval {
1964                 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
1965                     $circControlBranch, $return_date, $borrower->{'privacy'} );
1966             };
1967             if ( $@ ) {
1968                 $messages->{'Wrongbranch'} = {
1969                     Wrongbranch => $branch,
1970                     Rightbranch => $message
1971                 };
1972                 carp $@;
1973                 return ( 0, { WasReturned => 0 }, $issue, $borrower );
1974             }
1975
1976             # FIXME is the "= 1" right?  This could be the borrower hash.
1977             $messages->{'WasReturned'} = 1;
1978
1979         }
1980
1981         ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1982     }
1983
1984     # the holdingbranch is updated if the document is returned to another location.
1985     # this is always done regardless of whether the item was on loan or not
1986     my $item_holding_branch = $item->{ holdingbranch };
1987     if ($item->{'holdingbranch'} ne $branch) {
1988         UpdateHoldingbranch($branch, $item->{'itemnumber'});
1989         $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1990     }
1991     ModDateLastSeen( $item->{'itemnumber'} );
1992
1993     # check if we have a transfer for this document
1994     my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1995
1996     # if we have a transfer to do, we update the line of transfers with the datearrived
1997     my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
1998     if ($datesent) {
1999         if ( $tobranch eq $branch ) {
2000             my $sth = C4::Context->dbh->prepare(
2001                 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
2002             );
2003             $sth->execute( $item->{'itemnumber'} );
2004             # if we have a reservation with valid transfer, we can set it's status to 'W'
2005             ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2006             C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
2007         } else {
2008             $messages->{'WrongTransfer'}     = $tobranch;
2009             $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
2010         }
2011         $validTransfert = 1;
2012     } else {
2013         ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2014     }
2015
2016     # fix up the accounts.....
2017     if ( $item->{'itemlost'} ) {
2018         $messages->{'WasLost'} = 1;
2019
2020         if ( $item->{'itemlost'} ) {
2021             if (
2022                 Koha::RefundLostItemFeeRules->should_refund(
2023                     {
2024                         current_branch      => C4::Context->userenv->{branch},
2025                         item_home_branch    => $item->{homebranch},
2026                         item_holding_branch => $item_holding_branch
2027                     }
2028                 )
2029               )
2030             {
2031                 _FixAccountForLostAndReturned( $item->{'itemnumber'}, $borrowernumber, $barcode );
2032                 $messages->{'LostItemFeeRefunded'} = 1;
2033             }
2034         }
2035     }
2036
2037     # fix up the overdues in accounts...
2038     if ($borrowernumber) {
2039         my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
2040         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!";  # zero is OK, check defined
2041
2042         if ( $issue->{overdue} && $issue->{date_due} ) {
2043         # fix fine days
2044             $today = $dropboxdate if $dropbox;
2045             my ($debardate,$reminder) = _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
2046             if ($reminder){
2047                 $messages->{'PrevDebarred'} = $debardate;
2048             } else {
2049                 $messages->{'Debarred'} = $debardate if $debardate;
2050             }
2051         # there's no overdue on the item but borrower had been previously debarred
2052         } elsif ( $issue->{date_due} and $borrower->{'debarred'} ) {
2053              if ( $borrower->{debarred} eq "9999-12-31") {
2054                 $messages->{'ForeverDebarred'} = $borrower->{'debarred'};
2055              } else {
2056                   my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2057                   $borrower_debar_dt->truncate(to => 'day');
2058                   my $today_dt = $today->clone()->truncate(to => 'day');
2059                   if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2060                       $messages->{'PrevDebarred'} = $borrower->{'debarred'};
2061                   }
2062              }
2063         }
2064     }
2065
2066     # find reserves.....
2067     # if we don't have a reserve with the status W, we launch the Checkreserves routine
2068     my ($resfound, $resrec);
2069     my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2070     ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
2071     if ($resfound) {
2072           $resrec->{'ResFound'} = $resfound;
2073         $messages->{'ResFound'} = $resrec;
2074     }
2075
2076     # Record the fact that this book was returned.
2077     # FIXME itemtype should record item level type, not bibliolevel type
2078     UpdateStats({
2079                 branch => $branch,
2080                 type => $stat_type,
2081                 itemnumber => $item->{'itemnumber'},
2082                 itemtype => $biblio->{'itemtype'},
2083                 borrowernumber => $borrowernumber,
2084                 ccode => $item->{'ccode'}}
2085     );
2086
2087     # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
2088     my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2089     my %conditions = (
2090         branchcode   => $branch,
2091         categorycode => $borrower->{categorycode},
2092         item_type    => $item->{itype},
2093         notification => 'CHECKIN',
2094     );
2095     if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2096         SendCirculationAlert({
2097             type     => 'CHECKIN',
2098             item     => $item,
2099             borrower => $borrower,
2100             branch   => $branch,
2101         });
2102     }
2103
2104     logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2105         if C4::Context->preference("ReturnLog");
2106
2107     # Remove any OVERDUES related debarment if the borrower has no overdues
2108     if ( $borrowernumber
2109       && $borrower->{'debarred'}
2110       && C4::Context->preference('AutoRemoveOverduesRestrictions')
2111       && !Koha::Patrons->find( $borrowernumber )->has_overdues
2112       && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2113     ) {
2114         DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2115     }
2116
2117     # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2118     if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2119         if  (C4::Context->preference("AutomaticItemReturn"    ) or
2120             (C4::Context->preference("UseBranchTransferLimits") and
2121              ! IsBranchTransferAllowed($branch, $returnbranch, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2122            )) {
2123             $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $returnbranch;
2124             $debug and warn "item: " . Dumper($item);
2125             ModItemTransfer($item->{'itemnumber'}, $branch, $returnbranch);
2126             $messages->{'WasTransfered'} = 1;
2127         } else {
2128             $messages->{'NeedsTransfer'} = $returnbranch;
2129         }
2130     }
2131
2132     return ( $doreturn, $messages, $issue, $borrower );
2133 }
2134
2135 =head2 MarkIssueReturned
2136
2137   MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2138
2139 Unconditionally marks an issue as being returned by
2140 moving the C<issues> row to C<old_issues> and
2141 setting C<returndate> to the current date, or
2142 the last non-holiday date of the branccode specified in
2143 C<dropbox_branch> .  Assumes you've already checked that
2144 it's safe to do this, i.e. last non-holiday > issuedate.
2145
2146 if C<$returndate> is specified (in iso format), it is used as the date
2147 of the return. It is ignored when a dropbox_branch is passed in.
2148
2149 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2150 the old_issue is immediately anonymised
2151
2152 Ideally, this function would be internal to C<C4::Circulation>,
2153 not exported, but it is currently needed by one
2154 routine in C<C4::Accounts>.
2155
2156 =cut
2157
2158 sub MarkIssueReturned {
2159     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2160
2161     my $anonymouspatron;
2162     if ( $privacy == 2 ) {
2163         # The default of 0 will not work due to foreign key constraints
2164         # The anonymisation will fail if AnonymousPatron is not a valid entry
2165         # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2166         # Note that a warning should appear on the about page (System information tab).
2167         $anonymouspatron = C4::Context->preference('AnonymousPatron');
2168         die "Fatal error: the patron ($borrowernumber) has requested their circulation history be anonymized on check-in, but the AnonymousPatron system preference is empty or not set correctly."
2169             unless C4::Members::GetMember( borrowernumber => $anonymouspatron );
2170     }
2171     my $dbh   = C4::Context->dbh;
2172     my $query = 'UPDATE issues SET returndate=';
2173     my @bind;
2174     if ($dropbox_branch) {
2175         my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2176         my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2177         $query .= ' ? ';
2178         push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2179     } elsif ($returndate) {
2180         $query .= ' ? ';
2181         push @bind, $returndate;
2182     } else {
2183         $query .= ' now() ';
2184     }
2185     $query .= ' WHERE  borrowernumber = ?  AND itemnumber = ?';
2186     push @bind, $borrowernumber, $itemnumber;
2187     # FIXME transaction
2188     my $sth_upd  = $dbh->prepare($query);
2189     $sth_upd->execute(@bind);
2190     my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
2191                                   WHERE borrowernumber = ?
2192                                   AND itemnumber = ?');
2193     $sth_copy->execute($borrowernumber, $itemnumber);
2194     # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2195     if ( $privacy == 2) {
2196         my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
2197                                   WHERE borrowernumber = ?
2198                                   AND itemnumber = ?");
2199        $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
2200     }
2201     my $sth_del  = $dbh->prepare("DELETE FROM issues
2202                                   WHERE borrowernumber = ?
2203                                   AND itemnumber = ?");
2204     $sth_del->execute($borrowernumber, $itemnumber);
2205
2206     ModItem( { 'onloan' => undef }, undef, $itemnumber );
2207
2208     if ( C4::Context->preference('StoreLastBorrower') ) {
2209         my $item = Koha::Items->find( $itemnumber );
2210         my $patron = Koha::Patrons->find( $borrowernumber );
2211         $item->last_returned_by( $patron );
2212     }
2213 }
2214
2215 =head2 _debar_user_on_return
2216
2217     _debar_user_on_return($borrower, $item, $datedue, today);
2218
2219 C<$borrower> borrower hashref
2220
2221 C<$item> item hashref
2222
2223 C<$datedue> date due DateTime object
2224
2225 C<$today> DateTime object representing the return time
2226
2227 Internal function, called only by AddReturn that calculates and updates
2228  the user fine days, and debars him if necessary.
2229
2230 Should only be called for overdue returns
2231
2232 =cut
2233
2234 sub _debar_user_on_return {
2235     my ( $borrower, $item, $dt_due, $dt_today ) = @_;
2236
2237     my $branchcode = _GetCircControlBranch( $item, $borrower );
2238
2239     my $circcontrol = C4::Context->preference('CircControl');
2240     my $issuingrule =
2241       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2242     my $finedays = $issuingrule->{finedays};
2243     my $unit     = $issuingrule->{lengthunit};
2244     my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $dt_today, $branchcode);
2245
2246     if ($finedays) {
2247
2248         # finedays is in days, so hourly loans must multiply by 24
2249         # thus 1 hour late equals 1 day suspension * finedays rate
2250         $finedays = $finedays * 24 if ( $unit eq 'hours' );
2251
2252         # grace period is measured in the same units as the loan
2253         my $grace =
2254           DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
2255
2256         my $deltadays = DateTime::Duration->new(
2257             days => $chargeable_units
2258         );
2259         if ( $deltadays->subtract($grace)->is_positive() ) {
2260             my $suspension_days = $deltadays * $finedays;
2261
2262             # If the max suspension days is < than the suspension days
2263             # the suspension days is limited to this maximum period.
2264             my $max_sd = $issuingrule->{maxsuspensiondays};
2265             if ( defined $max_sd ) {
2266                 $max_sd = DateTime::Duration->new( days => $max_sd );
2267                 $suspension_days = $max_sd
2268                   if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2269             }
2270
2271             my $new_debar_dt =
2272               $dt_today->clone()->add_duration( $suspension_days );
2273
2274             Koha::Patron::Debarments::AddUniqueDebarment({
2275                 borrowernumber => $borrower->{borrowernumber},
2276                 expiration     => $new_debar_dt->ymd(),
2277                 type           => 'SUSPENSION',
2278             });
2279             # if borrower was already debarred but does not get an extra debarment
2280             my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
2281             if ( $borrower->{debarred} eq $patron->is_debarred ) {
2282                 return ($borrower->{debarred},1);
2283             }
2284             return $new_debar_dt->ymd();
2285         }
2286     }
2287     return;
2288 }
2289
2290 =head2 _FixOverduesOnReturn
2291
2292    &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2293
2294 C<$brn> borrowernumber
2295
2296 C<$itm> itemnumber
2297
2298 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2299 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2300
2301 Internal function, called only by AddReturn
2302
2303 =cut
2304
2305 sub _FixOverduesOnReturn {
2306     my ($borrowernumber, $item);
2307     unless ($borrowernumber = shift) {
2308         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2309         return;
2310     }
2311     unless ($item = shift) {
2312         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2313         return;
2314     }
2315     my ($exemptfine, $dropbox) = @_;
2316     my $dbh = C4::Context->dbh;
2317
2318     # check for overdue fine
2319     my $sth = $dbh->prepare(
2320 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2321     );
2322     $sth->execute( $borrowernumber, $item );
2323
2324     # alter fine to show that the book has been returned
2325     my $data = $sth->fetchrow_hashref;
2326     return 0 unless $data;    # no warning, there's just nothing to fix
2327
2328     my $uquery;
2329     my @bind = ($data->{'accountlines_id'});
2330     if ($exemptfine) {
2331         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2332         if (C4::Context->preference("FinesLog")) {
2333             &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2334         }
2335     } elsif ($dropbox && $data->{lastincrement}) {
2336         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2337         my $amt = $data->{amount} - $data->{lastincrement} ;
2338         if (C4::Context->preference("FinesLog")) {
2339             &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2340         }
2341          $uquery = "update accountlines set accounttype='F' ";
2342          if($outstanding  >= 0 && $amt >=0) {
2343             $uquery .= ", amount = ? , amountoutstanding=? ";
2344             unshift @bind, ($amt, $outstanding) ;
2345         }
2346     } else {
2347         $uquery = "update accountlines set accounttype='F' ";
2348     }
2349     $uquery .= " where (accountlines_id = ?)";
2350     my $usth = $dbh->prepare($uquery);
2351     return $usth->execute(@bind);
2352 }
2353
2354 =head2 _FixAccountForLostAndReturned
2355
2356   &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2357
2358 Calculates the charge for a book lost and returned.
2359
2360 Internal function, not exported, called only by AddReturn.
2361
2362 FIXME: This function reflects how inscrutable fines logic is.  Fix both.
2363 FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.
2364
2365 =cut
2366
2367 sub _FixAccountForLostAndReturned {
2368     my $itemnumber     = shift or return;
2369     my $borrowernumber = @_ ? shift : undef;
2370     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
2371     my $dbh = C4::Context->dbh;
2372     # check for charge made for lost book
2373     my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2374     $sth->execute($itemnumber);
2375     my $data = $sth->fetchrow_hashref;
2376     $data or return;    # bail if there is nothing to do
2377     $data->{accounttype} eq 'W' and return;    # Written off
2378
2379     # writeoff this amount
2380     my $offset;
2381     my $amount = $data->{'amount'};
2382     my $acctno = $data->{'accountno'};
2383     my $amountleft;                                             # Starts off undef/zero.
2384     if ($data->{'amountoutstanding'} == $amount) {
2385         $offset     = $data->{'amount'};
2386         $amountleft = 0;                                        # Hey, it's zero here, too.
2387     } else {
2388         $offset     = $amount - $data->{'amountoutstanding'};   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2389         $amountleft = $data->{'amountoutstanding'} - $amount;   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2390     }
2391     my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2392         WHERE (accountlines_id = ?)");
2393     $usth->execute($data->{'accountlines_id'});      # We might be adjusting an account for some OTHER borrowernumber now.  Not the one we passed in.
2394     #check if any credit is left if so writeoff other accounts
2395     my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2396     $amountleft *= -1 if ($amountleft < 0);
2397     if ($amountleft > 0) {
2398         my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2399                             AND (amountoutstanding >0) ORDER BY date");     # might want to order by amountoustanding ASC (pay smallest first)
2400         $msth->execute($data->{'borrowernumber'});
2401         # offset transactions
2402         my $newamtos;
2403         my $accdata;
2404         while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2405             if ($accdata->{'amountoutstanding'} < $amountleft) {
2406                 $newamtos = 0;
2407                 $amountleft -= $accdata->{'amountoutstanding'};
2408             }  else {
2409                 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2410                 $amountleft = 0;
2411             }
2412             my $thisacct = $accdata->{'accountlines_id'};
2413             # FIXME: move prepares outside while loop!
2414             my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2415                     WHERE (accountlines_id = ?)");
2416             $usth->execute($newamtos,$thisacct);
2417             $usth = $dbh->prepare("INSERT INTO accountoffsets
2418                 (borrowernumber, accountno, offsetaccount,  offsetamount)
2419                 VALUES
2420                 (?,?,?,?)");
2421             $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2422         }
2423     }
2424     $amountleft *= -1 if ($amountleft > 0);
2425     my $desc = "Item Returned " . $item_id;
2426     $usth = $dbh->prepare("INSERT INTO accountlines
2427         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2428         VALUES (?,?,now(),?,?,'CR',?)");
2429     $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2430     if ($borrowernumber) {
2431         # FIXME: same as query above.  use 1 sth for both
2432         $usth = $dbh->prepare("INSERT INTO accountoffsets
2433             (borrowernumber, accountno, offsetaccount,  offsetamount)
2434             VALUES (?,?,?,?)");
2435         $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2436     }
2437     ModItem({ paidfor => '' }, undef, $itemnumber);
2438     return;
2439 }
2440
2441 =head2 _GetCircControlBranch
2442
2443    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2444
2445 Internal function :
2446
2447 Return the library code to be used to determine which circulation
2448 policy applies to a transaction.  Looks up the CircControl and
2449 HomeOrHoldingBranch system preferences.
2450
2451 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2452
2453 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2454
2455 =cut
2456
2457 sub _GetCircControlBranch {
2458     my ($item, $borrower) = @_;
2459     my $circcontrol = C4::Context->preference('CircControl');
2460     my $branch;
2461
2462     if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2463         $branch= C4::Context->userenv->{'branch'};
2464     } elsif ($circcontrol eq 'PatronLibrary') {
2465         $branch=$borrower->{branchcode};
2466     } else {
2467         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2468         $branch = $item->{$branchfield};
2469         # default to item home branch if holdingbranch is used
2470         # and is not defined
2471         if (!defined($branch) && $branchfield eq 'holdingbranch') {
2472             $branch = $item->{homebranch};
2473         }
2474     }
2475     return $branch;
2476 }
2477
2478
2479
2480
2481
2482
2483 =head2 GetItemIssue
2484
2485   $issue = &GetItemIssue($itemnumber);
2486
2487 Returns patron currently having a book, or undef if not checked out.
2488
2489 C<$itemnumber> is the itemnumber.
2490
2491 C<$issue> is a hashref of the row from the issues table.
2492
2493 =cut
2494
2495 sub GetItemIssue {
2496     my ($itemnumber) = @_;
2497     return unless $itemnumber;
2498     my $sth = C4::Context->dbh->prepare(
2499         "SELECT items.*, issues.*
2500         FROM issues
2501         LEFT JOIN items ON issues.itemnumber=items.itemnumber
2502         WHERE issues.itemnumber=?");
2503     $sth->execute($itemnumber);
2504     my $data = $sth->fetchrow_hashref;
2505     return unless $data;
2506     $data->{issuedate_sql} = $data->{issuedate};
2507     $data->{date_due_sql} = $data->{date_due};
2508     $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2509     $data->{issuedate}->truncate(to => 'minute');
2510     $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2511     $data->{date_due}->truncate(to => 'minute');
2512     my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2513     $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2514     return $data;
2515 }
2516
2517 =head2 GetOpenIssue
2518
2519   $issue = GetOpenIssue( $itemnumber );
2520
2521 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2522
2523 C<$itemnumber> is the item's itemnumber
2524
2525 Returns a hashref
2526
2527 =cut
2528
2529 sub GetOpenIssue {
2530   my ( $itemnumber ) = @_;
2531   return unless $itemnumber;
2532   my $dbh = C4::Context->dbh;
2533   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2534   $sth->execute( $itemnumber );
2535   return $sth->fetchrow_hashref();
2536
2537 }
2538
2539 =head2 GetIssues
2540
2541     $issues = GetIssues({});    # return all issues!
2542     $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
2543
2544 Returns all pending issues that match given criteria.
2545 Returns a arrayref or undef if an error occurs.
2546
2547 Allowed criteria are:
2548
2549 =over 2
2550
2551 =item * borrowernumber
2552
2553 =item * biblionumber
2554
2555 =item * itemnumber
2556
2557 =back
2558
2559 =cut
2560
2561 sub GetIssues {
2562     my ($criteria) = @_;
2563
2564     # Build filters
2565     my @filters;
2566     my @allowed = qw(borrowernumber biblionumber itemnumber);
2567     foreach (@allowed) {
2568         if (defined $criteria->{$_}) {
2569             push @filters, {
2570                 field => $_,
2571                 value => $criteria->{$_},
2572             };
2573         }
2574     }
2575
2576     # Do we need to join other tables ?
2577     my %join;
2578     if (defined $criteria->{biblionumber}) {
2579         $join{items} = 1;
2580     }
2581
2582     # Build SQL query
2583     my $where = '';
2584     if (@filters) {
2585         $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
2586     }
2587     my $query = q{
2588         SELECT issues.*
2589         FROM issues
2590     };
2591     if (defined $join{items}) {
2592         $query .= q{
2593             LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
2594         };
2595     }
2596     $query .= $where;
2597
2598     # Execute SQL query
2599     my $dbh = C4::Context->dbh;
2600     my $sth = $dbh->prepare($query);
2601     my $rv = $sth->execute(map { $_->{value} } @filters);
2602
2603     return $rv ? $sth->fetchall_arrayref({}) : undef;
2604 }
2605
2606 =head2 GetItemIssues
2607
2608   $issues = &GetItemIssues($itemnumber, $history);
2609
2610 Returns patrons that have issued a book
2611
2612 C<$itemnumber> is the itemnumber
2613 C<$history> is false if you just want the current "issuer" (if any)
2614 and true if you want issues history from old_issues also.
2615
2616 Returns reference to an array of hashes
2617
2618 =cut
2619
2620 sub GetItemIssues {
2621     my ( $itemnumber, $history ) = @_;
2622
2623     my $today = DateTime->now( time_zome => C4::Context->tz);  # get today date
2624     $today->truncate( to => 'minute' );
2625     my $sql = "SELECT * FROM issues
2626               JOIN borrowers USING (borrowernumber)
2627               JOIN items     USING (itemnumber)
2628               WHERE issues.itemnumber = ? ";
2629     if ($history) {
2630         $sql .= "UNION ALL
2631                  SELECT * FROM old_issues
2632                  LEFT JOIN borrowers USING (borrowernumber)
2633                  JOIN items USING (itemnumber)
2634                  WHERE old_issues.itemnumber = ? ";
2635     }
2636     $sql .= "ORDER BY date_due DESC";
2637     my $sth = C4::Context->dbh->prepare($sql);
2638     if ($history) {
2639         $sth->execute($itemnumber, $itemnumber);
2640     } else {
2641         $sth->execute($itemnumber);
2642     }
2643     my $results = $sth->fetchall_arrayref({});
2644     foreach (@$results) {
2645         my $date_due = dt_from_string($_->{date_due},'sql');
2646         $date_due->truncate( to => 'minute' );
2647
2648         $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2649     }
2650     return $results;
2651 }
2652
2653 =head2 GetBiblioIssues
2654
2655   $issues = GetBiblioIssues($biblionumber);
2656
2657 this function get all issues from a biblionumber.
2658
2659 Return:
2660 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2661 tables issues and the firstname,surname & cardnumber from borrowers.
2662
2663 =cut
2664
2665 sub GetBiblioIssues {
2666     my $biblionumber = shift;
2667     return unless $biblionumber;
2668     my $dbh   = C4::Context->dbh;
2669     my $query = "
2670         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2671         FROM issues
2672             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2673             LEFT JOIN items ON issues.itemnumber = items.itemnumber
2674             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2675             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2676         WHERE biblio.biblionumber = ?
2677         UNION ALL
2678         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2679         FROM old_issues
2680             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2681             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2682             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2683             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2684         WHERE biblio.biblionumber = ?
2685         ORDER BY timestamp
2686     ";
2687     my $sth = $dbh->prepare($query);
2688     $sth->execute($biblionumber, $biblionumber);
2689
2690     my @issues;
2691     while ( my $data = $sth->fetchrow_hashref ) {
2692         push @issues, $data;
2693     }
2694     return \@issues;
2695 }
2696
2697 =head2 GetUpcomingDueIssues
2698
2699   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2700
2701 =cut
2702
2703 sub GetUpcomingDueIssues {
2704     my $params = shift;
2705
2706     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2707     my $dbh = C4::Context->dbh;
2708
2709     my $statement = <<END_SQL;
2710 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2711 FROM issues
2712 LEFT JOIN items USING (itemnumber)
2713 LEFT OUTER JOIN branches USING (branchcode)
2714 WHERE returndate is NULL
2715 HAVING days_until_due >= 0 AND days_until_due <= ?
2716 END_SQL
2717
2718     my @bind_parameters = ( $params->{'days_in_advance'} );
2719
2720     my $sth = $dbh->prepare( $statement );
2721     $sth->execute( @bind_parameters );
2722     my $upcoming_dues = $sth->fetchall_arrayref({});
2723
2724     return $upcoming_dues;
2725 }
2726
2727 =head2 CanBookBeRenewed
2728
2729   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2730
2731 Find out whether a borrowed item may be renewed.
2732
2733 C<$borrowernumber> is the borrower number of the patron who currently
2734 has the item on loan.
2735
2736 C<$itemnumber> is the number of the item to renew.
2737
2738 C<$override_limit>, if supplied with a true value, causes
2739 the limit on the number of times that the loan can be renewed
2740 (as controlled by the item type) to be ignored. Overriding also allows
2741 to renew sooner than "No renewal before" and to manually renew loans
2742 that are automatically renewed.
2743
2744 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2745 item must currently be on loan to the specified borrower; renewals
2746 must be allowed for the item's type; and the borrower must not have
2747 already renewed the loan. $error will contain the reason the renewal can not proceed
2748
2749 =cut
2750
2751 sub CanBookBeRenewed {
2752     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2753
2754     my $dbh    = C4::Context->dbh;
2755     my $renews = 1;
2756
2757     my $item      = GetItem($itemnumber)      or return ( 0, 'no_item' );
2758     my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
2759     return ( 0, 'onsite_checkout' ) if $itemissue->{onsite_checkout};
2760
2761     $borrowernumber ||= $itemissue->{borrowernumber};
2762     my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2763       or return;
2764
2765     my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2766
2767     # This item can fill one or more unfilled reserve, can those unfilled reserves
2768     # all be filled by other available items?
2769     if ( $resfound
2770         && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2771     {
2772         my $schema = Koha::Database->new()->schema();
2773
2774         my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2775         if ($item_holds) {
2776             # There is an item level hold on this item, no other item can fill the hold
2777             $resfound = 1;
2778         }
2779         else {
2780
2781             # Get all other items that could possibly fill reserves
2782             my @itemnumbers = $schema->resultset('Item')->search(
2783                 {
2784                     biblionumber => $resrec->{biblionumber},
2785                     onloan       => undef,
2786                     notforloan   => 0,
2787                     -not         => { itemnumber => $itemnumber }
2788                 },
2789                 { columns => 'itemnumber' }
2790             )->get_column('itemnumber')->all();
2791
2792             # Get all other reserves that could have been filled by this item
2793             my @borrowernumbers;
2794             while (1) {
2795                 my ( $reserve_found, $reserve, undef ) =
2796                   C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2797
2798                 if ($reserve_found) {
2799                     push( @borrowernumbers, $reserve->{borrowernumber} );
2800                 }
2801                 else {
2802                     last;
2803                 }
2804             }
2805
2806             # If the count of the union of the lists of reservable items for each borrower
2807             # is equal or greater than the number of borrowers, we know that all reserves
2808             # can be filled with available items. We can get the union of the sets simply
2809             # by pushing all the elements onto an array and removing the duplicates.
2810             my @reservable;
2811             foreach my $b (@borrowernumbers) {
2812                 my ($borr) = C4::Members::GetMemberDetails($b);
2813                 foreach my $i (@itemnumbers) {
2814                     my $item = GetItem($i);
2815                     if (   IsAvailableForItemLevelRequest( $item, $borr )
2816                         && CanItemBeReserved( $b, $i )
2817                         && !IsItemOnHoldAndFound($i) )
2818                     {
2819                         push( @reservable, $i );
2820                     }
2821                 }
2822             }
2823
2824             @reservable = uniq(@reservable);
2825
2826             if ( @reservable >= @borrowernumbers ) {
2827                 $resfound = 0;
2828             }
2829         }
2830     }
2831     return ( 0, "on_reserve" ) if $resfound;    # '' when no hold was found
2832
2833     return ( 1, undef ) if $override_limit;
2834
2835     my $branchcode = _GetCircControlBranch( $item, $borrower );
2836     my $issuingrule =
2837       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2838
2839     return ( 0, "too_many" )
2840       if $issuingrule->{renewalsallowed} <= $itemissue->{renewals};
2841
2842     my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2843     my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2844     my $patron      = Koha::Patrons->find($borrowernumber);
2845     my $restricted  = $patron->is_debarred;
2846     my $hasoverdues = $patron->has_overdues;
2847
2848     if ( $restricted and $restrictionblockrenewing ) {
2849         return ( 0, 'restriction');
2850     } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($itemissue->{overdue} and $overduesblockrenewing eq 'blockitem') ) {
2851         return ( 0, 'overdue');
2852     }
2853
2854     if ( defined $issuingrule->{norenewalbefore}
2855         and $issuingrule->{norenewalbefore} ne "" )
2856     {
2857
2858         # Calculate soonest renewal by subtracting 'No renewal before' from due date
2859         my $soonestrenewal =
2860           $itemissue->{date_due}->clone()
2861           ->subtract(
2862             $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
2863
2864         # Depending on syspref reset the exact time, only check the date
2865         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2866             and $issuingrule->{lengthunit} eq 'days' )
2867         {
2868             $soonestrenewal->truncate( to => 'day' );
2869         }
2870
2871         if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
2872         {
2873             return ( 0, "auto_too_soon" ) if $itemissue->{auto_renew};
2874             return ( 0, "too_soon" );
2875         }
2876         elsif ( $itemissue->{auto_renew} ) {
2877             return ( 0, "auto_renew" );
2878         }
2879     }
2880
2881     # Fallback for automatic renewals:
2882     # If norenewalbefore is undef, don't renew before due date.
2883     elsif ( $itemissue->{auto_renew} ) {
2884         my $now = dt_from_string;
2885         return ( 0, "auto_renew" )
2886           if $now >= $itemissue->{date_due};
2887         return ( 0, "auto_too_soon" );
2888     }
2889
2890     return ( 1, undef );
2891 }
2892
2893 =head2 AddRenewal
2894
2895   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2896
2897 Renews a loan.
2898
2899 C<$borrowernumber> is the borrower number of the patron who currently
2900 has the item.
2901
2902 C<$itemnumber> is the number of the item to renew.
2903
2904 C<$branch> is the library where the renewal took place (if any).
2905            The library that controls the circ policies for the renewal is retrieved from the issues record.
2906
2907 C<$datedue> can be a DateTime object used to set the due date.
2908
2909 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2910 this parameter is not supplied, lastreneweddate is set to the current date.
2911
2912 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2913 from the book's item type.
2914
2915 =cut
2916
2917 sub AddRenewal {
2918     my $borrowernumber  = shift;
2919     my $itemnumber      = shift or return;
2920     my $branch          = shift;
2921     my $datedue         = shift;
2922     my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2923
2924     my $item   = GetItem($itemnumber) or return;
2925     my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
2926
2927     my $dbh = C4::Context->dbh;
2928
2929     # Find the issues record for this book
2930     my $issuedata  = GetItemIssue($itemnumber);
2931
2932     return unless ( $issuedata );
2933
2934     $borrowernumber ||= $issuedata->{borrowernumber};
2935
2936     if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2937         carp 'Invalid date passed to AddRenewal.';
2938         return;
2939     }
2940
2941     my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
2942
2943     if ( C4::Context->preference('CalculateFinesOnReturn') && $issuedata->{overdue} ) {
2944         _CalculateAndUpdateFine( { issue => $issuedata, item => $item, borrower => $borrower } );
2945     }
2946     _FixOverduesOnReturn( $borrowernumber, $itemnumber );
2947
2948     # If the due date wasn't specified, calculate it by adding the
2949     # book's loan length to today's date or the current due date
2950     # based on the value of the RenewalPeriodBase syspref.
2951     unless ($datedue) {
2952
2953         my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2954
2955         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2956                                         dt_from_string( $issuedata->{date_due} ) :
2957                                         DateTime->now( time_zone => C4::Context->tz());
2958         $datedue =  CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
2959     }
2960
2961     # Update the issues record to have the new due date, and a new count
2962     # of how many times it has been renewed.
2963     my $renews = $issuedata->{'renewals'} + 1;
2964     my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2965                             WHERE borrowernumber=?
2966                             AND itemnumber=?"
2967     );
2968
2969     $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2970
2971     # Update the renewal count on the item, and tell zebra to reindex
2972     $renews = $biblio->{'renewals'} + 1;
2973     ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2974
2975     # Charge a new rental fee, if applicable?
2976     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2977     if ( $charge > 0 ) {
2978         my $accountno = getnextacctno( $borrowernumber );
2979         my $item = GetBiblioFromItemNumber($itemnumber);
2980         my $manager_id = 0;
2981         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2982         $sth = $dbh->prepare(
2983                 "INSERT INTO accountlines
2984                     (date, borrowernumber, accountno, amount, manager_id,
2985                     description,accounttype, amountoutstanding, itemnumber)
2986                     VALUES (now(),?,?,?,?,?,?,?,?)"
2987         );
2988         $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2989             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2990             'Rent', $charge, $itemnumber );
2991     }
2992
2993     # Send a renewal slip according to checkout alert preferencei
2994     if ( C4::Context->preference('RenewalSendNotice') eq '1' ) {
2995         $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
2996         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2997         my %conditions        = (
2998             branchcode   => $branch,
2999             categorycode => $borrower->{categorycode},
3000             item_type    => $item->{itype},
3001             notification => 'CHECKOUT',
3002         );
3003         if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
3004             SendCirculationAlert(
3005                 {
3006                     type     => 'RENEWAL',
3007                     item     => $item,
3008                     borrower => $borrower,
3009                     branch   => $branch,
3010                 }
3011             );
3012         }
3013     }
3014
3015     # Remove any OVERDUES related debarment if the borrower has no overdues
3016     $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
3017     if ( $borrowernumber
3018       && $borrower->{'debarred'}
3019       && !Koha::Patrons->find( $borrowernumber )->has_overdues
3020       && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
3021     ) {
3022         DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
3023     }
3024
3025     # Log the renewal
3026     UpdateStats({branch => $branch,
3027                 type => 'renew',
3028                 amount => $charge,
3029                 itemnumber => $itemnumber,
3030                 itemtype => $item->{itype},
3031                 borrowernumber => $borrowernumber,
3032                 ccode => $item->{'ccode'}}
3033                 );
3034         return $datedue;
3035 }
3036
3037 sub GetRenewCount {
3038     # check renewal status
3039     my ( $bornum, $itemno ) = @_;
3040     my $dbh           = C4::Context->dbh;
3041     my $renewcount    = 0;
3042     my $renewsallowed = 0;
3043     my $renewsleft    = 0;
3044
3045     my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
3046     my $item     = GetItem($itemno);
3047
3048     # Look in the issues table for this item, lent to this borrower,
3049     # and not yet returned.
3050
3051     # FIXME - I think this function could be redone to use only one SQL call.
3052     my $sth = $dbh->prepare(
3053         "select * from issues
3054                                 where (borrowernumber = ?)
3055                                 and (itemnumber = ?)"
3056     );
3057     $sth->execute( $bornum, $itemno );
3058     my $data = $sth->fetchrow_hashref;
3059     $renewcount = $data->{'renewals'} if $data->{'renewals'};
3060     # $item and $borrower should be calculated
3061     my $branchcode = _GetCircControlBranch($item, $borrower);
3062
3063     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
3064
3065     $renewsallowed = $issuingrule->{'renewalsallowed'};
3066     $renewsleft    = $renewsallowed - $renewcount;
3067     if($renewsleft < 0){ $renewsleft = 0; }
3068     return ( $renewcount, $renewsallowed, $renewsleft );
3069 }
3070
3071 =head2 GetSoonestRenewDate
3072
3073   $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3074
3075 Find out the soonest possible renew date of a borrowed item.
3076
3077 C<$borrowernumber> is the borrower number of the patron who currently
3078 has the item on loan.
3079
3080 C<$itemnumber> is the number of the item to renew.
3081
3082 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3083 renew date, based on the value "No renewal before" of the applicable
3084 issuing rule. Returns the current date if the item can already be
3085 renewed, and returns undefined if the borrower, loan, or item
3086 cannot be found.
3087
3088 =cut
3089
3090 sub GetSoonestRenewDate {
3091     my ( $borrowernumber, $itemnumber ) = @_;
3092
3093     my $dbh = C4::Context->dbh;
3094
3095     my $item      = GetItem($itemnumber)      or return;
3096     my $itemissue = GetItemIssue($itemnumber) or return;
3097
3098     $borrowernumber ||= $itemissue->{borrowernumber};
3099     my $borrower = C4::Members::GetMemberDetails($borrowernumber)
3100       or return;
3101
3102     my $branchcode = _GetCircControlBranch( $item, $borrower );
3103     my $issuingrule =
3104       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
3105
3106     my $now = dt_from_string;
3107
3108     if ( defined $issuingrule->{norenewalbefore}
3109         and $issuingrule->{norenewalbefore} ne "" )
3110     {
3111         my $soonestrenewal =
3112           $itemissue->{date_due}->clone()
3113           ->subtract(
3114             $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
3115
3116         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3117             and $issuingrule->{lengthunit} eq 'days' )
3118         {
3119             $soonestrenewal->truncate( to => 'day' );
3120         }
3121         return $soonestrenewal if $now < $soonestrenewal;
3122     }
3123     return $now;
3124 }
3125
3126 =head2 GetIssuingCharges
3127
3128   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3129
3130 Calculate how much it would cost for a given patron to borrow a given
3131 item, including any applicable discounts.
3132
3133 C<$itemnumber> is the item number of item the patron wishes to borrow.
3134
3135 C<$borrowernumber> is the patron's borrower number.
3136
3137 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3138 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3139 if it's a video).
3140
3141 =cut
3142
3143 sub GetIssuingCharges {
3144
3145     # calculate charges due
3146     my ( $itemnumber, $borrowernumber ) = @_;
3147     my $charge = 0;
3148     my $dbh    = C4::Context->dbh;
3149     my $item_type;
3150
3151     # Get the book's item type and rental charge (via its biblioitem).
3152     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3153         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3154     $charge_query .= (C4::Context->preference('item-level_itypes'))
3155         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3156         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3157
3158     $charge_query .= ' WHERE items.itemnumber =?';
3159
3160     my $sth = $dbh->prepare($charge_query);
3161     $sth->execute($itemnumber);
3162     if ( my $item_data = $sth->fetchrow_hashref ) {
3163         $item_type = $item_data->{itemtype};
3164         $charge    = $item_data->{rentalcharge};
3165         my $branch = C4::Context::mybranch();
3166         my $discount_query = q|SELECT rentaldiscount,
3167             issuingrules.itemtype, issuingrules.branchcode
3168             FROM borrowers
3169             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3170             WHERE borrowers.borrowernumber = ?
3171             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3172             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3173         my $discount_sth = $dbh->prepare($discount_query);
3174         $discount_sth->execute( $borrowernumber, $item_type, $branch );
3175         my $discount_rules = $discount_sth->fetchall_arrayref({});
3176         if (@{$discount_rules}) {
3177             # We may have multiple rules so get the most specific
3178             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3179             $charge = ( $charge * ( 100 - $discount ) ) / 100;
3180         }
3181     }
3182
3183     return ( $charge, $item_type );
3184 }
3185
3186 # Select most appropriate discount rule from those returned
3187 sub _get_discount_from_rule {
3188     my ($rules_ref, $branch, $itemtype) = @_;
3189     my $discount;
3190
3191     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3192         $discount = $rules_ref->[0]->{rentaldiscount};
3193         return (defined $discount) ? $discount : 0;
3194     }
3195     # could have up to 4 does one match $branch and $itemtype
3196     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3197     if (@d) {
3198         $discount = $d[0]->{rentaldiscount};
3199         return (defined $discount) ? $discount : 0;
3200     }
3201     # do we have item type + all branches
3202     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3203     if (@d) {
3204         $discount = $d[0]->{rentaldiscount};
3205         return (defined $discount) ? $discount : 0;
3206     }
3207     # do we all item types + this branch
3208     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3209     if (@d) {
3210         $discount = $d[0]->{rentaldiscount};
3211         return (defined $discount) ? $discount : 0;
3212     }
3213     # so all and all (surely we wont get here)
3214     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3215     if (@d) {
3216         $discount = $d[0]->{rentaldiscount};
3217         return (defined $discount) ? $discount : 0;
3218     }
3219     # none of the above
3220     return 0;
3221 }
3222
3223 =head2 AddIssuingCharge
3224
3225   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3226
3227 =cut
3228
3229 sub AddIssuingCharge {
3230     my ( $itemnumber, $borrowernumber, $charge ) = @_;
3231     my $dbh = C4::Context->dbh;
3232     my $nextaccntno = getnextacctno( $borrowernumber );
3233     my $manager_id = 0;
3234     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3235     my $query ="
3236         INSERT INTO accountlines
3237             (borrowernumber, itemnumber, accountno,
3238             date, amount, description, accounttype,
3239             amountoutstanding, manager_id)
3240         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3241     ";
3242     my $sth = $dbh->prepare($query);
3243     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3244 }
3245
3246 =head2 GetTransfers
3247
3248   GetTransfers($itemnumber);
3249
3250 =cut
3251
3252 sub GetTransfers {
3253     my ($itemnumber) = @_;
3254
3255     my $dbh = C4::Context->dbh;
3256
3257     my $query = '
3258         SELECT datesent,
3259                frombranch,
3260                tobranch
3261         FROM branchtransfers
3262         WHERE itemnumber = ?
3263           AND datearrived IS NULL
3264         ';
3265     my $sth = $dbh->prepare($query);
3266     $sth->execute($itemnumber);
3267     my @row = $sth->fetchrow_array();
3268     return @row;
3269 }
3270
3271 =head2 GetTransfersFromTo
3272
3273   @results = GetTransfersFromTo($frombranch,$tobranch);
3274
3275 Returns the list of pending transfers between $from and $to branch
3276
3277 =cut
3278
3279 sub GetTransfersFromTo {
3280     my ( $frombranch, $tobranch ) = @_;
3281     return unless ( $frombranch && $tobranch );
3282     my $dbh   = C4::Context->dbh;
3283     my $query = "
3284         SELECT itemnumber,datesent,frombranch
3285         FROM   branchtransfers
3286         WHERE  frombranch=?
3287           AND  tobranch=?
3288           AND datearrived IS NULL
3289     ";
3290     my $sth = $dbh->prepare($query);
3291     $sth->execute( $frombranch, $tobranch );
3292     my @gettransfers;
3293
3294     while ( my $data = $sth->fetchrow_hashref ) {
3295         push @gettransfers, $data;
3296     }
3297     return (@gettransfers);
3298 }
3299
3300 =head2 DeleteTransfer
3301
3302   &DeleteTransfer($itemnumber);
3303
3304 =cut
3305
3306 sub DeleteTransfer {
3307     my ($itemnumber) = @_;
3308     return unless $itemnumber;
3309     my $dbh          = C4::Context->dbh;
3310     my $sth          = $dbh->prepare(
3311         "DELETE FROM branchtransfers
3312          WHERE itemnumber=?
3313          AND datearrived IS NULL "
3314     );
3315     return $sth->execute($itemnumber);
3316 }
3317
3318 =head2 AnonymiseIssueHistory
3319
3320   ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3321
3322 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3323 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3324
3325 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3326 setting (force delete).
3327
3328 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3329
3330 =cut
3331
3332 sub AnonymiseIssueHistory {
3333     my $date           = shift;
3334     my $borrowernumber = shift;
3335     my $dbh            = C4::Context->dbh;
3336     my $query          = "
3337         UPDATE old_issues
3338         SET    borrowernumber = ?
3339         WHERE  returndate < ?
3340           AND borrowernumber IS NOT NULL
3341     ";
3342
3343     # The default of 0 does not work due to foreign key constraints
3344     # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
3345     # Set it to undef (NULL)
3346     my $anonymouspatron = C4::Context->preference('AnonymousPatron') || undef;
3347     my @bind_params = ($anonymouspatron, $date);
3348     if (defined $borrowernumber) {
3349        $query .= " AND borrowernumber = ?";
3350        push @bind_params, $borrowernumber;
3351     } else {
3352        $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3353     }
3354     my $sth = $dbh->prepare($query);
3355     $sth->execute(@bind_params);
3356     my $anonymisation_err = $dbh->err;
3357     my $rows_affected = $sth->rows;  ### doublecheck row count return function
3358     return ($rows_affected, $anonymisation_err);
3359 }
3360
3361 =head2 SendCirculationAlert
3362
3363 Send out a C<check-in> or C<checkout> alert using the messaging system.
3364
3365 B<Parameters>:
3366
3367 =over 4
3368
3369 =item type
3370
3371 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3372
3373 =item item
3374
3375 Hashref of information about the item being checked in or out.
3376
3377 =item borrower
3378
3379 Hashref of information about the borrower of the item.
3380
3381 =item branch
3382
3383 The branchcode from where the checkout or check-in took place.
3384
3385 =back
3386
3387 B<Example>:
3388
3389     SendCirculationAlert({
3390         type     => 'CHECKOUT',
3391         item     => $item,
3392         borrower => $borrower,
3393         branch   => $branch,
3394     });
3395
3396 =cut
3397
3398 sub SendCirculationAlert {
3399     my ($opts) = @_;
3400     my ($type, $item, $borrower, $branch) =
3401         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3402     my %message_name = (
3403         CHECKIN  => 'Item_Check_in',
3404         CHECKOUT => 'Item_Checkout',
3405         RENEWAL  => 'Item_Checkout',
3406     );
3407     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3408         borrowernumber => $borrower->{borrowernumber},
3409         message_name   => $message_name{$type},
3410     });
3411     my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3412
3413     my @transports = keys %{ $borrower_preferences->{transports} };
3414     # warn "no transports" unless @transports;
3415     for (@transports) {
3416         # warn "transport: $_";
3417         my $message = C4::Message->find_last_message($borrower, $type, $_);
3418         if (!$message) {
3419             #warn "create new message";
3420             my $letter =  C4::Letters::GetPreparedLetter (
3421                 module => 'circulation',
3422                 letter_code => $type,
3423                 branchcode => $branch,
3424                 message_transport_type => $_,
3425                 tables => {
3426                     $issues_table => $item->{itemnumber},
3427                     'items'       => $item->{itemnumber},
3428                     'biblio'      => $item->{biblionumber},
3429                     'biblioitems' => $item->{biblionumber},
3430                     'borrowers'   => $borrower,
3431                     'branches'    => $branch,
3432                 }
3433             ) or next;
3434             C4::Message->enqueue($letter, $borrower, $_);
3435         } else {
3436             #warn "append to old message";
3437             my $letter =  C4::Letters::GetPreparedLetter (
3438                 module => 'circulation',
3439                 letter_code => $type,
3440                 branchcode => $branch,
3441                 message_transport_type => $_,
3442                 tables => {
3443                     $issues_table => $item->{itemnumber},
3444                     'items'       => $item->{itemnumber},
3445                     'biblio'      => $item->{biblionumber},
3446                     'biblioitems' => $item->{biblionumber},
3447                     'borrowers'   => $borrower,
3448                     'branches'    => $branch,
3449                 }
3450             ) or next;
3451             $message->append($letter);
3452             $message->update;
3453         }
3454     }
3455
3456     return;
3457 }
3458
3459 =head2 updateWrongTransfer
3460
3461   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3462
3463 This function validate the line of brachtransfer but with the wrong destination (mistake from a librarian ...), and create a new line in branchtransfer from the actual library to the original library of reservation
3464
3465 =cut
3466
3467 sub updateWrongTransfer {
3468         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3469         my $dbh = C4::Context->dbh;
3470 # first step validate the actual line of transfert .
3471         my $sth =
3472                 $dbh->prepare(
3473                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3474                 );
3475                 $sth->execute($FromLibrary,$itemNumber);
3476
3477 # second step create a new line of branchtransfer to the right location .
3478         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3479
3480 #third step changing holdingbranch of item
3481         UpdateHoldingbranch($FromLibrary,$itemNumber);
3482 }
3483
3484 =head2 UpdateHoldingbranch
3485
3486   $items = UpdateHoldingbranch($branch,$itmenumber);
3487
3488 Simple methode for updating hodlingbranch in items BDD line
3489
3490 =cut
3491
3492 sub UpdateHoldingbranch {
3493         my ( $branch,$itemnumber ) = @_;
3494     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3495 }
3496
3497 =head2 CalcDateDue
3498
3499 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3500
3501 this function calculates the due date given the start date and configured circulation rules,
3502 checking against the holidays calendar as per the 'useDaysMode' syspref.
3503 C<$startdate>   = DateTime object representing start date of loan period (assumed to be today)
3504 C<$itemtype>  = itemtype code of item in question
3505 C<$branch>  = location whose calendar to use
3506 C<$borrower> = Borrower object
3507 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3508
3509 =cut
3510
3511 sub CalcDateDue {
3512     my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3513
3514     $isrenewal ||= 0;
3515
3516     # loanlength now a href
3517     my $loanlength =
3518             GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3519
3520     my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3521             ? qq{renewalperiod}
3522             : qq{issuelength};
3523
3524     my $datedue;
3525     if ( $startdate ) {
3526         if (ref $startdate ne 'DateTime' ) {
3527             $datedue = dt_from_string($datedue);
3528         } else {
3529             $datedue = $startdate->clone;
3530         }
3531     } else {
3532         $datedue =
3533           DateTime->now( time_zone => C4::Context->tz() )
3534           ->truncate( to => 'minute' );
3535     }
3536
3537
3538     # calculate the datedue as normal
3539     if ( C4::Context->preference('useDaysMode') eq 'Days' )
3540     {    # ignoring calendar
3541         if ( $loanlength->{lengthunit} eq 'hours' ) {
3542             $datedue->add( hours => $loanlength->{$length_key} );
3543         } else {    # days
3544             $datedue->add( days => $loanlength->{$length_key} );
3545             $datedue->set_hour(23);
3546             $datedue->set_minute(59);
3547         }
3548     } else {
3549         my $dur;
3550         if ($loanlength->{lengthunit} eq 'hours') {
3551             $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3552         }
3553         else { # days
3554             $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3555         }
3556         my $calendar = Koha::Calendar->new( branchcode => $branch );
3557         $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3558         if ($loanlength->{lengthunit} eq 'days') {
3559             $datedue->set_hour(23);
3560             $datedue->set_minute(59);
3561         }
3562     }
3563
3564     # if Hard Due Dates are used, retrieve them and apply as necessary
3565     my ( $hardduedate, $hardduedatecompare ) =
3566       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3567     if ($hardduedate) {    # hardduedates are currently dates
3568         $hardduedate->truncate( to => 'minute' );
3569         $hardduedate->set_hour(23);
3570         $hardduedate->set_minute(59);
3571         my $cmp = DateTime->compare( $hardduedate, $datedue );
3572
3573 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3574 # if the calculated date is before the 'after' Hard Due Date (floor), override
3575 # if the hard due date is set to 'exactly', overrride
3576         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3577             $datedue = $hardduedate->clone;
3578         }
3579
3580         # in all other cases, keep the date due as it is
3581
3582     }
3583
3584     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3585     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3586         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3587         if( $expiry_dt ) { #skip empty expiry date..
3588             $expiry_dt->set( hour => 23, minute => 59);
3589             my $d1= $datedue->clone->set_time_zone('floating');
3590             if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3591                 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3592             }
3593         }
3594     }
3595
3596     return $datedue;
3597 }
3598
3599
3600 sub CheckValidBarcode{
3601 my ($barcode) = @_;
3602 my $dbh = C4::Context->dbh;
3603 my $query=qq|SELECT count(*)
3604              FROM items
3605              WHERE barcode=?
3606             |;
3607 my $sth = $dbh->prepare($query);
3608 $sth->execute($barcode);
3609 my $exist=$sth->fetchrow ;
3610 return $exist;
3611 }
3612
3613 =head2 IsBranchTransferAllowed
3614
3615   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3616
3617 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3618
3619 =cut
3620
3621 sub IsBranchTransferAllowed {
3622         my ( $toBranch, $fromBranch, $code ) = @_;
3623
3624         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3625
3626         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3627         my $dbh = C4::Context->dbh;
3628
3629         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3630         $sth->execute( $toBranch, $fromBranch, $code );
3631         my $limit = $sth->fetchrow_hashref();
3632
3633         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3634         if ( $limit->{'limitId'} ) {
3635                 return 0;
3636         } else {
3637                 return 1;
3638         }
3639 }
3640
3641 =head2 CreateBranchTransferLimit
3642
3643   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3644
3645 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3646
3647 =cut
3648
3649 sub CreateBranchTransferLimit {
3650    my ( $toBranch, $fromBranch, $code ) = @_;
3651    return unless defined($toBranch) && defined($fromBranch);
3652    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3653
3654    my $dbh = C4::Context->dbh;
3655
3656    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3657    return $sth->execute( $code, $toBranch, $fromBranch );
3658 }
3659
3660 =head2 DeleteBranchTransferLimits
3661
3662     my $result = DeleteBranchTransferLimits($frombranch);
3663
3664 Deletes all the library transfer limits for one library.  Returns the
3665 number of limits deleted, 0e0 if no limits were deleted, or undef if
3666 no arguments are supplied.
3667
3668 =cut
3669
3670 sub DeleteBranchTransferLimits {
3671     my $branch = shift;
3672     return unless defined $branch;
3673     my $dbh    = C4::Context->dbh;
3674     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3675     return $sth->execute($branch);
3676 }
3677
3678 sub ReturnLostItem{
3679     my ( $borrowernumber, $itemnum ) = @_;
3680
3681     MarkIssueReturned( $borrowernumber, $itemnum );
3682     my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3683     my $item = C4::Items::GetItem( $itemnum );
3684     my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3685     my @datearr = localtime(time);
3686     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3687     my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3688     ModItem({ paidfor =>  $old_note."Paid for by $bor $date" }, undef, $itemnum);
3689 }
3690
3691
3692 sub LostItem{
3693     my ($itemnumber, $mark_returned) = @_;
3694
3695     my $dbh = C4::Context->dbh();
3696     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3697                            FROM issues
3698                            JOIN items USING (itemnumber)
3699                            JOIN biblio USING (biblionumber)
3700                            WHERE issues.itemnumber=?");
3701     $sth->execute($itemnumber);
3702     my $issues=$sth->fetchrow_hashref();
3703
3704     # If a borrower lost the item, add a replacement cost to the their record
3705     if ( my $borrowernumber = $issues->{borrowernumber} ){
3706         my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3707
3708         if (C4::Context->preference('WhenLostForgiveFine')){
3709             my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3710             defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!";  # zero is OK, check defined
3711         }
3712         if (C4::Context->preference('WhenLostChargeReplacementFee')){
3713             C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3714             #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3715             #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3716         }
3717
3718         MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3719     }
3720 }
3721
3722 sub GetOfflineOperations {
3723     my $dbh = C4::Context->dbh;
3724     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3725     $sth->execute(C4::Context->userenv->{'branch'});
3726     my $results = $sth->fetchall_arrayref({});
3727     return $results;
3728 }
3729
3730 sub GetOfflineOperation {
3731     my $operationid = shift;
3732     return unless $operationid;
3733     my $dbh = C4::Context->dbh;
3734     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3735     $sth->execute( $operationid );
3736     return $sth->fetchrow_hashref;
3737 }
3738
3739 sub AddOfflineOperation {
3740     my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3741     my $dbh = C4::Context->dbh;
3742     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3743     $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3744     return "Added.";
3745 }
3746
3747 sub DeleteOfflineOperation {
3748     my $dbh = C4::Context->dbh;
3749     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3750     $sth->execute( shift );
3751     return "Deleted.";
3752 }
3753
3754 sub ProcessOfflineOperation {
3755     my $operation = shift;
3756
3757     my $report;
3758     if ( $operation->{action} eq 'return' ) {
3759         $report = ProcessOfflineReturn( $operation );
3760     } elsif ( $operation->{action} eq 'issue' ) {
3761         $report = ProcessOfflineIssue( $operation );
3762     } elsif ( $operation->{action} eq 'payment' ) {
3763         $report = ProcessOfflinePayment( $operation );
3764     }
3765
3766     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3767
3768     return $report;
3769 }
3770
3771 sub ProcessOfflineReturn {
3772     my $operation = shift;
3773
3774     my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3775
3776     if ( $itemnumber ) {
3777         my $issue = GetOpenIssue( $itemnumber );
3778         if ( $issue ) {
3779             MarkIssueReturned(
3780                 $issue->{borrowernumber},
3781                 $itemnumber,
3782                 undef,
3783                 $operation->{timestamp},
3784             );
3785             ModItem(
3786                 { renewals => 0, onloan => undef },
3787                 $issue->{'biblionumber'},
3788                 $itemnumber
3789             );
3790             return "Success.";
3791         } else {
3792             return "Item not issued.";
3793         }
3794     } else {
3795         return "Item not found.";
3796     }
3797 }
3798
3799 sub ProcessOfflineIssue {
3800     my $operation = shift;
3801
3802     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3803
3804     if ( $borrower->{borrowernumber} ) {
3805         my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3806         unless ($itemnumber) {
3807             return "Barcode not found.";
3808         }
3809         my $issue = GetOpenIssue( $itemnumber );
3810
3811         if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3812             MarkIssueReturned(
3813                 $issue->{borrowernumber},
3814                 $itemnumber,
3815                 undef,
3816                 $operation->{timestamp},
3817             );
3818         }
3819         AddIssue(
3820             $borrower,
3821             $operation->{'barcode'},
3822             undef,
3823             1,
3824             $operation->{timestamp},
3825             undef,
3826         );
3827         return "Success.";
3828     } else {
3829         return "Borrower not found.";
3830     }
3831 }
3832
3833 sub ProcessOfflinePayment {
3834     my $operation = shift;
3835
3836     my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} });
3837     my $amount = $operation->{amount};
3838
3839     Koha::Account->new( { patron_id => $patron->id } )->pay( { amount => $amount } );
3840
3841     return "Success."
3842 }
3843
3844
3845 =head2 TransferSlip
3846
3847   TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3848
3849   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3850
3851 =cut
3852
3853 sub TransferSlip {
3854     my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3855
3856     my $item =  GetItem( $itemnumber, $barcode )
3857       or return;
3858
3859     return C4::Letters::GetPreparedLetter (
3860         module => 'circulation',
3861         letter_code => 'TRANSFERSLIP',
3862         branchcode => $branch,
3863         tables => {
3864             'branches'    => $to_branch,
3865             'biblio'      => $item->{biblionumber},
3866             'items'       => $item,
3867         },
3868     );
3869 }
3870
3871 =head2 CheckIfIssuedToPatron
3872
3873   CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3874
3875   Return 1 if any record item is issued to patron, otherwise return 0
3876
3877 =cut
3878
3879 sub CheckIfIssuedToPatron {
3880     my ($borrowernumber, $biblionumber) = @_;
3881
3882     my $dbh = C4::Context->dbh;
3883     my $query = q|
3884         SELECT COUNT(*) FROM issues
3885         LEFT JOIN items ON items.itemnumber = issues.itemnumber
3886         WHERE items.biblionumber = ?
3887         AND issues.borrowernumber = ?
3888     |;
3889     my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3890     return 1 if $is_issued;
3891     return;
3892 }
3893
3894 =head2 IsItemIssued
3895
3896   IsItemIssued( $itemnumber )
3897
3898   Return 1 if the item is on loan, otherwise return 0
3899
3900 =cut
3901
3902 sub IsItemIssued {
3903     my $itemnumber = shift;
3904     my $dbh = C4::Context->dbh;
3905     my $sth = $dbh->prepare(q{
3906         SELECT COUNT(*)
3907         FROM issues
3908         WHERE itemnumber = ?
3909     });
3910     $sth->execute($itemnumber);
3911     return $sth->fetchrow;
3912 }
3913
3914 =head2 GetAgeRestriction
3915
3916   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3917   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3918
3919   if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
3920   if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3921
3922 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3923 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3924 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3925          Negative days mean the borrower has gone past the age restriction age.
3926
3927 =cut
3928
3929 sub GetAgeRestriction {
3930     my ($record_restrictions, $borrower) = @_;
3931     my $markers = C4::Context->preference('AgeRestrictionMarker');
3932
3933     # Split $record_restrictions to something like FSK 16 or PEGI 6
3934     my @values = split ' ', uc($record_restrictions);
3935     return unless @values;
3936
3937     # Search first occurrence of one of the markers
3938     my @markers = split /\|/, uc($markers);
3939     return unless @markers;
3940
3941     my $index            = 0;
3942     my $restriction_year = 0;
3943     for my $value (@values) {
3944         $index++;
3945         for my $marker (@markers) {
3946             $marker =~ s/^\s+//;    #remove leading spaces
3947             $marker =~ s/\s+$//;    #remove trailing spaces
3948             if ( $marker eq $value ) {
3949                 if ( $index <= $#values ) {
3950                     $restriction_year += $values[$index];
3951                 }
3952                 last;
3953             }
3954             elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3955
3956                 # Perhaps it is something like "K16" (as in Finland)
3957                 $restriction_year += $1;
3958                 last;
3959             }
3960         }
3961         last if ( $restriction_year > 0 );
3962     }
3963
3964     #Check if the borrower is age restricted for this material and for how long.
3965     if ($restriction_year && $borrower) {
3966         if ( $borrower->{'dateofbirth'} ) {
3967             my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3968             $alloweddate[0] += $restriction_year;
3969
3970             #Prevent runime eror on leap year (invalid date)
3971             if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3972                 $alloweddate[2] = 28;
3973             }
3974
3975             #Get how many days the borrower has to reach the age restriction
3976             my @Today = split /-/, DateTime->today->ymd();
3977             my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
3978             #Negative days means the borrower went past the age restriction age
3979             return ($restriction_year, $daysToAgeRestriction);
3980         }
3981     }
3982
3983     return ($restriction_year);
3984 }
3985
3986
3987 =head2 GetPendingOnSiteCheckouts
3988
3989 =cut
3990
3991 sub GetPendingOnSiteCheckouts {
3992     my $dbh = C4::Context->dbh;
3993     return $dbh->selectall_arrayref(q|
3994         SELECT
3995           items.barcode,
3996           items.biblionumber,
3997           items.itemnumber,
3998           items.itemnotes,
3999           items.itemcallnumber,
4000           items.location,
4001           issues.date_due,
4002           issues.branchcode,
4003           issues.date_due < NOW() AS is_overdue,
4004           biblio.author,
4005           biblio.title,
4006           borrowers.firstname,
4007           borrowers.surname,
4008           borrowers.cardnumber,
4009           borrowers.borrowernumber
4010         FROM items
4011         LEFT JOIN issues ON items.itemnumber = issues.itemnumber
4012         LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
4013         LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
4014         WHERE issues.onsite_checkout = 1
4015     |, { Slice => {} } );
4016 }
4017
4018 sub GetTopIssues {
4019     my ($params) = @_;
4020
4021     my ($count, $branch, $itemtype, $ccode, $newness)
4022         = @$params{qw(count branch itemtype ccode newness)};
4023
4024     my $dbh = C4::Context->dbh;
4025     my $query = q{
4026         SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4027           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4028           i.ccode, SUM(i.issues) AS count
4029         FROM biblio b
4030         LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4031         LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4032     };
4033
4034     my (@where_strs, @where_args);
4035
4036     if ($branch) {
4037         push @where_strs, 'i.homebranch = ?';
4038         push @where_args, $branch;
4039     }
4040     if ($itemtype) {
4041         if (C4::Context->preference('item-level_itypes')){
4042             push @where_strs, 'i.itype = ?';
4043             push @where_args, $itemtype;
4044         } else {
4045             push @where_strs, 'bi.itemtype = ?';
4046             push @where_args, $itemtype;
4047         }
4048     }
4049     if ($ccode) {
4050         push @where_strs, 'i.ccode = ?';
4051         push @where_args, $ccode;
4052     }
4053     if ($newness) {
4054         push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4055         push @where_args, $newness;
4056     }
4057
4058     if (@where_strs) {
4059         $query .= 'WHERE ' . join(' AND ', @where_strs);
4060     }
4061
4062     $query .= q{
4063         GROUP BY b.biblionumber
4064         HAVING count > 0
4065         ORDER BY count DESC
4066     };
4067
4068     $count = int($count);
4069     if ($count > 0) {
4070         $query .= "LIMIT $count";
4071     }
4072
4073     my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4074
4075     return @$rows;
4076 }
4077
4078 sub _CalculateAndUpdateFine {
4079     my ($params) = @_;
4080
4081     my $borrower    = $params->{borrower};
4082     my $item        = $params->{item};
4083     my $issue       = $params->{issue};
4084     my $return_date = $params->{return_date};
4085
4086     unless ($borrower) { carp "No borrower passed in!" && return; }
4087     unless ($item)     { carp "No item passed in!"     && return; }
4088     unless ($issue)    { carp "No issue passed in!"    && return; }
4089
4090     my $datedue = $issue->{date_due};
4091
4092     # we only need to calculate and change the fines if we want to do that on return
4093     # Should be on for hourly loans
4094     my $control = C4::Context->preference('CircControl');
4095     my $control_branchcode =
4096         ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4097       : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
4098       :                                     $issue->{branchcode};
4099
4100     my $date_returned = $return_date ? dt_from_string($return_date) : dt_from_string();
4101
4102     my ( $amount, $type, $unitcounttotal ) =
4103       C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4104
4105     $type ||= q{};
4106
4107     if ( C4::Context->preference('finesMode') eq 'production' ) {
4108         if ( $amount > 0 ) {
4109             C4::Overdues::UpdateFine({
4110                 issue_id       => $issue->{issue_id},
4111                 itemnumber     => $issue->{itemnumber},
4112                 borrowernumber => $issue->{borrowernumber},
4113                 amount         => $amount,
4114                 type           => $type,
4115                 due            => output_pref($datedue),
4116             });
4117         }
4118         elsif ($return_date) {
4119
4120             # Backdated returns may have fines that shouldn't exist,
4121             # so in this case, we need to drop those fines to 0
4122
4123             C4::Overdues::UpdateFine({
4124                 issue_id       => $issue->{issue_id},
4125                 itemnumber     => $issue->{itemnumber},
4126                 borrowernumber => $issue->{borrowernumber},
4127                 amount         => 0,
4128                 type           => $type,
4129                 due            => output_pref($datedue),
4130             });
4131         }
4132     }
4133 }
4134
4135 1;
4136
4137 __END__
4138
4139 =head1 AUTHOR
4140
4141 Koha Development Team <http://koha-community.org/>
4142
4143 =cut