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