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