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