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