C4/Circulation.pm

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