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