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