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