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