C4/Circulation.pm

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