C4/Circulation.pm

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