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