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