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