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