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