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