C4/Circulation.pm

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