C4/Circulation.pm

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