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