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 $validTransfert = 0;
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         if ( $tobranch eq $branch ) {
2081             my $sth = C4::Context->dbh->prepare(
2082                 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
2083             );
2084             $sth->execute( $item->itemnumber );
2085         } else {
2086             $messages->{'WrongTransfer'}     = $tobranch;
2087             $messages->{'WrongTransferItem'} = $item->itemnumber;
2088         }
2089         $validTransfert = 1;
2090     }
2091
2092     # fix up the accounts.....
2093     if ( $item->itemlost ) {
2094         $messages->{'WasLost'} = 1;
2095         unless ( C4::Context->preference("BlockReturnOfLostItems") ) {
2096             my $refund = 1;
2097             my $no_refund_after_days = C4::Context->preference('NoRefundOnLostReturnedItemsAge');
2098             if ($no_refund_after_days) {
2099                 my $today = dt_from_string();
2100                 my $lost_age_in_days =
2101                   dt_from_string( $item->itemlost_on )
2102                   ->delta_days($today)
2103                   ->in_units('days');
2104
2105                 $refund = 0 unless ( $lost_age_in_days < $no_refund_after_days );
2106             }
2107
2108             if (
2109                 $refund &&
2110                 Koha::CirculationRules->get_lostreturn_policy(
2111                     {
2112                         return_branch => C4::Context->userenv->{branch},
2113                         item          => $item,
2114                     }
2115                   )
2116               )
2117             {
2118                 _FixAccountForLostAndFound( $item->itemnumber,
2119                     $borrowernumber, $barcode );
2120                 $messages->{'LostItemFeeRefunded'} = 1;
2121             }
2122         }
2123     }
2124
2125     # fix up the overdues in accounts...
2126     if ($borrowernumber) {
2127         my $fix = _FixOverduesOnReturn( $borrowernumber, $item->itemnumber, $exemptfine, 'RETURNED' );
2128         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, ".$item->itemnumber."...) failed!";  # zero is OK, check defined
2129
2130         if ( $issue and $issue->is_overdue($return_date) ) {
2131         # fix fine days
2132             my ($debardate,$reminder) = _debar_user_on_return( $patron_unblessed, $item->unblessed, dt_from_string($issue->date_due), $return_date );
2133             if ($reminder){
2134                 $messages->{'PrevDebarred'} = $debardate;
2135             } else {
2136                 $messages->{'Debarred'} = $debardate if $debardate;
2137             }
2138         # there's no overdue on the item but borrower had been previously debarred
2139         } elsif ( $issue->date_due and $patron->debarred ) {
2140              if ( $patron->debarred eq "9999-12-31") {
2141                 $messages->{'ForeverDebarred'} = $patron->debarred;
2142              } else {
2143                   my $borrower_debar_dt = dt_from_string( $patron->debarred );
2144                   $borrower_debar_dt->truncate(to => 'day');
2145                   my $today_dt = $return_date->clone()->truncate(to => 'day');
2146                   if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2147                       $messages->{'PrevDebarred'} = $patron->debarred;
2148                   }
2149              }
2150         }
2151     }
2152
2153     # find reserves.....
2154     # launch the Checkreserves routine to find any holds
2155     my ($resfound, $resrec);
2156     my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2157     ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->itemnumber, undef, $lookahead ) unless ( $item->withdrawn );
2158     # 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)
2159     if ( $resfound and $resfound eq "Waiting" and $branch ne $resrec->{branchcode} ) {
2160         my $hold = C4::Reserves::RevertWaitingStatus( { itemnumber => $item->itemnumber } );
2161         $resfound = 'Reserved';
2162         $resrec = $hold->unblessed;
2163     }
2164     if ($resfound) {
2165           $resrec->{'ResFound'} = $resfound;
2166         $messages->{'ResFound'} = $resrec;
2167     }
2168
2169     # Record the fact that this book was returned.
2170     UpdateStats({
2171         branch         => $branch,
2172         type           => $stat_type,
2173         itemnumber     => $itemnumber,
2174         itemtype       => $itemtype,
2175         location       => $item->location,
2176         borrowernumber => $borrowernumber,
2177         ccode          => $item->ccode,
2178     });
2179
2180     # Send a check-in slip. # NOTE: borrower may be undef. Do not try to send messages then.
2181     if ( $patron ) {
2182         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2183         my %conditions = (
2184             branchcode   => $branch,
2185             categorycode => $patron->categorycode,
2186             item_type    => $itemtype,
2187             notification => 'CHECKIN',
2188         );
2189         if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2190             SendCirculationAlert({
2191                 type     => 'CHECKIN',
2192                 item     => $item->unblessed,
2193                 borrower => $patron->unblessed,
2194                 branch   => $branch,
2195             });
2196         }
2197
2198         logaction("CIRCULATION", "RETURN", $borrowernumber, $item->itemnumber)
2199             if C4::Context->preference("ReturnLog");
2200         }
2201
2202     # Check if this item belongs to a biblio record that is attached to an
2203     # ILL request, if it is we need to update the ILL request's status
2204     if (C4::Context->preference('CirculateILL')) {
2205         my $request = Koha::Illrequests->find(
2206             { biblio_id => $item->biblio->biblionumber }
2207         );
2208         $request->status('RET') if $request;
2209     }
2210
2211     # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2212     if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2213         my $BranchTransferLimitsType = C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ? 'effective_itemtype' : 'ccode';
2214         if  (C4::Context->preference("AutomaticItemReturn"    ) or
2215             (C4::Context->preference("UseBranchTransferLimits") and
2216              ! IsBranchTransferAllowed($branch, $returnbranch, $item->$BranchTransferLimitsType )
2217            )) {
2218             $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s, %s)", $item->itemnumber,$branch, $returnbranch, $transfer_trigger;
2219             $debug and warn "item: " . Dumper($item->unblessed);
2220             ModItemTransfer($item->itemnumber, $branch, $returnbranch, $transfer_trigger);
2221             $messages->{'WasTransfered'} = 1;
2222         } else {
2223             $messages->{'NeedsTransfer'} = $returnbranch;
2224             $messages->{'TransferTrigger'} = $transfer_trigger;
2225         }
2226     }
2227
2228     if ( C4::Context->preference('ClaimReturnedLostValue') ) {
2229         my $claims = Koha::Checkouts::ReturnClaims->search(
2230            {
2231                itemnumber => $item->id,
2232                resolution => undef,
2233            }
2234         );
2235
2236         if ( $claims->count ) {
2237             $messages->{ReturnClaims} = $claims;
2238         }
2239     }
2240
2241     if ( $doreturn and $issue ) {
2242         my $checkin = Koha::Old::Checkouts->find($issue->id);
2243
2244         Koha::Plugins->call('after_circ_action', {
2245             action  => 'checkin',
2246             payload => {
2247                 checkout=> $checkin
2248             }
2249         });
2250     }
2251
2252     return ( $doreturn, $messages, $issue, ( $patron ? $patron->unblessed : {} ));
2253 }
2254
2255 =head2 MarkIssueReturned
2256
2257   MarkIssueReturned($borrowernumber, $itemnumber, $returndate, $privacy);
2258
2259 Unconditionally marks an issue as being returned by
2260 moving the C<issues> row to C<old_issues> and
2261 setting C<returndate> to the current date.
2262
2263 if C<$returndate> is specified (in iso format), it is used as the date
2264 of the return.
2265
2266 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2267 the old_issue is immediately anonymised
2268
2269 Ideally, this function would be internal to C<C4::Circulation>,
2270 not exported, but it is currently used in misc/cronjobs/longoverdue.pl
2271 and offline_circ/process_koc.pl.
2272
2273 =cut
2274
2275 sub MarkIssueReturned {
2276     my ( $borrowernumber, $itemnumber, $returndate, $privacy ) = @_;
2277
2278     # Retrieve the issue
2279     my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
2280
2281     return unless $issue->borrowernumber == $borrowernumber; # If the item is checked out to another patron we do not return it
2282
2283     my $issue_id = $issue->issue_id;
2284
2285     my $anonymouspatron;
2286     if ( $privacy && $privacy == 2 ) {
2287         # The default of 0 will not work due to foreign key constraints
2288         # The anonymisation will fail if AnonymousPatron is not a valid entry
2289         # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2290         # Note that a warning should appear on the about page (System information tab).
2291         $anonymouspatron = C4::Context->preference('AnonymousPatron');
2292         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."
2293             unless Koha::Patrons->find( $anonymouspatron );
2294     }
2295
2296     my $schema = Koha::Database->schema;
2297
2298     # FIXME Improve the return value and handle it from callers
2299     $schema->txn_do(sub {
2300
2301         my $patron = Koha::Patrons->find( $borrowernumber );
2302
2303         # Update the returndate value
2304         if ( $returndate ) {
2305             $issue->returndate( $returndate )->store->discard_changes; # update and refetch
2306         }
2307         else {
2308             $issue->returndate( \'NOW()' )->store->discard_changes; # update and refetch
2309         }
2310
2311         # Create the old_issues entry
2312         my $old_checkout = Koha::Old::Checkout->new($issue->unblessed)->store;
2313
2314         # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2315         if ( $privacy && $privacy == 2) {
2316             $old_checkout->borrowernumber($anonymouspatron)->store;
2317         }
2318
2319         # And finally delete the issue
2320         $issue->delete;
2321
2322         $issue->item->onloan(undef)->store({ log_action => 0 });
2323
2324         if ( C4::Context->preference('StoreLastBorrower') ) {
2325             my $item = Koha::Items->find( $itemnumber );
2326             $item->last_returned_by( $patron );
2327         }
2328
2329         # Remove any OVERDUES related debarment if the borrower has no overdues
2330         if ( C4::Context->preference('AutoRemoveOverduesRestrictions')
2331           && $patron->debarred
2332           && !$patron->has_overdues
2333           && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2334         ) {
2335             DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2336         }
2337
2338     });
2339
2340     return $issue_id;
2341 }
2342
2343 =head2 _debar_user_on_return
2344
2345     _debar_user_on_return($borrower, $item, $datedue, $returndate);
2346
2347 C<$borrower> borrower hashref
2348
2349 C<$item> item hashref
2350
2351 C<$datedue> date due DateTime object
2352
2353 C<$returndate> DateTime object representing the return time
2354
2355 Internal function, called only by AddReturn that calculates and updates
2356  the user fine days, and debars them if necessary.
2357
2358 Should only be called for overdue returns
2359
2360 Calculation of the debarment date has been moved to a separate subroutine _calculate_new_debar_dt
2361 to ease testing.
2362
2363 =cut
2364
2365 sub _calculate_new_debar_dt {
2366     my ( $borrower, $item, $dt_due, $return_date ) = @_;
2367
2368     my $branchcode = _GetCircControlBranch( $item, $borrower );
2369     my $circcontrol = C4::Context->preference('CircControl');
2370     my $issuing_rule = Koha::CirculationRules->get_effective_rules(
2371         {   categorycode => $borrower->{categorycode},
2372             itemtype     => $item->{itype},
2373             branchcode   => $branchcode,
2374             rules => [
2375                 'finedays',
2376                 'lengthunit',
2377                 'firstremind',
2378                 'maxsuspensiondays',
2379                 'suspension_chargeperiod',
2380             ]
2381         }
2382     );
2383     my $finedays = $issuing_rule ? $issuing_rule->{finedays} : undef;
2384     my $unit     = $issuing_rule ? $issuing_rule->{lengthunit} : undef;
2385     my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $return_date, $branchcode);
2386
2387     return unless $finedays;
2388
2389     # finedays is in days, so hourly loans must multiply by 24
2390     # thus 1 hour late equals 1 day suspension * finedays rate
2391     $finedays = $finedays * 24 if ( $unit eq 'hours' );
2392
2393     # grace period is measured in the same units as the loan
2394     my $grace =
2395       DateTime::Duration->new( $unit => $issuing_rule->{firstremind} );
2396
2397     my $deltadays = DateTime::Duration->new(
2398         days => $chargeable_units
2399     );
2400
2401     if ( $deltadays->subtract($grace)->is_positive() ) {
2402         my $suspension_days = $deltadays * $finedays;
2403
2404         if ( defined $issuing_rule->{suspension_chargeperiod} && $issuing_rule->{suspension_chargeperiod} > 1 ) {
2405             # No need to / 1 and do not consider / 0
2406             $suspension_days = DateTime::Duration->new(
2407                 days => floor( $suspension_days->in_units('days') / $issuing_rule->{suspension_chargeperiod} )
2408             );
2409         }
2410
2411         # If the max suspension days is < than the suspension days
2412         # the suspension days is limited to this maximum period.
2413         my $max_sd = $issuing_rule->{maxsuspensiondays};
2414         if ( defined $max_sd && $max_sd ne '' ) {
2415             $max_sd = DateTime::Duration->new( days => $max_sd );
2416             $suspension_days = $max_sd
2417               if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2418         }
2419
2420         my ( $has_been_extended );
2421         if ( C4::Context->preference('CumulativeRestrictionPeriods') and $borrower->{debarred} ) {
2422             my $debarment = @{ GetDebarments( { borrowernumber => $borrower->{borrowernumber}, type => 'SUSPENSION' } ) }[0];
2423             if ( $debarment ) {
2424                 $return_date = dt_from_string( $debarment->{expiration}, 'sql' );
2425                 $has_been_extended = 1;
2426             }
2427         }
2428
2429         my $new_debar_dt;
2430         # Use the calendar or not to calculate the debarment date
2431         if ( C4::Context->preference('SuspensionsCalendar') eq 'noSuspensionsWhenClosed' ) {
2432             my $calendar = Koha::Calendar->new(
2433                 branchcode => $branchcode,
2434                 days_mode  => 'Calendar'
2435             );
2436             $new_debar_dt = $calendar->addDate( $return_date, $suspension_days );
2437         }
2438         else {
2439             $new_debar_dt = $return_date->clone()->add_duration($suspension_days);
2440         }
2441         return $new_debar_dt;
2442     }
2443     return;
2444 }
2445
2446 sub _debar_user_on_return {
2447     my ( $borrower, $item, $dt_due, $return_date ) = @_;
2448
2449     $return_date //= dt_from_string();
2450
2451     my $new_debar_dt = _calculate_new_debar_dt ($borrower, $item, $dt_due, $return_date);
2452
2453     return unless $new_debar_dt;
2454
2455     Koha::Patron::Debarments::AddUniqueDebarment({
2456         borrowernumber => $borrower->{borrowernumber},
2457         expiration     => $new_debar_dt->ymd(),
2458         type           => 'SUSPENSION',
2459     });
2460     # if borrower was already debarred but does not get an extra debarment
2461     my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
2462     my ($new_debarment_str, $is_a_reminder);
2463     if ( $borrower->{debarred} && $borrower->{debarred} eq $patron->is_debarred ) {
2464         $is_a_reminder = 1;
2465         $new_debarment_str = $borrower->{debarred};
2466     } else {
2467         $new_debarment_str = $new_debar_dt->ymd();
2468     }
2469     # FIXME Should return a DateTime object
2470     return $new_debarment_str, $is_a_reminder;
2471 }
2472
2473 =head2 _FixOverduesOnReturn
2474
2475    &_FixOverduesOnReturn($borrowernumber, $itemnumber, $exemptfine, $status);
2476
2477 C<$borrowernumber> borrowernumber
2478
2479 C<$itemnumber> itemnumber
2480
2481 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2482
2483 C<$status> ENUM -- reason for fix [ RETURNED, RENEWED, LOST, FORGIVEN ]
2484
2485 Internal function
2486
2487 =cut
2488
2489 sub _FixOverduesOnReturn {
2490     my ( $borrowernumber, $item, $exemptfine, $status ) = @_;
2491     unless( $borrowernumber ) {
2492         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2493         return;
2494     }
2495     unless( $item ) {
2496         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2497         return;
2498     }
2499     unless( $status ) {
2500         warn "_FixOverduesOnReturn() not supplied valid status";
2501         return;
2502     }
2503
2504     my $schema = Koha::Database->schema;
2505
2506     my $result = $schema->txn_do(
2507         sub {
2508             # check for overdue fine
2509             my $accountlines = Koha::Account::Lines->search(
2510                 {
2511                     borrowernumber  => $borrowernumber,
2512                     itemnumber      => $item,
2513                     debit_type_code => 'OVERDUE',
2514                     status          => 'UNRETURNED'
2515                 }
2516             );
2517             return 0 unless $accountlines->count; # no warning, there's just nothing to fix
2518
2519             my $accountline = $accountlines->next;
2520             my $payments = $accountline->credits;
2521
2522             my $amountoutstanding = $accountline->amountoutstanding;
2523             if ( $accountline->amount == 0 && $payments->count == 0 ) {
2524                 $accountline->delete;
2525             } elsif ($exemptfine && ($amountoutstanding != 0)) {
2526                 my $account = Koha::Account->new({patron_id => $borrowernumber});
2527                 my $credit = $account->add_credit(
2528                     {
2529                         amount     => $amountoutstanding,
2530                         user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
2531                         library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
2532                         interface  => C4::Context->interface,
2533                         type       => 'FORGIVEN',
2534                         item_id    => $item
2535                     }
2536                 );
2537
2538                 $credit->apply({ debits => [ $accountline ], offset_type => 'Forgiven' });
2539
2540                 if (C4::Context->preference("FinesLog")) {
2541                     &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2542                 }
2543
2544                 $accountline->status('FORGIVEN');
2545                 $accountline->store();
2546             } else {
2547                 $accountline->status($status);
2548                 $accountline->store();
2549
2550             }
2551         }
2552     );
2553
2554     return $result;
2555 }
2556
2557 =head2 _FixAccountForLostAndFound
2558
2559   &_FixAccountForLostAndFound($itemnumber, [$borrowernumber, $barcode]);
2560
2561 Finds the most recent lost item charge for this item and refunds the borrower
2562 appropriatly, taking into account any payments or writeoffs already applied
2563 against the charge.
2564
2565 Internal function, not exported, called only by AddReturn.
2566
2567 =cut
2568
2569 sub _FixAccountForLostAndFound {
2570     my $itemnumber     = shift or return;
2571     my $borrowernumber = @_ ? shift : undef;
2572     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
2573
2574     my $credit;
2575
2576     # check for charge made for lost book
2577     my $accountlines = Koha::Account::Lines->search(
2578         {
2579             itemnumber      => $itemnumber,
2580             debit_type_code => 'LOST',
2581             status          => [ undef, { '<>' => 'FOUND' } ]
2582         },
2583         {
2584             order_by => { -desc => [ 'date', 'accountlines_id' ] }
2585         }
2586     );
2587
2588     return unless $accountlines->count > 0;
2589     my $accountline     = $accountlines->next;
2590     my $total_to_refund = 0;
2591
2592     return unless $accountline->borrowernumber;
2593     my $patron = Koha::Patrons->find( $accountline->borrowernumber );
2594     return unless $patron; # Patron has been deleted, nobody to credit the return to
2595
2596     my $account = $patron->account;
2597
2598     # Use cases
2599     if ( $accountline->amount > $accountline->amountoutstanding ) {
2600         # some amount has been cancelled. collect the offsets that are not writeoffs
2601         # this works because the only way to subtract from this kind of a debt is
2602         # using the UI buttons 'Pay' and 'Write off'
2603         my $credits_offsets = Koha::Account::Offsets->search({
2604             debit_id  => $accountline->id,
2605             credit_id => { '!=' => undef }, # it is not the debit itself
2606             type      => { '!=' => 'Writeoff' },
2607             amount    => { '<'  => 0 } # credits are negative on the DB
2608         });
2609
2610         $total_to_refund = ( $credits_offsets->count > 0 )
2611                             ? $credits_offsets->total * -1 # credits are negative on the DB
2612                             : 0;
2613     }
2614
2615     my $credit_total = $accountline->amountoutstanding + $total_to_refund;
2616
2617     if ( $credit_total > 0 ) {
2618         my $branchcode = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
2619         $credit = $account->add_credit(
2620             {
2621                 amount      => $credit_total,
2622                 description => 'Item found ' . $item_id,
2623                 type        => 'LOST_FOUND',
2624                 interface   => C4::Context->interface,
2625                 library_id  => $branchcode,
2626                 item_id     => $itemnumber
2627             }
2628         );
2629
2630         $credit->apply( { debits => [ $accountline ] } );
2631     }
2632
2633     # Update the account status
2634     $accountline->discard_changes->status('FOUND');
2635     $accountline->store;
2636
2637     $accountline->item->paidfor('')->store({ log_action => 0 });
2638
2639     if ( defined $account and C4::Context->preference('AccountAutoReconcile') ) {
2640         $account->reconcile_balance;
2641     }
2642
2643     return ($credit) ? $credit->id : undef;
2644 }
2645
2646 =head2 _GetCircControlBranch
2647
2648    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2649
2650 Internal function :
2651
2652 Return the library code to be used to determine which circulation
2653 policy applies to a transaction.  Looks up the CircControl and
2654 HomeOrHoldingBranch system preferences.
2655
2656 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2657
2658 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2659
2660 =cut
2661
2662 sub _GetCircControlBranch {
2663     my ($item, $borrower) = @_;
2664     my $circcontrol = C4::Context->preference('CircControl');
2665     my $branch;
2666
2667     if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2668         $branch= C4::Context->userenv->{'branch'};
2669     } elsif ($circcontrol eq 'PatronLibrary') {
2670         $branch=$borrower->{branchcode};
2671     } else {
2672         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2673         $branch = $item->{$branchfield};
2674         # default to item home branch if holdingbranch is used
2675         # and is not defined
2676         if (!defined($branch) && $branchfield eq 'holdingbranch') {
2677             $branch = $item->{homebranch};
2678         }
2679     }
2680     return $branch;
2681 }
2682
2683 =head2 GetOpenIssue
2684
2685   $issue = GetOpenIssue( $itemnumber );
2686
2687 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2688
2689 C<$itemnumber> is the item's itemnumber
2690
2691 Returns a hashref
2692
2693 =cut
2694
2695 sub GetOpenIssue {
2696   my ( $itemnumber ) = @_;
2697   return unless $itemnumber;
2698   my $dbh = C4::Context->dbh;
2699   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2700   $sth->execute( $itemnumber );
2701   return $sth->fetchrow_hashref();
2702
2703 }
2704
2705 =head2 GetBiblioIssues
2706
2707   $issues = GetBiblioIssues($biblionumber);
2708
2709 this function get all issues from a biblionumber.
2710
2711 Return:
2712 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash contains all column from
2713 tables issues and the firstname,surname & cardnumber from borrowers.
2714
2715 =cut
2716
2717 sub GetBiblioIssues {
2718     my $biblionumber = shift;
2719     return unless $biblionumber;
2720     my $dbh   = C4::Context->dbh;
2721     my $query = "
2722         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2723         FROM issues
2724             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2725             LEFT JOIN items ON issues.itemnumber = items.itemnumber
2726             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2727             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2728         WHERE biblio.biblionumber = ?
2729         UNION ALL
2730         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2731         FROM old_issues
2732             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2733             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2734             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2735             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2736         WHERE biblio.biblionumber = ?
2737         ORDER BY timestamp
2738     ";
2739     my $sth = $dbh->prepare($query);
2740     $sth->execute($biblionumber, $biblionumber);
2741
2742     my @issues;
2743     while ( my $data = $sth->fetchrow_hashref ) {
2744         push @issues, $data;
2745     }
2746     return \@issues;
2747 }
2748
2749 =head2 GetUpcomingDueIssues
2750
2751   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2752
2753 =cut
2754
2755 sub GetUpcomingDueIssues {
2756     my $params = shift;
2757
2758     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2759     my $dbh = C4::Context->dbh;
2760
2761     my $statement = <<END_SQL;
2762 SELECT *
2763 FROM (
2764     SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2765     FROM issues
2766     LEFT JOIN items USING (itemnumber)
2767     LEFT OUTER JOIN branches USING (branchcode)
2768     WHERE returndate is NULL
2769 ) tmp
2770 WHERE days_until_due >= 0 AND days_until_due <= ?
2771 END_SQL
2772
2773     my @bind_parameters = ( $params->{'days_in_advance'} );
2774
2775     my $sth = $dbh->prepare( $statement );
2776     $sth->execute( @bind_parameters );
2777     my $upcoming_dues = $sth->fetchall_arrayref({});
2778
2779     return $upcoming_dues;
2780 }
2781
2782 =head2 CanBookBeRenewed
2783
2784   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2785
2786 Find out whether a borrowed item may be renewed.
2787
2788 C<$borrowernumber> is the borrower number of the patron who currently
2789 has the item on loan.
2790
2791 C<$itemnumber> is the number of the item to renew.
2792
2793 C<$override_limit>, if supplied with a true value, causes
2794 the limit on the number of times that the loan can be renewed
2795 (as controlled by the item type) to be ignored. Overriding also allows
2796 to renew sooner than "No renewal before" and to manually renew loans
2797 that are automatically renewed.
2798
2799 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2800 item must currently be on loan to the specified borrower; renewals
2801 must be allowed for the item's type; and the borrower must not have
2802 already renewed the loan. $error will contain the reason the renewal can not proceed
2803
2804 =cut
2805
2806 sub CanBookBeRenewed {
2807     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2808
2809     my $dbh    = C4::Context->dbh;
2810     my $renews = 1;
2811     my $auto_renew = 0;
2812
2813     my $item      = Koha::Items->find($itemnumber)      or return ( 0, 'no_item' );
2814     my $issue = $item->checkout or return ( 0, 'no_checkout' );
2815     return ( 0, 'onsite_checkout' ) if $issue->onsite_checkout;
2816     return ( 0, 'item_denied_renewal') if _item_denied_renewal({ item => $item });
2817
2818     my $patron = $issue->patron or return;
2819
2820     # override_limit will override anything else except on_reserve
2821     unless ( $override_limit ){
2822         my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
2823         my $issuing_rule = Koha::CirculationRules->get_effective_rules(
2824             {
2825                 categorycode => $patron->categorycode,
2826                 itemtype     => $item->effective_itemtype,
2827                 branchcode   => $branchcode,
2828                 rules => [
2829                     'renewalsallowed',
2830                     'no_auto_renewal_after',
2831                     'no_auto_renewal_after_hard_limit',
2832                     'lengthunit',
2833                     'norenewalbefore',
2834                 ]
2835             }
2836         );
2837
2838         return ( 0, "too_many" )
2839           if not $issuing_rule->{renewalsallowed} or $issuing_rule->{renewalsallowed} <= $issue->renewals;
2840
2841         my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2842         my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2843         $patron         = Koha::Patrons->find($borrowernumber); # FIXME Is this really useful?
2844         my $restricted  = $patron->is_debarred;
2845         my $hasoverdues = $patron->has_overdues;
2846
2847         if ( $restricted and $restrictionblockrenewing ) {
2848             return ( 0, 'restriction');
2849         } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($issue->is_overdue and $overduesblockrenewing eq 'blockitem') ) {
2850             return ( 0, 'overdue');
2851         }
2852
2853         if ( $issue->auto_renew && $patron->autorenew_checkouts ) {
2854
2855             if ( $patron->category->effective_BlockExpiredPatronOpacActions and $patron->is_expired ) {
2856                 return ( 0, 'auto_account_expired' );
2857             }
2858
2859             if ( defined $issuing_rule->{no_auto_renewal_after}
2860                     and $issuing_rule->{no_auto_renewal_after} ne "" ) {
2861                 # Get issue_date and add no_auto_renewal_after
2862                 # If this is greater than today, it's too late for renewal.
2863                 my $maximum_renewal_date = dt_from_string($issue->issuedate, 'sql');
2864                 $maximum_renewal_date->add(
2865                     $issuing_rule->{lengthunit} => $issuing_rule->{no_auto_renewal_after}
2866                 );
2867                 my $now = dt_from_string;
2868                 if ( $now >= $maximum_renewal_date ) {
2869                     return ( 0, "auto_too_late" );
2870                 }
2871             }
2872             if ( defined $issuing_rule->{no_auto_renewal_after_hard_limit}
2873                           and $issuing_rule->{no_auto_renewal_after_hard_limit} ne "" ) {
2874                 # If no_auto_renewal_after_hard_limit is >= today, it's also too late for renewal
2875                 if ( dt_from_string >= dt_from_string( $issuing_rule->{no_auto_renewal_after_hard_limit} ) ) {
2876                     return ( 0, "auto_too_late" );
2877                 }
2878             }
2879
2880             if ( C4::Context->preference('OPACFineNoRenewalsBlockAutoRenew') ) {
2881                 my $fine_no_renewals = C4::Context->preference("OPACFineNoRenewals");
2882                 my $amountoutstanding =
2883                   C4::Context->preference("OPACFineNoRenewalsIncludeCredit")
2884                   ? $patron->account->balance
2885                   : $patron->account->outstanding_debits->total_outstanding;
2886                 if ( $amountoutstanding and $amountoutstanding > $fine_no_renewals ) {
2887                     return ( 0, "auto_too_much_oweing" );
2888                 }
2889             }
2890         }
2891
2892         if ( defined $issuing_rule->{norenewalbefore}
2893             and $issuing_rule->{norenewalbefore} ne "" )
2894         {
2895
2896             # Calculate soonest renewal by subtracting 'No renewal before' from due date
2897             my $soonestrenewal = dt_from_string( $issue->date_due, 'sql' )->subtract(
2898                 $issuing_rule->{lengthunit} => $issuing_rule->{norenewalbefore} );
2899
2900             # Depending on syspref reset the exact time, only check the date
2901             if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2902                 and $issuing_rule->{lengthunit} eq 'days' )
2903             {
2904                 $soonestrenewal->truncate( to => 'day' );
2905             }
2906
2907             if ( $soonestrenewal > dt_from_string() )
2908             {
2909                 return ( 0, "auto_too_soon" ) if $issue->auto_renew && $patron->autorenew_checkouts;
2910                 return ( 0, "too_soon" );
2911             }
2912             elsif ( $issue->auto_renew && $patron->autorenew_checkouts ) {
2913                 $auto_renew = 1;
2914             }
2915         }
2916
2917         # Fallback for automatic renewals:
2918         # If norenewalbefore is undef, don't renew before due date.
2919         if ( $issue->auto_renew && !$auto_renew && $patron->autorenew_checkouts ) {
2920             my $now = dt_from_string;
2921             if ( $now >= dt_from_string( $issue->date_due, 'sql' ) ){
2922                 $auto_renew = 1;
2923             } else {
2924                 return ( 0, "auto_too_soon" );
2925             }
2926         }
2927     }
2928
2929     my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2930
2931     # This item can fill one or more unfilled reserve, can those unfilled reserves
2932     # all be filled by other available items?
2933     if ( $resfound
2934         && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2935     {
2936         my $schema = Koha::Database->new()->schema();
2937
2938         my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2939         if ($item_holds) {
2940             # There is an item level hold on this item, no other item can fill the hold
2941             $resfound = 1;
2942         }
2943         else {
2944
2945             # Get all other items that could possibly fill reserves
2946             my @itemnumbers = $schema->resultset('Item')->search(
2947                 {
2948                     biblionumber => $resrec->{biblionumber},
2949                     onloan       => undef,
2950                     notforloan   => 0,
2951                     -not         => { itemnumber => $itemnumber }
2952                 },
2953                 { columns => 'itemnumber' }
2954             )->get_column('itemnumber')->all();
2955
2956             # Get all other reserves that could have been filled by this item
2957             my @borrowernumbers;
2958             while (1) {
2959                 my ( $reserve_found, $reserve, undef ) =
2960                   C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2961
2962                 if ($reserve_found) {
2963                     push( @borrowernumbers, $reserve->{borrowernumber} );
2964                 }
2965                 else {
2966                     last;
2967                 }
2968             }
2969
2970             # If the count of the union of the lists of reservable items for each borrower
2971             # is equal or greater than the number of borrowers, we know that all reserves
2972             # can be filled with available items. We can get the union of the sets simply
2973             # by pushing all the elements onto an array and removing the duplicates.
2974             my @reservable;
2975             my %patrons;
2976             ITEM: foreach my $itemnumber (@itemnumbers) {
2977                 my $item = Koha::Items->find( $itemnumber );
2978                 next if IsItemOnHoldAndFound( $itemnumber );
2979                 for my $borrowernumber (@borrowernumbers) {
2980                     my $patron = $patrons{$borrowernumber} //= Koha::Patrons->find( $borrowernumber );
2981                     next unless IsAvailableForItemLevelRequest($item, $patron);
2982                     next unless CanItemBeReserved($borrowernumber,$itemnumber);
2983
2984                     push @reservable, $itemnumber;
2985                     if (@reservable >= @borrowernumbers) {
2986                         $resfound = 0;
2987                         last ITEM;
2988                     }
2989                     last;
2990                 }
2991             }
2992         }
2993     }
2994     return ( 0, "on_reserve" ) if $resfound;    # '' when no hold was found
2995     return ( 0, "auto_renew" ) if $auto_renew && !$override_limit; # 0 if auto-renewal should not succeed
2996
2997     return ( 1, undef );
2998 }
2999
3000 =head2 AddRenewal
3001
3002   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
3003
3004 Renews a loan.
3005
3006 C<$borrowernumber> is the borrower number of the patron who currently
3007 has the item.
3008
3009 C<$itemnumber> is the number of the item to renew.
3010
3011 C<$branch> is the library where the renewal took place (if any).
3012            The library that controls the circ policies for the renewal is retrieved from the issues record.
3013
3014 C<$datedue> can be a DateTime object used to set the due date.
3015
3016 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
3017 this parameter is not supplied, lastreneweddate is set to the current date.
3018
3019 C<$skipfinecalc> is an optional boolean. There may be circumstances where, even if the
3020 CalculateFinesOnReturn syspref is enabled, we don't want to calculate fines upon renew,
3021 for example, when we're renewing as a result of a fine being paid (see RenewAccruingItemWhenPaid
3022 syspref)
3023
3024 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
3025 from the book's item type.
3026
3027 =cut
3028
3029 sub AddRenewal {
3030     my $borrowernumber  = shift;
3031     my $itemnumber      = shift or return;
3032     my $branch          = shift;
3033     my $datedue         = shift;
3034     my $lastreneweddate = shift || dt_from_string();
3035     my $skipfinecalc    = shift;
3036
3037     my $item_object   = Koha::Items->find($itemnumber) or return;
3038     my $biblio = $item_object->biblio;
3039     my $issue  = $item_object->checkout;
3040     my $item_unblessed = $item_object->unblessed;
3041
3042     my $dbh = C4::Context->dbh;
3043
3044     return unless $issue;
3045
3046     $borrowernumber ||= $issue->borrowernumber;
3047
3048     if ( defined $datedue && ref $datedue ne 'DateTime' ) {
3049         carp 'Invalid date passed to AddRenewal.';
3050         return;
3051     }
3052
3053     my $patron = Koha::Patrons->find( $borrowernumber ) or return; # FIXME Should do more than just return
3054     my $patron_unblessed = $patron->unblessed;
3055
3056     my $circ_library = Koha::Libraries->find( _GetCircControlBranch($item_unblessed, $patron_unblessed) );
3057
3058     my $schema = Koha::Database->schema;
3059     $schema->txn_do(sub{
3060
3061         if ( !$skipfinecalc && C4::Context->preference('CalculateFinesOnReturn') ) {
3062             _CalculateAndUpdateFine( { issue => $issue, item => $item_unblessed, borrower => $patron_unblessed } );
3063         }
3064         _FixOverduesOnReturn( $borrowernumber, $itemnumber, undef, 'RENEWED' );
3065
3066         # If the due date wasn't specified, calculate it by adding the
3067         # book's loan length to today's date or the current due date
3068         # based on the value of the RenewalPeriodBase syspref.
3069         my $itemtype = $item_object->effective_itemtype;
3070         unless ($datedue) {
3071
3072             $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
3073                                             dt_from_string( $issue->date_due, 'sql' ) :
3074                                             dt_from_string();
3075             $datedue =  CalcDateDue($datedue, $itemtype, $circ_library->branchcode, $patron_unblessed, 'is a renewal');
3076         }
3077
3078         my $fees = Koha::Charges::Fees->new(
3079             {
3080                 patron    => $patron,
3081                 library   => $circ_library,
3082                 item      => $item_object,
3083                 from_date => dt_from_string( $issue->date_due, 'sql' ),
3084                 to_date   => dt_from_string($datedue),
3085             }
3086         );
3087
3088         # Update the issues record to have the new due date, and a new count
3089         # of how many times it has been renewed.
3090         my $renews = ( $issue->renewals || 0 ) + 1;
3091         my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
3092                                 WHERE borrowernumber=?
3093                                 AND itemnumber=?"
3094         );
3095
3096         $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
3097
3098         # Update the renewal count on the item, and tell zebra to reindex
3099         $renews = ( $item_object->renewals || 0 ) + 1;
3100         $item_object->renewals($renews);
3101         $item_object->onloan($datedue);
3102         $item_object->store({ log_action => 0 });
3103
3104         # Charge a new rental fee, if applicable
3105         my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
3106         if ( $charge > 0 ) {
3107             AddIssuingCharge($issue, $charge, 'RENT_RENEW');
3108         }
3109
3110         # Charge a new accumulate rental fee, if applicable
3111         my $itemtype_object = Koha::ItemTypes->find( $itemtype );
3112         if ( $itemtype_object ) {
3113             my $accumulate_charge = $fees->accumulate_rentalcharge();
3114             if ( $accumulate_charge > 0 ) {
3115                 AddIssuingCharge( $issue, $accumulate_charge, 'RENT_DAILY_RENEW' )
3116             }
3117             $charge += $accumulate_charge;
3118         }
3119
3120         # Send a renewal slip according to checkout alert preferencei
3121         if ( C4::Context->preference('RenewalSendNotice') eq '1' ) {
3122             my $circulation_alert = 'C4::ItemCirculationAlertPreference';
3123             my %conditions        = (
3124                 branchcode   => $branch,
3125                 categorycode => $patron->categorycode,
3126                 item_type    => $itemtype,
3127                 notification => 'CHECKOUT',
3128             );
3129             if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
3130                 SendCirculationAlert(
3131                     {
3132                         type     => 'RENEWAL',
3133                         item     => $item_unblessed,
3134                         borrower => $patron->unblessed,
3135                         branch   => $branch,
3136                     }
3137                 );
3138             }
3139         }
3140
3141         # Remove any OVERDUES related debarment if the borrower has no overdues
3142         if ( $patron
3143           && $patron->is_debarred
3144           && ! $patron->has_overdues
3145           && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
3146         ) {
3147             DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
3148         }
3149
3150         # Add the renewal to stats
3151         UpdateStats(
3152             {
3153                 branch         => $item_object->renewal_branchcode({branch => $branch}),
3154                 type           => 'renew',
3155                 amount         => $charge,
3156                 itemnumber     => $itemnumber,
3157                 itemtype       => $itemtype,
3158                 location       => $item_object->location,
3159                 borrowernumber => $borrowernumber,
3160                 ccode          => $item_object->ccode,
3161             }
3162         );
3163
3164         #Log the renewal
3165         logaction("CIRCULATION", "RENEWAL", $borrowernumber, $itemnumber) if C4::Context->preference("RenewalLog");
3166
3167         Koha::Plugins->call('after_circ_action', {
3168             action  => 'renewal',
3169             payload => {
3170                 checkout  => $issue->get_from_storage
3171             }
3172         });
3173     });
3174
3175     return $datedue;
3176 }
3177
3178 sub GetRenewCount {
3179     # check renewal status
3180     my ( $bornum, $itemno ) = @_;
3181     my $dbh           = C4::Context->dbh;
3182     my $renewcount    = 0;
3183     my $renewsallowed = 0;
3184     my $renewsleft    = 0;
3185
3186     my $patron = Koha::Patrons->find( $bornum );
3187     my $item   = Koha::Items->find($itemno);
3188
3189     return (0, 0, 0) unless $patron or $item; # Wrong call, no renewal allowed
3190
3191     # Look in the issues table for this item, lent to this borrower,
3192     # and not yet returned.
3193
3194     # FIXME - I think this function could be redone to use only one SQL call.
3195     my $sth = $dbh->prepare(
3196         "select * from issues
3197                                 where (borrowernumber = ?)
3198                                 and (itemnumber = ?)"
3199     );
3200     $sth->execute( $bornum, $itemno );
3201     my $data = $sth->fetchrow_hashref;
3202     $renewcount = $data->{'renewals'} if $data->{'renewals'};
3203     # $item and $borrower should be calculated
3204     my $branchcode = _GetCircControlBranch($item->unblessed, $patron->unblessed);
3205
3206     my $rule = Koha::CirculationRules->get_effective_rule(
3207         {
3208             categorycode => $patron->categorycode,
3209             itemtype     => $item->effective_itemtype,
3210             branchcode   => $branchcode,
3211             rule_name    => 'renewalsallowed',
3212         }
3213     );
3214
3215     $renewsallowed = $rule ? $rule->rule_value : 0;
3216     $renewsleft    = $renewsallowed - $renewcount;
3217     if($renewsleft < 0){ $renewsleft = 0; }
3218     return ( $renewcount, $renewsallowed, $renewsleft );
3219 }
3220
3221 =head2 GetSoonestRenewDate
3222
3223   $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3224
3225 Find out the soonest possible renew date of a borrowed item.
3226
3227 C<$borrowernumber> is the borrower number of the patron who currently
3228 has the item on loan.
3229
3230 C<$itemnumber> is the number of the item to renew.
3231
3232 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3233 renew date, based on the value "No renewal before" of the applicable
3234 issuing rule. Returns the current date if the item can already be
3235 renewed, and returns undefined if the borrower, loan, or item
3236 cannot be found.
3237
3238 =cut
3239
3240 sub GetSoonestRenewDate {
3241     my ( $borrowernumber, $itemnumber ) = @_;
3242
3243     my $dbh = C4::Context->dbh;
3244
3245     my $item      = Koha::Items->find($itemnumber)      or return;
3246     my $itemissue = $item->checkout or return;
3247
3248     $borrowernumber ||= $itemissue->borrowernumber;
3249     my $patron = Koha::Patrons->find( $borrowernumber )
3250       or return;
3251
3252     my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
3253     my $issuing_rule = Koha::CirculationRules->get_effective_rules(
3254         {   categorycode => $patron->categorycode,
3255             itemtype     => $item->effective_itemtype,
3256             branchcode   => $branchcode,
3257             rules => [
3258                 'norenewalbefore',
3259                 'lengthunit',
3260             ]
3261         }
3262     );
3263
3264     my $now = dt_from_string;
3265     return $now unless $issuing_rule;
3266
3267     if ( defined $issuing_rule->{norenewalbefore}
3268         and $issuing_rule->{norenewalbefore} ne "" )
3269     {
3270         my $soonestrenewal =
3271           dt_from_string( $itemissue->date_due )->subtract(
3272             $issuing_rule->{lengthunit} => $issuing_rule->{norenewalbefore} );
3273
3274         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3275             and $issuing_rule->{lengthunit} eq 'days' )
3276         {
3277             $soonestrenewal->truncate( to => 'day' );
3278         }
3279         return $soonestrenewal if $now < $soonestrenewal;
3280     }
3281     return $now;
3282 }
3283
3284 =head2 GetLatestAutoRenewDate
3285
3286   $NoAutoRenewalAfterThisDate = &GetLatestAutoRenewDate($borrowernumber, $itemnumber);
3287
3288 Find out the latest possible auto renew date of a borrowed item.
3289
3290 C<$borrowernumber> is the borrower number of the patron who currently
3291 has the item on loan.
3292
3293 C<$itemnumber> is the number of the item to renew.
3294
3295 C<$GetLatestAutoRenewDate> returns the DateTime of the latest possible
3296 auto renew date, based on the value "No auto renewal after" and the "No auto
3297 renewal after (hard limit) of the applicable issuing rule.
3298 Returns undef if there is no date specify in the circ rules or if the patron, loan,
3299 or item cannot be found.
3300
3301 =cut
3302
3303 sub GetLatestAutoRenewDate {
3304     my ( $borrowernumber, $itemnumber ) = @_;
3305
3306     my $dbh = C4::Context->dbh;
3307
3308     my $item      = Koha::Items->find($itemnumber)  or return;
3309     my $itemissue = $item->checkout                 or return;
3310
3311     $borrowernumber ||= $itemissue->borrowernumber;
3312     my $patron = Koha::Patrons->find( $borrowernumber )
3313       or return;
3314
3315     my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
3316     my $circulation_rules = Koha::CirculationRules->get_effective_rules(
3317         {
3318             categorycode => $patron->categorycode,
3319             itemtype     => $item->effective_itemtype,
3320             branchcode   => $branchcode,
3321             rules => [
3322                 'no_auto_renewal_after',
3323                 'no_auto_renewal_after_hard_limit',
3324                 'lengthunit',
3325             ]
3326         }
3327     );
3328
3329     return unless $circulation_rules;
3330     return
3331       if ( not $circulation_rules->{no_auto_renewal_after}
3332             or $circulation_rules->{no_auto_renewal_after} eq '' )
3333       and ( not $circulation_rules->{no_auto_renewal_after_hard_limit}
3334              or $circulation_rules->{no_auto_renewal_after_hard_limit} eq '' );
3335
3336     my $maximum_renewal_date;
3337     if ( $circulation_rules->{no_auto_renewal_after} ) {
3338         $maximum_renewal_date = dt_from_string($itemissue->issuedate);
3339         $maximum_renewal_date->add(
3340             $circulation_rules->{lengthunit} => $circulation_rules->{no_auto_renewal_after}
3341         );
3342     }
3343
3344     if ( $circulation_rules->{no_auto_renewal_after_hard_limit} ) {
3345         my $dt = dt_from_string( $circulation_rules->{no_auto_renewal_after_hard_limit} );
3346         $maximum_renewal_date = $dt if not $maximum_renewal_date or $maximum_renewal_date > $dt;
3347     }
3348     return $maximum_renewal_date;
3349 }
3350
3351
3352 =head2 GetIssuingCharges
3353
3354   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3355
3356 Calculate how much it would cost for a given patron to borrow a given
3357 item, including any applicable discounts.
3358
3359 C<$itemnumber> is the item number of item the patron wishes to borrow.
3360
3361 C<$borrowernumber> is the patron's borrower number.
3362
3363 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3364 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3365 if it's a video).
3366
3367 =cut
3368
3369 sub GetIssuingCharges {
3370
3371     # calculate charges due
3372     my ( $itemnumber, $borrowernumber ) = @_;
3373     my $charge = 0;
3374     my $dbh    = C4::Context->dbh;
3375     my $item_type;
3376
3377     # Get the book's item type and rental charge (via its biblioitem).
3378     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3379         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3380     $charge_query .= (C4::Context->preference('item-level_itypes'))
3381         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3382         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3383
3384     $charge_query .= ' WHERE items.itemnumber =?';
3385
3386     my $sth = $dbh->prepare($charge_query);
3387     $sth->execute($itemnumber);
3388     if ( my $item_data = $sth->fetchrow_hashref ) {
3389         $item_type = $item_data->{itemtype};
3390         $charge    = $item_data->{rentalcharge};
3391         my $branch = C4::Context::mybranch();
3392         my $patron = Koha::Patrons->find( $borrowernumber );
3393         my $discount = _get_discount_from_rule($patron->categorycode, $branch, $item_type);
3394         if ($discount) {
3395             # We may have multiple rules so get the most specific
3396             $charge = ( $charge * ( 100 - $discount ) ) / 100;
3397         }
3398         if ($charge) {
3399             $charge = sprintf '%.2f', $charge; # ensure no fractions of a penny returned
3400         }
3401     }
3402
3403     return ( $charge, $item_type );
3404 }
3405
3406 # Select most appropriate discount rule from those returned
3407 sub _get_discount_from_rule {
3408     my ($categorycode, $branchcode, $itemtype) = @_;
3409
3410     # Set search precedences
3411     my @params = (
3412         {
3413             branchcode   => $branchcode,
3414             itemtype     => $itemtype,
3415             categorycode => $categorycode,
3416         },
3417         {
3418             branchcode   => undef,
3419             categorycode => $categorycode,
3420             itemtype     => $itemtype,
3421         },
3422         {
3423             branchcode   => $branchcode,
3424             categorycode => $categorycode,
3425             itemtype     => undef,
3426         },
3427         {
3428             branchcode   => undef,
3429             categorycode => $categorycode,
3430             itemtype     => undef,
3431         },
3432     );
3433
3434     foreach my $params (@params) {
3435         my $rule = Koha::CirculationRules->search(
3436             {
3437                 rule_name => 'rentaldiscount',
3438                 %$params,
3439             }
3440         )->next();
3441
3442         return $rule->rule_value if $rule;
3443     }
3444
3445     # none of the above
3446     return 0;
3447 }
3448
3449 =head2 AddIssuingCharge
3450
3451   &AddIssuingCharge( $checkout, $charge, $type )
3452
3453 =cut
3454
3455 sub AddIssuingCharge {
3456     my ( $checkout, $charge, $type ) = @_;
3457
3458     # FIXME What if checkout does not exist?
3459
3460     my $account = Koha::Account->new({ patron_id => $checkout->borrowernumber });
3461     my $accountline = $account->add_debit(
3462         {
3463             amount      => $charge,
3464             note        => undef,
3465             user_id     => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
3466             library_id  => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
3467             interface   => C4::Context->interface,
3468             type        => $type,
3469             item_id     => $checkout->itemnumber,
3470             issue_id    => $checkout->issue_id,
3471         }
3472     );
3473 }
3474
3475 =head2 GetTransfers
3476
3477   GetTransfers($itemnumber);
3478
3479 =cut
3480
3481 sub GetTransfers {
3482     my ($itemnumber) = @_;
3483
3484     my $dbh = C4::Context->dbh;
3485
3486     my $query = '
3487         SELECT datesent,
3488                frombranch,
3489                tobranch,
3490                branchtransfer_id
3491         FROM branchtransfers
3492         WHERE itemnumber = ?
3493           AND datearrived IS NULL
3494         ';
3495     my $sth = $dbh->prepare($query);
3496     $sth->execute($itemnumber);
3497     my @row = $sth->fetchrow_array();
3498     return @row;
3499 }
3500
3501 =head2 GetTransfersFromTo
3502
3503   @results = GetTransfersFromTo($frombranch,$tobranch);
3504
3505 Returns the list of pending transfers between $from and $to branch
3506
3507 =cut
3508
3509 sub GetTransfersFromTo {
3510     my ( $frombranch, $tobranch ) = @_;
3511     return unless ( $frombranch && $tobranch );
3512     my $dbh   = C4::Context->dbh;
3513     my $query = "
3514         SELECT branchtransfer_id,itemnumber,datesent,frombranch
3515         FROM   branchtransfers
3516         WHERE  frombranch=?
3517           AND  tobranch=?
3518           AND datearrived IS NULL
3519     ";
3520     my $sth = $dbh->prepare($query);
3521     $sth->execute( $frombranch, $tobranch );
3522     my @gettransfers;
3523
3524     while ( my $data = $sth->fetchrow_hashref ) {
3525         push @gettransfers, $data;
3526     }
3527     return (@gettransfers);
3528 }
3529
3530 =head2 DeleteTransfer
3531
3532   &DeleteTransfer($itemnumber);
3533
3534 =cut
3535
3536 sub DeleteTransfer {
3537     my ($itemnumber) = @_;
3538     return unless $itemnumber;
3539     my $dbh          = C4::Context->dbh;
3540     my $sth          = $dbh->prepare(
3541         "DELETE FROM branchtransfers
3542          WHERE itemnumber=?
3543          AND datearrived IS NULL "
3544     );
3545     return $sth->execute($itemnumber);
3546 }
3547
3548 =head2 SendCirculationAlert
3549
3550 Send out a C<check-in> or C<checkout> alert using the messaging system.
3551
3552 B<Parameters>:
3553
3554 =over 4
3555
3556 =item type
3557
3558 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3559
3560 =item item
3561
3562 Hashref of information about the item being checked in or out.
3563
3564 =item borrower
3565
3566 Hashref of information about the borrower of the item.
3567
3568 =item branch
3569
3570 The branchcode from where the checkout or check-in took place.
3571
3572 =back
3573
3574 B<Example>:
3575
3576     SendCirculationAlert({
3577         type     => 'CHECKOUT',
3578         item     => $item,
3579         borrower => $borrower,
3580         branch   => $branch,
3581     });
3582
3583 =cut
3584
3585 sub SendCirculationAlert {
3586     my ($opts) = @_;
3587     my ($type, $item, $borrower, $branch) =
3588         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3589     my %message_name = (
3590         CHECKIN  => 'Item_Check_in',
3591         CHECKOUT => 'Item_Checkout',
3592         RENEWAL  => 'Item_Checkout',
3593     );
3594     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3595         borrowernumber => $borrower->{borrowernumber},
3596         message_name   => $message_name{$type},
3597     });
3598     my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3599
3600     my $schema = Koha::Database->new->schema;
3601     my @transports = keys %{ $borrower_preferences->{transports} };
3602
3603     # From the MySQL doc:
3604     # LOCK TABLES is not transaction-safe and implicitly commits any active transaction before attempting to lock the tables.
3605     # If the LOCK/UNLOCK statements are executed from tests, the current transaction will be committed.
3606     # To avoid that we need to guess if this code is execute from tests or not (yes it is a bit hacky)
3607     my $do_not_lock = ( exists $ENV{_} && $ENV{_} =~ m|prove| ) || $ENV{KOHA_TESTING};
3608
3609     for my $mtt (@transports) {
3610         my $letter =  C4::Letters::GetPreparedLetter (
3611             module => 'circulation',
3612             letter_code => $type,
3613             branchcode => $branch,
3614             message_transport_type => $mtt,
3615             lang => $borrower->{lang},
3616             tables => {
3617                 $issues_table => $item->{itemnumber},
3618                 'items'       => $item->{itemnumber},
3619                 'biblio'      => $item->{biblionumber},
3620                 'biblioitems' => $item->{biblionumber},
3621                 'borrowers'   => $borrower,
3622                 'branches'    => $branch,
3623             }
3624         ) or next;
3625
3626         $schema->storage->txn_begin;
3627         C4::Context->dbh->do(q|LOCK TABLE message_queue READ|) unless $do_not_lock;
3628         C4::Context->dbh->do(q|LOCK TABLE message_queue WRITE|) unless $do_not_lock;
3629         my $message = C4::Message->find_last_message($borrower, $type, $mtt);
3630         unless ( $message ) {
3631             C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3632             C4::Message->enqueue($letter, $borrower, $mtt);
3633         } else {
3634             $message->append($letter);
3635             $message->update;
3636         }
3637         C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3638         $schema->storage->txn_commit;
3639     }
3640
3641     return;
3642 }
3643
3644 =head2 updateWrongTransfer
3645
3646   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3647
3648 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
3649
3650 =cut
3651
3652 sub updateWrongTransfer {
3653         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3654         my $dbh = C4::Context->dbh;
3655 # first step validate the actual line of transfert .
3656         my $sth =
3657                 $dbh->prepare(
3658                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3659                 );
3660                 $sth->execute($FromLibrary,$itemNumber);
3661
3662 # second step create a new line of branchtransfer to the right location .
3663         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3664
3665 #third step changing holdingbranch of item
3666     my $item = Koha::Items->find($itemNumber)->holdingbranch($FromLibrary)->store;
3667 }
3668
3669 =head2 CalcDateDue
3670
3671 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3672
3673 this function calculates the due date given the start date and configured circulation rules,
3674 checking against the holidays calendar as per the daysmode circulation rule.
3675 C<$startdate>   = DateTime object representing start date of loan period (assumed to be today)
3676 C<$itemtype>  = itemtype code of item in question
3677 C<$branch>  = location whose calendar to use
3678 C<$borrower> = Borrower object
3679 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3680
3681 =cut
3682
3683 sub CalcDateDue {
3684     my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3685
3686     $isrenewal ||= 0;
3687
3688     # loanlength now a href
3689     my $loanlength =
3690             GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3691
3692     my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3693             ? qq{renewalperiod}
3694             : qq{issuelength};
3695
3696     my $datedue;
3697     if ( $startdate ) {
3698         if (ref $startdate ne 'DateTime' ) {
3699             $datedue = dt_from_string($datedue);
3700         } else {
3701             $datedue = $startdate->clone;
3702         }
3703     } else {
3704         $datedue = dt_from_string()->truncate( to => 'minute' );
3705     }
3706
3707
3708     my $daysmode = Koha::CirculationRules->get_effective_daysmode(
3709         {
3710             categorycode => $borrower->{categorycode},
3711             itemtype     => $itemtype,
3712             branchcode   => $branch,
3713         }
3714     );
3715
3716     # calculate the datedue as normal
3717     if ( $daysmode eq 'Days' )
3718     {    # ignoring calendar
3719         if ( $loanlength->{lengthunit} eq 'hours' ) {
3720             $datedue->add( hours => $loanlength->{$length_key} );
3721         } else {    # days
3722             $datedue->add( days => $loanlength->{$length_key} );
3723             $datedue->set_hour(23);
3724             $datedue->set_minute(59);
3725         }
3726     } else {
3727         my $dur;
3728         if ($loanlength->{lengthunit} eq 'hours') {
3729             $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3730         }
3731         else { # days
3732             $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3733         }
3734         my $calendar = Koha::Calendar->new( branchcode => $branch, days_mode => $daysmode );
3735         $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3736         if ($loanlength->{lengthunit} eq 'days') {
3737             $datedue->set_hour(23);
3738             $datedue->set_minute(59);
3739         }
3740     }
3741
3742     # if Hard Due Dates are used, retrieve them and apply as necessary
3743     my ( $hardduedate, $hardduedatecompare ) =
3744       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3745     if ($hardduedate) {    # hardduedates are currently dates
3746         $hardduedate->truncate( to => 'minute' );
3747         $hardduedate->set_hour(23);
3748         $hardduedate->set_minute(59);
3749         my $cmp = DateTime->compare( $hardduedate, $datedue );
3750
3751 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3752 # if the calculated date is before the 'after' Hard Due Date (floor), override
3753 # if the hard due date is set to 'exactly', overrride
3754         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3755             $datedue = $hardduedate->clone;
3756         }
3757
3758         # in all other cases, keep the date due as it is
3759
3760     }
3761
3762     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3763     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3764         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3765         if( $expiry_dt ) { #skip empty expiry date..
3766             $expiry_dt->set( hour => 23, minute => 59);
3767             my $d1= $datedue->clone->set_time_zone('floating');
3768             if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3769                 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3770             }
3771         }
3772         if ( $daysmode ne 'Days' ) {
3773           my $calendar = Koha::Calendar->new( branchcode => $branch, days_mode => $daysmode );
3774           if ( $calendar->is_holiday($datedue) ) {
3775               # Don't return on a closed day
3776               $datedue = $calendar->prev_open_days( $datedue, 1 );
3777           }
3778         }
3779     }
3780
3781     return $datedue;
3782 }
3783
3784
3785 sub CheckValidBarcode{
3786 my ($barcode) = @_;
3787 my $dbh = C4::Context->dbh;
3788 my $query=qq|SELECT count(*)
3789              FROM items
3790              WHERE barcode=?
3791             |;
3792 my $sth = $dbh->prepare($query);
3793 $sth->execute($barcode);
3794 my $exist=$sth->fetchrow ;
3795 return $exist;
3796 }
3797
3798 =head2 IsBranchTransferAllowed
3799
3800   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3801
3802 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3803
3804 Deprecated in favor of Koha::Item::Transfer::Limits->find/search and
3805 Koha::Item->can_be_transferred.
3806
3807 =cut
3808
3809 sub IsBranchTransferAllowed {
3810         my ( $toBranch, $fromBranch, $code ) = @_;
3811
3812         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3813
3814         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3815         my $dbh = C4::Context->dbh;
3816
3817         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3818         $sth->execute( $toBranch, $fromBranch, $code );
3819         my $limit = $sth->fetchrow_hashref();
3820
3821         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3822         if ( $limit->{'limitId'} ) {
3823                 return 0;
3824         } else {
3825                 return 1;
3826         }
3827 }
3828
3829 =head2 CreateBranchTransferLimit
3830
3831   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3832
3833 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3834
3835 Deprecated in favor of Koha::Item::Transfer::Limit->new.
3836
3837 =cut
3838
3839 sub CreateBranchTransferLimit {
3840    my ( $toBranch, $fromBranch, $code ) = @_;
3841    return unless defined($toBranch) && defined($fromBranch);
3842    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3843
3844    my $dbh = C4::Context->dbh;
3845
3846    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3847    return $sth->execute( $code, $toBranch, $fromBranch );
3848 }
3849
3850 =head2 DeleteBranchTransferLimits
3851
3852     my $result = DeleteBranchTransferLimits($frombranch);
3853
3854 Deletes all the library transfer limits for one library.  Returns the
3855 number of limits deleted, 0e0 if no limits were deleted, or undef if
3856 no arguments are supplied.
3857
3858 Deprecated in favor of Koha::Item::Transfer::Limits->search({
3859     fromBranch => $fromBranch
3860     })->delete.
3861
3862 =cut
3863
3864 sub DeleteBranchTransferLimits {
3865     my $branch = shift;
3866     return unless defined $branch;
3867     my $dbh    = C4::Context->dbh;
3868     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3869     return $sth->execute($branch);
3870 }
3871
3872 sub ReturnLostItem{
3873     my ( $borrowernumber, $itemnum ) = @_;
3874     MarkIssueReturned( $borrowernumber, $itemnum );
3875 }
3876
3877
3878 sub LostItem{
3879     my ($itemnumber, $mark_lost_from, $force_mark_returned) = @_;
3880
3881     unless ( $mark_lost_from ) {
3882         # Temporary check to avoid regressions
3883         die q|LostItem called without $mark_lost_from, check the API.|;
3884     }
3885
3886     my $mark_returned;
3887     if ( $force_mark_returned ) {
3888         $mark_returned = 1;
3889     } else {
3890         my $pref = C4::Context->preference('MarkLostItemsAsReturned') // q{};
3891         $mark_returned = ( $pref =~ m|$mark_lost_from| );
3892     }
3893
3894     my $dbh = C4::Context->dbh();
3895     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3896                            FROM issues
3897                            JOIN items USING (itemnumber)
3898                            JOIN biblio USING (biblionumber)
3899                            WHERE issues.itemnumber=?");
3900     $sth->execute($itemnumber);
3901     my $issues=$sth->fetchrow_hashref();
3902
3903     # If a borrower lost the item, add a replacement cost to the their record
3904     if ( my $borrowernumber = $issues->{borrowernumber} ){
3905         my $patron = Koha::Patrons->find( $borrowernumber );
3906
3907         my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, C4::Context->preference('WhenLostForgiveFine'), 'LOST');
3908         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!";  # zero is OK, check defined
3909
3910         if (C4::Context->preference('WhenLostChargeReplacementFee')){
3911             C4::Accounts::chargelostitem(
3912                 $borrowernumber,
3913                 $itemnumber,
3914                 $issues->{'replacementprice'},
3915                 sprintf( "%s %s %s",
3916                     $issues->{'title'}          || q{},
3917                     $issues->{'barcode'}        || q{},
3918                     $issues->{'itemcallnumber'} || q{},
3919                 ),
3920             );
3921             #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3922             #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3923         }
3924
3925         MarkIssueReturned($borrowernumber,$itemnumber,undef,$patron->privacy) if $mark_returned;
3926     }
3927
3928     #When item is marked lost automatically cancel its outstanding transfers and set items holdingbranch to the transfer source branch (frombranch)
3929     if (my ( $datesent,$frombranch,$tobranch ) = GetTransfers($itemnumber)) {
3930         Koha::Items->find($itemnumber)->holdingbranch($frombranch)->store;
3931     }
3932     my $transferdeleted = DeleteTransfer($itemnumber);
3933 }
3934
3935 sub GetOfflineOperations {
3936     my $dbh = C4::Context->dbh;
3937     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3938     $sth->execute(C4::Context->userenv->{'branch'});
3939     my $results = $sth->fetchall_arrayref({});
3940     return $results;
3941 }
3942
3943 sub GetOfflineOperation {
3944     my $operationid = shift;
3945     return unless $operationid;
3946     my $dbh = C4::Context->dbh;
3947     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3948     $sth->execute( $operationid );
3949     return $sth->fetchrow_hashref;
3950 }
3951
3952 sub AddOfflineOperation {
3953     my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3954     my $dbh = C4::Context->dbh;
3955     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3956     $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3957     return "Added.";
3958 }
3959
3960 sub DeleteOfflineOperation {
3961     my $dbh = C4::Context->dbh;
3962     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3963     $sth->execute( shift );
3964     return "Deleted.";
3965 }
3966
3967 sub ProcessOfflineOperation {
3968     my $operation = shift;
3969
3970     my $report;
3971     if ( $operation->{action} eq 'return' ) {
3972         $report = ProcessOfflineReturn( $operation );
3973     } elsif ( $operation->{action} eq 'issue' ) {
3974         $report = ProcessOfflineIssue( $operation );
3975     } elsif ( $operation->{action} eq 'payment' ) {
3976         $report = ProcessOfflinePayment( $operation );
3977     }
3978
3979     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3980
3981     return $report;
3982 }
3983
3984 sub ProcessOfflineReturn {
3985     my $operation = shift;
3986
3987     my $item = Koha::Items->find({barcode => $operation->{barcode}});
3988
3989     if ( $item ) {
3990         my $itemnumber = $item->itemnumber;
3991         my $issue = GetOpenIssue( $itemnumber );
3992         if ( $issue ) {
3993             my $leave_item_lost = C4::Context->preference("BlockReturnOfLostItems") ? 1 : 0;
3994             ModDateLastSeen( $itemnumber, $leave_item_lost );
3995             MarkIssueReturned(
3996                 $issue->{borrowernumber},
3997                 $itemnumber,
3998                 $operation->{timestamp},
3999             );
4000             $item->renewals(0);
4001             $item->onloan(undef);
4002             $item->store({ log_action => 0 });
4003             return "Success.";
4004         } else {
4005             return "Item not issued.";
4006         }
4007     } else {
4008         return "Item not found.";
4009     }
4010 }
4011
4012 sub ProcessOfflineIssue {
4013     my $operation = shift;
4014
4015     my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} } );
4016
4017     if ( $patron ) {
4018         my $item = Koha::Items->find({ barcode => $operation->{barcode} });
4019         unless ($item) {
4020             return "Barcode not found.";
4021         }
4022         my $itemnumber = $item->itemnumber;
4023         my $issue = GetOpenIssue( $itemnumber );
4024
4025         if ( $issue and ( $issue->{borrowernumber} ne $patron->borrowernumber ) ) { # Item already issued to another patron mark it returned
4026             MarkIssueReturned(
4027                 $issue->{borrowernumber},
4028                 $itemnumber,
4029                 $operation->{timestamp},
4030             );
4031         }
4032         AddIssue(
4033             $patron->unblessed,
4034             $operation->{'barcode'},
4035             undef,
4036             1,
4037             $operation->{timestamp},
4038             undef,
4039         );
4040         return "Success.";
4041     } else {
4042         return "Borrower not found.";
4043     }
4044 }
4045
4046 sub ProcessOfflinePayment {
4047     my $operation = shift;
4048
4049     my $patron = Koha::Patrons->find({ cardnumber => $operation->{cardnumber} });
4050
4051     $patron->account->pay(
4052         {
4053             amount     => $operation->{amount},
4054             library_id => $operation->{branchcode},
4055             interface  => 'koc'
4056         }
4057     );
4058
4059     return "Success.";
4060 }
4061
4062 =head2 TransferSlip
4063
4064   TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
4065
4066   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
4067
4068 =cut
4069
4070 sub TransferSlip {
4071     my ($branch, $itemnumber, $barcode, $to_branch) = @_;
4072
4073     my $item =
4074       $itemnumber
4075       ? Koha::Items->find($itemnumber)
4076       : Koha::Items->find( { barcode => $barcode } );
4077
4078     $item or return;
4079
4080     return C4::Letters::GetPreparedLetter (
4081         module => 'circulation',
4082         letter_code => 'TRANSFERSLIP',
4083         branchcode => $branch,
4084         tables => {
4085             'branches'    => $to_branch,
4086             'biblio'      => $item->biblionumber,
4087             'items'       => $item->unblessed,
4088         },
4089     );
4090 }
4091
4092 =head2 CheckIfIssuedToPatron
4093
4094   CheckIfIssuedToPatron($borrowernumber, $biblionumber)
4095
4096   Return 1 if any record item is issued to patron, otherwise return 0
4097
4098 =cut
4099
4100 sub CheckIfIssuedToPatron {
4101     my ($borrowernumber, $biblionumber) = @_;
4102
4103     my $dbh = C4::Context->dbh;
4104     my $query = q|
4105         SELECT COUNT(*) FROM issues
4106         LEFT JOIN items ON items.itemnumber = issues.itemnumber
4107         WHERE items.biblionumber = ?
4108         AND issues.borrowernumber = ?
4109     |;
4110     my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
4111     return 1 if $is_issued;
4112     return;
4113 }
4114
4115 =head2 IsItemIssued
4116
4117   IsItemIssued( $itemnumber )
4118
4119   Return 1 if the item is on loan, otherwise return 0
4120
4121 =cut
4122
4123 sub IsItemIssued {
4124     my $itemnumber = shift;
4125     my $dbh = C4::Context->dbh;
4126     my $sth = $dbh->prepare(q{
4127         SELECT COUNT(*)
4128         FROM issues
4129         WHERE itemnumber = ?
4130     });
4131     $sth->execute($itemnumber);
4132     return $sth->fetchrow;
4133 }
4134
4135 =head2 GetAgeRestriction
4136
4137   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
4138   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
4139
4140   if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as they are older or as old as the agerestriction }
4141   if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
4142
4143 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
4144 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
4145 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
4146          Negative days mean the borrower has gone past the age restriction age.
4147
4148 =cut
4149
4150 sub GetAgeRestriction {
4151     my ($record_restrictions, $borrower) = @_;
4152     my $markers = C4::Context->preference('AgeRestrictionMarker');
4153
4154     return unless $record_restrictions;
4155     # Split $record_restrictions to something like FSK 16 or PEGI 6
4156     my @values = split ' ', uc($record_restrictions);
4157     return unless @values;
4158
4159     # Search first occurrence of one of the markers
4160     my @markers = split /\|/, uc($markers);
4161     return unless @markers;
4162
4163     my $index            = 0;
4164     my $restriction_year = 0;
4165     for my $value (@values) {
4166         $index++;
4167         for my $marker (@markers) {
4168             $marker =~ s/^\s+//;    #remove leading spaces
4169             $marker =~ s/\s+$//;    #remove trailing spaces
4170             if ( $marker eq $value ) {
4171                 if ( $index <= $#values ) {
4172                     $restriction_year += $values[$index];
4173                 }
4174                 last;
4175             }
4176             elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
4177
4178                 # Perhaps it is something like "K16" (as in Finland)
4179                 $restriction_year += $1;
4180                 last;
4181             }
4182         }
4183         last if ( $restriction_year > 0 );
4184     }
4185
4186     #Check if the borrower is age restricted for this material and for how long.
4187     if ($restriction_year && $borrower) {
4188         if ( $borrower->{'dateofbirth'} ) {
4189             my @alloweddate = split /-/, $borrower->{'dateofbirth'};
4190             $alloweddate[0] += $restriction_year;
4191
4192             #Prevent runime eror on leap year (invalid date)
4193             if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
4194                 $alloweddate[2] = 28;
4195             }
4196
4197             #Get how many days the borrower has to reach the age restriction
4198             my @Today = split /-/, dt_from_string()->ymd();
4199             my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
4200             #Negative days means the borrower went past the age restriction age
4201             return ($restriction_year, $daysToAgeRestriction);
4202         }
4203     }
4204
4205     return ($restriction_year);
4206 }
4207
4208
4209 =head2 GetPendingOnSiteCheckouts
4210
4211 =cut
4212
4213 sub GetPendingOnSiteCheckouts {
4214     my $dbh = C4::Context->dbh;
4215     return $dbh->selectall_arrayref(q|
4216         SELECT
4217           items.barcode,
4218           items.biblionumber,
4219           items.itemnumber,
4220           items.itemnotes,
4221           items.itemcallnumber,
4222           items.location,
4223           issues.date_due,
4224           issues.branchcode,
4225           issues.date_due < NOW() AS is_overdue,
4226           biblio.author,
4227           biblio.title,
4228           borrowers.firstname,
4229           borrowers.surname,
4230           borrowers.cardnumber,
4231           borrowers.borrowernumber
4232         FROM items
4233         LEFT JOIN issues ON items.itemnumber = issues.itemnumber
4234         LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
4235         LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
4236         WHERE issues.onsite_checkout = 1
4237     |, { Slice => {} } );
4238 }
4239
4240 sub GetTopIssues {
4241     my ($params) = @_;
4242
4243     my ($count, $branch, $itemtype, $ccode, $newness)
4244         = @$params{qw(count branch itemtype ccode newness)};
4245
4246     my $dbh = C4::Context->dbh;
4247     my $query = q{
4248         SELECT * FROM (
4249         SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4250           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4251           i.ccode, SUM(i.issues) AS count
4252         FROM biblio b
4253         LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4254         LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4255     };
4256
4257     my (@where_strs, @where_args);
4258
4259     if ($branch) {
4260         push @where_strs, 'i.homebranch = ?';
4261         push @where_args, $branch;
4262     }
4263     if ($itemtype) {
4264         if (C4::Context->preference('item-level_itypes')){
4265             push @where_strs, 'i.itype = ?';
4266             push @where_args, $itemtype;
4267         } else {
4268             push @where_strs, 'bi.itemtype = ?';
4269             push @where_args, $itemtype;
4270         }
4271     }
4272     if ($ccode) {
4273         push @where_strs, 'i.ccode = ?';
4274         push @where_args, $ccode;
4275     }
4276     if ($newness) {
4277         push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4278         push @where_args, $newness;
4279     }
4280
4281     if (@where_strs) {
4282         $query .= 'WHERE ' . join(' AND ', @where_strs);
4283     }
4284
4285     $query .= q{
4286         GROUP BY b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4287           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4288           i.ccode
4289         ORDER BY count DESC
4290     };
4291
4292     $query .= q{ ) xxx WHERE count > 0 };
4293     $count = int($count);
4294     if ($count > 0) {
4295         $query .= "LIMIT $count";
4296     }
4297
4298     my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4299
4300     return @$rows;
4301 }
4302
4303 =head2 Internal methods
4304
4305 =cut
4306
4307 sub _CalculateAndUpdateFine {
4308     my ($params) = @_;
4309
4310     my $borrower    = $params->{borrower};
4311     my $item        = $params->{item};
4312     my $issue       = $params->{issue};
4313     my $return_date = $params->{return_date};
4314
4315     unless ($borrower) { carp "No borrower passed in!" && return; }
4316     unless ($item)     { carp "No item passed in!"     && return; }
4317     unless ($issue)    { carp "No issue passed in!"    && return; }
4318
4319     my $datedue = dt_from_string( $issue->date_due );
4320
4321     # we only need to calculate and change the fines if we want to do that on return
4322     # Should be on for hourly loans
4323     my $control = C4::Context->preference('CircControl');
4324     my $control_branchcode =
4325         ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4326       : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
4327       :                                     $issue->branchcode;
4328
4329     my $date_returned = $return_date ? $return_date : dt_from_string();
4330
4331     my ( $amount, $unitcounttotal, $unitcount  ) =
4332       C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4333
4334     if ( C4::Context->preference('finesMode') eq 'production' ) {
4335         if ( $amount > 0 ) {
4336             C4::Overdues::UpdateFine({
4337                 issue_id       => $issue->issue_id,
4338                 itemnumber     => $issue->itemnumber,
4339                 borrowernumber => $issue->borrowernumber,
4340                 amount         => $amount,
4341                 due            => output_pref($datedue),
4342             });
4343         }
4344         elsif ($return_date) {
4345
4346             # Backdated returns may have fines that shouldn't exist,
4347             # so in this case, we need to drop those fines to 0
4348
4349             C4::Overdues::UpdateFine({
4350                 issue_id       => $issue->issue_id,
4351                 itemnumber     => $issue->itemnumber,
4352                 borrowernumber => $issue->borrowernumber,
4353                 amount         => 0,
4354                 due            => output_pref($datedue),
4355             });
4356         }
4357     }
4358 }
4359
4360 sub _item_denied_renewal {
4361     my ($params) = @_;
4362
4363     my $item = $params->{item};
4364     return unless $item;
4365
4366     my $denyingrules = Koha::Config::SysPrefs->find('ItemsDeniedRenewal')->get_yaml_pref_hash();
4367     return unless $denyingrules;
4368     foreach my $field (keys %$denyingrules) {
4369         my $val = $item->$field;
4370         if( !defined $val) {
4371             if ( any { !defined $_ }  @{$denyingrules->{$field}} ){
4372                 return 1;
4373             }
4374         } elsif (any { defined($_) && $val eq $_ } @{$denyingrules->{$field}}) {
4375            # If the results matches the values in the syspref
4376            # We return true if match found
4377             return 1;
4378         }
4379     }
4380     return 0;
4381 }
4382
4383 1;
4384
4385 __END__
4386
4387 =head1 AUTHOR
4388
4389 Koha Development Team <http://koha-community.org/>
4390
4391 =cut