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