C4/Circulation.pm

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