C4/Circulation.pm

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