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