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 issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2528 FROM issues
2529 LEFT JOIN items USING (itemnumber)
2530 LEFT OUTER JOIN branches USING (branchcode)
2531 WHERE returndate is NULL
2532 HAVING days_until_due >= 0 AND days_until_due <= ?
2533 END_SQL
2534
2535     my @bind_parameters = ( $params->{'days_in_advance'} );
2536
2537     my $sth = $dbh->prepare( $statement );
2538     $sth->execute( @bind_parameters );
2539     my $upcoming_dues = $sth->fetchall_arrayref({});
2540
2541     return $upcoming_dues;
2542 }
2543
2544 =head2 CanBookBeRenewed
2545
2546   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2547
2548 Find out whether a borrowed item may be renewed.
2549
2550 C<$borrowernumber> is the borrower number of the patron who currently
2551 has the item on loan.
2552
2553 C<$itemnumber> is the number of the item to renew.
2554
2555 C<$override_limit>, if supplied with a true value, causes
2556 the limit on the number of times that the loan can be renewed
2557 (as controlled by the item type) to be ignored. Overriding also allows
2558 to renew sooner than "No renewal before" and to manually renew loans
2559 that are automatically renewed.
2560
2561 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2562 item must currently be on loan to the specified borrower; renewals
2563 must be allowed for the item's type; and the borrower must not have
2564 already renewed the loan. $error will contain the reason the renewal can not proceed
2565
2566 =cut
2567
2568 sub CanBookBeRenewed {
2569     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2570
2571     my $dbh    = C4::Context->dbh;
2572     my $renews = 1;
2573
2574     my $item      = GetItem($itemnumber)      or return ( 0, 'no_item' );
2575     my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return ( 0, 'no_checkout' );
2576     return ( 0, 'onsite_checkout' ) if $issue->onsite_checkout;
2577
2578     $borrowernumber ||= $issue->borrowernumber;
2579     my $patron = Koha::Patrons->find( $borrowernumber )
2580       or return;
2581
2582     my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2583
2584     # This item can fill one or more unfilled reserve, can those unfilled reserves
2585     # all be filled by other available items?
2586     if ( $resfound
2587         && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2588     {
2589         my $schema = Koha::Database->new()->schema();
2590
2591         my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2592         if ($item_holds) {
2593             # There is an item level hold on this item, no other item can fill the hold
2594             $resfound = 1;
2595         }
2596         else {
2597
2598             # Get all other items that could possibly fill reserves
2599             my @itemnumbers = $schema->resultset('Item')->search(
2600                 {
2601                     biblionumber => $resrec->{biblionumber},
2602                     onloan       => undef,
2603                     notforloan   => 0,
2604                     -not         => { itemnumber => $itemnumber }
2605                 },
2606                 { columns => 'itemnumber' }
2607             )->get_column('itemnumber')->all();
2608
2609             # Get all other reserves that could have been filled by this item
2610             my @borrowernumbers;
2611             while (1) {
2612                 my ( $reserve_found, $reserve, undef ) =
2613                   C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2614
2615                 if ($reserve_found) {
2616                     push( @borrowernumbers, $reserve->{borrowernumber} );
2617                 }
2618                 else {
2619                     last;
2620                 }
2621             }
2622
2623             # If the count of the union of the lists of reservable items for each borrower
2624             # is equal or greater than the number of borrowers, we know that all reserves
2625             # can be filled with available items. We can get the union of the sets simply
2626             # by pushing all the elements onto an array and removing the duplicates.
2627             my @reservable;
2628             my %borrowers;
2629             ITEM: foreach my $i (@itemnumbers) {
2630                 my $item = GetItem($i);
2631                 next if IsItemOnHoldAndFound($i);
2632                 for my $b (@borrowernumbers) {
2633                     my $borr = $borrowers{$b} //= Koha::Patrons->find( $b )->unblessed;
2634                     next unless IsAvailableForItemLevelRequest($item, $borr);
2635                     next unless CanItemBeReserved($b,$i);
2636
2637                     push @reservable, $i;
2638                     if (@reservable >= @borrowernumbers) {
2639                         $resfound = 0;
2640                         last ITEM;
2641                     }
2642                     last;
2643                 }
2644             }
2645         }
2646     }
2647     return ( 0, "on_reserve" ) if $resfound;    # '' when no hold was found
2648
2649     return ( 1, undef ) if $override_limit;
2650
2651     my $branchcode = _GetCircControlBranch( $item, $patron->unblessed );
2652     my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2653         {   categorycode => $patron->categorycode,
2654             itemtype     => $item->{itype},
2655             branchcode   => $branchcode
2656         }
2657     );
2658
2659     return ( 0, "too_many" )
2660       if not $issuing_rule or $issuing_rule->renewalsallowed <= $issue->renewals;
2661
2662     my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2663     my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2664     $patron         = Koha::Patrons->find($borrowernumber); # FIXME Is this really useful?
2665     my $restricted  = $patron->is_debarred;
2666     my $hasoverdues = $patron->has_overdues;
2667
2668     if ( $restricted and $restrictionblockrenewing ) {
2669         return ( 0, 'restriction');
2670     } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($issue->is_overdue and $overduesblockrenewing eq 'blockitem') ) {
2671         return ( 0, 'overdue');
2672     }
2673
2674     if ( $issue->auto_renew ) {
2675
2676         if ( $patron->category->effective_BlockExpiredPatronOpacActions and $patron->is_expired ) {
2677             return ( 0, 'auto_account_expired' );
2678         }
2679
2680         if ( defined $issuing_rule->no_auto_renewal_after
2681                 and $issuing_rule->no_auto_renewal_after ne "" ) {
2682             # Get issue_date and add no_auto_renewal_after
2683             # If this is greater than today, it's too late for renewal.
2684             my $maximum_renewal_date = dt_from_string($issue->issuedate, 'sql');
2685             $maximum_renewal_date->add(
2686                 $issuing_rule->lengthunit => $issuing_rule->no_auto_renewal_after
2687             );
2688             my $now = dt_from_string;
2689             if ( $now >= $maximum_renewal_date ) {
2690                 return ( 0, "auto_too_late" );
2691             }
2692         }
2693         if ( defined $issuing_rule->no_auto_renewal_after_hard_limit
2694                       and $issuing_rule->no_auto_renewal_after_hard_limit ne "" ) {
2695             # If no_auto_renewal_after_hard_limit is >= today, it's also too late for renewal
2696             if ( dt_from_string >= dt_from_string( $issuing_rule->no_auto_renewal_after_hard_limit ) ) {
2697                 return ( 0, "auto_too_late" );
2698             }
2699         }
2700
2701         if ( C4::Context->preference('OPACFineNoRenewalsBlockAutoRenew') ) {
2702             my $fine_no_renewals = C4::Context->preference("OPACFineNoRenewals");
2703             my ( $amountoutstanding ) = C4::Members::GetMemberAccountRecords($patron->borrowernumber);
2704             if ( $amountoutstanding and $amountoutstanding > $fine_no_renewals ) {
2705                 return ( 0, "auto_too_much_oweing" );
2706             }
2707         }
2708     }
2709
2710     if ( defined $issuing_rule->norenewalbefore
2711         and $issuing_rule->norenewalbefore ne "" )
2712     {
2713
2714         # Calculate soonest renewal by subtracting 'No renewal before' from due date
2715         my $soonestrenewal = dt_from_string( $issue->date_due, 'sql' )->subtract(
2716             $issuing_rule->lengthunit => $issuing_rule->norenewalbefore );
2717
2718         # Depending on syspref reset the exact time, only check the date
2719         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2720             and $issuing_rule->lengthunit eq 'days' )
2721         {
2722             $soonestrenewal->truncate( to => 'day' );
2723         }
2724
2725         if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
2726         {
2727             return ( 0, "auto_too_soon" ) if $issue->auto_renew;
2728             return ( 0, "too_soon" );
2729         }
2730         elsif ( $issue->auto_renew ) {
2731             return ( 0, "auto_renew" );
2732         }
2733     }
2734
2735     # Fallback for automatic renewals:
2736     # If norenewalbefore is undef, don't renew before due date.
2737     if ( $issue->auto_renew ) {
2738         my $now = dt_from_string;
2739         return ( 0, "auto_renew" )
2740           if $now >= dt_from_string( $issue->date_due, 'sql' );
2741         return ( 0, "auto_too_soon" );
2742     }
2743
2744     return ( 1, undef );
2745 }
2746
2747 =head2 AddRenewal
2748
2749   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2750
2751 Renews a loan.
2752
2753 C<$borrowernumber> is the borrower number of the patron who currently
2754 has the item.
2755
2756 C<$itemnumber> is the number of the item to renew.
2757
2758 C<$branch> is the library where the renewal took place (if any).
2759            The library that controls the circ policies for the renewal is retrieved from the issues record.
2760
2761 C<$datedue> can be a DateTime object used to set the due date.
2762
2763 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2764 this parameter is not supplied, lastreneweddate is set to the current date.
2765
2766 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2767 from the book's item type.
2768
2769 =cut
2770
2771 sub AddRenewal {
2772     my $borrowernumber  = shift;
2773     my $itemnumber      = shift or return;
2774     my $branch          = shift;
2775     my $datedue         = shift;
2776     my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2777
2778     my $item   = GetItem($itemnumber) or return;
2779     my $item_object = Koha::Items->find( $itemnumber ); # Should replace $item
2780     my $biblio = $item_object->biblio;
2781
2782     my $dbh = C4::Context->dbh;
2783
2784     # Find the issues record for this book
2785     my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } );
2786
2787     return unless $issue;
2788
2789     $borrowernumber ||= $issue->borrowernumber;
2790
2791     if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2792         carp 'Invalid date passed to AddRenewal.';
2793         return;
2794     }
2795
2796     my $patron = Koha::Patrons->find( $borrowernumber ) or return; # FIXME Should do more than just return
2797     my $patron_unblessed = $patron->unblessed;
2798
2799     if ( C4::Context->preference('CalculateFinesOnReturn') && $issue->is_overdue ) {
2800         _CalculateAndUpdateFine( { issue => $issue, item => $item, borrower => $patron_unblessed } );
2801     }
2802     _FixOverduesOnReturn( $borrowernumber, $itemnumber );
2803
2804     # If the due date wasn't specified, calculate it by adding the
2805     # book's loan length to today's date or the current due date
2806     # based on the value of the RenewalPeriodBase syspref.
2807     unless ($datedue) {
2808
2809         my $itemtype = $item_object->effective_itemtype;
2810         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2811                                         dt_from_string( $issue->date_due, 'sql' ) :
2812                                         DateTime->now( time_zone => C4::Context->tz());
2813         $datedue =  CalcDateDue($datedue, $itemtype, _GetCircControlBranch($item, $patron_unblessed), $patron_unblessed, 'is a renewal');
2814     }
2815
2816     # Update the issues record to have the new due date, and a new count
2817     # of how many times it has been renewed.
2818     my $renews = $issue->renewals + 1;
2819     my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2820                             WHERE borrowernumber=?
2821                             AND itemnumber=?"
2822     );
2823
2824     $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2825
2826     # Update the renewal count on the item, and tell zebra to reindex
2827     $renews = $item->{renewals} + 1;
2828     ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $item->{biblionumber}, $itemnumber);
2829
2830     # Charge a new rental fee, if applicable?
2831     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2832     if ( $charge > 0 ) {
2833         my $accountno = getnextacctno( $borrowernumber );
2834         my $manager_id = 0;
2835         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2836         $sth = $dbh->prepare(
2837                 "INSERT INTO accountlines
2838                     (date, borrowernumber, accountno, amount, manager_id,
2839                     description,accounttype, amountoutstanding, itemnumber)
2840                     VALUES (now(),?,?,?,?,?,?,?,?)"
2841         );
2842         $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2843             "Renewal of Rental Item " . $biblio->title . " $item->{'barcode'}",
2844             'Rent', $charge, $itemnumber );
2845     }
2846
2847     # Send a renewal slip according to checkout alert preferencei
2848     if ( C4::Context->preference('RenewalSendNotice') eq '1' ) {
2849         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2850         my %conditions        = (
2851             branchcode   => $branch,
2852             categorycode => $patron->categorycode,
2853             item_type    => $item->{itype},
2854             notification => 'CHECKOUT',
2855         );
2856         if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
2857             SendCirculationAlert(
2858                 {
2859                     type     => 'RENEWAL',
2860                     item     => $item,
2861                     borrower => $patron->unblessed,
2862                     branch   => $branch,
2863                 }
2864             );
2865         }
2866     }
2867
2868     # Remove any OVERDUES related debarment if the borrower has no overdues
2869     if ( $patron
2870       && $patron->is_debarred
2871       && ! $patron->has_overdues
2872       && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2873     ) {
2874         DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2875     }
2876
2877     unless ( C4::Context->interface eq 'opac' ) { #if from opac we are obeying OpacRenewalBranch as calculated in opac-renew.pl
2878         $branch = C4::Context->userenv ? C4::Context->userenv->{branch} : $branch;
2879     }
2880
2881     # Add the renewal to stats
2882     UpdateStats(
2883         {
2884             branch         => $branch,
2885             type           => 'renew',
2886             amount         => $charge,
2887             itemnumber     => $itemnumber,
2888             itemtype       => $item->{itype},
2889             location       => $item->{location},
2890             borrowernumber => $borrowernumber,
2891             ccode          => $item->{'ccode'}
2892         }
2893     );
2894
2895     #Log the renewal
2896     logaction("CIRCULATION", "RENEWAL", $borrowernumber, $itemnumber) if C4::Context->preference("RenewalLog");
2897     return $datedue;
2898 }
2899
2900 sub GetRenewCount {
2901     # check renewal status
2902     my ( $bornum, $itemno ) = @_;
2903     my $dbh           = C4::Context->dbh;
2904     my $renewcount    = 0;
2905     my $renewsallowed = 0;
2906     my $renewsleft    = 0;
2907
2908     my $patron = Koha::Patrons->find( $bornum );
2909     my $item     = GetItem($itemno);
2910
2911     return (0, 0, 0) unless $patron or $item; # Wrong call, no renewal allowed
2912
2913     # Look in the issues table for this item, lent to this borrower,
2914     # and not yet returned.
2915
2916     # FIXME - I think this function could be redone to use only one SQL call.
2917     my $sth = $dbh->prepare(
2918         "select * from issues
2919                                 where (borrowernumber = ?)
2920                                 and (itemnumber = ?)"
2921     );
2922     $sth->execute( $bornum, $itemno );
2923     my $data = $sth->fetchrow_hashref;
2924     $renewcount = $data->{'renewals'} if $data->{'renewals'};
2925     # $item and $borrower should be calculated
2926     my $branchcode = _GetCircControlBranch($item, $patron->unblessed);
2927
2928     my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2929         {   categorycode => $patron->categorycode,
2930             itemtype     => $item->{itype},
2931             branchcode   => $branchcode
2932         }
2933     );
2934
2935     $renewsallowed = $issuing_rule ? $issuing_rule->renewalsallowed : 0;
2936     $renewsleft    = $renewsallowed - $renewcount;
2937     if($renewsleft < 0){ $renewsleft = 0; }
2938     return ( $renewcount, $renewsallowed, $renewsleft );
2939 }
2940
2941 =head2 GetSoonestRenewDate
2942
2943   $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
2944
2945 Find out the soonest possible renew date of a borrowed item.
2946
2947 C<$borrowernumber> is the borrower number of the patron who currently
2948 has the item on loan.
2949
2950 C<$itemnumber> is the number of the item to renew.
2951
2952 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
2953 renew date, based on the value "No renewal before" of the applicable
2954 issuing rule. Returns the current date if the item can already be
2955 renewed, and returns undefined if the borrower, loan, or item
2956 cannot be found.
2957
2958 =cut
2959
2960 sub GetSoonestRenewDate {
2961     my ( $borrowernumber, $itemnumber ) = @_;
2962
2963     my $dbh = C4::Context->dbh;
2964
2965     my $item      = GetItem($itemnumber)      or return;
2966     my $itemissue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
2967
2968     $borrowernumber ||= $itemissue->borrowernumber;
2969     my $patron = Koha::Patrons->find( $borrowernumber )
2970       or return;
2971
2972     my $branchcode = _GetCircControlBranch( $item, $patron->unblessed );
2973     my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2974         {   categorycode => $patron->categorycode,
2975             itemtype     => $item->{itype},
2976             branchcode   => $branchcode
2977         }
2978     );
2979
2980     my $now = dt_from_string;
2981     return $now unless $issuing_rule;
2982
2983     if ( defined $issuing_rule->norenewalbefore
2984         and $issuing_rule->norenewalbefore ne "" )
2985     {
2986         my $soonestrenewal =
2987           dt_from_string( $itemissue->date_due )->subtract(
2988             $issuing_rule->lengthunit => $issuing_rule->norenewalbefore );
2989
2990         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2991             and $issuing_rule->lengthunit eq 'days' )
2992         {
2993             $soonestrenewal->truncate( to => 'day' );
2994         }
2995         return $soonestrenewal if $now < $soonestrenewal;
2996     }
2997     return $now;
2998 }
2999
3000 =head2 GetLatestAutoRenewDate
3001
3002   $NoAutoRenewalAfterThisDate = &GetLatestAutoRenewDate($borrowernumber, $itemnumber);
3003
3004 Find out the latest possible auto renew date of a borrowed item.
3005
3006 C<$borrowernumber> is the borrower number of the patron who currently
3007 has the item on loan.
3008
3009 C<$itemnumber> is the number of the item to renew.
3010
3011 C<$GetLatestAutoRenewDate> returns the DateTime of the latest possible
3012 auto renew date, based on the value "No auto renewal after" and the "No auto
3013 renewal after (hard limit) of the applicable issuing rule.
3014 Returns undef if there is no date specify in the circ rules or if the patron, loan,
3015 or item cannot be found.
3016
3017 =cut
3018
3019 sub GetLatestAutoRenewDate {
3020     my ( $borrowernumber, $itemnumber ) = @_;
3021
3022     my $dbh = C4::Context->dbh;
3023
3024     my $item      = GetItem($itemnumber)      or return;
3025     my $itemissue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
3026
3027     $borrowernumber ||= $itemissue->borrowernumber;
3028     my $patron = Koha::Patrons->find( $borrowernumber )
3029       or return;
3030
3031     my $branchcode = _GetCircControlBranch( $item, $patron->unblessed );
3032     my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
3033         {   categorycode => $patron->categorycode,
3034             itemtype     => $item->{itype},
3035             branchcode   => $branchcode
3036         }
3037     );
3038
3039     return unless $issuing_rule;
3040     return
3041       if ( not $issuing_rule->no_auto_renewal_after
3042             or $issuing_rule->no_auto_renewal_after eq '' )
3043       and ( not $issuing_rule->no_auto_renewal_after_hard_limit
3044              or $issuing_rule->no_auto_renewal_after_hard_limit eq '' );
3045
3046     my $maximum_renewal_date;
3047     if ( $issuing_rule->no_auto_renewal_after ) {
3048         $maximum_renewal_date = dt_from_string($itemissue->issuedate);
3049         $maximum_renewal_date->add(
3050             $issuing_rule->lengthunit => $issuing_rule->no_auto_renewal_after
3051         );
3052     }
3053
3054     if ( $issuing_rule->no_auto_renewal_after_hard_limit ) {
3055         my $dt = dt_from_string( $issuing_rule->no_auto_renewal_after_hard_limit );
3056         $maximum_renewal_date = $dt if not $maximum_renewal_date or $maximum_renewal_date > $dt;
3057     }
3058     return $maximum_renewal_date;
3059 }
3060
3061
3062 =head2 GetIssuingCharges
3063
3064   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3065
3066 Calculate how much it would cost for a given patron to borrow a given
3067 item, including any applicable discounts.
3068
3069 C<$itemnumber> is the item number of item the patron wishes to borrow.
3070
3071 C<$borrowernumber> is the patron's borrower number.
3072
3073 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3074 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3075 if it's a video).
3076
3077 =cut
3078
3079 sub GetIssuingCharges {
3080
3081     # calculate charges due
3082     my ( $itemnumber, $borrowernumber ) = @_;
3083     my $charge = 0;
3084     my $dbh    = C4::Context->dbh;
3085     my $item_type;
3086
3087     # Get the book's item type and rental charge (via its biblioitem).
3088     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3089         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3090     $charge_query .= (C4::Context->preference('item-level_itypes'))
3091         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3092         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3093
3094     $charge_query .= ' WHERE items.itemnumber =?';
3095
3096     my $sth = $dbh->prepare($charge_query);
3097     $sth->execute($itemnumber);
3098     if ( my $item_data = $sth->fetchrow_hashref ) {
3099         $item_type = $item_data->{itemtype};
3100         $charge    = $item_data->{rentalcharge};
3101         my $branch = C4::Context::mybranch();
3102         my $discount_query = q|SELECT rentaldiscount,
3103             issuingrules.itemtype, issuingrules.branchcode
3104             FROM borrowers
3105             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3106             WHERE borrowers.borrowernumber = ?
3107             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3108             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3109         my $discount_sth = $dbh->prepare($discount_query);
3110         $discount_sth->execute( $borrowernumber, $item_type, $branch );
3111         my $discount_rules = $discount_sth->fetchall_arrayref({});
3112         if (@{$discount_rules}) {
3113             # We may have multiple rules so get the most specific
3114             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3115             $charge = ( $charge * ( 100 - $discount ) ) / 100;
3116         }
3117         if ($charge) {
3118             $charge = sprintf '%.2f', $charge; # ensure no fractions of a penny returned
3119         }
3120     }
3121
3122     return ( $charge, $item_type );
3123 }
3124
3125 # Select most appropriate discount rule from those returned
3126 sub _get_discount_from_rule {
3127     my ($rules_ref, $branch, $itemtype) = @_;
3128     my $discount;
3129
3130     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3131         $discount = $rules_ref->[0]->{rentaldiscount};
3132         return (defined $discount) ? $discount : 0;
3133     }
3134     # could have up to 4 does one match $branch and $itemtype
3135     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3136     if (@d) {
3137         $discount = $d[0]->{rentaldiscount};
3138         return (defined $discount) ? $discount : 0;
3139     }
3140     # do we have item type + all branches
3141     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3142     if (@d) {
3143         $discount = $d[0]->{rentaldiscount};
3144         return (defined $discount) ? $discount : 0;
3145     }
3146     # do we all item types + this branch
3147     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3148     if (@d) {
3149         $discount = $d[0]->{rentaldiscount};
3150         return (defined $discount) ? $discount : 0;
3151     }
3152     # so all and all (surely we wont get here)
3153     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3154     if (@d) {
3155         $discount = $d[0]->{rentaldiscount};
3156         return (defined $discount) ? $discount : 0;
3157     }
3158     # none of the above
3159     return 0;
3160 }
3161
3162 =head2 AddIssuingCharge
3163
3164   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3165
3166 =cut
3167
3168 sub AddIssuingCharge {
3169     my ( $itemnumber, $borrowernumber, $charge ) = @_;
3170
3171     my $nextaccntno = getnextacctno($borrowernumber);
3172
3173     my $manager_id  = 0;
3174     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3175
3176     my $accountline = Koha::Account::Line->new(
3177         {
3178             borrowernumber    => $borrowernumber,
3179             itemnumber        => $itemnumber,
3180             accountno         => $nextaccntno,
3181             amount            => $charge,
3182             amountoutstanding => $charge,
3183             manager_id        => $manager_id,
3184             description       => 'Rental',
3185             accounttype       => 'Rent',
3186             date              => \'NOW()',
3187         }
3188     )->store();
3189
3190     Koha::Account::Offset->new(
3191         {
3192             debit_id => $accountline->id,
3193             type     => 'Rental Fee',
3194             amount   => $charge,
3195         }
3196     )->store();
3197 }
3198
3199 =head2 GetTransfers
3200
3201   GetTransfers($itemnumber);
3202
3203 =cut
3204
3205 sub GetTransfers {
3206     my ($itemnumber) = @_;
3207
3208     my $dbh = C4::Context->dbh;
3209
3210     my $query = '
3211         SELECT datesent,
3212                frombranch,
3213                tobranch,
3214                branchtransfer_id
3215         FROM branchtransfers
3216         WHERE itemnumber = ?
3217           AND datearrived IS NULL
3218         ';
3219     my $sth = $dbh->prepare($query);
3220     $sth->execute($itemnumber);
3221     my @row = $sth->fetchrow_array();
3222     return @row;
3223 }
3224
3225 =head2 GetTransfersFromTo
3226
3227   @results = GetTransfersFromTo($frombranch,$tobranch);
3228
3229 Returns the list of pending transfers between $from and $to branch
3230
3231 =cut
3232
3233 sub GetTransfersFromTo {
3234     my ( $frombranch, $tobranch ) = @_;
3235     return unless ( $frombranch && $tobranch );
3236     my $dbh   = C4::Context->dbh;
3237     my $query = "
3238         SELECT branchtransfer_id,itemnumber,datesent,frombranch
3239         FROM   branchtransfers
3240         WHERE  frombranch=?
3241           AND  tobranch=?
3242           AND datearrived IS NULL
3243     ";
3244     my $sth = $dbh->prepare($query);
3245     $sth->execute( $frombranch, $tobranch );
3246     my @gettransfers;
3247
3248     while ( my $data = $sth->fetchrow_hashref ) {
3249         push @gettransfers, $data;
3250     }
3251     return (@gettransfers);
3252 }
3253
3254 =head2 DeleteTransfer
3255
3256   &DeleteTransfer($itemnumber);
3257
3258 =cut
3259
3260 sub DeleteTransfer {
3261     my ($itemnumber) = @_;
3262     return unless $itemnumber;
3263     my $dbh          = C4::Context->dbh;
3264     my $sth          = $dbh->prepare(
3265         "DELETE FROM branchtransfers
3266          WHERE itemnumber=?
3267          AND datearrived IS NULL "
3268     );
3269     return $sth->execute($itemnumber);
3270 }
3271
3272 =head2 SendCirculationAlert
3273
3274 Send out a C<check-in> or C<checkout> alert using the messaging system.
3275
3276 B<Parameters>:
3277
3278 =over 4
3279
3280 =item type
3281
3282 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3283
3284 =item item
3285
3286 Hashref of information about the item being checked in or out.
3287
3288 =item borrower
3289
3290 Hashref of information about the borrower of the item.
3291
3292 =item branch
3293
3294 The branchcode from where the checkout or check-in took place.
3295
3296 =back
3297
3298 B<Example>:
3299
3300     SendCirculationAlert({
3301         type     => 'CHECKOUT',
3302         item     => $item,
3303         borrower => $borrower,
3304         branch   => $branch,
3305     });
3306
3307 =cut
3308
3309 sub SendCirculationAlert {
3310     my ($opts) = @_;
3311     my ($type, $item, $borrower, $branch) =
3312         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3313     my %message_name = (
3314         CHECKIN  => 'Item_Check_in',
3315         CHECKOUT => 'Item_Checkout',
3316         RENEWAL  => 'Item_Checkout',
3317     );
3318     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3319         borrowernumber => $borrower->{borrowernumber},
3320         message_name   => $message_name{$type},
3321     });
3322     my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3323
3324     my $schema = Koha::Database->new->schema;
3325     my @transports = keys %{ $borrower_preferences->{transports} };
3326
3327     # From the MySQL doc:
3328     # LOCK TABLES is not transaction-safe and implicitly commits any active transaction before attempting to lock the tables.
3329     # If the LOCK/UNLOCK statements are executed from tests, the current transaction will be committed.
3330     # To avoid that we need to guess if this code is execute from tests or not (yes it is a bit hacky)
3331     my $do_not_lock = ( exists $ENV{_} && $ENV{_} =~ m|prove| ) || $ENV{KOHA_NO_TABLE_LOCKS};
3332
3333     for my $mtt (@transports) {
3334         my $letter =  C4::Letters::GetPreparedLetter (
3335             module => 'circulation',
3336             letter_code => $type,
3337             branchcode => $branch,
3338             message_transport_type => $mtt,
3339             lang => $borrower->{lang},
3340             tables => {
3341                 $issues_table => $item->{itemnumber},
3342                 'items'       => $item->{itemnumber},
3343                 'biblio'      => $item->{biblionumber},
3344                 'biblioitems' => $item->{biblionumber},
3345                 'borrowers'   => $borrower,
3346                 'branches'    => $branch,
3347             }
3348         ) or next;
3349
3350         $schema->storage->txn_begin;
3351         C4::Context->dbh->do(q|LOCK TABLE message_queue READ|) unless $do_not_lock;
3352         C4::Context->dbh->do(q|LOCK TABLE message_queue WRITE|) unless $do_not_lock;
3353         my $message = C4::Message->find_last_message($borrower, $type, $mtt);
3354         unless ( $message ) {
3355             C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3356             C4::Message->enqueue($letter, $borrower, $mtt);
3357         } else {
3358             $message->append($letter);
3359             $message->update;
3360         }
3361         C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3362         $schema->storage->txn_commit;
3363     }
3364
3365     return;
3366 }
3367
3368 =head2 updateWrongTransfer
3369
3370   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3371
3372 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
3373
3374 =cut
3375
3376 sub updateWrongTransfer {
3377         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3378         my $dbh = C4::Context->dbh;
3379 # first step validate the actual line of transfert .
3380         my $sth =
3381                 $dbh->prepare(
3382                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3383                 );
3384                 $sth->execute($FromLibrary,$itemNumber);
3385
3386 # second step create a new line of branchtransfer to the right location .
3387         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3388
3389 #third step changing holdingbranch of item
3390         UpdateHoldingbranch($FromLibrary,$itemNumber);
3391 }
3392
3393 =head2 UpdateHoldingbranch
3394
3395   $items = UpdateHoldingbranch($branch,$itmenumber);
3396
3397 Simple methode for updating hodlingbranch in items BDD line
3398
3399 =cut
3400
3401 sub UpdateHoldingbranch {
3402         my ( $branch,$itemnumber ) = @_;
3403     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3404 }
3405
3406 =head2 CalcDateDue
3407
3408 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3409
3410 this function calculates the due date given the start date and configured circulation rules,
3411 checking against the holidays calendar as per the 'useDaysMode' syspref.
3412 C<$startdate>   = DateTime object representing start date of loan period (assumed to be today)
3413 C<$itemtype>  = itemtype code of item in question
3414 C<$branch>  = location whose calendar to use
3415 C<$borrower> = Borrower object
3416 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3417
3418 =cut
3419
3420 sub CalcDateDue {
3421     my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3422
3423     $isrenewal ||= 0;
3424
3425     # loanlength now a href
3426     my $loanlength =
3427             GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3428
3429     my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3430             ? qq{renewalperiod}
3431             : qq{issuelength};
3432
3433     my $datedue;
3434     if ( $startdate ) {
3435         if (ref $startdate ne 'DateTime' ) {
3436             $datedue = dt_from_string($datedue);
3437         } else {
3438             $datedue = $startdate->clone;
3439         }
3440     } else {
3441         $datedue =
3442           DateTime->now( time_zone => C4::Context->tz() )
3443           ->truncate( to => 'minute' );
3444     }
3445
3446
3447     # calculate the datedue as normal
3448     if ( C4::Context->preference('useDaysMode') eq 'Days' )
3449     {    # ignoring calendar
3450         if ( $loanlength->{lengthunit} eq 'hours' ) {
3451             $datedue->add( hours => $loanlength->{$length_key} );
3452         } else {    # days
3453             $datedue->add( days => $loanlength->{$length_key} );
3454             $datedue->set_hour(23);
3455             $datedue->set_minute(59);
3456         }
3457     } else {
3458         my $dur;
3459         if ($loanlength->{lengthunit} eq 'hours') {
3460             $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3461         }
3462         else { # days
3463             $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3464         }
3465         my $calendar = Koha::Calendar->new( branchcode => $branch );
3466         $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3467         if ($loanlength->{lengthunit} eq 'days') {
3468             $datedue->set_hour(23);
3469             $datedue->set_minute(59);
3470         }
3471     }
3472
3473     # if Hard Due Dates are used, retrieve them and apply as necessary
3474     my ( $hardduedate, $hardduedatecompare ) =
3475       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3476     if ($hardduedate) {    # hardduedates are currently dates
3477         $hardduedate->truncate( to => 'minute' );
3478         $hardduedate->set_hour(23);
3479         $hardduedate->set_minute(59);
3480         my $cmp = DateTime->compare( $hardduedate, $datedue );
3481
3482 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3483 # if the calculated date is before the 'after' Hard Due Date (floor), override
3484 # if the hard due date is set to 'exactly', overrride
3485         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3486             $datedue = $hardduedate->clone;
3487         }
3488
3489         # in all other cases, keep the date due as it is
3490
3491     }
3492
3493     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3494     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3495         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3496         if( $expiry_dt ) { #skip empty expiry date..
3497             $expiry_dt->set( hour => 23, minute => 59);
3498             my $d1= $datedue->clone->set_time_zone('floating');
3499             if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3500                 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3501             }
3502         }
3503         if ( C4::Context->preference('useDaysMode') ne 'Days' ) {
3504           my $calendar = Koha::Calendar->new( branchcode => $branch );
3505           if ( $calendar->is_holiday($datedue) ) {
3506               # Don't return on a closed day
3507               $datedue = $calendar->prev_open_day( $datedue );
3508           }
3509         }
3510     }
3511
3512     return $datedue;
3513 }
3514
3515
3516 sub CheckValidBarcode{
3517 my ($barcode) = @_;
3518 my $dbh = C4::Context->dbh;
3519 my $query=qq|SELECT count(*)
3520              FROM items
3521              WHERE barcode=?
3522             |;
3523 my $sth = $dbh->prepare($query);
3524 $sth->execute($barcode);
3525 my $exist=$sth->fetchrow ;
3526 return $exist;
3527 }
3528
3529 =head2 IsBranchTransferAllowed
3530
3531   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3532
3533 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3534
3535 =cut
3536
3537 sub IsBranchTransferAllowed {
3538         my ( $toBranch, $fromBranch, $code ) = @_;
3539
3540         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3541
3542         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3543         my $dbh = C4::Context->dbh;
3544
3545         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3546         $sth->execute( $toBranch, $fromBranch, $code );
3547         my $limit = $sth->fetchrow_hashref();
3548
3549         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3550         if ( $limit->{'limitId'} ) {
3551                 return 0;
3552         } else {
3553                 return 1;
3554         }
3555 }
3556
3557 =head2 CreateBranchTransferLimit
3558
3559   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3560
3561 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3562
3563 =cut
3564
3565 sub CreateBranchTransferLimit {
3566    my ( $toBranch, $fromBranch, $code ) = @_;
3567    return unless defined($toBranch) && defined($fromBranch);
3568    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3569
3570    my $dbh = C4::Context->dbh;
3571
3572    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3573    return $sth->execute( $code, $toBranch, $fromBranch );
3574 }
3575
3576 =head2 DeleteBranchTransferLimits
3577
3578     my $result = DeleteBranchTransferLimits($frombranch);
3579
3580 Deletes all the library transfer limits for one library.  Returns the
3581 number of limits deleted, 0e0 if no limits were deleted, or undef if
3582 no arguments are supplied.
3583
3584 =cut
3585
3586 sub DeleteBranchTransferLimits {
3587     my $branch = shift;
3588     return unless defined $branch;
3589     my $dbh    = C4::Context->dbh;
3590     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3591     return $sth->execute($branch);
3592 }
3593
3594 sub ReturnLostItem{
3595     my ( $borrowernumber, $itemnum ) = @_;
3596
3597     MarkIssueReturned( $borrowernumber, $itemnum );
3598     my $patron = Koha::Patrons->find( $borrowernumber );
3599     my $item = C4::Items::GetItem( $itemnum );
3600     my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3601     my @datearr = localtime(time);
3602     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3603     my $bor = $patron->firstname . ' ' . $patron->surname . ' ' . $patron->cardnumber;
3604     ModItem({ paidfor =>  $old_note."Paid for by $bor $date" }, undef, $itemnum);
3605 }
3606
3607
3608 sub LostItem{
3609     my ($itemnumber, $mark_returned) = @_;
3610
3611     $mark_returned //= C4::Context->preference('MarkLostItemsAsReturned');
3612
3613     my $dbh = C4::Context->dbh();
3614     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3615                            FROM issues
3616                            JOIN items USING (itemnumber)
3617                            JOIN biblio USING (biblionumber)
3618                            WHERE issues.itemnumber=?");
3619     $sth->execute($itemnumber);
3620     my $issues=$sth->fetchrow_hashref();
3621
3622     # If a borrower lost the item, add a replacement cost to the their record
3623     if ( my $borrowernumber = $issues->{borrowernumber} ){
3624         my $patron = Koha::Patrons->find( $borrowernumber );
3625
3626         if (C4::Context->preference('WhenLostForgiveFine')){
3627             my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3628             defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!";  # zero is OK, check defined
3629         }
3630         if (C4::Context->preference('WhenLostChargeReplacementFee')){
3631             C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3632             #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3633             #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3634         }
3635
3636         MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$patron->privacy) if $mark_returned;
3637     }
3638 }
3639
3640 sub GetOfflineOperations {
3641     my $dbh = C4::Context->dbh;
3642     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3643     $sth->execute(C4::Context->userenv->{'branch'});
3644     my $results = $sth->fetchall_arrayref({});
3645     return $results;
3646 }
3647
3648 sub GetOfflineOperation {
3649     my $operationid = shift;
3650     return unless $operationid;
3651     my $dbh = C4::Context->dbh;
3652     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3653     $sth->execute( $operationid );
3654     return $sth->fetchrow_hashref;
3655 }
3656
3657 sub AddOfflineOperation {
3658     my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3659     my $dbh = C4::Context->dbh;
3660     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3661     $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3662     return "Added.";
3663 }
3664
3665 sub DeleteOfflineOperation {
3666     my $dbh = C4::Context->dbh;
3667     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3668     $sth->execute( shift );
3669     return "Deleted.";
3670 }
3671
3672 sub ProcessOfflineOperation {
3673     my $operation = shift;
3674
3675     my $report;
3676     if ( $operation->{action} eq 'return' ) {
3677         $report = ProcessOfflineReturn( $operation );
3678     } elsif ( $operation->{action} eq 'issue' ) {
3679         $report = ProcessOfflineIssue( $operation );
3680     } elsif ( $operation->{action} eq 'payment' ) {
3681         $report = ProcessOfflinePayment( $operation );
3682     }
3683
3684     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3685
3686     return $report;
3687 }
3688
3689 sub ProcessOfflineReturn {
3690     my $operation = shift;
3691
3692     my $item = Koha::Items->find({barcode => $operation->{barcode}});
3693
3694     if ( $item ) {
3695         my $itemnumber = $item->itemnumber;
3696         my $issue = GetOpenIssue( $itemnumber );
3697         if ( $issue ) {
3698             MarkIssueReturned(
3699                 $issue->{borrowernumber},
3700                 $itemnumber,
3701                 undef,
3702                 $operation->{timestamp},
3703             );
3704             ModItem(
3705                 { renewals => 0, onloan => undef },
3706                 $issue->{'biblionumber'},
3707                 $itemnumber
3708             );
3709             return "Success.";
3710         } else {
3711             return "Item not issued.";
3712         }
3713     } else {
3714         return "Item not found.";
3715     }
3716 }
3717
3718 sub ProcessOfflineIssue {
3719     my $operation = shift;
3720
3721     my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} } );
3722
3723     if ( $patron ) {
3724         my $item = Koha::Items->find({ barcode => $operation->{barcode} });
3725         unless ($item) {
3726             return "Barcode not found.";
3727         }
3728         my $itemnumber = $item->itemnumber;
3729         my $issue = GetOpenIssue( $itemnumber );
3730
3731         if ( $issue and ( $issue->{borrowernumber} ne $patron->borrowernumber ) ) { # Item already issued to another patron mark it returned
3732             MarkIssueReturned(
3733                 $issue->{borrowernumber},
3734                 $itemnumber,
3735                 undef,
3736                 $operation->{timestamp},
3737             );
3738         }
3739         AddIssue(
3740             $patron->unblessed,
3741             $operation->{'barcode'},
3742             undef,
3743             1,
3744             $operation->{timestamp},
3745             undef,
3746         );
3747         return "Success.";
3748     } else {
3749         return "Borrower not found.";
3750     }
3751 }
3752
3753 sub ProcessOfflinePayment {
3754     my $operation = shift;
3755
3756     my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} });
3757     my $amount = $operation->{amount};
3758
3759     Koha::Account->new( { patron_id => $patron->id } )->pay( { amount => $amount } );
3760
3761     return "Success."
3762 }
3763
3764
3765 =head2 TransferSlip
3766
3767   TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3768
3769   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3770
3771 =cut
3772
3773 sub TransferSlip {
3774     my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3775
3776     my $item =  GetItem( $itemnumber, $barcode )
3777       or return;
3778
3779     return C4::Letters::GetPreparedLetter (
3780         module => 'circulation',
3781         letter_code => 'TRANSFERSLIP',
3782         branchcode => $branch,
3783         tables => {
3784             'branches'    => $to_branch,
3785             'biblio'      => $item->{biblionumber},
3786             'items'       => $item,
3787         },
3788     );
3789 }
3790
3791 =head2 CheckIfIssuedToPatron
3792
3793   CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3794
3795   Return 1 if any record item is issued to patron, otherwise return 0
3796
3797 =cut
3798
3799 sub CheckIfIssuedToPatron {
3800     my ($borrowernumber, $biblionumber) = @_;
3801
3802     my $dbh = C4::Context->dbh;
3803     my $query = q|
3804         SELECT COUNT(*) FROM issues
3805         LEFT JOIN items ON items.itemnumber = issues.itemnumber
3806         WHERE items.biblionumber = ?
3807         AND issues.borrowernumber = ?
3808     |;
3809     my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3810     return 1 if $is_issued;
3811     return;
3812 }
3813
3814 =head2 IsItemIssued
3815
3816   IsItemIssued( $itemnumber )
3817
3818   Return 1 if the item is on loan, otherwise return 0
3819
3820 =cut
3821
3822 sub IsItemIssued {
3823     my $itemnumber = shift;
3824     my $dbh = C4::Context->dbh;
3825     my $sth = $dbh->prepare(q{
3826         SELECT COUNT(*)
3827         FROM issues
3828         WHERE itemnumber = ?
3829     });
3830     $sth->execute($itemnumber);
3831     return $sth->fetchrow;
3832 }
3833
3834 =head2 GetAgeRestriction
3835
3836   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3837   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3838
3839   if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as they are older or as old as the agerestriction }
3840   if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3841
3842 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3843 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3844 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3845          Negative days mean the borrower has gone past the age restriction age.
3846
3847 =cut
3848
3849 sub GetAgeRestriction {
3850     my ($record_restrictions, $borrower) = @_;
3851     my $markers = C4::Context->preference('AgeRestrictionMarker');
3852
3853     # Split $record_restrictions to something like FSK 16 or PEGI 6
3854     my @values = split ' ', uc($record_restrictions);
3855     return unless @values;
3856
3857     # Search first occurrence of one of the markers
3858     my @markers = split /\|/, uc($markers);
3859     return unless @markers;
3860
3861     my $index            = 0;
3862     my $restriction_year = 0;
3863     for my $value (@values) {
3864         $index++;
3865         for my $marker (@markers) {
3866             $marker =~ s/^\s+//;    #remove leading spaces
3867             $marker =~ s/\s+$//;    #remove trailing spaces
3868             if ( $marker eq $value ) {
3869                 if ( $index <= $#values ) {
3870                     $restriction_year += $values[$index];
3871                 }
3872                 last;
3873             }
3874             elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3875
3876                 # Perhaps it is something like "K16" (as in Finland)
3877                 $restriction_year += $1;
3878                 last;
3879             }
3880         }
3881         last if ( $restriction_year > 0 );
3882     }
3883
3884     #Check if the borrower is age restricted for this material and for how long.
3885     if ($restriction_year && $borrower) {
3886         if ( $borrower->{'dateofbirth'} ) {
3887             my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3888             $alloweddate[0] += $restriction_year;
3889
3890             #Prevent runime eror on leap year (invalid date)
3891             if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3892                 $alloweddate[2] = 28;
3893             }
3894
3895             #Get how many days the borrower has to reach the age restriction
3896             my @Today = split /-/, DateTime->today->ymd();
3897             my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
3898             #Negative days means the borrower went past the age restriction age
3899             return ($restriction_year, $daysToAgeRestriction);
3900         }
3901     }
3902
3903     return ($restriction_year);
3904 }
3905
3906
3907 =head2 GetPendingOnSiteCheckouts
3908
3909 =cut
3910
3911 sub GetPendingOnSiteCheckouts {
3912     my $dbh = C4::Context->dbh;
3913     return $dbh->selectall_arrayref(q|
3914         SELECT
3915           items.barcode,
3916           items.biblionumber,
3917           items.itemnumber,
3918           items.itemnotes,
3919           items.itemcallnumber,
3920           items.location,
3921           issues.date_due,
3922           issues.branchcode,
3923           issues.date_due < NOW() AS is_overdue,
3924           biblio.author,
3925           biblio.title,
3926           borrowers.firstname,
3927           borrowers.surname,
3928           borrowers.cardnumber,
3929           borrowers.borrowernumber
3930         FROM items
3931         LEFT JOIN issues ON items.itemnumber = issues.itemnumber
3932         LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
3933         LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
3934         WHERE issues.onsite_checkout = 1
3935     |, { Slice => {} } );
3936 }
3937
3938 sub GetTopIssues {
3939     my ($params) = @_;
3940
3941     my ($count, $branch, $itemtype, $ccode, $newness)
3942         = @$params{qw(count branch itemtype ccode newness)};
3943
3944     my $dbh = C4::Context->dbh;
3945     my $query = q{
3946         SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
3947           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
3948           i.ccode, SUM(i.issues) AS count
3949         FROM biblio b
3950         LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
3951         LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
3952     };
3953
3954     my (@where_strs, @where_args);
3955
3956     if ($branch) {
3957         push @where_strs, 'i.homebranch = ?';
3958         push @where_args, $branch;
3959     }
3960     if ($itemtype) {
3961         if (C4::Context->preference('item-level_itypes')){
3962             push @where_strs, 'i.itype = ?';
3963             push @where_args, $itemtype;
3964         } else {
3965             push @where_strs, 'bi.itemtype = ?';
3966             push @where_args, $itemtype;
3967         }
3968     }
3969     if ($ccode) {
3970         push @where_strs, 'i.ccode = ?';
3971         push @where_args, $ccode;
3972     }
3973     if ($newness) {
3974         push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
3975         push @where_args, $newness;
3976     }
3977
3978     if (@where_strs) {
3979         $query .= 'WHERE ' . join(' AND ', @where_strs);
3980     }
3981
3982     $query .= q{
3983         GROUP BY b.biblionumber
3984         HAVING count > 0
3985         ORDER BY count DESC
3986     };
3987
3988     $count = int($count);
3989     if ($count > 0) {
3990         $query .= "LIMIT $count";
3991     }
3992
3993     my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
3994
3995     return @$rows;
3996 }
3997
3998 sub _CalculateAndUpdateFine {
3999     my ($params) = @_;
4000
4001     my $borrower    = $params->{borrower};
4002     my $item        = $params->{item};
4003     my $issue       = $params->{issue};
4004     my $return_date = $params->{return_date};
4005
4006     unless ($borrower) { carp "No borrower passed in!" && return; }
4007     unless ($item)     { carp "No item passed in!"     && return; }
4008     unless ($issue)    { carp "No issue passed in!"    && return; }
4009
4010     my $datedue = dt_from_string( $issue->date_due );
4011
4012     # we only need to calculate and change the fines if we want to do that on return
4013     # Should be on for hourly loans
4014     my $control = C4::Context->preference('CircControl');
4015     my $control_branchcode =
4016         ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4017       : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
4018       :                                     $issue->branchcode;
4019
4020     my $date_returned = $return_date ? dt_from_string($return_date) : dt_from_string();
4021
4022     my ( $amount, $type, $unitcounttotal ) =
4023       C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4024
4025     $type ||= q{};
4026
4027     if ( C4::Context->preference('finesMode') eq 'production' ) {
4028         if ( $amount > 0 ) {
4029             C4::Overdues::UpdateFine({
4030                 issue_id       => $issue->issue_id,
4031                 itemnumber     => $issue->itemnumber,
4032                 borrowernumber => $issue->borrowernumber,
4033                 amount         => $amount,
4034                 type           => $type,
4035                 due            => output_pref($datedue),
4036             });
4037         }
4038         elsif ($return_date) {
4039
4040             # Backdated returns may have fines that shouldn't exist,
4041             # so in this case, we need to drop those fines to 0
4042
4043             C4::Overdues::UpdateFine({
4044                 issue_id       => $issue->issue_id,
4045                 itemnumber     => $issue->itemnumber,
4046                 borrowernumber => $issue->borrowernumber,
4047                 amount         => 0,
4048                 type           => $type,
4049                 due            => output_pref($datedue),
4050             });
4051         }
4052     }
4053 }
4054
4055 1;
4056
4057 __END__
4058
4059 =head1 AUTHOR
4060
4061 Koha Development Team <http://koha-community.org/>
4062
4063 =cut