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