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,
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  = Koha::Checkouts->find( { itemnumber => $itemnumber } );
1827     if ( $issue ) {
1828         $patron = Koha::Patrons->find( $issue->borrowernumber )
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 = Koha::Checkouts->find( { itemnumber => $itemnumber } ) 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
2624     $borrowernumber ||= $issue->borrowernumber;
2625     my $patron = Koha::Patrons->find( $borrowernumber )
2626       or return;
2627
2628     my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2629
2630     # This item can fill one or more unfilled reserve, can those unfilled reserves
2631     # all be filled by other available items?
2632     if ( $resfound
2633         && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2634     {
2635         my $schema = Koha::Database->new()->schema();
2636
2637         my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2638         if ($item_holds) {
2639             # There is an item level hold on this item, no other item can fill the hold
2640             $resfound = 1;
2641         }
2642         else {
2643
2644             # Get all other items that could possibly fill reserves
2645             my @itemnumbers = $schema->resultset('Item')->search(
2646                 {
2647                     biblionumber => $resrec->{biblionumber},
2648                     onloan       => undef,
2649                     notforloan   => 0,
2650                     -not         => { itemnumber => $itemnumber }
2651                 },
2652                 { columns => 'itemnumber' }
2653             )->get_column('itemnumber')->all();
2654
2655             # Get all other reserves that could have been filled by this item
2656             my @borrowernumbers;
2657             while (1) {
2658                 my ( $reserve_found, $reserve, undef ) =
2659                   C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2660
2661                 if ($reserve_found) {
2662                     push( @borrowernumbers, $reserve->{borrowernumber} );
2663                 }
2664                 else {
2665                     last;
2666                 }
2667             }
2668
2669             # If the count of the union of the lists of reservable items for each borrower
2670             # is equal or greater than the number of borrowers, we know that all reserves
2671             # can be filled with available items. We can get the union of the sets simply
2672             # by pushing all the elements onto an array and removing the duplicates.
2673             my @reservable;
2674             my %borrowers;
2675             ITEM: foreach my $i (@itemnumbers) {
2676                 my $item = Koha::Items->find($i)->unblessed;
2677                 next if IsItemOnHoldAndFound($i);
2678                 for my $b (@borrowernumbers) {
2679                     my $borr = $borrowers{$b} //= Koha::Patrons->find( $b )->unblessed;
2680                     next unless IsAvailableForItemLevelRequest($item, $borr);
2681                     next unless CanItemBeReserved($b,$i);
2682
2683                     push @reservable, $i;
2684                     if (@reservable >= @borrowernumbers) {
2685                         $resfound = 0;
2686                         last ITEM;
2687                     }
2688                     last;
2689                 }
2690             }
2691         }
2692     }
2693     return ( 0, "on_reserve" ) if $resfound;    # '' when no hold was found
2694
2695     return ( 1, undef ) if $override_limit;
2696
2697     my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
2698     my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2699         {   categorycode => $patron->categorycode,
2700             itemtype     => $item->effective_itemtype,
2701             branchcode   => $branchcode
2702         }
2703     );
2704
2705     return ( 0, "too_many" )
2706       if not $issuing_rule or $issuing_rule->renewalsallowed <= $issue->renewals;
2707
2708     my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2709     my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2710     $patron         = Koha::Patrons->find($borrowernumber); # FIXME Is this really useful?
2711     my $restricted  = $patron->is_debarred;
2712     my $hasoverdues = $patron->has_overdues;
2713
2714     if ( $restricted and $restrictionblockrenewing ) {
2715         return ( 0, 'restriction');
2716     } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($issue->is_overdue and $overduesblockrenewing eq 'blockitem') ) {
2717         return ( 0, 'overdue');
2718     }
2719
2720     if ( $issue->auto_renew ) {
2721
2722         if ( $patron->category->effective_BlockExpiredPatronOpacActions and $patron->is_expired ) {
2723             return ( 0, 'auto_account_expired' );
2724         }
2725
2726         if ( defined $issuing_rule->no_auto_renewal_after
2727                 and $issuing_rule->no_auto_renewal_after ne "" ) {
2728             # Get issue_date and add no_auto_renewal_after
2729             # If this is greater than today, it's too late for renewal.
2730             my $maximum_renewal_date = dt_from_string($issue->issuedate, 'sql');
2731             $maximum_renewal_date->add(
2732                 $issuing_rule->lengthunit => $issuing_rule->no_auto_renewal_after
2733             );
2734             my $now = dt_from_string;
2735             if ( $now >= $maximum_renewal_date ) {
2736                 return ( 0, "auto_too_late" );
2737             }
2738         }
2739         if ( defined $issuing_rule->no_auto_renewal_after_hard_limit
2740                       and $issuing_rule->no_auto_renewal_after_hard_limit ne "" ) {
2741             # If no_auto_renewal_after_hard_limit is >= today, it's also too late for renewal
2742             if ( dt_from_string >= dt_from_string( $issuing_rule->no_auto_renewal_after_hard_limit ) ) {
2743                 return ( 0, "auto_too_late" );
2744             }
2745         }
2746
2747         if ( C4::Context->preference('OPACFineNoRenewalsBlockAutoRenew') ) {
2748             my $fine_no_renewals = C4::Context->preference("OPACFineNoRenewals");
2749             my $amountoutstanding = $patron->account->balance;
2750             if ( $amountoutstanding and $amountoutstanding > $fine_no_renewals ) {
2751                 return ( 0, "auto_too_much_oweing" );
2752             }
2753         }
2754     }
2755
2756     if ( defined $issuing_rule->norenewalbefore
2757         and $issuing_rule->norenewalbefore ne "" )
2758     {
2759
2760         # Calculate soonest renewal by subtracting 'No renewal before' from due date
2761         my $soonestrenewal = dt_from_string( $issue->date_due, 'sql' )->subtract(
2762             $issuing_rule->lengthunit => $issuing_rule->norenewalbefore );
2763
2764         # Depending on syspref reset the exact time, only check the date
2765         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2766             and $issuing_rule->lengthunit eq 'days' )
2767         {
2768             $soonestrenewal->truncate( to => 'day' );
2769         }
2770
2771         if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
2772         {
2773             return ( 0, "auto_too_soon" ) if $issue->auto_renew;
2774             return ( 0, "too_soon" );
2775         }
2776         elsif ( $issue->auto_renew ) {
2777             return ( 0, "auto_renew" );
2778         }
2779     }
2780
2781     # Fallback for automatic renewals:
2782     # If norenewalbefore is undef, don't renew before due date.
2783     if ( $issue->auto_renew ) {
2784         my $now = dt_from_string;
2785         return ( 0, "auto_renew" )
2786           if $now >= dt_from_string( $issue->date_due, 'sql' );
2787         return ( 0, "auto_too_soon" );
2788     }
2789
2790     return ( 1, undef );
2791 }
2792
2793 =head2 AddRenewal
2794
2795   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2796
2797 Renews a loan.
2798
2799 C<$borrowernumber> is the borrower number of the patron who currently
2800 has the item.
2801
2802 C<$itemnumber> is the number of the item to renew.
2803
2804 C<$branch> is the library where the renewal took place (if any).
2805            The library that controls the circ policies for the renewal is retrieved from the issues record.
2806
2807 C<$datedue> can be a DateTime object used to set the due date.
2808
2809 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2810 this parameter is not supplied, lastreneweddate is set to the current date.
2811
2812 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2813 from the book's item type.
2814
2815 =cut
2816
2817 sub AddRenewal {
2818     my $borrowernumber  = shift;
2819     my $itemnumber      = shift or return;
2820     my $branch          = shift;
2821     my $datedue         = shift;
2822     my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz);
2823
2824     my $item   = Koha::Items->find($itemnumber) or return;
2825     my $biblio = $item->biblio;
2826     my $issue  = $item->checkout;
2827     my $item_unblessed = $item->unblessed;
2828
2829     my $dbh = C4::Context->dbh;
2830
2831     return unless $issue;
2832
2833     $borrowernumber ||= $issue->borrowernumber;
2834
2835     if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2836         carp 'Invalid date passed to AddRenewal.';
2837         return;
2838     }
2839
2840     my $patron = Koha::Patrons->find( $borrowernumber ) or return; # FIXME Should do more than just return
2841     my $patron_unblessed = $patron->unblessed;
2842
2843     if ( C4::Context->preference('CalculateFinesOnReturn') && $issue->is_overdue ) {
2844         _CalculateAndUpdateFine( { issue => $issue, item => $item_unblessed, borrower => $patron_unblessed } );
2845     }
2846     _FixOverduesOnReturn( $borrowernumber, $itemnumber );
2847
2848     # If the due date wasn't specified, calculate it by adding the
2849     # book's loan length to today's date or the current due date
2850     # based on the value of the RenewalPeriodBase syspref.
2851     unless ($datedue) {
2852
2853         my $itemtype = $item->effective_itemtype;
2854         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2855                                         dt_from_string( $issue->date_due, 'sql' ) :
2856                                         DateTime->now( time_zone => C4::Context->tz());
2857         $datedue =  CalcDateDue($datedue, $itemtype, _GetCircControlBranch($item_unblessed, $patron_unblessed), $patron_unblessed, 'is a renewal');
2858     }
2859
2860     # Update the issues record to have the new due date, and a new count
2861     # of how many times it has been renewed.
2862     my $renews = $issue->renewals + 1;
2863     my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2864                             WHERE borrowernumber=?
2865                             AND itemnumber=?"
2866     );
2867
2868     $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2869
2870     # Update the renewal count on the item, and tell zebra to reindex
2871     $renews = $item->renewals + 1;
2872     ModItem( { renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $item->biblionumber, $itemnumber, { log_action => 0 } );
2873
2874     # Charge a new rental fee, if applicable?
2875     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2876     if ( $charge > 0 ) {
2877         my $accountno = C4::Accounts::getnextacctno( $borrowernumber );
2878         my $manager_id = 0;
2879         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2880         my $branchcode = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
2881         Koha::Account::Line->new(
2882             {
2883                 date              => dt_from_string(),
2884                 borrowernumber    => $borrowernumber,
2885                 accountno         => $accountno,
2886                 amount            => $charge,
2887                 manager_id        => $manager_id,
2888                 accounttype       => 'Rent',
2889                 amountoutstanding => $charge,
2890                 itemnumber        => $itemnumber,
2891                 branchcode        => $branchcode,
2892                 description       => 'Renewal of Rental Item '
2893                   . $biblio->title
2894                   . " $item->barcode",
2895             }
2896         )->store();
2897     }
2898
2899     # Send a renewal slip according to checkout alert preferencei
2900     if ( C4::Context->preference('RenewalSendNotice') eq '1' ) {
2901         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2902         my %conditions        = (
2903             branchcode   => $branch,
2904             categorycode => $patron->categorycode,
2905             item_type    => $item->effective_itemtype,
2906             notification => 'CHECKOUT',
2907         );
2908         if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
2909             SendCirculationAlert(
2910                 {
2911                     type     => 'RENEWAL',
2912                     item     => $item_unblessed,
2913                     borrower => $patron->unblessed,
2914                     branch   => $branch,
2915                 }
2916             );
2917         }
2918     }
2919
2920     # Remove any OVERDUES related debarment if the borrower has no overdues
2921     if ( $patron
2922       && $patron->is_debarred
2923       && ! $patron->has_overdues
2924       && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2925     ) {
2926         DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2927     }
2928
2929     unless ( C4::Context->interface eq 'opac' ) { #if from opac we are obeying OpacRenewalBranch as calculated in opac-renew.pl
2930         $branch = C4::Context->userenv ? C4::Context->userenv->{branch} : $branch;
2931     }
2932
2933     # Add the renewal to stats
2934     UpdateStats(
2935         {
2936             branch         => $branch,
2937             type           => 'renew',
2938             amount         => $charge,
2939             itemnumber     => $itemnumber,
2940             itemtype       => $item->effective_itemtype,
2941             location       => $item->location,
2942             borrowernumber => $borrowernumber,
2943             ccode          => $item->ccode,
2944         }
2945     );
2946
2947     #Log the renewal
2948     logaction("CIRCULATION", "RENEWAL", $borrowernumber, $itemnumber) if C4::Context->preference("RenewalLog");
2949     return $datedue;
2950 }
2951
2952 sub GetRenewCount {
2953     # check renewal status
2954     my ( $bornum, $itemno ) = @_;
2955     my $dbh           = C4::Context->dbh;
2956     my $renewcount    = 0;
2957     my $renewsallowed = 0;
2958     my $renewsleft    = 0;
2959
2960     my $patron = Koha::Patrons->find( $bornum );
2961     my $item   = Koha::Items->find($itemno);
2962
2963     return (0, 0, 0) unless $patron or $item; # Wrong call, no renewal allowed
2964
2965     # Look in the issues table for this item, lent to this borrower,
2966     # and not yet returned.
2967
2968     # FIXME - I think this function could be redone to use only one SQL call.
2969     my $sth = $dbh->prepare(
2970         "select * from issues
2971                                 where (borrowernumber = ?)
2972                                 and (itemnumber = ?)"
2973     );
2974     $sth->execute( $bornum, $itemno );
2975     my $data = $sth->fetchrow_hashref;
2976     $renewcount = $data->{'renewals'} if $data->{'renewals'};
2977     # $item and $borrower should be calculated
2978     my $branchcode = _GetCircControlBranch($item->unblessed, $patron->unblessed);
2979
2980     my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2981         {   categorycode => $patron->categorycode,
2982             itemtype     => $item->effective_itemtype,
2983             branchcode   => $branchcode
2984         }
2985     );
2986
2987     $renewsallowed = $issuing_rule ? $issuing_rule->renewalsallowed : 0;
2988     $renewsleft    = $renewsallowed - $renewcount;
2989     if($renewsleft < 0){ $renewsleft = 0; }
2990     return ( $renewcount, $renewsallowed, $renewsleft );
2991 }
2992
2993 =head2 GetSoonestRenewDate
2994
2995   $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
2996
2997 Find out the soonest possible renew date of a borrowed item.
2998
2999 C<$borrowernumber> is the borrower number of the patron who currently
3000 has the item on loan.
3001
3002 C<$itemnumber> is the number of the item to renew.
3003
3004 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3005 renew date, based on the value "No renewal before" of the applicable
3006 issuing rule. Returns the current date if the item can already be
3007 renewed, and returns undefined if the borrower, loan, or item
3008 cannot be found.
3009
3010 =cut
3011
3012 sub GetSoonestRenewDate {
3013     my ( $borrowernumber, $itemnumber ) = @_;
3014
3015     my $dbh = C4::Context->dbh;
3016
3017     my $item      = Koha::Items->find($itemnumber)      or return;
3018     my $itemissue = $item->checkout or return;
3019
3020     $borrowernumber ||= $itemissue->borrowernumber;
3021     my $patron = Koha::Patrons->find( $borrowernumber )
3022       or return;
3023
3024     my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
3025     my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
3026         {   categorycode => $patron->categorycode,
3027             itemtype     => $item->effective_itemtype,
3028             branchcode   => $branchcode
3029         }
3030     );
3031
3032     my $now = dt_from_string;
3033     return $now unless $issuing_rule;
3034
3035     if ( defined $issuing_rule->norenewalbefore
3036         and $issuing_rule->norenewalbefore ne "" )
3037     {
3038         my $soonestrenewal =
3039           dt_from_string( $itemissue->date_due )->subtract(
3040             $issuing_rule->lengthunit => $issuing_rule->norenewalbefore );
3041
3042         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3043             and $issuing_rule->lengthunit eq 'days' )
3044         {
3045             $soonestrenewal->truncate( to => 'day' );
3046         }
3047         return $soonestrenewal if $now < $soonestrenewal;
3048     }
3049     return $now;
3050 }
3051
3052 =head2 GetLatestAutoRenewDate
3053
3054   $NoAutoRenewalAfterThisDate = &GetLatestAutoRenewDate($borrowernumber, $itemnumber);
3055
3056 Find out the latest possible auto renew date of a borrowed item.
3057
3058 C<$borrowernumber> is the borrower number of the patron who currently
3059 has the item on loan.
3060
3061 C<$itemnumber> is the number of the item to renew.
3062
3063 C<$GetLatestAutoRenewDate> returns the DateTime of the latest possible
3064 auto renew date, based on the value "No auto renewal after" and the "No auto
3065 renewal after (hard limit) of the applicable issuing rule.
3066 Returns undef if there is no date specify in the circ rules or if the patron, loan,
3067 or item cannot be found.
3068
3069 =cut
3070
3071 sub GetLatestAutoRenewDate {
3072     my ( $borrowernumber, $itemnumber ) = @_;
3073
3074     my $dbh = C4::Context->dbh;
3075
3076     my $item      = Koha::Items->find($itemnumber)  or return;
3077     my $itemissue = $item->checkout                 or return;
3078
3079     $borrowernumber ||= $itemissue->borrowernumber;
3080     my $patron = Koha::Patrons->find( $borrowernumber )
3081       or return;
3082
3083     my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
3084     my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
3085         {   categorycode => $patron->categorycode,
3086             itemtype     => $item->effective_itemtype,
3087             branchcode   => $branchcode
3088         }
3089     );
3090
3091     return unless $issuing_rule;
3092     return
3093       if ( not $issuing_rule->no_auto_renewal_after
3094             or $issuing_rule->no_auto_renewal_after eq '' )
3095       and ( not $issuing_rule->no_auto_renewal_after_hard_limit
3096              or $issuing_rule->no_auto_renewal_after_hard_limit eq '' );
3097
3098     my $maximum_renewal_date;
3099     if ( $issuing_rule->no_auto_renewal_after ) {
3100         $maximum_renewal_date = dt_from_string($itemissue->issuedate);
3101         $maximum_renewal_date->add(
3102             $issuing_rule->lengthunit => $issuing_rule->no_auto_renewal_after
3103         );
3104     }
3105
3106     if ( $issuing_rule->no_auto_renewal_after_hard_limit ) {
3107         my $dt = dt_from_string( $issuing_rule->no_auto_renewal_after_hard_limit );
3108         $maximum_renewal_date = $dt if not $maximum_renewal_date or $maximum_renewal_date > $dt;
3109     }
3110     return $maximum_renewal_date;
3111 }
3112
3113
3114 =head2 GetIssuingCharges
3115
3116   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3117
3118 Calculate how much it would cost for a given patron to borrow a given
3119 item, including any applicable discounts.
3120
3121 C<$itemnumber> is the item number of item the patron wishes to borrow.
3122
3123 C<$borrowernumber> is the patron's borrower number.
3124
3125 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3126 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3127 if it's a video).
3128
3129 =cut
3130
3131 sub GetIssuingCharges {
3132
3133     # calculate charges due
3134     my ( $itemnumber, $borrowernumber ) = @_;
3135     my $charge = 0;
3136     my $dbh    = C4::Context->dbh;
3137     my $item_type;
3138
3139     # Get the book's item type and rental charge (via its biblioitem).
3140     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3141         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3142     $charge_query .= (C4::Context->preference('item-level_itypes'))
3143         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3144         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3145
3146     $charge_query .= ' WHERE items.itemnumber =?';
3147
3148     my $sth = $dbh->prepare($charge_query);
3149     $sth->execute($itemnumber);
3150     if ( my $item_data = $sth->fetchrow_hashref ) {
3151         $item_type = $item_data->{itemtype};
3152         $charge    = $item_data->{rentalcharge};
3153         my $branch = C4::Context::mybranch();
3154         my $discount_query = q|SELECT rentaldiscount,
3155             issuingrules.itemtype, issuingrules.branchcode
3156             FROM borrowers
3157             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3158             WHERE borrowers.borrowernumber = ?
3159             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3160             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3161         my $discount_sth = $dbh->prepare($discount_query);
3162         $discount_sth->execute( $borrowernumber, $item_type, $branch );
3163         my $discount_rules = $discount_sth->fetchall_arrayref({});
3164         if (@{$discount_rules}) {
3165             # We may have multiple rules so get the most specific
3166             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3167             $charge = ( $charge * ( 100 - $discount ) ) / 100;
3168         }
3169         if ($charge) {
3170             $charge = sprintf '%.2f', $charge; # ensure no fractions of a penny returned
3171         }
3172     }
3173
3174     return ( $charge, $item_type );
3175 }
3176
3177 # Select most appropriate discount rule from those returned
3178 sub _get_discount_from_rule {
3179     my ($rules_ref, $branch, $itemtype) = @_;
3180     my $discount;
3181
3182     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3183         $discount = $rules_ref->[0]->{rentaldiscount};
3184         return (defined $discount) ? $discount : 0;
3185     }
3186     # could have up to 4 does one match $branch and $itemtype
3187     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3188     if (@d) {
3189         $discount = $d[0]->{rentaldiscount};
3190         return (defined $discount) ? $discount : 0;
3191     }
3192     # do we have item type + all branches
3193     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3194     if (@d) {
3195         $discount = $d[0]->{rentaldiscount};
3196         return (defined $discount) ? $discount : 0;
3197     }
3198     # do we all item types + this branch
3199     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3200     if (@d) {
3201         $discount = $d[0]->{rentaldiscount};
3202         return (defined $discount) ? $discount : 0;
3203     }
3204     # so all and all (surely we wont get here)
3205     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3206     if (@d) {
3207         $discount = $d[0]->{rentaldiscount};
3208         return (defined $discount) ? $discount : 0;
3209     }
3210     # none of the above
3211     return 0;
3212 }
3213
3214 =head2 AddIssuingCharge
3215
3216   &AddIssuingCharge( $checkout, $charge )
3217
3218 =cut
3219
3220 sub AddIssuingCharge {
3221     my ( $checkout, $charge ) = @_;
3222
3223     # FIXME What if checkout does not exist?
3224
3225     my $nextaccntno = C4::Accounts::getnextacctno( $checkout->borrowernumber );
3226
3227     my $manager_id  = 0;
3228     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3229
3230     my $branchcode = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
3231
3232     my $accountline = Koha::Account::Line->new(
3233         {
3234             borrowernumber    => $checkout->borrowernumber,
3235             itemnumber        => $checkout->itemnumber,
3236             issue_id          => $checkout->issue_id,
3237             accountno         => $nextaccntno,
3238             amount            => $charge,
3239             amountoutstanding => $charge,
3240             manager_id        => $manager_id,
3241             branchcode        => $branchcode,
3242             description       => 'Rental',
3243             accounttype       => 'Rent',
3244             date              => \'NOW()',
3245         }
3246     )->store();
3247
3248     Koha::Account::Offset->new(
3249         {
3250             debit_id => $accountline->id,
3251             type     => 'Rental Fee',
3252             amount   => $charge,
3253         }
3254     )->store();
3255 }
3256
3257 =head2 GetTransfers
3258
3259   GetTransfers($itemnumber);
3260
3261 =cut
3262
3263 sub GetTransfers {
3264     my ($itemnumber) = @_;
3265
3266     my $dbh = C4::Context->dbh;
3267
3268     my $query = '
3269         SELECT datesent,
3270                frombranch,
3271                tobranch,
3272                branchtransfer_id
3273         FROM branchtransfers
3274         WHERE itemnumber = ?
3275           AND datearrived IS NULL
3276         ';
3277     my $sth = $dbh->prepare($query);
3278     $sth->execute($itemnumber);
3279     my @row = $sth->fetchrow_array();
3280     return @row;
3281 }
3282
3283 =head2 GetTransfersFromTo
3284
3285   @results = GetTransfersFromTo($frombranch,$tobranch);
3286
3287 Returns the list of pending transfers between $from and $to branch
3288
3289 =cut
3290
3291 sub GetTransfersFromTo {
3292     my ( $frombranch, $tobranch ) = @_;
3293     return unless ( $frombranch && $tobranch );
3294     my $dbh   = C4::Context->dbh;
3295     my $query = "
3296         SELECT branchtransfer_id,itemnumber,datesent,frombranch
3297         FROM   branchtransfers
3298         WHERE  frombranch=?
3299           AND  tobranch=?
3300           AND datearrived IS NULL
3301     ";
3302     my $sth = $dbh->prepare($query);
3303     $sth->execute( $frombranch, $tobranch );
3304     my @gettransfers;
3305
3306     while ( my $data = $sth->fetchrow_hashref ) {
3307         push @gettransfers, $data;
3308     }
3309     return (@gettransfers);
3310 }
3311
3312 =head2 DeleteTransfer
3313
3314   &DeleteTransfer($itemnumber);
3315
3316 =cut
3317
3318 sub DeleteTransfer {
3319     my ($itemnumber) = @_;
3320     return unless $itemnumber;
3321     my $dbh          = C4::Context->dbh;
3322     my $sth          = $dbh->prepare(
3323         "DELETE FROM branchtransfers
3324          WHERE itemnumber=?
3325          AND datearrived IS NULL "
3326     );
3327     return $sth->execute($itemnumber);
3328 }
3329
3330 =head2 SendCirculationAlert
3331
3332 Send out a C<check-in> or C<checkout> alert using the messaging system.
3333
3334 B<Parameters>:
3335
3336 =over 4
3337
3338 =item type
3339
3340 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3341
3342 =item item
3343
3344 Hashref of information about the item being checked in or out.
3345
3346 =item borrower
3347
3348 Hashref of information about the borrower of the item.
3349
3350 =item branch
3351
3352 The branchcode from where the checkout or check-in took place.
3353
3354 =back
3355
3356 B<Example>:
3357
3358     SendCirculationAlert({
3359         type     => 'CHECKOUT',
3360         item     => $item,
3361         borrower => $borrower,
3362         branch   => $branch,
3363     });
3364
3365 =cut
3366
3367 sub SendCirculationAlert {
3368     my ($opts) = @_;
3369     my ($type, $item, $borrower, $branch) =
3370         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3371     my %message_name = (
3372         CHECKIN  => 'Item_Check_in',
3373         CHECKOUT => 'Item_Checkout',
3374         RENEWAL  => 'Item_Checkout',
3375     );
3376     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3377         borrowernumber => $borrower->{borrowernumber},
3378         message_name   => $message_name{$type},
3379     });
3380     my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3381
3382     my $schema = Koha::Database->new->schema;
3383     my @transports = keys %{ $borrower_preferences->{transports} };
3384
3385     # From the MySQL doc:
3386     # LOCK TABLES is not transaction-safe and implicitly commits any active transaction before attempting to lock the tables.
3387     # If the LOCK/UNLOCK statements are executed from tests, the current transaction will be committed.
3388     # To avoid that we need to guess if this code is execute from tests or not (yes it is a bit hacky)
3389     my $do_not_lock = ( exists $ENV{_} && $ENV{_} =~ m|prove| ) || $ENV{KOHA_NO_TABLE_LOCKS};
3390
3391     for my $mtt (@transports) {
3392         my $letter =  C4::Letters::GetPreparedLetter (
3393             module => 'circulation',
3394             letter_code => $type,
3395             branchcode => $branch,
3396             message_transport_type => $mtt,
3397             lang => $borrower->{lang},
3398             tables => {
3399                 $issues_table => $item->{itemnumber},
3400                 'items'       => $item->{itemnumber},
3401                 'biblio'      => $item->{biblionumber},
3402                 'biblioitems' => $item->{biblionumber},
3403                 'borrowers'   => $borrower,
3404                 'branches'    => $branch,
3405             }
3406         ) or next;
3407
3408         $schema->storage->txn_begin;
3409         C4::Context->dbh->do(q|LOCK TABLE message_queue READ|) unless $do_not_lock;
3410         C4::Context->dbh->do(q|LOCK TABLE message_queue WRITE|) unless $do_not_lock;
3411         my $message = C4::Message->find_last_message($borrower, $type, $mtt);
3412         unless ( $message ) {
3413             C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3414             C4::Message->enqueue($letter, $borrower, $mtt);
3415         } else {
3416             $message->append($letter);
3417             $message->update;
3418         }
3419         C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3420         $schema->storage->txn_commit;
3421     }
3422
3423     return;
3424 }
3425
3426 =head2 updateWrongTransfer
3427
3428   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3429
3430 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
3431
3432 =cut
3433
3434 sub updateWrongTransfer {
3435         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3436         my $dbh = C4::Context->dbh;
3437 # first step validate the actual line of transfert .
3438         my $sth =
3439                 $dbh->prepare(
3440                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3441                 );
3442                 $sth->execute($FromLibrary,$itemNumber);
3443
3444 # second step create a new line of branchtransfer to the right location .
3445         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3446
3447 #third step changing holdingbranch of item
3448         UpdateHoldingbranch($FromLibrary,$itemNumber);
3449 }
3450
3451 =head2 UpdateHoldingbranch
3452
3453   $items = UpdateHoldingbranch($branch,$itmenumber);
3454
3455 Simple methode for updating hodlingbranch in items BDD line
3456
3457 =cut
3458
3459 sub UpdateHoldingbranch {
3460         my ( $branch,$itemnumber ) = @_;
3461     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3462 }
3463
3464 =head2 CalcDateDue
3465
3466 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3467
3468 this function calculates the due date given the start date and configured circulation rules,
3469 checking against the holidays calendar as per the 'useDaysMode' syspref.
3470 C<$startdate>   = DateTime object representing start date of loan period (assumed to be today)
3471 C<$itemtype>  = itemtype code of item in question
3472 C<$branch>  = location whose calendar to use
3473 C<$borrower> = Borrower object
3474 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3475
3476 =cut
3477
3478 sub CalcDateDue {
3479     my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3480
3481     $isrenewal ||= 0;
3482
3483     # loanlength now a href
3484     my $loanlength =
3485             GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3486
3487     my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3488             ? qq{renewalperiod}
3489             : qq{issuelength};
3490
3491     my $datedue;
3492     if ( $startdate ) {
3493         if (ref $startdate ne 'DateTime' ) {
3494             $datedue = dt_from_string($datedue);
3495         } else {
3496             $datedue = $startdate->clone;
3497         }
3498     } else {
3499         $datedue =
3500           DateTime->now( time_zone => C4::Context->tz() )
3501           ->truncate( to => 'minute' );
3502     }
3503
3504
3505     # calculate the datedue as normal
3506     if ( C4::Context->preference('useDaysMode') eq 'Days' )
3507     {    # ignoring calendar
3508         if ( $loanlength->{lengthunit} eq 'hours' ) {
3509             $datedue->add( hours => $loanlength->{$length_key} );
3510         } else {    # days
3511             $datedue->add( days => $loanlength->{$length_key} );
3512             $datedue->set_hour(23);
3513             $datedue->set_minute(59);
3514         }
3515     } else {
3516         my $dur;
3517         if ($loanlength->{lengthunit} eq 'hours') {
3518             $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3519         }
3520         else { # days
3521             $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3522         }
3523         my $calendar = Koha::Calendar->new( branchcode => $branch );
3524         $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3525         if ($loanlength->{lengthunit} eq 'days') {
3526             $datedue->set_hour(23);
3527             $datedue->set_minute(59);
3528         }
3529     }
3530
3531     # if Hard Due Dates are used, retrieve them and apply as necessary
3532     my ( $hardduedate, $hardduedatecompare ) =
3533       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3534     if ($hardduedate) {    # hardduedates are currently dates
3535         $hardduedate->truncate( to => 'minute' );
3536         $hardduedate->set_hour(23);
3537         $hardduedate->set_minute(59);
3538         my $cmp = DateTime->compare( $hardduedate, $datedue );
3539
3540 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3541 # if the calculated date is before the 'after' Hard Due Date (floor), override
3542 # if the hard due date is set to 'exactly', overrride
3543         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3544             $datedue = $hardduedate->clone;
3545         }
3546
3547         # in all other cases, keep the date due as it is
3548
3549     }
3550
3551     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3552     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3553         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3554         if( $expiry_dt ) { #skip empty expiry date..
3555             $expiry_dt->set( hour => 23, minute => 59);
3556             my $d1= $datedue->clone->set_time_zone('floating');
3557             if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3558                 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3559             }
3560         }
3561         if ( C4::Context->preference('useDaysMode') ne 'Days' ) {
3562           my $calendar = Koha::Calendar->new( branchcode => $branch );
3563           if ( $calendar->is_holiday($datedue) ) {
3564               # Don't return on a closed day
3565               $datedue = $calendar->prev_open_day( $datedue );
3566           }
3567         }
3568     }
3569
3570     return $datedue;
3571 }
3572
3573
3574 sub CheckValidBarcode{
3575 my ($barcode) = @_;
3576 my $dbh = C4::Context->dbh;
3577 my $query=qq|SELECT count(*)
3578              FROM items
3579              WHERE barcode=?
3580             |;
3581 my $sth = $dbh->prepare($query);
3582 $sth->execute($barcode);
3583 my $exist=$sth->fetchrow ;
3584 return $exist;
3585 }
3586
3587 =head2 IsBranchTransferAllowed
3588
3589   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3590
3591 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3592
3593 Deprecated in favor of Koha::Item::Transfer::Limits->find/search and
3594 Koha::Item->can_be_transferred.
3595
3596 =cut
3597
3598 sub IsBranchTransferAllowed {
3599         my ( $toBranch, $fromBranch, $code ) = @_;
3600
3601         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3602
3603         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3604         my $dbh = C4::Context->dbh;
3605
3606         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3607         $sth->execute( $toBranch, $fromBranch, $code );
3608         my $limit = $sth->fetchrow_hashref();
3609
3610         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3611         if ( $limit->{'limitId'} ) {
3612                 return 0;
3613         } else {
3614                 return 1;
3615         }
3616 }
3617
3618 =head2 CreateBranchTransferLimit
3619
3620   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3621
3622 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3623
3624 Deprecated in favor of Koha::Item::Transfer::Limit->new.
3625
3626 =cut
3627
3628 sub CreateBranchTransferLimit {
3629    my ( $toBranch, $fromBranch, $code ) = @_;
3630    return unless defined($toBranch) && defined($fromBranch);
3631    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3632
3633    my $dbh = C4::Context->dbh;
3634
3635    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3636    return $sth->execute( $code, $toBranch, $fromBranch );
3637 }
3638
3639 =head2 DeleteBranchTransferLimits
3640
3641     my $result = DeleteBranchTransferLimits($frombranch);
3642
3643 Deletes all the library transfer limits for one library.  Returns the
3644 number of limits deleted, 0e0 if no limits were deleted, or undef if
3645 no arguments are supplied.
3646
3647 Deprecated in favor of Koha::Item::Transfer::Limits->search({
3648     fromBranch => $fromBranch
3649     })->delete.
3650
3651 =cut
3652
3653 sub DeleteBranchTransferLimits {
3654     my $branch = shift;
3655     return unless defined $branch;
3656     my $dbh    = C4::Context->dbh;
3657     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3658     return $sth->execute($branch);
3659 }
3660
3661 sub ReturnLostItem{
3662     my ( $borrowernumber, $itemnum ) = @_;
3663
3664     MarkIssueReturned( $borrowernumber, $itemnum );
3665     my $patron = Koha::Patrons->find( $borrowernumber );
3666     my $item = Koha::Items->find($itemnum);
3667     my $old_note = ($item->paidfor && ($item->paidfor ne q{})) ? $item->paidfor.' / ' : q{};
3668     my @datearr = localtime(time);
3669     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3670     my $bor = $patron->firstname . ' ' . $patron->surname . ' ' . $patron->cardnumber;
3671     ModItem({ paidfor =>  $old_note."Paid for by $bor $date" }, undef, $itemnum);
3672 }
3673
3674
3675 sub LostItem{
3676     my ($itemnumber, $mark_lost_from, $force_mark_returned) = @_;
3677
3678     unless ( $mark_lost_from ) {
3679         # Temporary check to avoid regressions
3680         die q|LostItem called without $mark_lost_from, check the API.|;
3681     }
3682
3683     my $mark_returned;
3684     if ( $force_mark_returned ) {
3685         $mark_returned = 1;
3686     } else {
3687         my $pref = C4::Context->preference('MarkLostItemsAsReturned') // q{};
3688         $mark_returned = ( $pref =~ m|$mark_lost_from| );
3689     }
3690
3691     my $dbh = C4::Context->dbh();
3692     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3693                            FROM issues
3694                            JOIN items USING (itemnumber)
3695                            JOIN biblio USING (biblionumber)
3696                            WHERE issues.itemnumber=?");
3697     $sth->execute($itemnumber);
3698     my $issues=$sth->fetchrow_hashref();
3699
3700     # If a borrower lost the item, add a replacement cost to the their record
3701     if ( my $borrowernumber = $issues->{borrowernumber} ){
3702         my $patron = Koha::Patrons->find( $borrowernumber );
3703
3704         my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, C4::Context->preference('WhenLostForgiveFine'), 0); # 1, 0 = exemptfine, no-dropbox
3705         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!";  # zero is OK, check defined
3706
3707         if (C4::Context->preference('WhenLostChargeReplacementFee')){
3708             C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'} $issues->{'itemcallnumber'}");
3709             #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3710             #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3711         }
3712
3713         MarkIssueReturned($borrowernumber,$itemnumber,undef,$patron->privacy) if $mark_returned;
3714     }
3715
3716     #When item is marked lost automatically cancel its outstanding transfers and set items holdingbranch to the transfer source branch (frombranch)
3717     if (my ( $datesent,$frombranch,$tobranch ) = GetTransfers($itemnumber)) {
3718         ModItem({holdingbranch => $frombranch}, undef, $itemnumber);
3719     }
3720     my $transferdeleted = DeleteTransfer($itemnumber);
3721 }
3722
3723 sub GetOfflineOperations {
3724     my $dbh = C4::Context->dbh;
3725     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3726     $sth->execute(C4::Context->userenv->{'branch'});
3727     my $results = $sth->fetchall_arrayref({});
3728     return $results;
3729 }
3730
3731 sub GetOfflineOperation {
3732     my $operationid = shift;
3733     return unless $operationid;
3734     my $dbh = C4::Context->dbh;
3735     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3736     $sth->execute( $operationid );
3737     return $sth->fetchrow_hashref;
3738 }
3739
3740 sub AddOfflineOperation {
3741     my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3742     my $dbh = C4::Context->dbh;
3743     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3744     $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3745     return "Added.";
3746 }
3747
3748 sub DeleteOfflineOperation {
3749     my $dbh = C4::Context->dbh;
3750     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3751     $sth->execute( shift );
3752     return "Deleted.";
3753 }
3754
3755 sub ProcessOfflineOperation {
3756     my $operation = shift;
3757
3758     my $report;
3759     if ( $operation->{action} eq 'return' ) {
3760         $report = ProcessOfflineReturn( $operation );
3761     } elsif ( $operation->{action} eq 'issue' ) {
3762         $report = ProcessOfflineIssue( $operation );
3763     } elsif ( $operation->{action} eq 'payment' ) {
3764         $report = ProcessOfflinePayment( $operation );
3765     }
3766
3767     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3768
3769     return $report;
3770 }
3771
3772 sub ProcessOfflineReturn {
3773     my $operation = shift;
3774
3775     my $item = Koha::Items->find({barcode => $operation->{barcode}});
3776
3777     if ( $item ) {
3778         my $itemnumber = $item->itemnumber;
3779         my $issue = GetOpenIssue( $itemnumber );
3780         if ( $issue ) {
3781             MarkIssueReturned(
3782                 $issue->{borrowernumber},
3783                 $itemnumber,
3784                 $operation->{timestamp},
3785             );
3786             ModItem(
3787                 { renewals => 0, onloan => undef },
3788                 $issue->{'biblionumber'},
3789                 $itemnumber,
3790                 { log_action => 0 }
3791             );
3792             return "Success.";
3793         } else {
3794             return "Item not issued.";
3795         }
3796     } else {
3797         return "Item not found.";
3798     }
3799 }
3800
3801 sub ProcessOfflineIssue {
3802     my $operation = shift;
3803
3804     my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} } );
3805
3806     if ( $patron ) {
3807         my $item = Koha::Items->find({ barcode => $operation->{barcode} });
3808         unless ($item) {
3809             return "Barcode not found.";
3810         }
3811         my $itemnumber = $item->itemnumber;
3812         my $issue = GetOpenIssue( $itemnumber );
3813
3814         if ( $issue and ( $issue->{borrowernumber} ne $patron->borrowernumber ) ) { # Item already issued to another patron mark it returned
3815             MarkIssueReturned(
3816                 $issue->{borrowernumber},
3817                 $itemnumber,
3818                 $operation->{timestamp},
3819             );
3820         }
3821         AddIssue(
3822             $patron->unblessed,
3823             $operation->{'barcode'},
3824             undef,
3825             1,
3826             $operation->{timestamp},
3827             undef,
3828         );
3829         return "Success.";
3830     } else {
3831         return "Borrower not found.";
3832     }
3833 }
3834
3835 sub ProcessOfflinePayment {
3836     my $operation = shift;
3837
3838     my $patron = Koha::Patrons->find({ cardnumber => $operation->{cardnumber} });
3839
3840     $patron->account->pay({ amount => $operation->{amount}, library_id => $operation->{branchcode} });
3841
3842     return "Success.";
3843 }
3844
3845 =head2 TransferSlip
3846
3847   TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3848
3849   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3850
3851 =cut
3852
3853 sub TransferSlip {
3854     my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3855
3856     my $item =
3857       $itemnumber
3858       ? Koha::Items->find($itemnumber)
3859       : Koha::Items->find( { barcode => $barcode } );
3860
3861     $item or return;
3862
3863     return C4::Letters::GetPreparedLetter (
3864         module => 'circulation',
3865         letter_code => 'TRANSFERSLIP',
3866         branchcode => $branch,
3867         tables => {
3868             'branches'    => $to_branch,
3869             'biblio'      => $item->biblionumber,
3870             'items'       => $item->unblessed,
3871         },
3872     );
3873 }
3874
3875 =head2 CheckIfIssuedToPatron
3876
3877   CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3878
3879   Return 1 if any record item is issued to patron, otherwise return 0
3880
3881 =cut
3882
3883 sub CheckIfIssuedToPatron {
3884     my ($borrowernumber, $biblionumber) = @_;
3885
3886     my $dbh = C4::Context->dbh;
3887     my $query = q|
3888         SELECT COUNT(*) FROM issues
3889         LEFT JOIN items ON items.itemnumber = issues.itemnumber
3890         WHERE items.biblionumber = ?
3891         AND issues.borrowernumber = ?
3892     |;
3893     my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3894     return 1 if $is_issued;
3895     return;
3896 }
3897
3898 =head2 IsItemIssued
3899
3900   IsItemIssued( $itemnumber )
3901
3902   Return 1 if the item is on loan, otherwise return 0
3903
3904 =cut
3905
3906 sub IsItemIssued {
3907     my $itemnumber = shift;
3908     my $dbh = C4::Context->dbh;
3909     my $sth = $dbh->prepare(q{
3910         SELECT COUNT(*)
3911         FROM issues
3912         WHERE itemnumber = ?
3913     });
3914     $sth->execute($itemnumber);
3915     return $sth->fetchrow;
3916 }
3917
3918 =head2 GetAgeRestriction
3919
3920   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3921   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3922
3923   if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as they are older or as old as the agerestriction }
3924   if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3925
3926 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3927 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3928 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3929          Negative days mean the borrower has gone past the age restriction age.
3930
3931 =cut
3932
3933 sub GetAgeRestriction {
3934     my ($record_restrictions, $borrower) = @_;
3935     my $markers = C4::Context->preference('AgeRestrictionMarker');
3936
3937     # Split $record_restrictions to something like FSK 16 or PEGI 6
3938     my @values = split ' ', uc($record_restrictions);
3939     return unless @values;
3940
3941     # Search first occurrence of one of the markers
3942     my @markers = split /\|/, uc($markers);
3943     return unless @markers;
3944
3945     my $index            = 0;
3946     my $restriction_year = 0;
3947     for my $value (@values) {
3948         $index++;
3949         for my $marker (@markers) {
3950             $marker =~ s/^\s+//;    #remove leading spaces
3951             $marker =~ s/\s+$//;    #remove trailing spaces
3952             if ( $marker eq $value ) {
3953                 if ( $index <= $#values ) {
3954                     $restriction_year += $values[$index];
3955                 }
3956                 last;
3957             }
3958             elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3959
3960                 # Perhaps it is something like "K16" (as in Finland)
3961                 $restriction_year += $1;
3962                 last;
3963             }
3964         }
3965         last if ( $restriction_year > 0 );
3966     }
3967
3968     #Check if the borrower is age restricted for this material and for how long.
3969     if ($restriction_year && $borrower) {
3970         if ( $borrower->{'dateofbirth'} ) {
3971             my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3972             $alloweddate[0] += $restriction_year;
3973
3974             #Prevent runime eror on leap year (invalid date)
3975             if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3976                 $alloweddate[2] = 28;
3977             }
3978
3979             #Get how many days the borrower has to reach the age restriction
3980             my @Today = split /-/, DateTime->today->ymd();
3981             my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
3982             #Negative days means the borrower went past the age restriction age
3983             return ($restriction_year, $daysToAgeRestriction);
3984         }
3985     }
3986
3987     return ($restriction_year);
3988 }
3989
3990
3991 =head2 GetPendingOnSiteCheckouts
3992
3993 =cut
3994
3995 sub GetPendingOnSiteCheckouts {
3996     my $dbh = C4::Context->dbh;
3997     return $dbh->selectall_arrayref(q|
3998         SELECT
3999           items.barcode,
4000           items.biblionumber,
4001           items.itemnumber,
4002           items.itemnotes,
4003           items.itemcallnumber,
4004           items.location,
4005           issues.date_due,
4006           issues.branchcode,
4007           issues.date_due < NOW() AS is_overdue,
4008           biblio.author,
4009           biblio.title,
4010           borrowers.firstname,
4011           borrowers.surname,
4012           borrowers.cardnumber,
4013           borrowers.borrowernumber
4014         FROM items
4015         LEFT JOIN issues ON items.itemnumber = issues.itemnumber
4016         LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
4017         LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
4018         WHERE issues.onsite_checkout = 1
4019     |, { Slice => {} } );
4020 }
4021
4022 sub GetTopIssues {
4023     my ($params) = @_;
4024
4025     my ($count, $branch, $itemtype, $ccode, $newness)
4026         = @$params{qw(count branch itemtype ccode newness)};
4027
4028     my $dbh = C4::Context->dbh;
4029     my $query = q{
4030         SELECT * FROM (
4031         SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4032           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4033           i.ccode, SUM(i.issues) AS count
4034         FROM biblio b
4035         LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4036         LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4037     };
4038
4039     my (@where_strs, @where_args);
4040
4041     if ($branch) {
4042         push @where_strs, 'i.homebranch = ?';
4043         push @where_args, $branch;
4044     }
4045     if ($itemtype) {
4046         if (C4::Context->preference('item-level_itypes')){
4047             push @where_strs, 'i.itype = ?';
4048             push @where_args, $itemtype;
4049         } else {
4050             push @where_strs, 'bi.itemtype = ?';
4051             push @where_args, $itemtype;
4052         }
4053     }
4054     if ($ccode) {
4055         push @where_strs, 'i.ccode = ?';
4056         push @where_args, $ccode;
4057     }
4058     if ($newness) {
4059         push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4060         push @where_args, $newness;
4061     }
4062
4063     if (@where_strs) {
4064         $query .= 'WHERE ' . join(' AND ', @where_strs);
4065     }
4066
4067     $query .= q{
4068         GROUP BY b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4069           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4070           i.ccode
4071         ORDER BY count DESC
4072     };
4073
4074     $query .= q{ ) xxx WHERE count > 0 };
4075     $count = int($count);
4076     if ($count > 0) {
4077         $query .= "LIMIT $count";
4078     }
4079
4080     my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4081
4082     return @$rows;
4083 }
4084
4085 sub _CalculateAndUpdateFine {
4086     my ($params) = @_;
4087
4088     my $borrower    = $params->{borrower};
4089     my $item        = $params->{item};
4090     my $issue       = $params->{issue};
4091     my $return_date = $params->{return_date};
4092
4093     unless ($borrower) { carp "No borrower passed in!" && return; }
4094     unless ($item)     { carp "No item passed in!"     && return; }
4095     unless ($issue)    { carp "No issue passed in!"    && return; }
4096
4097     my $datedue = dt_from_string( $issue->date_due );
4098
4099     # we only need to calculate and change the fines if we want to do that on return
4100     # Should be on for hourly loans
4101     my $control = C4::Context->preference('CircControl');
4102     my $control_branchcode =
4103         ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4104       : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
4105       :                                     $issue->branchcode;
4106
4107     my $date_returned = $return_date ? dt_from_string($return_date) : dt_from_string();
4108
4109     my ( $amount, $unitcounttotal, $unitcount  ) =
4110       C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4111
4112     if ( C4::Context->preference('finesMode') eq 'production' ) {
4113         if ( $amount > 0 ) {
4114             C4::Overdues::UpdateFine({
4115                 issue_id       => $issue->issue_id,
4116                 itemnumber     => $issue->itemnumber,
4117                 borrowernumber => $issue->borrowernumber,
4118                 amount         => $amount,
4119                 due            => output_pref($datedue),
4120             });
4121         }
4122         elsif ($return_date) {
4123
4124             # Backdated returns may have fines that shouldn't exist,
4125             # so in this case, we need to drop those fines to 0
4126
4127             C4::Overdues::UpdateFine({
4128                 issue_id       => $issue->issue_id,
4129                 itemnumber     => $issue->itemnumber,
4130                 borrowernumber => $issue->borrowernumber,
4131                 amount         => 0,
4132                 due            => output_pref($datedue),
4133             });
4134         }
4135     }
4136 }
4137
4138 sub _item_denied_renewal {
4139     my ($params) = @_;
4140
4141     my $item = $params->{item};
4142     return unless $item;
4143
4144     my $denyingrules = Koha::Config::SysPrefs->find('ItemsDeniedRenewal')->get_yaml_pref_hash();
4145     return unless $denyingrules;
4146     foreach my $field (keys %$denyingrules) {
4147         my $val = $item->{$field};
4148         if( !defined $val) {
4149             if ( any { !defined $_ }  @{$denyingrules->{$field}} ){
4150                 return 1;
4151             }
4152         } elsif (any { defined($_) && $val eq $_ } @{$denyingrules->{$field}}) {
4153            # If the results matches the values in the syspref
4154            # We return true if match found
4155             return 1;
4156         }
4157     }
4158     return 0;
4159 }
4160
4161
4162 1;
4163
4164 __END__
4165
4166 =head1 AUTHOR
4167
4168 Koha Development Team <http://koha-community.org/>
4169
4170 =cut