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