C4/Circulation.pm

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