C4/Circulation.pm

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