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