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