C4/Circulation.pm

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