C4/Circulation.pm

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