C4/Circulation.pm

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