C4/Circulation.pm

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