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($borrowernumber, $itemnumber);
2790         return ( 0, $auto_renew  ) if $auto_renew =~ 'auto_account_expired';
2791         return ( 0, $auto_renew  ) if $auto_renew =~ 'auto_too_late';
2792         return ( 0, $auto_renew  ) if $auto_renew =~ 'auto_too_much_oweing';
2793     }
2794
2795     my ( $resfound, $resrec, $possible_reserves ) = C4::Reserves::CheckReserves($itemnumber);
2796
2797     # If next hold is non priority, then check if any hold with priority (non_priority = 0) exists for the same biblionumber.
2798     if ( $resfound && $resrec->{non_priority} ) {
2799         $resfound = Koha::Holds->search(
2800             { biblionumber => $resrec->{biblionumber}, non_priority => 0 } )
2801           ->count > 0;
2802     }
2803
2804
2805
2806     # This item can fill one or more unfilled reserve, can those unfilled reserves
2807     # all be filled by other available items?
2808     if ( $resfound
2809         && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2810     {
2811         my $item_holds = Koha::Holds->search( { itemnumber => $itemnumber, found => undef } )->count();
2812         if ($item_holds) {
2813             # There is an item level hold on this item, no other item can fill the hold
2814             $resfound = 1;
2815         }
2816         else {
2817
2818             # Get all other items that could possibly fill reserves
2819             my $items = Koha::Items->search({
2820                 biblionumber => $resrec->{biblionumber},
2821                 onloan       => undef,
2822                 notforloan   => 0,
2823                 -not         => { itemnumber => $itemnumber }
2824             });
2825
2826             # Get all other reserves that could have been filled by this item
2827             my @borrowernumbers = map { $_->{borrowernumber} } @$possible_reserves;
2828             my $patrons = Koha::Patrons->search({
2829                 borrowernumber => { -in => \@borrowernumbers }
2830             });
2831
2832             # If the count of the union of the lists of reservable items for each borrower
2833             # is equal or greater than the number of borrowers, we know that all reserves
2834             # can be filled with available items. We can get the union of the sets simply
2835             # by pushing all the elements onto an array and removing the duplicates.
2836             my @reservable;
2837             ITEM: while ( my $item = $items->next ) {
2838                 next if IsItemOnHoldAndFound( $item->itemnumber );
2839                 while ( my $patron = $patrons->next ) {
2840                     next unless IsAvailableForItemLevelRequest($item, $patron);
2841                     next unless CanItemBeReserved($patron->borrowernumber,$item->itemnumber,undef,{ignore_hold_counts=>1})->{status} eq 'OK';
2842                     push @reservable, $item->itemnumber;
2843                     if (@reservable >= @borrowernumbers) {
2844                         $resfound = 0;
2845                         last ITEM;
2846                     }
2847                     last;
2848                 }
2849                 $patrons->reset;
2850             }
2851         }
2852     }
2853     if( $cron ) { #The cron wants to return 'too_soon' over 'on_reserve'
2854         return ( 0, $auto_renew  ) if $auto_renew =~ 'too_soon';#$auto_renew ne "no" && $auto_renew ne "ok";
2855         return ( 0, "on_reserve" ) if $resfound;    # '' when no hold was found
2856     } else { # For other purposes we want 'on_reserve' before 'too_soon'
2857         return ( 0, "on_reserve" ) if $resfound;    # '' when no hold was found
2858         return ( 0, $auto_renew  ) if $auto_renew =~ 'too_soon';#$auto_renew ne "no" && $auto_renew ne "ok";
2859     }
2860
2861     return ( 0, "auto_renew" ) if $auto_renew eq "ok" && !$override_limit; # 0 if auto-renewal should not succeed
2862
2863     return ( 1, undef );
2864 }
2865
2866 =head2 AddRenewal
2867
2868   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate], [$seen]);
2869
2870 Renews a loan.
2871
2872 C<$borrowernumber> is the borrower number of the patron who currently
2873 has the item.
2874
2875 C<$itemnumber> is the number of the item to renew.
2876
2877 C<$branch> is the library where the renewal took place (if any).
2878            The library that controls the circ policies for the renewal is retrieved from the issues record.
2879
2880 C<$datedue> can be a DateTime object used to set the due date.
2881
2882 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2883 this parameter is not supplied, lastreneweddate is set to the current date.
2884
2885 C<$skipfinecalc> is an optional boolean. There may be circumstances where, even if the
2886 CalculateFinesOnReturn syspref is enabled, we don't want to calculate fines upon renew,
2887 for example, when we're renewing as a result of a fine being paid (see RenewAccruingItemWhenPaid
2888 syspref)
2889
2890 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2891 from the book's item type.
2892
2893 C<$seen> is a boolean flag indicating if the item was seen or not during the renewal. This
2894 informs the incrementing of the unseen_renewals column. If this flag is not supplied, we
2895 fallback to a true value
2896
2897 =cut
2898
2899 sub AddRenewal {
2900     my $borrowernumber  = shift;
2901     my $itemnumber      = shift or return;
2902     my $branch          = shift;
2903     my $datedue         = shift;
2904     my $lastreneweddate = shift || dt_from_string();
2905     my $skipfinecalc    = shift;
2906     my $seen            = shift;
2907
2908     # Fallback on a 'seen' renewal
2909     $seen = defined $seen && $seen == 0 ? 0 : 1;
2910
2911     my $item_object   = Koha::Items->find($itemnumber) or return;
2912     my $biblio = $item_object->biblio;
2913     my $issue  = $item_object->checkout;
2914     my $item_unblessed = $item_object->unblessed;
2915
2916     my $dbh = C4::Context->dbh;
2917
2918     return unless $issue;
2919
2920     $borrowernumber ||= $issue->borrowernumber;
2921
2922     if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2923         carp 'Invalid date passed to AddRenewal.';
2924         return;
2925     }
2926
2927     my $patron = Koha::Patrons->find( $borrowernumber ) or return; # FIXME Should do more than just return
2928     my $patron_unblessed = $patron->unblessed;
2929
2930     my $circ_library = Koha::Libraries->find( _GetCircControlBranch($item_unblessed, $patron_unblessed) );
2931
2932     my $schema = Koha::Database->schema;
2933     $schema->txn_do(sub{
2934
2935         if ( !$skipfinecalc && C4::Context->preference('CalculateFinesOnReturn') ) {
2936             _CalculateAndUpdateFine( { issue => $issue, item => $item_unblessed, borrower => $patron_unblessed } );
2937         }
2938         _FixOverduesOnReturn( $borrowernumber, $itemnumber, undef, 'RENEWED' );
2939
2940         # If the due date wasn't specified, calculate it by adding the
2941         # book's loan length to today's date or the current due date
2942         # based on the value of the RenewalPeriodBase syspref.
2943         my $itemtype = $item_object->effective_itemtype;
2944         unless ($datedue) {
2945
2946             $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2947                                             dt_from_string( $issue->date_due, 'sql' ) :
2948                                             dt_from_string();
2949             $datedue =  CalcDateDue($datedue, $itemtype, $circ_library->branchcode, $patron_unblessed, 'is a renewal');
2950         }
2951
2952         my $fees = Koha::Charges::Fees->new(
2953             {
2954                 patron    => $patron,
2955                 library   => $circ_library,
2956                 item      => $item_object,
2957                 from_date => dt_from_string( $issue->date_due, 'sql' ),
2958                 to_date   => dt_from_string($datedue),
2959             }
2960         );
2961
2962         # Increment the unseen renewals, if appropriate
2963         # We only do so if the syspref is enabled and
2964         # a maximum value has been set in the circ rules
2965         my $unseen_renewals = $issue->unseen_renewals;
2966         if (C4::Context->preference('UnseenRenewals')) {
2967             my $rule = Koha::CirculationRules->get_effective_rule(
2968                 {   categorycode => $patron->categorycode,
2969                     itemtype     => $item_object->effective_itemtype,
2970                     branchcode   => $circ_library->branchcode,
2971                     rule_name    => 'unseen_renewals_allowed'
2972                 }
2973             );
2974             if (!$seen && $rule && $rule->rule_value) {
2975                 $unseen_renewals++;
2976             } else {
2977                 # If the renewal is seen, unseen should revert to 0
2978                 $unseen_renewals = 0;
2979             }
2980         }
2981
2982         # Update the issues record to have the new due date, and a new count
2983         # of how many times it has been renewed.
2984         my $renews = ( $issue->renewals || 0 ) + 1;
2985         my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, unseen_renewals = ?, lastreneweddate = ? WHERE issue_id = ?");
2986
2987         eval{
2988             $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $unseen_renewals, $lastreneweddate, $issue->issue_id );
2989         };
2990         if( $sth->err ){
2991             Koha::Exceptions::Checkout::FailedRenewal->throw(
2992                 error => 'Update of issue# ' . $issue->issue_id . ' failed with error: ' . $sth->errstr
2993             );
2994         }
2995
2996         # Update the renewal count on the item, and tell zebra to reindex
2997         $renews = ( $item_object->renewals || 0 ) + 1;
2998         $item_object->renewals($renews);
2999         $item_object->onloan($datedue);
3000         $item_object->store({ log_action => 0 });
3001
3002         # Charge a new rental fee, if applicable
3003         my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
3004         if ( $charge > 0 ) {
3005             AddIssuingCharge($issue, $charge, 'RENT_RENEW');
3006         }
3007
3008         # Charge a new accumulate rental fee, if applicable
3009         my $itemtype_object = Koha::ItemTypes->find( $itemtype );
3010         if ( $itemtype_object ) {
3011             my $accumulate_charge = $fees->accumulate_rentalcharge();
3012             if ( $accumulate_charge > 0 ) {
3013                 AddIssuingCharge( $issue, $accumulate_charge, 'RENT_DAILY_RENEW' )
3014             }
3015             $charge += $accumulate_charge;
3016         }
3017
3018         # Send a renewal slip according to checkout alert preferencei
3019         if ( C4::Context->preference('RenewalSendNotice') eq '1' ) {
3020             my $circulation_alert = 'C4::ItemCirculationAlertPreference';
3021             my %conditions        = (
3022                 branchcode   => $branch,
3023                 categorycode => $patron->categorycode,
3024                 item_type    => $itemtype,
3025                 notification => 'CHECKOUT',
3026             );
3027             if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
3028                 SendCirculationAlert(
3029                     {
3030                         type     => 'RENEWAL',
3031                         item     => $item_unblessed,
3032                         borrower => $patron->unblessed,
3033                         branch   => $branch,
3034                     }
3035                 );
3036             }
3037         }
3038
3039         # Remove any OVERDUES related debarment if the borrower has no overdues
3040         if ( $patron
3041           && $patron->is_debarred
3042           && ! $patron->has_overdues
3043           && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
3044         ) {
3045             DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
3046         }
3047
3048         # Add the renewal to stats
3049         C4::Stats::UpdateStats(
3050             {
3051                 branch         => $item_object->renewal_branchcode({branch => $branch}),
3052                 type           => 'renew',
3053                 amount         => $charge,
3054                 itemnumber     => $itemnumber,
3055                 itemtype       => $itemtype,
3056                 location       => $item_object->location,
3057                 borrowernumber => $borrowernumber,
3058                 ccode          => $item_object->ccode,
3059             }
3060         );
3061
3062         #Log the renewal
3063         logaction("CIRCULATION", "RENEWAL", $borrowernumber, $itemnumber) if C4::Context->preference("RenewalLog");
3064
3065         Koha::Plugins->call('after_circ_action', {
3066             action  => 'renewal',
3067             payload => {
3068                 checkout  => $issue->get_from_storage
3069             }
3070         });
3071     });
3072
3073     return $datedue;
3074 }
3075
3076 sub GetRenewCount {
3077     # check renewal status
3078     my ( $bornum, $itemno ) = @_;
3079     my $dbh           = C4::Context->dbh;
3080     my $renewcount    = 0;
3081     my $unseencount    = 0;
3082     my $renewsallowed = 0;
3083     my $unseenallowed = 0;
3084     my $renewsleft    = 0;
3085     my $unseenleft    = 0;
3086
3087     my $patron = Koha::Patrons->find( $bornum );
3088     my $item   = Koha::Items->find($itemno);
3089
3090     return (0, 0, 0, 0, 0, 0) unless $patron or $item; # Wrong call, no renewal allowed
3091
3092     # Look in the issues table for this item, lent to this borrower,
3093     # and not yet returned.
3094
3095     # FIXME - I think this function could be redone to use only one SQL call.
3096     my $sth = $dbh->prepare(
3097         "select * from issues
3098                                 where (borrowernumber = ?)
3099                                 and (itemnumber = ?)"
3100     );
3101     $sth->execute( $bornum, $itemno );
3102     my $data = $sth->fetchrow_hashref;
3103     $renewcount = $data->{'renewals'} if $data->{'renewals'};
3104     $unseencount = $data->{'unseen_renewals'} if $data->{'unseen_renewals'};
3105     # $item and $borrower should be calculated
3106     my $branchcode = _GetCircControlBranch($item->unblessed, $patron->unblessed);
3107
3108     my $rules = Koha::CirculationRules->get_effective_rules(
3109         {
3110             categorycode => $patron->categorycode,
3111             itemtype     => $item->effective_itemtype,
3112             branchcode   => $branchcode,
3113             rules        => [ 'renewalsallowed', 'unseen_renewals_allowed' ]
3114         }
3115     );
3116     $renewsallowed = $rules ? $rules->{renewalsallowed} : 0;
3117     $unseenallowed = $rules->{unseen_renewals_allowed} ?
3118         $rules->{unseen_renewals_allowed} :
3119         0;
3120     $renewsleft    = $renewsallowed - $renewcount;
3121     $unseenleft    = $unseenallowed - $unseencount;
3122     if($renewsleft < 0){ $renewsleft = 0; }
3123     if($unseenleft < 0){ $unseenleft = 0; }
3124     return (
3125         $renewcount,
3126         $renewsallowed,
3127         $renewsleft,
3128         $unseencount,
3129         $unseenallowed,
3130         $unseenleft
3131     );
3132 }
3133
3134 =head2 GetSoonestRenewDate
3135
3136   $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3137
3138 Find out the soonest possible renew date of a borrowed item.
3139
3140 C<$borrowernumber> is the borrower number of the patron who currently
3141 has the item on loan.
3142
3143 C<$itemnumber> is the number of the item to renew.
3144
3145 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3146 renew date, based on the value "No renewal before" of the applicable
3147 issuing rule. Returns the current date if the item can already be
3148 renewed, and returns undefined if the borrower, loan, or item
3149 cannot be found.
3150
3151 =cut
3152
3153 sub GetSoonestRenewDate {
3154     my ( $borrowernumber, $itemnumber ) = @_;
3155
3156     my $dbh = C4::Context->dbh;
3157
3158     my $item      = Koha::Items->find($itemnumber)      or return;
3159     my $itemissue = $item->checkout or return;
3160
3161     $borrowernumber ||= $itemissue->borrowernumber;
3162     my $patron = Koha::Patrons->find( $borrowernumber )
3163       or return;
3164
3165     my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
3166     my $issuing_rule = Koha::CirculationRules->get_effective_rules(
3167         {   categorycode => $patron->categorycode,
3168             itemtype     => $item->effective_itemtype,
3169             branchcode   => $branchcode,
3170             rules => [
3171                 'norenewalbefore',
3172                 'lengthunit',
3173             ]
3174         }
3175     );
3176
3177     my $now = dt_from_string;
3178     return $now unless $issuing_rule;
3179
3180     if ( defined $issuing_rule->{norenewalbefore}
3181         and $issuing_rule->{norenewalbefore} ne "" )
3182     {
3183         my $soonestrenewal =
3184           dt_from_string( $itemissue->date_due )->subtract(
3185             $issuing_rule->{lengthunit} => $issuing_rule->{norenewalbefore} );
3186
3187         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3188             and $issuing_rule->{lengthunit} eq 'days' )
3189         {
3190             $soonestrenewal->truncate( to => 'day' );
3191         }
3192         return $soonestrenewal if $now < $soonestrenewal;
3193     }
3194     return $now;
3195 }
3196
3197 =head2 GetLatestAutoRenewDate
3198
3199   $NoAutoRenewalAfterThisDate = &GetLatestAutoRenewDate($borrowernumber, $itemnumber);
3200
3201 Find out the latest possible auto renew date of a borrowed item.
3202
3203 C<$borrowernumber> is the borrower number of the patron who currently
3204 has the item on loan.
3205
3206 C<$itemnumber> is the number of the item to renew.
3207
3208 C<$GetLatestAutoRenewDate> returns the DateTime of the latest possible
3209 auto renew date, based on the value "No auto renewal after" and the "No auto
3210 renewal after (hard limit) of the applicable issuing rule.
3211 Returns undef if there is no date specify in the circ rules or if the patron, loan,
3212 or item cannot be found.
3213
3214 =cut
3215
3216 sub GetLatestAutoRenewDate {
3217     my ( $borrowernumber, $itemnumber ) = @_;
3218
3219     my $dbh = C4::Context->dbh;
3220
3221     my $item      = Koha::Items->find($itemnumber)  or return;
3222     my $itemissue = $item->checkout                 or return;
3223
3224     $borrowernumber ||= $itemissue->borrowernumber;
3225     my $patron = Koha::Patrons->find( $borrowernumber )
3226       or return;
3227
3228     my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
3229     my $circulation_rules = Koha::CirculationRules->get_effective_rules(
3230         {
3231             categorycode => $patron->categorycode,
3232             itemtype     => $item->effective_itemtype,
3233             branchcode   => $branchcode,
3234             rules => [
3235                 'no_auto_renewal_after',
3236                 'no_auto_renewal_after_hard_limit',
3237                 'lengthunit',
3238             ]
3239         }
3240     );
3241
3242     return unless $circulation_rules;
3243     return
3244       if ( not $circulation_rules->{no_auto_renewal_after}
3245             or $circulation_rules->{no_auto_renewal_after} eq '' )
3246       and ( not $circulation_rules->{no_auto_renewal_after_hard_limit}
3247              or $circulation_rules->{no_auto_renewal_after_hard_limit} eq '' );
3248
3249     my $maximum_renewal_date;
3250     if ( $circulation_rules->{no_auto_renewal_after} ) {
3251         $maximum_renewal_date = dt_from_string($itemissue->issuedate);
3252         $maximum_renewal_date->add(
3253             $circulation_rules->{lengthunit} => $circulation_rules->{no_auto_renewal_after}
3254         );
3255     }
3256
3257     if ( $circulation_rules->{no_auto_renewal_after_hard_limit} ) {
3258         my $dt = dt_from_string( $circulation_rules->{no_auto_renewal_after_hard_limit} );
3259         $maximum_renewal_date = $dt if not $maximum_renewal_date or $maximum_renewal_date > $dt;
3260     }
3261     return $maximum_renewal_date;
3262 }
3263
3264
3265 =head2 GetIssuingCharges
3266
3267   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3268
3269 Calculate how much it would cost for a given patron to borrow a given
3270 item, including any applicable discounts.
3271
3272 C<$itemnumber> is the item number of item the patron wishes to borrow.
3273
3274 C<$borrowernumber> is the patron's borrower number.
3275
3276 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3277 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3278 if it's a video).
3279
3280 =cut
3281
3282 sub GetIssuingCharges {
3283
3284     # calculate charges due
3285     my ( $itemnumber, $borrowernumber ) = @_;
3286     my $charge = 0;
3287     my $dbh    = C4::Context->dbh;
3288     my $item_type;
3289
3290     # Get the book's item type and rental charge (via its biblioitem).
3291     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3292         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3293     $charge_query .= (C4::Context->preference('item-level_itypes'))
3294         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3295         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3296
3297     $charge_query .= ' WHERE items.itemnumber =?';
3298
3299     my $sth = $dbh->prepare($charge_query);
3300     $sth->execute($itemnumber);
3301     if ( my $item_data = $sth->fetchrow_hashref ) {
3302         $item_type = $item_data->{itemtype};
3303         $charge    = $item_data->{rentalcharge};
3304         if ($charge) {
3305             # FIXME This should follow CircControl
3306             my $branch = C4::Context::mybranch();
3307             my $patron = Koha::Patrons->find( $borrowernumber );
3308             my $discount = Koha::CirculationRules->get_effective_rule({
3309                 categorycode => $patron->categorycode,
3310                 branchcode   => $branch,
3311                 itemtype     => $item_type,
3312                 rule_name    => 'rentaldiscount'
3313             });
3314             if ($discount) {
3315                 $charge = ( $charge * ( 100 - $discount->rule_value ) ) / 100;
3316             }
3317             $charge = sprintf '%.2f', $charge; # ensure no fractions of a penny returned
3318         }
3319     }
3320
3321     return ( $charge, $item_type );
3322 }
3323
3324 =head2 AddIssuingCharge
3325
3326   &AddIssuingCharge( $checkout, $charge, $type )
3327
3328 =cut
3329
3330 sub AddIssuingCharge {
3331     my ( $checkout, $charge, $type ) = @_;
3332
3333     # FIXME What if checkout does not exist?
3334
3335     my $account = Koha::Account->new({ patron_id => $checkout->borrowernumber });
3336     my $accountline = $account->add_debit(
3337         {
3338             amount      => $charge,
3339             note        => undef,
3340             user_id     => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
3341             library_id  => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
3342             interface   => C4::Context->interface,
3343             type        => $type,
3344             item_id     => $checkout->itemnumber,
3345             issue_id    => $checkout->issue_id,
3346         }
3347     );
3348 }
3349
3350 =head2 GetTransfers
3351
3352   GetTransfers($itemnumber);
3353
3354 =cut
3355
3356 sub GetTransfers {
3357     my ($itemnumber) = @_;
3358
3359     my $dbh = C4::Context->dbh;
3360
3361     my $query = '
3362         SELECT datesent,
3363                frombranch,
3364                tobranch,
3365                branchtransfer_id,
3366                daterequested,
3367                reason
3368         FROM branchtransfers
3369         WHERE itemnumber = ?
3370           AND datearrived IS NULL
3371           AND datecancelled IS NULL
3372         ';
3373     my $sth = $dbh->prepare($query);
3374     $sth->execute($itemnumber);
3375     my @row = $sth->fetchrow_array();
3376     return @row;
3377 }
3378
3379 =head2 GetTransfersFromTo
3380
3381   @results = GetTransfersFromTo($frombranch,$tobranch);
3382
3383 Returns the list of pending transfers between $from and $to branch
3384
3385 =cut
3386
3387 sub GetTransfersFromTo {
3388     my ( $frombranch, $tobranch ) = @_;
3389     return unless ( $frombranch && $tobranch );
3390     my $dbh   = C4::Context->dbh;
3391     my $query = "
3392         SELECT branchtransfer_id,itemnumber,datesent,frombranch
3393         FROM   branchtransfers
3394         WHERE  frombranch=?
3395           AND  tobranch=?
3396           AND datecancelled IS NULL
3397           AND datesent IS NOT NULL
3398           AND datearrived IS NULL
3399     ";
3400     my $sth = $dbh->prepare($query);
3401     $sth->execute( $frombranch, $tobranch );
3402     my @gettransfers;
3403
3404     while ( my $data = $sth->fetchrow_hashref ) {
3405         push @gettransfers, $data;
3406     }
3407     return (@gettransfers);
3408 }
3409
3410 =head2 SendCirculationAlert
3411
3412 Send out a C<check-in> or C<checkout> alert using the messaging system.
3413
3414 B<Parameters>:
3415
3416 =over 4
3417
3418 =item type
3419
3420 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3421
3422 =item item
3423
3424 Hashref of information about the item being checked in or out.
3425
3426 =item borrower
3427
3428 Hashref of information about the borrower of the item.
3429
3430 =item branch
3431
3432 The branchcode from where the checkout or check-in took place.
3433
3434 =back
3435
3436 B<Example>:
3437
3438     SendCirculationAlert({
3439         type     => 'CHECKOUT',
3440         item     => $item,
3441         borrower => $borrower,
3442         branch   => $branch,
3443     });
3444
3445 =cut
3446
3447 sub SendCirculationAlert {
3448     my ($opts) = @_;
3449     my ($type, $item, $borrower, $branch) =
3450         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3451     my %message_name = (
3452         CHECKIN  => 'Item_Check_in',
3453         CHECKOUT => 'Item_Checkout',
3454         RENEWAL  => 'Item_Checkout',
3455     );
3456     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3457         borrowernumber => $borrower->{borrowernumber},
3458         message_name   => $message_name{$type},
3459     });
3460     my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3461
3462     my $schema = Koha::Database->new->schema;
3463     my @transports = keys %{ $borrower_preferences->{transports} };
3464
3465     # From the MySQL doc:
3466     # LOCK TABLES is not transaction-safe and implicitly commits any active transaction before attempting to lock the tables.
3467     # If the LOCK/UNLOCK statements are executed from tests, the current transaction will be committed.
3468     # To avoid that we need to guess if this code is execute from tests or not (yes it is a bit hacky)
3469     my $do_not_lock = ( exists $ENV{_} && $ENV{_} =~ m|prove| ) || $ENV{KOHA_TESTING};
3470
3471     for my $mtt (@transports) {
3472         my $letter =  C4::Letters::GetPreparedLetter (
3473             module => 'circulation',
3474             letter_code => $type,
3475             branchcode => $branch,
3476             message_transport_type => $mtt,
3477             lang => $borrower->{lang},
3478             tables => {
3479                 $issues_table => $item->{itemnumber},
3480                 'items'       => $item->{itemnumber},
3481                 'biblio'      => $item->{biblionumber},
3482                 'biblioitems' => $item->{biblionumber},
3483                 'borrowers'   => $borrower,
3484                 'branches'    => $branch,
3485             }
3486         ) or next;
3487
3488         C4::Context->dbh->do(q|LOCK TABLE message_queue READ|) unless $do_not_lock;
3489         C4::Context->dbh->do(q|LOCK TABLE message_queue WRITE|) unless $do_not_lock;
3490         my $message = C4::Message->find_last_message($borrower, $type, $mtt);
3491         unless ( $message ) {
3492             C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3493             C4::Message->enqueue($letter, $borrower, $mtt);
3494         } else {
3495             $message->append($letter);
3496             $message->update;
3497         }
3498         C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3499     }
3500
3501     return;
3502 }
3503
3504 =head2 updateWrongTransfer
3505
3506   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3507
3508 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
3509
3510 =cut
3511
3512 sub updateWrongTransfer {
3513         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3514
3515     # first step: cancel the original transfer
3516     my $item = Koha::Items->find($itemNumber);
3517     my $transfer = $item->get_transfer;
3518     $transfer->set({ datecancelled => dt_from_string, cancellation_reason => 'WrongTransfer' })->store();
3519
3520     # second step: create a new transfer to the right location
3521     my $new_transfer = $item->request_transfer(
3522         {
3523             to            => $transfer->to_library,
3524             reason        => $transfer->reason,
3525             comment       => $transfer->comments,
3526             ignore_limits => 1,
3527             enqueue       => 1
3528         }
3529     );
3530
3531     return $new_transfer;
3532 }
3533
3534 =head2 CalcDateDue
3535
3536 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3537
3538 this function calculates the due date given the start date and configured circulation rules,
3539 checking against the holidays calendar as per the daysmode circulation rule.
3540 C<$startdate>   = DateTime object representing start date of loan period (assumed to be today)
3541 C<$itemtype>  = itemtype code of item in question
3542 C<$branch>  = location whose calendar to use
3543 C<$borrower> = Borrower object
3544 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3545
3546 =cut
3547
3548 sub CalcDateDue {
3549     my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3550
3551     $isrenewal ||= 0;
3552
3553     # loanlength now a href
3554     my $loanlength =
3555             GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3556
3557     my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3558             ? qq{renewalperiod}
3559             : qq{issuelength};
3560
3561     my $datedue;
3562     if ( $startdate ) {
3563         if (ref $startdate ne 'DateTime' ) {
3564             $datedue = dt_from_string($datedue);
3565         } else {
3566             $datedue = $startdate->clone;
3567         }
3568     } else {
3569         $datedue = dt_from_string()->truncate( to => 'minute' );
3570     }
3571
3572
3573     my $daysmode = Koha::CirculationRules->get_effective_daysmode(
3574         {
3575             categorycode => $borrower->{categorycode},
3576             itemtype     => $itemtype,
3577             branchcode   => $branch,
3578         }
3579     );
3580
3581     # calculate the datedue as normal
3582     if ( $daysmode eq 'Days' )
3583     {    # ignoring calendar
3584         if ( $loanlength->{lengthunit} eq 'hours' ) {
3585             $datedue->add( hours => $loanlength->{$length_key} );
3586         } else {    # days
3587             $datedue->add( days => $loanlength->{$length_key} );
3588             $datedue->set_hour(23);
3589             $datedue->set_minute(59);
3590         }
3591     } else {
3592         my $dur;
3593         if ($loanlength->{lengthunit} eq 'hours') {
3594             $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3595         }
3596         else { # days
3597             $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3598         }
3599         my $calendar = Koha::Calendar->new( branchcode => $branch, days_mode => $daysmode );
3600         $datedue = $calendar->addDuration( $datedue, $dur, $loanlength->{lengthunit} );
3601         if ($loanlength->{lengthunit} eq 'days') {
3602             $datedue->set_hour(23);
3603             $datedue->set_minute(59);
3604         }
3605     }
3606
3607     # if Hard Due Dates are used, retrieve them and apply as necessary
3608     my ( $hardduedate, $hardduedatecompare ) =
3609       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3610     if ($hardduedate) {    # hardduedates are currently dates
3611         $hardduedate->truncate( to => 'minute' );
3612         $hardduedate->set_hour(23);
3613         $hardduedate->set_minute(59);
3614         my $cmp = DateTime->compare( $hardduedate, $datedue );
3615
3616 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3617 # if the calculated date is before the 'after' Hard Due Date (floor), override
3618 # if the hard due date is set to 'exactly', overrride
3619         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3620             $datedue = $hardduedate->clone;
3621         }
3622
3623         # in all other cases, keep the date due as it is
3624
3625     }
3626
3627     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3628     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3629         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3630         if( $expiry_dt ) { #skip empty expiry date..
3631             $expiry_dt->set( hour => 23, minute => 59);
3632             my $d1= $datedue->clone->set_time_zone('floating');
3633             if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3634                 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3635             }
3636         }
3637         if ( $daysmode ne 'Days' ) {
3638           my $calendar = Koha::Calendar->new( branchcode => $branch, days_mode => $daysmode );
3639           if ( $calendar->is_holiday($datedue) ) {
3640               # Don't return on a closed day
3641               $datedue = $calendar->prev_open_days( $datedue, 1 );
3642           }
3643         }
3644     }
3645
3646     return $datedue;
3647 }
3648
3649
3650 sub CheckValidBarcode{
3651 my ($barcode) = @_;
3652 my $dbh = C4::Context->dbh;
3653 my $query=qq|SELECT count(*)
3654              FROM items
3655              WHERE barcode=?
3656             |;
3657 my $sth = $dbh->prepare($query);
3658 $sth->execute($barcode);
3659 my $exist=$sth->fetchrow ;
3660 return $exist;
3661 }
3662
3663 =head2 IsBranchTransferAllowed
3664
3665   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3666
3667 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3668
3669 Deprecated in favor of Koha::Item::Transfer::Limits->find/search and
3670 Koha::Item->can_be_transferred.
3671
3672 =cut
3673
3674 sub IsBranchTransferAllowed {
3675         my ( $toBranch, $fromBranch, $code ) = @_;
3676
3677         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3678
3679         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3680         my $dbh = C4::Context->dbh;
3681
3682         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3683         $sth->execute( $toBranch, $fromBranch, $code );
3684         my $limit = $sth->fetchrow_hashref();
3685
3686         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3687         if ( $limit->{'limitId'} ) {
3688                 return 0;
3689         } else {
3690                 return 1;
3691         }
3692 }
3693
3694 =head2 CreateBranchTransferLimit
3695
3696   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3697
3698 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3699
3700 Deprecated in favor of Koha::Item::Transfer::Limit->new.
3701
3702 =cut
3703
3704 sub CreateBranchTransferLimit {
3705    my ( $toBranch, $fromBranch, $code ) = @_;
3706    return unless defined($toBranch) && defined($fromBranch);
3707    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3708
3709    my $dbh = C4::Context->dbh;
3710
3711    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3712    return $sth->execute( $code, $toBranch, $fromBranch );
3713 }
3714
3715 =head2 DeleteBranchTransferLimits
3716
3717     my $result = DeleteBranchTransferLimits($frombranch);
3718
3719 Deletes all the library transfer limits for one library.  Returns the
3720 number of limits deleted, 0e0 if no limits were deleted, or undef if
3721 no arguments are supplied.
3722
3723 Deprecated in favor of Koha::Item::Transfer::Limits->search({
3724     fromBranch => $fromBranch
3725     })->delete.
3726
3727 =cut
3728
3729 sub DeleteBranchTransferLimits {
3730     my $branch = shift;
3731     return unless defined $branch;
3732     my $dbh    = C4::Context->dbh;
3733     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3734     return $sth->execute($branch);
3735 }
3736
3737 sub ReturnLostItem{
3738     my ( $borrowernumber, $itemnum ) = @_;
3739     MarkIssueReturned( $borrowernumber, $itemnum );
3740 }
3741
3742 =head2 LostItem
3743
3744   LostItem( $itemnumber, $mark_lost_from, $force_mark_returned, [$params] );
3745
3746 The final optional parameter, C<$params>, expected to contain
3747 'skip_record_index' key, which relayed down to Koha::Item/store,
3748 there it prevents calling of ModZebra index_records,
3749 which takes most of the time in batch adds/deletes: index_records better
3750 to be called later in C<additem.pl> after the whole loop.
3751
3752 $params:
3753     skip_record_index => 1|0
3754
3755 =cut
3756
3757 sub LostItem{
3758     my ($itemnumber, $mark_lost_from, $force_mark_returned, $params) = @_;
3759
3760     unless ( $mark_lost_from ) {
3761         # Temporary check to avoid regressions
3762         die q|LostItem called without $mark_lost_from, check the API.|;
3763     }
3764
3765     my $mark_returned;
3766     if ( $force_mark_returned ) {
3767         $mark_returned = 1;
3768     } else {
3769         my $pref = C4::Context->preference('MarkLostItemsAsReturned') // q{};
3770         $mark_returned = ( $pref =~ m|$mark_lost_from| );
3771     }
3772
3773     my $dbh = C4::Context->dbh();
3774     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3775                            FROM issues
3776                            JOIN items USING (itemnumber)
3777                            JOIN biblio USING (biblionumber)
3778                            WHERE issues.itemnumber=?");
3779     $sth->execute($itemnumber);
3780     my $issues=$sth->fetchrow_hashref();
3781
3782     # If a borrower lost the item, add a replacement cost to the their record
3783     if ( my $borrowernumber = $issues->{borrowernumber} ){
3784         my $patron = Koha::Patrons->find( $borrowernumber );
3785
3786         my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, C4::Context->preference('WhenLostForgiveFine'), 'LOST');
3787         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!";  # zero is OK, check defined
3788
3789         if (C4::Context->preference('WhenLostChargeReplacementFee')){
3790             C4::Accounts::chargelostitem(
3791                 $borrowernumber,
3792                 $itemnumber,
3793                 $issues->{'replacementprice'},
3794                 sprintf( "%s %s %s",
3795                     $issues->{'title'}          || q{},
3796                     $issues->{'barcode'}        || q{},
3797                     $issues->{'itemcallnumber'} || q{},
3798                 ),
3799             );
3800             #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3801             #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3802         }
3803
3804         MarkIssueReturned($borrowernumber,$itemnumber,undef,$patron->privacy,$params) if $mark_returned;
3805     }
3806
3807     # When an item is marked as lost, we should automatically cancel its outstanding transfers.
3808     my $item = Koha::Items->find($itemnumber);
3809     my $transfers = $item->get_transfers;
3810     while (my $transfer = $transfers->next) {
3811         $transfer->cancel({ reason => 'ItemLost', force => 1 });
3812     }
3813 }
3814
3815 sub GetOfflineOperations {
3816     my $dbh = C4::Context->dbh;
3817     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3818     $sth->execute(C4::Context->userenv->{'branch'});
3819     my $results = $sth->fetchall_arrayref({});
3820     return $results;
3821 }
3822
3823 sub GetOfflineOperation {
3824     my $operationid = shift;
3825     return unless $operationid;
3826     my $dbh = C4::Context->dbh;
3827     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3828     $sth->execute( $operationid );
3829     return $sth->fetchrow_hashref;
3830 }
3831
3832 sub AddOfflineOperation {
3833     my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3834     my $dbh = C4::Context->dbh;
3835     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3836     $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3837     return "Added.";
3838 }
3839
3840 sub DeleteOfflineOperation {
3841     my $dbh = C4::Context->dbh;
3842     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3843     $sth->execute( shift );
3844     return "Deleted.";
3845 }
3846
3847 sub ProcessOfflineOperation {
3848     my $operation = shift;
3849
3850     my $report;
3851     if ( $operation->{action} eq 'return' ) {
3852         $report = ProcessOfflineReturn( $operation );
3853     } elsif ( $operation->{action} eq 'issue' ) {
3854         $report = ProcessOfflineIssue( $operation );
3855     } elsif ( $operation->{action} eq 'payment' ) {
3856         $report = ProcessOfflinePayment( $operation );
3857     }
3858
3859     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3860
3861     return $report;
3862 }
3863
3864 sub ProcessOfflineReturn {
3865     my $operation = shift;
3866
3867     my $item = Koha::Items->find({barcode => $operation->{barcode}});
3868
3869     if ( $item ) {
3870         my $itemnumber = $item->itemnumber;
3871         my $issue = GetOpenIssue( $itemnumber );
3872         if ( $issue ) {
3873             my $leave_item_lost = C4::Context->preference("BlockReturnOfLostItems") ? 1 : 0;
3874             ModDateLastSeen( $itemnumber, $leave_item_lost );
3875             MarkIssueReturned(
3876                 $issue->{borrowernumber},
3877                 $itemnumber,
3878                 $operation->{timestamp},
3879             );
3880             $item->renewals(0);
3881             $item->onloan(undef);
3882             $item->store({ log_action => 0 });
3883             return "Success.";
3884         } else {
3885             return "Item not issued.";
3886         }
3887     } else {
3888         return "Item not found.";
3889     }
3890 }
3891
3892 sub ProcessOfflineIssue {
3893     my $operation = shift;
3894
3895     my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} } );
3896
3897     if ( $patron ) {
3898         my $item = Koha::Items->find({ barcode => $operation->{barcode} });
3899         unless ($item) {
3900             return "Barcode not found.";
3901         }
3902         my $itemnumber = $item->itemnumber;
3903         my $issue = GetOpenIssue( $itemnumber );
3904
3905         if ( $issue and ( $issue->{borrowernumber} ne $patron->borrowernumber ) ) { # Item already issued to another patron mark it returned
3906             MarkIssueReturned(
3907                 $issue->{borrowernumber},
3908                 $itemnumber,
3909                 $operation->{timestamp},
3910             );
3911         }
3912         AddIssue(
3913             $patron->unblessed,
3914             $operation->{'barcode'},
3915             undef,
3916             1,
3917             $operation->{timestamp},
3918             undef,
3919         );
3920         return "Success.";
3921     } else {
3922         return "Borrower not found.";
3923     }
3924 }
3925
3926 sub ProcessOfflinePayment {
3927     my $operation = shift;
3928
3929     my $patron = Koha::Patrons->find({ cardnumber => $operation->{cardnumber} });
3930
3931     $patron->account->pay(
3932         {
3933             amount     => $operation->{amount},
3934             library_id => $operation->{branchcode},
3935             interface  => 'koc'
3936         }
3937     );
3938
3939     return "Success.";
3940 }
3941
3942 =head2 TransferSlip
3943
3944   TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3945
3946   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3947
3948 =cut
3949
3950 sub TransferSlip {
3951     my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3952
3953     my $item =
3954       $itemnumber
3955       ? Koha::Items->find($itemnumber)
3956       : Koha::Items->find( { barcode => $barcode } );
3957
3958     $item or return;
3959
3960     return C4::Letters::GetPreparedLetter (
3961         module => 'circulation',
3962         letter_code => 'TRANSFERSLIP',
3963         branchcode => $branch,
3964         tables => {
3965             'branches'    => $to_branch,
3966             'biblio'      => $item->biblionumber,
3967             'items'       => $item->unblessed,
3968         },
3969     );
3970 }
3971
3972 =head2 CheckIfIssuedToPatron
3973
3974   CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3975
3976   Return 1 if any record item is issued to patron, otherwise return 0
3977
3978 =cut
3979
3980 sub CheckIfIssuedToPatron {
3981     my ($borrowernumber, $biblionumber) = @_;
3982
3983     my $dbh = C4::Context->dbh;
3984     my $query = q|
3985         SELECT COUNT(*) FROM issues
3986         LEFT JOIN items ON items.itemnumber = issues.itemnumber
3987         WHERE items.biblionumber = ?
3988         AND issues.borrowernumber = ?
3989     |;
3990     my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3991     return 1 if $is_issued;
3992     return;
3993 }
3994
3995 =head2 IsItemIssued
3996
3997   IsItemIssued( $itemnumber )
3998
3999   Return 1 if the item is on loan, otherwise return 0
4000
4001 =cut
4002
4003 sub IsItemIssued {
4004     my $itemnumber = shift;
4005     my $dbh = C4::Context->dbh;
4006     my $sth = $dbh->prepare(q{
4007         SELECT COUNT(*)
4008         FROM issues
4009         WHERE itemnumber = ?
4010     });
4011     $sth->execute($itemnumber);
4012     return $sth->fetchrow;
4013 }
4014
4015 =head2 GetAgeRestriction
4016
4017   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
4018   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
4019
4020   if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as they are older or as old as the agerestriction }
4021   if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
4022
4023 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
4024 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
4025 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
4026          Negative days mean the borrower has gone past the age restriction age.
4027
4028 =cut
4029
4030 sub GetAgeRestriction {
4031     my ($record_restrictions, $borrower) = @_;
4032     my $markers = C4::Context->preference('AgeRestrictionMarker');
4033
4034     return unless $record_restrictions;
4035     # Split $record_restrictions to something like FSK 16 or PEGI 6
4036     my @values = split ' ', uc($record_restrictions);
4037     return unless @values;
4038
4039     # Search first occurrence of one of the markers
4040     my @markers = split /\|/, uc($markers);
4041     return unless @markers;
4042
4043     my $index            = 0;
4044     my $restriction_year = 0;
4045     for my $value (@values) {
4046         $index++;
4047         for my $marker (@markers) {
4048             $marker =~ s/^\s+//;    #remove leading spaces
4049             $marker =~ s/\s+$//;    #remove trailing spaces
4050             if ( $marker eq $value ) {
4051                 if ( $index <= $#values ) {
4052                     $restriction_year += $values[$index];
4053                 }
4054                 last;
4055             }
4056             elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
4057
4058                 # Perhaps it is something like "K16" (as in Finland)
4059                 $restriction_year += $1;
4060                 last;
4061             }
4062         }
4063         last if ( $restriction_year > 0 );
4064     }
4065
4066     #Check if the borrower is age restricted for this material and for how long.
4067     if ($restriction_year && $borrower) {
4068         if ( $borrower->{'dateofbirth'} ) {
4069             my @alloweddate = split /-/, $borrower->{'dateofbirth'};
4070             $alloweddate[0] += $restriction_year;
4071
4072             #Prevent runime eror on leap year (invalid date)
4073             if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
4074                 $alloweddate[2] = 28;
4075             }
4076
4077             #Get how many days the borrower has to reach the age restriction
4078             my @Today = split /-/, dt_from_string()->ymd();
4079             my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
4080             #Negative days means the borrower went past the age restriction age
4081             return ($restriction_year, $daysToAgeRestriction);
4082         }
4083     }
4084
4085     return ($restriction_year);
4086 }
4087
4088
4089 =head2 GetPendingOnSiteCheckouts
4090
4091 =cut
4092
4093 sub GetPendingOnSiteCheckouts {
4094     my $dbh = C4::Context->dbh;
4095     return $dbh->selectall_arrayref(q|
4096         SELECT
4097           items.barcode,
4098           items.biblionumber,
4099           items.itemnumber,
4100           items.itemnotes,
4101           items.itemcallnumber,
4102           items.location,
4103           issues.date_due,
4104           issues.branchcode,
4105           issues.date_due < NOW() AS is_overdue,
4106           biblio.author,
4107           biblio.title,
4108           borrowers.firstname,
4109           borrowers.surname,
4110           borrowers.cardnumber,
4111           borrowers.borrowernumber
4112         FROM items
4113         LEFT JOIN issues ON items.itemnumber = issues.itemnumber
4114         LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
4115         LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
4116         WHERE issues.onsite_checkout = 1
4117     |, { Slice => {} } );
4118 }
4119
4120 sub GetTopIssues {
4121     my ($params) = @_;
4122
4123     my ($count, $branch, $itemtype, $ccode, $newness)
4124         = @$params{qw(count branch itemtype ccode newness)};
4125
4126     my $dbh = C4::Context->dbh;
4127     my $query = q{
4128         SELECT * FROM (
4129         SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4130           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4131           i.ccode, SUM(i.issues) AS count
4132         FROM biblio b
4133         LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4134         LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4135     };
4136
4137     my (@where_strs, @where_args);
4138
4139     if ($branch) {
4140         push @where_strs, 'i.homebranch = ?';
4141         push @where_args, $branch;
4142     }
4143     if ($itemtype) {
4144         if (C4::Context->preference('item-level_itypes')){
4145             push @where_strs, 'i.itype = ?';
4146             push @where_args, $itemtype;
4147         } else {
4148             push @where_strs, 'bi.itemtype = ?';
4149             push @where_args, $itemtype;
4150         }
4151     }
4152     if ($ccode) {
4153         push @where_strs, 'i.ccode = ?';
4154         push @where_args, $ccode;
4155     }
4156     if ($newness) {
4157         push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4158         push @where_args, $newness;
4159     }
4160
4161     if (@where_strs) {
4162         $query .= 'WHERE ' . join(' AND ', @where_strs);
4163     }
4164
4165     $query .= q{
4166         GROUP BY b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4167           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4168           i.ccode
4169         ORDER BY count DESC
4170     };
4171
4172     $query .= q{ ) xxx WHERE count > 0 };
4173     $count = int($count);
4174     if ($count > 0) {
4175         $query .= "LIMIT $count";
4176     }
4177
4178     my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4179
4180     return @$rows;
4181 }
4182
4183 =head2 Internal methods
4184
4185 =cut
4186
4187 sub _CalculateAndUpdateFine {
4188     my ($params) = @_;
4189
4190     my $borrower    = $params->{borrower};
4191     my $item        = $params->{item};
4192     my $issue       = $params->{issue};
4193     my $return_date = $params->{return_date};
4194
4195     unless ($borrower) { carp "No borrower passed in!" && return; }
4196     unless ($item)     { carp "No item passed in!"     && return; }
4197     unless ($issue)    { carp "No issue passed in!"    && return; }
4198
4199     my $datedue = dt_from_string( $issue->date_due );
4200
4201     # we only need to calculate and change the fines if we want to do that on return
4202     # Should be on for hourly loans
4203     my $control = C4::Context->preference('CircControl');
4204     my $control_branchcode =
4205         ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4206       : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
4207       :                                     $issue->branchcode;
4208
4209     my $date_returned = $return_date ? $return_date : dt_from_string();
4210
4211     my ( $amount, $unitcounttotal, $unitcount  ) =
4212       C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4213
4214     if ( C4::Context->preference('finesMode') eq 'production' ) {
4215         if ( $amount > 0 ) {
4216             C4::Overdues::UpdateFine({
4217                 issue_id       => $issue->issue_id,
4218                 itemnumber     => $issue->itemnumber,
4219                 borrowernumber => $issue->borrowernumber,
4220                 amount         => $amount,
4221                 due            => output_pref($datedue),
4222             });
4223         }
4224         elsif ($return_date) {
4225
4226             # Backdated returns may have fines that shouldn't exist,
4227             # so in this case, we need to drop those fines to 0
4228
4229             C4::Overdues::UpdateFine({
4230                 issue_id       => $issue->issue_id,
4231                 itemnumber     => $issue->itemnumber,
4232                 borrowernumber => $issue->borrowernumber,
4233                 amount         => 0,
4234                 due            => output_pref($datedue),
4235             });
4236         }
4237     }
4238 }
4239
4240 sub _CanBookBeAutoRenewed {
4241     my ( $borrowernumber, $itemnumber ) = @_;
4242
4243     my $item = Koha::Items->find($itemnumber);
4244     my $issue = $item->checkout;
4245     my $patron = $issue->patron;
4246     my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
4247
4248     my $issuing_rule = Koha::CirculationRules->get_effective_rules(
4249         {
4250             categorycode => $patron->categorycode,
4251             itemtype     => $item->effective_itemtype,
4252             branchcode   => $branchcode,
4253             rules => [
4254                 'no_auto_renewal_after',
4255                 'no_auto_renewal_after_hard_limit',
4256                 'lengthunit',
4257                 'norenewalbefore',
4258             ]
4259         }
4260     );
4261
4262     if ( $issue->auto_renew && $patron->autorenew_checkouts ) {
4263
4264         if ( $patron->category->effective_BlockExpiredPatronOpacActions and $patron->is_expired ) {
4265             return 'auto_account_expired';
4266         }
4267
4268         if ( defined $issuing_rule->{no_auto_renewal_after}
4269                 and $issuing_rule->{no_auto_renewal_after} ne "" ) {
4270             # Get issue_date and add no_auto_renewal_after
4271             # If this is greater than today, it's too late for renewal.
4272             my $maximum_renewal_date = dt_from_string($issue->issuedate, 'sql');
4273             $maximum_renewal_date->add(
4274                 $issuing_rule->{lengthunit} => $issuing_rule->{no_auto_renewal_after}
4275             );
4276             my $now = dt_from_string;
4277             if ( $now >= $maximum_renewal_date ) {
4278                 return "auto_too_late";
4279             }
4280         }
4281         if ( defined $issuing_rule->{no_auto_renewal_after_hard_limit}
4282                       and $issuing_rule->{no_auto_renewal_after_hard_limit} ne "" ) {
4283             # If no_auto_renewal_after_hard_limit is >= today, it's also too late for renewal
4284             if ( dt_from_string >= dt_from_string( $issuing_rule->{no_auto_renewal_after_hard_limit} ) ) {
4285                 return "auto_too_late";
4286             }
4287         }
4288
4289         if ( C4::Context->preference('OPACFineNoRenewalsBlockAutoRenew') ) {
4290             my $fine_no_renewals = C4::Context->preference("OPACFineNoRenewals");
4291             my $amountoutstanding =
4292               C4::Context->preference("OPACFineNoRenewalsIncludeCredit")
4293               ? $patron->account->balance
4294               : $patron->account->outstanding_debits->total_outstanding;
4295             if ( $amountoutstanding and $amountoutstanding > $fine_no_renewals ) {
4296                 return "auto_too_much_oweing";
4297             }
4298         }
4299     }
4300
4301     if ( defined $issuing_rule->{norenewalbefore}
4302         and $issuing_rule->{norenewalbefore} ne "" )
4303     {
4304
4305         # Calculate soonest renewal by subtracting 'No renewal before' from due date
4306         my $soonestrenewal = dt_from_string( $issue->date_due, 'sql' )->subtract(
4307             $issuing_rule->{lengthunit} => $issuing_rule->{norenewalbefore} );
4308
4309         # Depending on syspref reset the exact time, only check the date
4310         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
4311             and $issuing_rule->{lengthunit} eq 'days' )
4312         {
4313             $soonestrenewal->truncate( to => 'day' );
4314         }
4315
4316         if ( $soonestrenewal > dt_from_string() )
4317         {
4318             return ($issue->auto_renew && $patron->autorenew_checkouts) ? "auto_too_soon" : "too_soon";
4319         }
4320         elsif ( $issue->auto_renew && $patron->autorenew_checkouts ) {
4321             return "ok";
4322         }
4323     }
4324
4325     # Fallback for automatic renewals:
4326     # If norenewalbefore is undef, don't renew before due date.
4327     if ( $issue->auto_renew && $patron->autorenew_checkouts ) {
4328         my $now = dt_from_string;
4329         if ( $now >= dt_from_string( $issue->date_due, 'sql' ) ){
4330             return "ok";
4331         } else {
4332             return "auto_too_soon";
4333         }
4334     }
4335     return "no";
4336 }
4337
4338 sub _item_denied_renewal {
4339     my ($params) = @_;
4340
4341     my $item = $params->{item};
4342     return unless $item;
4343
4344     my $denyingrules = Koha::Config::SysPrefs->find('ItemsDeniedRenewal')->get_yaml_pref_hash();
4345     return unless $denyingrules;
4346     foreach my $field (keys %$denyingrules) {
4347         my $val = $item->$field;
4348         if( !defined $val) {
4349             if ( any { !defined $_ }  @{$denyingrules->{$field}} ){
4350                 return 1;
4351             }
4352         } elsif (any { defined($_) && $val eq $_ } @{$denyingrules->{$field}}) {
4353            # If the results matches the values in the syspref
4354            # We return true if match found
4355             return 1;
4356         }
4357     }
4358     return 0;
4359 }
4360
4361 1;
4362
4363 __END__
4364
4365 =head1 AUTHOR
4366
4367 Koha Development Team <http://koha-community.org/>
4368
4369 =cut