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