C4/Circulation.pm

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