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