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