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