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