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