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