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