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