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