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::GetMemberDetails($b);
2761                 foreach my $i (@itemnumbers) {
2762                     my $item = GetItem($i);
2763                     if (   IsAvailableForItemLevelRequest( $item, $borr )
2764                         && CanItemBeReserved( $b, $i )
2765                         && !IsItemOnHoldAndFound($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({branch => $branch,
2974                 type => 'renew',
2975                 amount => $charge,
2976                 itemnumber => $itemnumber,
2977                 itemtype => $item->{itype},
2978                 borrowernumber => $borrowernumber,
2979                 ccode => $item->{'ccode'}}
2980                 );
2981         return $datedue;
2982 }
2983
2984 sub GetRenewCount {
2985     # check renewal status
2986     my ( $bornum, $itemno ) = @_;
2987     my $dbh           = C4::Context->dbh;
2988     my $renewcount    = 0;
2989     my $renewsallowed = 0;
2990     my $renewsleft    = 0;
2991
2992     my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
2993     my $item     = GetItem($itemno);
2994
2995     # Look in the issues table for this item, lent to this borrower,
2996     # and not yet returned.
2997
2998     # FIXME - I think this function could be redone to use only one SQL call.
2999     my $sth = $dbh->prepare(
3000         "select * from issues
3001                                 where (borrowernumber = ?)
3002                                 and (itemnumber = ?)"
3003     );
3004     $sth->execute( $bornum, $itemno );
3005     my $data = $sth->fetchrow_hashref;
3006     $renewcount = $data->{'renewals'} if $data->{'renewals'};
3007     # $item and $borrower should be calculated
3008     my $branchcode = _GetCircControlBranch($item, $borrower);
3009
3010     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
3011
3012     $renewsallowed = $issuingrule->{'renewalsallowed'};
3013     $renewsleft    = $renewsallowed - $renewcount;
3014     if($renewsleft < 0){ $renewsleft = 0; }
3015     return ( $renewcount, $renewsallowed, $renewsleft );
3016 }
3017
3018 =head2 GetSoonestRenewDate
3019
3020   $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3021
3022 Find out the soonest possible renew date of a borrowed item.
3023
3024 C<$borrowernumber> is the borrower number of the patron who currently
3025 has the item on loan.
3026
3027 C<$itemnumber> is the number of the item to renew.
3028
3029 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3030 renew date, based on the value "No renewal before" of the applicable
3031 issuing rule. Returns the current date if the item can already be
3032 renewed, and returns undefined if the borrower, loan, or item
3033 cannot be found.
3034
3035 =cut
3036
3037 sub GetSoonestRenewDate {
3038     my ( $borrowernumber, $itemnumber ) = @_;
3039
3040     my $dbh = C4::Context->dbh;
3041
3042     my $item      = GetItem($itemnumber)      or return;
3043     my $itemissue = GetItemIssue($itemnumber) or return;
3044
3045     $borrowernumber ||= $itemissue->{borrowernumber};
3046     my $borrower = C4::Members::GetMemberDetails($borrowernumber)
3047       or return;
3048
3049     my $branchcode = _GetCircControlBranch( $item, $borrower );
3050     my $issuingrule =
3051       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
3052
3053     my $now = dt_from_string;
3054
3055     if ( defined $issuingrule->{norenewalbefore}
3056         and $issuingrule->{norenewalbefore} ne "" )
3057     {
3058         my $soonestrenewal =
3059           $itemissue->{date_due}->clone()
3060           ->subtract(
3061             $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
3062
3063         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3064             and $issuingrule->{lengthunit} eq 'days' )
3065         {
3066             $soonestrenewal->truncate( to => 'day' );
3067         }
3068         return $soonestrenewal if $now < $soonestrenewal;
3069     }
3070     return $now;
3071 }
3072
3073 =head2 GetIssuingCharges
3074
3075   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3076
3077 Calculate how much it would cost for a given patron to borrow a given
3078 item, including any applicable discounts.
3079
3080 C<$itemnumber> is the item number of item the patron wishes to borrow.
3081
3082 C<$borrowernumber> is the patron's borrower number.
3083
3084 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3085 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3086 if it's a video).
3087
3088 =cut
3089
3090 sub GetIssuingCharges {
3091
3092     # calculate charges due
3093     my ( $itemnumber, $borrowernumber ) = @_;
3094     my $charge = 0;
3095     my $dbh    = C4::Context->dbh;
3096     my $item_type;
3097
3098     # Get the book's item type and rental charge (via its biblioitem).
3099     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3100         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3101     $charge_query .= (C4::Context->preference('item-level_itypes'))
3102         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3103         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3104
3105     $charge_query .= ' WHERE items.itemnumber =?';
3106
3107     my $sth = $dbh->prepare($charge_query);
3108     $sth->execute($itemnumber);
3109     if ( my $item_data = $sth->fetchrow_hashref ) {
3110         $item_type = $item_data->{itemtype};
3111         $charge    = $item_data->{rentalcharge};
3112         my $branch = C4::Branch::mybranch();
3113         my $discount_query = q|SELECT rentaldiscount,
3114             issuingrules.itemtype, issuingrules.branchcode
3115             FROM borrowers
3116             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3117             WHERE borrowers.borrowernumber = ?
3118             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3119             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3120         my $discount_sth = $dbh->prepare($discount_query);
3121         $discount_sth->execute( $borrowernumber, $item_type, $branch );
3122         my $discount_rules = $discount_sth->fetchall_arrayref({});
3123         if (@{$discount_rules}) {
3124             # We may have multiple rules so get the most specific
3125             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3126             $charge = ( $charge * ( 100 - $discount ) ) / 100;
3127         }
3128     }
3129
3130     return ( $charge, $item_type );
3131 }
3132
3133 # Select most appropriate discount rule from those returned
3134 sub _get_discount_from_rule {
3135     my ($rules_ref, $branch, $itemtype) = @_;
3136     my $discount;
3137
3138     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3139         $discount = $rules_ref->[0]->{rentaldiscount};
3140         return (defined $discount) ? $discount : 0;
3141     }
3142     # could have up to 4 does one match $branch and $itemtype
3143     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3144     if (@d) {
3145         $discount = $d[0]->{rentaldiscount};
3146         return (defined $discount) ? $discount : 0;
3147     }
3148     # do we have item type + all branches
3149     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3150     if (@d) {
3151         $discount = $d[0]->{rentaldiscount};
3152         return (defined $discount) ? $discount : 0;
3153     }
3154     # do we all item types + this branch
3155     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3156     if (@d) {
3157         $discount = $d[0]->{rentaldiscount};
3158         return (defined $discount) ? $discount : 0;
3159     }
3160     # so all and all (surely we wont get here)
3161     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3162     if (@d) {
3163         $discount = $d[0]->{rentaldiscount};
3164         return (defined $discount) ? $discount : 0;
3165     }
3166     # none of the above
3167     return 0;
3168 }
3169
3170 =head2 AddIssuingCharge
3171
3172   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3173
3174 =cut
3175
3176 sub AddIssuingCharge {
3177     my ( $itemnumber, $borrowernumber, $charge ) = @_;
3178     my $dbh = C4::Context->dbh;
3179     my $nextaccntno = getnextacctno( $borrowernumber );
3180     my $manager_id = 0;
3181     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3182     my $query ="
3183         INSERT INTO accountlines
3184             (borrowernumber, itemnumber, accountno,
3185             date, amount, description, accounttype,
3186             amountoutstanding, manager_id)
3187         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3188     ";
3189     my $sth = $dbh->prepare($query);
3190     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3191 }
3192
3193 =head2 GetTransfers
3194
3195   GetTransfers($itemnumber);
3196
3197 =cut
3198
3199 sub GetTransfers {
3200     my ($itemnumber) = @_;
3201
3202     my $dbh = C4::Context->dbh;
3203
3204     my $query = '
3205         SELECT datesent,
3206                frombranch,
3207                tobranch
3208         FROM branchtransfers
3209         WHERE itemnumber = ?
3210           AND datearrived IS NULL
3211         ';
3212     my $sth = $dbh->prepare($query);
3213     $sth->execute($itemnumber);
3214     my @row = $sth->fetchrow_array();
3215     return @row;
3216 }
3217
3218 =head2 GetTransfersFromTo
3219
3220   @results = GetTransfersFromTo($frombranch,$tobranch);
3221
3222 Returns the list of pending transfers between $from and $to branch
3223
3224 =cut
3225
3226 sub GetTransfersFromTo {
3227     my ( $frombranch, $tobranch ) = @_;
3228     return unless ( $frombranch && $tobranch );
3229     my $dbh   = C4::Context->dbh;
3230     my $query = "
3231         SELECT itemnumber,datesent,frombranch
3232         FROM   branchtransfers
3233         WHERE  frombranch=?
3234           AND  tobranch=?
3235           AND datearrived IS NULL
3236     ";
3237     my $sth = $dbh->prepare($query);
3238     $sth->execute( $frombranch, $tobranch );
3239     my @gettransfers;
3240
3241     while ( my $data = $sth->fetchrow_hashref ) {
3242         push @gettransfers, $data;
3243     }
3244     return (@gettransfers);
3245 }
3246
3247 =head2 DeleteTransfer
3248
3249   &DeleteTransfer($itemnumber);
3250
3251 =cut
3252
3253 sub DeleteTransfer {
3254     my ($itemnumber) = @_;
3255     return unless $itemnumber;
3256     my $dbh          = C4::Context->dbh;
3257     my $sth          = $dbh->prepare(
3258         "DELETE FROM branchtransfers
3259          WHERE itemnumber=?
3260          AND datearrived IS NULL "
3261     );
3262     return $sth->execute($itemnumber);
3263 }
3264
3265 =head2 AnonymiseIssueHistory
3266
3267   ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3268
3269 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3270 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3271
3272 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3273 setting (force delete).
3274
3275 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3276
3277 =cut
3278
3279 sub AnonymiseIssueHistory {
3280     my $date           = shift;
3281     my $borrowernumber = shift;
3282     my $dbh            = C4::Context->dbh;
3283     my $query          = "
3284         UPDATE old_issues
3285         SET    borrowernumber = ?
3286         WHERE  returndate < ?
3287           AND borrowernumber IS NOT NULL
3288     ";
3289
3290     # The default of 0 does not work due to foreign key constraints
3291     # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
3292     # Set it to undef (NULL)
3293     my $anonymouspatron = C4::Context->preference('AnonymousPatron') || undef;
3294     my @bind_params = ($anonymouspatron, $date);
3295     if (defined $borrowernumber) {
3296        $query .= " AND borrowernumber = ?";
3297        push @bind_params, $borrowernumber;
3298     } else {
3299        $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3300     }
3301     my $sth = $dbh->prepare($query);
3302     $sth->execute(@bind_params);
3303     my $anonymisation_err = $dbh->err;
3304     my $rows_affected = $sth->rows;  ### doublecheck row count return function
3305     return ($rows_affected, $anonymisation_err);
3306 }
3307
3308 =head2 SendCirculationAlert
3309
3310 Send out a C<check-in> or C<checkout> alert using the messaging system.
3311
3312 B<Parameters>:
3313
3314 =over 4
3315
3316 =item type
3317
3318 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3319
3320 =item item
3321
3322 Hashref of information about the item being checked in or out.
3323
3324 =item borrower
3325
3326 Hashref of information about the borrower of the item.
3327
3328 =item branch
3329
3330 The branchcode from where the checkout or check-in took place.
3331
3332 =back
3333
3334 B<Example>:
3335
3336     SendCirculationAlert({
3337         type     => 'CHECKOUT',
3338         item     => $item,
3339         borrower => $borrower,
3340         branch   => $branch,
3341     });
3342
3343 =cut
3344
3345 sub SendCirculationAlert {
3346     my ($opts) = @_;
3347     my ($type, $item, $borrower, $branch) =
3348         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3349     my %message_name = (
3350         CHECKIN  => 'Item_Check_in',
3351         CHECKOUT => 'Item_Checkout',
3352         RENEWAL  => 'Item_Checkout',
3353     );
3354     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3355         borrowernumber => $borrower->{borrowernumber},
3356         message_name   => $message_name{$type},
3357     });
3358     my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3359
3360     my @transports = keys %{ $borrower_preferences->{transports} };
3361     # warn "no transports" unless @transports;
3362     for (@transports) {
3363         # warn "transport: $_";
3364         my $message = C4::Message->find_last_message($borrower, $type, $_);
3365         if (!$message) {
3366             #warn "create new message";
3367             my $letter =  C4::Letters::GetPreparedLetter (
3368                 module => 'circulation',
3369                 letter_code => $type,
3370                 branchcode => $branch,
3371                 message_transport_type => $_,
3372                 tables => {
3373                     $issues_table => $item->{itemnumber},
3374                     'items'       => $item->{itemnumber},
3375                     'biblio'      => $item->{biblionumber},
3376                     'biblioitems' => $item->{biblionumber},
3377                     'borrowers'   => $borrower,
3378                     'branches'    => $branch,
3379                 }
3380             ) or next;
3381             C4::Message->enqueue($letter, $borrower, $_);
3382         } else {
3383             #warn "append to old message";
3384             my $letter =  C4::Letters::GetPreparedLetter (
3385                 module => 'circulation',
3386                 letter_code => $type,
3387                 branchcode => $branch,
3388                 message_transport_type => $_,
3389                 tables => {
3390                     $issues_table => $item->{itemnumber},
3391                     'items'       => $item->{itemnumber},
3392                     'biblio'      => $item->{biblionumber},
3393                     'biblioitems' => $item->{biblionumber},
3394                     'borrowers'   => $borrower,
3395                     'branches'    => $branch,
3396                 }
3397             ) or next;
3398             $message->append($letter);
3399             $message->update;
3400         }
3401     }
3402
3403     return;
3404 }
3405
3406 =head2 updateWrongTransfer
3407
3408   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3409
3410 This function validate the line of brachtransfer but with the wrong destination (mistake from a librarian ...), and create a new line in branchtransfer from the actual library to the original library of reservation
3411
3412 =cut
3413
3414 sub updateWrongTransfer {
3415         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3416         my $dbh = C4::Context->dbh;
3417 # first step validate the actual line of transfert .
3418         my $sth =
3419                 $dbh->prepare(
3420                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3421                 );
3422                 $sth->execute($FromLibrary,$itemNumber);
3423
3424 # second step create a new line of branchtransfer to the right location .
3425         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3426
3427 #third step changing holdingbranch of item
3428         UpdateHoldingbranch($FromLibrary,$itemNumber);
3429 }
3430
3431 =head2 UpdateHoldingbranch
3432
3433   $items = UpdateHoldingbranch($branch,$itmenumber);
3434
3435 Simple methode for updating hodlingbranch in items BDD line
3436
3437 =cut
3438
3439 sub UpdateHoldingbranch {
3440         my ( $branch,$itemnumber ) = @_;
3441     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3442 }
3443
3444 =head2 CalcDateDue
3445
3446 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3447
3448 this function calculates the due date given the start date and configured circulation rules,
3449 checking against the holidays calendar as per the 'useDaysMode' syspref.
3450 C<$startdate>   = DateTime object representing start date of loan period (assumed to be today)
3451 C<$itemtype>  = itemtype code of item in question
3452 C<$branch>  = location whose calendar to use
3453 C<$borrower> = Borrower object
3454 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3455
3456 =cut
3457
3458 sub CalcDateDue {
3459     my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3460
3461     $isrenewal ||= 0;
3462
3463     # loanlength now a href
3464     my $loanlength =
3465             GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3466
3467     my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3468             ? qq{renewalperiod}
3469             : qq{issuelength};
3470
3471     my $datedue;
3472     if ( $startdate ) {
3473         if (ref $startdate ne 'DateTime' ) {
3474             $datedue = dt_from_string($datedue);
3475         } else {
3476             $datedue = $startdate->clone;
3477         }
3478     } else {
3479         $datedue =
3480           DateTime->now( time_zone => C4::Context->tz() )
3481           ->truncate( to => 'minute' );
3482     }
3483
3484
3485     # calculate the datedue as normal
3486     if ( C4::Context->preference('useDaysMode') eq 'Days' )
3487     {    # ignoring calendar
3488         if ( $loanlength->{lengthunit} eq 'hours' ) {
3489             $datedue->add( hours => $loanlength->{$length_key} );
3490         } else {    # days
3491             $datedue->add( days => $loanlength->{$length_key} );
3492             $datedue->set_hour(23);
3493             $datedue->set_minute(59);
3494         }
3495     } else {
3496         my $dur;
3497         if ($loanlength->{lengthunit} eq 'hours') {
3498             $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3499         }
3500         else { # days
3501             $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3502         }
3503         my $calendar = Koha::Calendar->new( branchcode => $branch );
3504         $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3505         if ($loanlength->{lengthunit} eq 'days') {
3506             $datedue->set_hour(23);
3507             $datedue->set_minute(59);
3508         }
3509     }
3510
3511     # if Hard Due Dates are used, retrieve them and apply as necessary
3512     my ( $hardduedate, $hardduedatecompare ) =
3513       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3514     if ($hardduedate) {    # hardduedates are currently dates
3515         $hardduedate->truncate( to => 'minute' );
3516         $hardduedate->set_hour(23);
3517         $hardduedate->set_minute(59);
3518         my $cmp = DateTime->compare( $hardduedate, $datedue );
3519
3520 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3521 # if the calculated date is before the 'after' Hard Due Date (floor), override
3522 # if the hard due date is set to 'exactly', overrride
3523         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3524             $datedue = $hardduedate->clone;
3525         }
3526
3527         # in all other cases, keep the date due as it is
3528
3529     }
3530
3531     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3532     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3533         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3534         if( $expiry_dt ) { #skip empty expiry date..
3535             $expiry_dt->set( hour => 23, minute => 59);
3536             my $d1= $datedue->clone->set_time_zone('floating');
3537             if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3538                 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3539             }
3540         }
3541     }
3542
3543     return $datedue;
3544 }
3545
3546
3547 sub CheckValidBarcode{
3548 my ($barcode) = @_;
3549 my $dbh = C4::Context->dbh;
3550 my $query=qq|SELECT count(*)
3551              FROM items
3552              WHERE barcode=?
3553             |;
3554 my $sth = $dbh->prepare($query);
3555 $sth->execute($barcode);
3556 my $exist=$sth->fetchrow ;
3557 return $exist;
3558 }
3559
3560 =head2 IsBranchTransferAllowed
3561
3562   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3563
3564 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3565
3566 =cut
3567
3568 sub IsBranchTransferAllowed {
3569         my ( $toBranch, $fromBranch, $code ) = @_;
3570
3571         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3572
3573         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3574         my $dbh = C4::Context->dbh;
3575
3576         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3577         $sth->execute( $toBranch, $fromBranch, $code );
3578         my $limit = $sth->fetchrow_hashref();
3579
3580         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3581         if ( $limit->{'limitId'} ) {
3582                 return 0;
3583         } else {
3584                 return 1;
3585         }
3586 }
3587
3588 =head2 CreateBranchTransferLimit
3589
3590   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3591
3592 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3593
3594 =cut
3595
3596 sub CreateBranchTransferLimit {
3597    my ( $toBranch, $fromBranch, $code ) = @_;
3598    return unless defined($toBranch) && defined($fromBranch);
3599    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3600
3601    my $dbh = C4::Context->dbh;
3602
3603    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3604    return $sth->execute( $code, $toBranch, $fromBranch );
3605 }
3606
3607 =head2 DeleteBranchTransferLimits
3608
3609     my $result = DeleteBranchTransferLimits($frombranch);
3610
3611 Deletes all the library transfer limits for one library.  Returns the
3612 number of limits deleted, 0e0 if no limits were deleted, or undef if
3613 no arguments are supplied.
3614
3615 =cut
3616
3617 sub DeleteBranchTransferLimits {
3618     my $branch = shift;
3619     return unless defined $branch;
3620     my $dbh    = C4::Context->dbh;
3621     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3622     return $sth->execute($branch);
3623 }
3624
3625 sub ReturnLostItem{
3626     my ( $borrowernumber, $itemnum ) = @_;
3627
3628     MarkIssueReturned( $borrowernumber, $itemnum );
3629     my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3630     my $item = C4::Items::GetItem( $itemnum );
3631     my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3632     my @datearr = localtime(time);
3633     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3634     my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3635     ModItem({ paidfor =>  $old_note."Paid for by $bor $date" }, undef, $itemnum);
3636 }
3637
3638
3639 sub LostItem{
3640     my ($itemnumber, $mark_returned) = @_;
3641
3642     my $dbh = C4::Context->dbh();
3643     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3644                            FROM issues
3645                            JOIN items USING (itemnumber)
3646                            JOIN biblio USING (biblionumber)
3647                            WHERE issues.itemnumber=?");
3648     $sth->execute($itemnumber);
3649     my $issues=$sth->fetchrow_hashref();
3650
3651     # If a borrower lost the item, add a replacement cost to the their record
3652     if ( my $borrowernumber = $issues->{borrowernumber} ){
3653         my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3654
3655         if (C4::Context->preference('WhenLostForgiveFine')){
3656             my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3657             defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!";  # zero is OK, check defined
3658         }
3659         if (C4::Context->preference('WhenLostChargeReplacementFee')){
3660             C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3661             #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3662             #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3663         }
3664
3665         MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3666     }
3667 }
3668
3669 sub GetOfflineOperations {
3670     my $dbh = C4::Context->dbh;
3671     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3672     $sth->execute(C4::Context->userenv->{'branch'});
3673     my $results = $sth->fetchall_arrayref({});
3674     return $results;
3675 }
3676
3677 sub GetOfflineOperation {
3678     my $operationid = shift;
3679     return unless $operationid;
3680     my $dbh = C4::Context->dbh;
3681     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3682     $sth->execute( $operationid );
3683     return $sth->fetchrow_hashref;
3684 }
3685
3686 sub AddOfflineOperation {
3687     my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3688     my $dbh = C4::Context->dbh;
3689     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3690     $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3691     return "Added.";
3692 }
3693
3694 sub DeleteOfflineOperation {
3695     my $dbh = C4::Context->dbh;
3696     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3697     $sth->execute( shift );
3698     return "Deleted.";
3699 }
3700
3701 sub ProcessOfflineOperation {
3702     my $operation = shift;
3703
3704     my $report;
3705     if ( $operation->{action} eq 'return' ) {
3706         $report = ProcessOfflineReturn( $operation );
3707     } elsif ( $operation->{action} eq 'issue' ) {
3708         $report = ProcessOfflineIssue( $operation );
3709     } elsif ( $operation->{action} eq 'payment' ) {
3710         $report = ProcessOfflinePayment( $operation );
3711     }
3712
3713     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3714
3715     return $report;
3716 }
3717
3718 sub ProcessOfflineReturn {
3719     my $operation = shift;
3720
3721     my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3722
3723     if ( $itemnumber ) {
3724         my $issue = GetOpenIssue( $itemnumber );
3725         if ( $issue ) {
3726             MarkIssueReturned(
3727                 $issue->{borrowernumber},
3728                 $itemnumber,
3729                 undef,
3730                 $operation->{timestamp},
3731             );
3732             ModItem(
3733                 { renewals => 0, onloan => undef },
3734                 $issue->{'biblionumber'},
3735                 $itemnumber
3736             );
3737             return "Success.";
3738         } else {
3739             return "Item not issued.";
3740         }
3741     } else {
3742         return "Item not found.";
3743     }
3744 }
3745
3746 sub ProcessOfflineIssue {
3747     my $operation = shift;
3748
3749     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3750
3751     if ( $borrower->{borrowernumber} ) {
3752         my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3753         unless ($itemnumber) {
3754             return "Barcode not found.";
3755         }
3756         my $issue = GetOpenIssue( $itemnumber );
3757
3758         if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3759             MarkIssueReturned(
3760                 $issue->{borrowernumber},
3761                 $itemnumber,
3762                 undef,
3763                 $operation->{timestamp},
3764             );
3765         }
3766         AddIssue(
3767             $borrower,
3768             $operation->{'barcode'},
3769             undef,
3770             1,
3771             $operation->{timestamp},
3772             undef,
3773         );
3774         return "Success.";
3775     } else {
3776         return "Borrower not found.";
3777     }
3778 }
3779
3780 sub ProcessOfflinePayment {
3781     my $operation = shift;
3782
3783     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3784     my $amount = $operation->{amount};
3785
3786     recordpayment( $borrower->{borrowernumber}, $amount );
3787
3788     return "Success."
3789 }
3790
3791
3792 =head2 TransferSlip
3793
3794   TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3795
3796   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3797
3798 =cut
3799
3800 sub TransferSlip {
3801     my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3802
3803     my $item =  GetItem( $itemnumber, $barcode )
3804       or return;
3805
3806     return C4::Letters::GetPreparedLetter (
3807         module => 'circulation',
3808         letter_code => 'TRANSFERSLIP',
3809         branchcode => $branch,
3810         tables => {
3811             'branches'    => $to_branch,
3812             'biblio'      => $item->{biblionumber},
3813             'items'       => $item,
3814         },
3815     );
3816 }
3817
3818 =head2 CheckIfIssuedToPatron
3819
3820   CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3821
3822   Return 1 if any record item is issued to patron, otherwise return 0
3823
3824 =cut
3825
3826 sub CheckIfIssuedToPatron {
3827     my ($borrowernumber, $biblionumber) = @_;
3828
3829     my $dbh = C4::Context->dbh;
3830     my $query = q|
3831         SELECT COUNT(*) FROM issues
3832         LEFT JOIN items ON items.itemnumber = issues.itemnumber
3833         WHERE items.biblionumber = ?
3834         AND issues.borrowernumber = ?
3835     |;
3836     my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3837     return 1 if $is_issued;
3838     return;
3839 }
3840
3841 =head2 IsItemIssued
3842
3843   IsItemIssued( $itemnumber )
3844
3845   Return 1 if the item is on loan, otherwise return 0
3846
3847 =cut
3848
3849 sub IsItemIssued {
3850     my $itemnumber = shift;
3851     my $dbh = C4::Context->dbh;
3852     my $sth = $dbh->prepare(q{
3853         SELECT COUNT(*)
3854         FROM issues
3855         WHERE itemnumber = ?
3856     });
3857     $sth->execute($itemnumber);
3858     return $sth->fetchrow;
3859 }
3860
3861 =head2 GetAgeRestriction
3862
3863   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3864   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3865
3866   if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
3867   if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3868
3869 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3870 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3871 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3872          Negative days mean the borrower has gone past the age restriction age.
3873
3874 =cut
3875
3876 sub GetAgeRestriction {
3877     my ($record_restrictions, $borrower) = @_;
3878     my $markers = C4::Context->preference('AgeRestrictionMarker');
3879
3880     # Split $record_restrictions to something like FSK 16 or PEGI 6
3881     my @values = split ' ', uc($record_restrictions);
3882     return unless @values;
3883
3884     # Search first occurrence of one of the markers
3885     my @markers = split /\|/, uc($markers);
3886     return unless @markers;
3887
3888     my $index            = 0;
3889     my $restriction_year = 0;
3890     for my $value (@values) {
3891         $index++;
3892         for my $marker (@markers) {
3893             $marker =~ s/^\s+//;    #remove leading spaces
3894             $marker =~ s/\s+$//;    #remove trailing spaces
3895             if ( $marker eq $value ) {
3896                 if ( $index <= $#values ) {
3897                     $restriction_year += $values[$index];
3898                 }
3899                 last;
3900             }
3901             elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3902
3903                 # Perhaps it is something like "K16" (as in Finland)
3904                 $restriction_year += $1;
3905                 last;
3906             }
3907         }
3908         last if ( $restriction_year > 0 );
3909     }
3910
3911     #Check if the borrower is age restricted for this material and for how long.
3912     if ($restriction_year && $borrower) {
3913         if ( $borrower->{'dateofbirth'} ) {
3914             my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3915             $alloweddate[0] += $restriction_year;
3916
3917             #Prevent runime eror on leap year (invalid date)
3918             if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3919                 $alloweddate[2] = 28;
3920             }
3921
3922             #Get how many days the borrower has to reach the age restriction
3923             my @Today = split /-/, DateTime->today->ymd();
3924             my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
3925             #Negative days means the borrower went past the age restriction age
3926             return ($restriction_year, $daysToAgeRestriction);
3927         }
3928     }
3929
3930     return ($restriction_year);
3931 }
3932
3933
3934 =head2 GetPendingOnSiteCheckouts
3935
3936 =cut
3937
3938 sub GetPendingOnSiteCheckouts {
3939     my $dbh = C4::Context->dbh;
3940     return $dbh->selectall_arrayref(q|
3941         SELECT
3942           items.barcode,
3943           items.biblionumber,
3944           items.itemnumber,
3945           items.itemnotes,
3946           items.itemcallnumber,
3947           items.location,
3948           issues.date_due,
3949           issues.branchcode,
3950           issues.date_due < NOW() AS is_overdue,
3951           biblio.author,
3952           biblio.title,
3953           borrowers.firstname,
3954           borrowers.surname,
3955           borrowers.cardnumber,
3956           borrowers.borrowernumber
3957         FROM items
3958         LEFT JOIN issues ON items.itemnumber = issues.itemnumber
3959         LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
3960         LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
3961         WHERE issues.onsite_checkout = 1
3962     |, { Slice => {} } );
3963 }
3964
3965 sub GetTopIssues {
3966     my ($params) = @_;
3967
3968     my ($count, $branch, $itemtype, $ccode, $newness)
3969         = @$params{qw(count branch itemtype ccode newness)};
3970
3971     my $dbh = C4::Context->dbh;
3972     my $query = q{
3973         SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
3974           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
3975           i.ccode, SUM(i.issues) AS count
3976         FROM biblio b
3977         LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
3978         LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
3979     };
3980
3981     my (@where_strs, @where_args);
3982
3983     if ($branch) {
3984         push @where_strs, 'i.homebranch = ?';
3985         push @where_args, $branch;
3986     }
3987     if ($itemtype) {
3988         if (C4::Context->preference('item-level_itypes')){
3989             push @where_strs, 'i.itype = ?';
3990             push @where_args, $itemtype;
3991         } else {
3992             push @where_strs, 'bi.itemtype = ?';
3993             push @where_args, $itemtype;
3994         }
3995     }
3996     if ($ccode) {
3997         push @where_strs, 'i.ccode = ?';
3998         push @where_args, $ccode;
3999     }
4000     if ($newness) {
4001         push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4002         push @where_args, $newness;
4003     }
4004
4005     if (@where_strs) {
4006         $query .= 'WHERE ' . join(' AND ', @where_strs);
4007     }
4008
4009     $query .= q{
4010         GROUP BY b.biblionumber
4011         HAVING count > 0
4012         ORDER BY count DESC
4013     };
4014
4015     $count = int($count);
4016     if ($count > 0) {
4017         $query .= "LIMIT $count";
4018     }
4019
4020     my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4021
4022     return @$rows;
4023 }
4024
4025 sub _CalculateAndUpdateFine {
4026     my ($params) = @_;
4027
4028     my $borrower    = $params->{borrower};
4029     my $item        = $params->{item};
4030     my $issue       = $params->{issue};
4031     my $return_date = $params->{return_date};
4032
4033     unless ($borrower) { carp "No borrower passed in!" && return; }
4034     unless ($item)     { carp "No item passed in!"     && return; }
4035     unless ($issue)    { carp "No issue passed in!"    && return; }
4036
4037     my $datedue = $issue->{date_due};
4038
4039     # we only need to calculate and change the fines if we want to do that on return
4040     # Should be on for hourly loans
4041     my $control = C4::Context->preference('CircControl');
4042     my $control_branchcode =
4043         ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4044       : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
4045       :                                     $issue->{branchcode};
4046
4047     my $date_returned = $return_date ? dt_from_string($return_date) : dt_from_string();
4048
4049     my ( $amount, $type, $unitcounttotal ) =
4050       C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4051
4052     $type ||= q{};
4053
4054     if ( C4::Context->preference('finesMode') eq 'production' ) {
4055         if ( $amount > 0 ) {
4056             C4::Overdues::UpdateFine({
4057                 issue_id       => $issue->{issue_id},
4058                 itemnumber     => $issue->{itemnumber},
4059                 borrowernumber => $issue->{borrowernumber},
4060                 amount         => $amount,
4061                 type           => $type,
4062                 due            => output_pref($datedue),
4063             });
4064         }
4065         elsif ($return_date) {
4066
4067             # Backdated returns may have fines that shouldn't exist,
4068             # so in this case, we need to drop those fines to 0
4069
4070             C4::Overdues::UpdateFine({
4071                 issue_id       => $issue->{issue_id},
4072                 itemnumber     => $issue->{itemnumber},
4073                 borrowernumber => $issue->{borrowernumber},
4074                 amount         => 0,
4075                 type           => $type,
4076                 due            => output_pref($datedue),
4077             });
4078         }
4079     }
4080 }
4081
4082 1;
4083
4084 __END__
4085
4086 =head1 AUTHOR
4087
4088 Koha Development Team <http://koha-community.org/>
4089
4090 =cut