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::Context::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} = $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                 if ( $restype eq "Waiting" )
 974                 {
 975                     # The item is on reserve and waiting, but has been
 976                     # reserved by some other patron.
 977                     $needsconfirmation{RESERVE_WAITING} = 1;
 978                     $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
 979                     $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
 980                     $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
 981                     $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
 982                     $needsconfirmation{'resbranchcode'} = $res->{branchcode};
 983                     $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
 984                 }
 985                 elsif ( $restype eq "Reserved" ) {
 986                     # The item is on reserve for someone else.
 987                     $needsconfirmation{RESERVED} = 1;
 988                     $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
 989                     $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
 990                     $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
 991                     $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
 992                     $needsconfirmation{'resbranchcode'} = $res->{branchcode};
 993                     $needsconfirmation{'resreservedate'} = $res->{'reservedate'};
 994                 }
 995             }
 996         }
 997     }
 998
 999     ## CHECK AGE RESTRICTION
1000     my $agerestriction  = $biblioitem->{'agerestriction'};
1001     my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
1002     if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1003         if ( C4::Context->preference('AgeRestrictionOverride') ) {
1004             $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1005         }
1006         else {
1007             $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1008         }
1009     }
1010
1011     ## check for high holds decreasing loan period
1012     if ( C4::Context->preference('decreaseLoanHighHolds') ) {
1013         my $check = checkHighHolds( $item, $borrower );
1014
1015         if ( $check->{exceeded} ) {
1016             if ($override_high_holds) {
1017                 $alerts{HIGHHOLDS} = {
1018                     num_holds  => $check->{outstanding},
1019                     duration   => $check->{duration},
1020                     returndate => output_pref( $check->{due_date} ),
1021                 };
1022             }
1023             else {
1024                 $needsconfirmation{HIGHHOLDS} = {
1025                     num_holds  => $check->{outstanding},
1026                     duration   => $check->{duration},
1027                     returndate => output_pref( $check->{due_date} ),
1028                 };
1029             }
1030         }
1031     }
1032
1033     if (
1034         !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1035         # don't do the multiple loans per bib check if we've
1036         # already determined that we've got a loan on the same item
1037         !$issuingimpossible{NO_MORE_RENEWALS} &&
1038         !$needsconfirmation{RENEW_ISSUE}
1039     ) {
1040         # Check if borrower has already issued an item from the same biblio
1041         # Only if it's not a subscription
1042         my $biblionumber = $item->{biblionumber};
1043         require C4::Serials;
1044         my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1045         unless ($is_a_subscription) {
1046             my $issues = GetIssues( {
1047                 borrowernumber => $borrower->{borrowernumber},
1048                 biblionumber   => $biblionumber,
1049             } );
1050             my @issues = $issues ? @$issues : ();
1051             # if we get here, we don't already have a loan on this item,
1052             # so if there are any loans on this bib, ask for confirmation
1053             if (scalar @issues > 0) {
1054                 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1055             }
1056         }
1057     }
1058
1059     return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1060 }
1061
1062 =head2 CanBookBeReturned
1063
1064   ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1065
1066 Check whether the item can be returned to the provided branch
1067
1068 =over 4
1069
1070 =item C<$item> is a hash of item information as returned from GetItem
1071
1072 =item C<$branch> is the branchcode where the return is taking place
1073
1074 =back
1075
1076 Returns:
1077
1078 =over 4
1079
1080 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1081
1082 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1083
1084 =back
1085
1086 =cut
1087
1088 sub CanBookBeReturned {
1089   my ($item, $branch) = @_;
1090   my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1091
1092   # assume return is allowed to start
1093   my $allowed = 1;
1094   my $message;
1095
1096   # identify all cases where return is forbidden
1097   if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1098      $allowed = 0;
1099      $message = $item->{'homebranch'};
1100   } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1101      $allowed = 0;
1102      $message = $item->{'holdingbranch'};
1103   } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1104      $allowed = 0;
1105      $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1106   }
1107
1108   return ($allowed, $message);
1109 }
1110
1111 =head2 CheckHighHolds
1112
1113     used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1114     decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1115     has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1116
1117 =cut
1118
1119 sub checkHighHolds {
1120     my ( $item, $borrower ) = @_;
1121     my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1122     my $branch = _GetCircControlBranch( $item, $borrower );
1123
1124     my $return_data = {
1125         exceeded    => 0,
1126         outstanding => 0,
1127         duration    => 0,
1128         due_date    => undef,
1129     };
1130
1131     my $holds = Koha::Holds->search( { biblionumber => $item->{'biblionumber'} } );
1132
1133     if ( $holds->count() ) {
1134         $return_data->{outstanding} = $holds->count();
1135
1136         my $decreaseLoanHighHoldsControl        = C4::Context->preference('decreaseLoanHighHoldsControl');
1137         my $decreaseLoanHighHoldsValue          = C4::Context->preference('decreaseLoanHighHoldsValue');
1138         my $decreaseLoanHighHoldsIgnoreStatuses = C4::Context->preference('decreaseLoanHighHoldsIgnoreStatuses');
1139
1140         my @decreaseLoanHighHoldsIgnoreStatuses = split( /,/, $decreaseLoanHighHoldsIgnoreStatuses );
1141
1142         if ( $decreaseLoanHighHoldsControl eq 'static' ) {
1143
1144             # static means just more than a given number of holds on the record
1145
1146             # If the number of holds is less than the threshold, we can stop here
1147             if ( $holds->count() < $decreaseLoanHighHoldsValue ) {
1148                 return $return_data;
1149             }
1150         }
1151         elsif ( $decreaseLoanHighHoldsControl eq 'dynamic' ) {
1152
1153             # dynamic means X more than the number of holdable items on the record
1154
1155             # let's get the items
1156             my @items = $holds->next()->biblio()->items();
1157
1158             # Remove any items with status defined to be ignored even if the would not make item unholdable
1159             foreach my $status (@decreaseLoanHighHoldsIgnoreStatuses) {
1160                 @items = grep { !$_->$status } @items;
1161             }
1162
1163             # Remove any items that are not holdable for this patron
1164             @items = grep { CanItemBeReserved( $borrower->{borrowernumber}, $_->itemnumber ) eq 'OK' } @items;
1165
1166             my $items_count = scalar @items;
1167
1168             my $threshold = $items_count + $decreaseLoanHighHoldsValue;
1169
1170             # If the number of holds is less than the count of items we have
1171             # plus the number of holds allowed above that count, we can stop here
1172             if ( $holds->count() <= $threshold ) {
1173                 return $return_data;
1174             }
1175         }
1176
1177         my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1178
1179         my $calendar = Koha::Calendar->new( branchcode => $branch );
1180
1181         my $itype =
1182           ( C4::Context->preference('item-level_itypes') )
1183           ? $biblio->{'itype'}
1184           : $biblio->{'itemtype'};
1185
1186         my $orig_due = C4::Circulation::CalcDateDue( $issuedate, $itype, $branch, $borrower );
1187
1188         my $decreaseLoanHighHoldsDuration = C4::Context->preference('decreaseLoanHighHoldsDuration');
1189
1190         my $reduced_datedue = $calendar->addDate( $issuedate, $decreaseLoanHighHoldsDuration );
1191
1192         if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1193             $return_data->{exceeded} = 1;
1194             $return_data->{duration} = $decreaseLoanHighHoldsDuration;
1195             $return_data->{due_date} = $reduced_datedue;
1196         }
1197     }
1198
1199     return $return_data;
1200 }
1201
1202 =head2 AddIssue
1203
1204   &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1205
1206 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1207
1208 =over 4
1209
1210 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).
1211
1212 =item C<$barcode> is the barcode of the item being issued.
1213
1214 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1215 Calculated if empty.
1216
1217 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1218
1219 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1220 Defaults to today.  Unlike C<$datedue>, NOT a DateTime object, unfortunately.
1221
1222 AddIssue does the following things :
1223
1224   - step 01: check that there is a borrowernumber & a barcode provided
1225   - check for RENEWAL (book issued & being issued to the same patron)
1226       - renewal YES = Calculate Charge & renew
1227       - renewal NO  =
1228           * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1229           * RESERVE PLACED ?
1230               - fill reserve if reserve to this patron
1231               - cancel reserve or not, otherwise
1232           * TRANSFERT PENDING ?
1233               - complete the transfert
1234           * ISSUE THE BOOK
1235
1236 =back
1237
1238 =cut
1239
1240 sub AddIssue {
1241     my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1242
1243     my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1244     my $auto_renew = $params && $params->{auto_renew};
1245     my $dbh          = C4::Context->dbh;
1246     my $barcodecheck = CheckValidBarcode($barcode);
1247
1248     my $issue;
1249
1250     if ( $datedue && ref $datedue ne 'DateTime' ) {
1251         $datedue = dt_from_string($datedue);
1252     }
1253
1254     # $issuedate defaults to today.
1255     if ( !defined $issuedate ) {
1256         $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1257     }
1258     else {
1259         if ( ref $issuedate ne 'DateTime' ) {
1260             $issuedate = dt_from_string($issuedate);
1261
1262         }
1263     }
1264
1265     # Stop here if the patron or barcode doesn't exist
1266     if ( $borrower && $barcode && $barcodecheck ) {
1267         # find which item we issue
1268         my $item = GetItem( '', $barcode )
1269           or return;    # if we don't get an Item, abort.
1270
1271         my $branch = _GetCircControlBranch( $item, $borrower );
1272
1273         # get actual issuing if there is one
1274         my $actualissue = GetItemIssue( $item->{itemnumber} );
1275
1276         # get biblioinformation for this item
1277         my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1278
1279         # check if we just renew the issue.
1280         if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
1281             $datedue = AddRenewal(
1282                 $borrower->{'borrowernumber'},
1283                 $item->{'itemnumber'},
1284                 $branch,
1285                 $datedue,
1286                 $issuedate,    # here interpreted as the renewal date
1287             );
1288         }
1289         else {
1290             # it's NOT a renewal
1291             if ( $actualissue->{borrowernumber} ) {
1292                 # This book is currently on loan, but not to the person
1293                 # who wants to borrow it now. mark it returned before issuing to the new borrower
1294                 my ( $allowed, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
1295                 return unless $allowed;
1296                 AddReturn( $item->{'barcode'}, C4::Context->userenv->{'branch'} );
1297             }
1298
1299             MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1300
1301             # Starting process for transfer job (checking transfert and validate it if we have one)
1302             my ($datesent) = GetTransfers( $item->{'itemnumber'} );
1303             if ($datesent) {
1304                 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1305                 my $sth = $dbh->prepare(
1306                     "UPDATE branchtransfers
1307                         SET datearrived = now(),
1308                         tobranch = ?,
1309                         comments = 'Forced branchtransfer'
1310                     WHERE itemnumber= ? AND datearrived IS NULL"
1311                 );
1312                 $sth->execute( C4::Context->userenv->{'branch'},
1313                     $item->{'itemnumber'} );
1314             }
1315
1316             # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1317             unless ($auto_renew) {
1318                 my $issuingrule = GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branch );
1319                 $auto_renew = $issuingrule->{auto_renew};
1320             }
1321
1322             # Record in the database the fact that the book was issued.
1323             unless ($datedue) {
1324                 my $itype =
1325                   ( C4::Context->preference('item-level_itypes') )
1326                   ? $biblio->{'itype'}
1327                   : $biblio->{'itemtype'};
1328                 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1329
1330             }
1331             $datedue->truncate( to => 'minute' );
1332
1333             $issue = Koha::Database->new()->schema()->resultset('Issue')->create(
1334                 {
1335                     borrowernumber => $borrower->{'borrowernumber'},
1336                     itemnumber     => $item->{'itemnumber'},
1337                     issuedate      => $issuedate->strftime('%Y-%m-%d %H:%M:%S'),
1338                     date_due       => $datedue->strftime('%Y-%m-%d %H:%M:%S'),
1339                     branchcode     => C4::Context->userenv->{'branch'},
1340                     onsite_checkout => $onsite_checkout,
1341                     auto_renew      => $auto_renew ? 1 : 0
1342                 }
1343               );
1344
1345             if ( C4::Context->preference('ReturnToShelvingCart') ) {
1346                 # ReturnToShelvingCart is on, anything issued should be taken off the cart.
1347                 CartToShelf( $item->{'itemnumber'} );
1348             }
1349             $item->{'issues'}++;
1350             if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1351                 UpdateTotalIssues( $item->{'biblionumber'}, 1 );
1352             }
1353
1354             ## If item was lost, it has now been found, reverse any list item charges if necessary.
1355             if ( $item->{'itemlost'} ) {
1356                 if (
1357                     Koha::RefundLostItemFeeRules->should_refund(
1358                         {
1359                             current_branch      => C4::Context->userenv->{branch},
1360                             item_home_branch    => $item->{homebranch},
1361                             item_holding_branch => $item->{holdingbranch}
1362                         }
1363                     )
1364                   )
1365                 {
1366                     _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef,
1367                         $item->{'barcode'} );
1368                 }
1369             }
1370
1371             ModItem(
1372                 {
1373                     issues        => $item->{'issues'},
1374                     holdingbranch => C4::Context->userenv->{'branch'},
1375                     itemlost      => 0,
1376                     onloan        => $datedue->ymd(),
1377                     datelastborrowed => DateTime->now( time_zone => C4::Context->tz() )->ymd(),
1378                 },
1379                 $item->{'biblionumber'},
1380                 $item->{'itemnumber'}
1381             );
1382             ModDateLastSeen( $item->{'itemnumber'} );
1383
1384            # If it costs to borrow this book, charge it to the patron's account.
1385             my ( $charge, $itemtype ) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
1386             if ( $charge > 0 ) {
1387                 AddIssuingCharge( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge );
1388                 $item->{'charge'} = $charge;
1389             }
1390
1391             # Record the fact that this book was issued.
1392             &UpdateStats(
1393                 {
1394                     branch => C4::Context->userenv->{'branch'},
1395                     type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1396                     amount         => $charge,
1397                     other          => ( $sipmode ? "SIP-$sipmode" : '' ),
1398                     itemnumber     => $item->{'itemnumber'},
1399                     itemtype       => $item->{'itype'},
1400                     borrowernumber => $borrower->{'borrowernumber'},
1401                     ccode          => $item->{'ccode'}
1402                 }
1403             );
1404
1405             # Send a checkout slip.
1406             my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1407             my %conditions        = (
1408                 branchcode   => $branch,
1409                 categorycode => $borrower->{categorycode},
1410                 item_type    => $item->{itype},
1411                 notification => 'CHECKOUT',
1412             );
1413             if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
1414                 SendCirculationAlert(
1415                     {
1416                         type     => 'CHECKOUT',
1417                         item     => $item,
1418                         borrower => $borrower,
1419                         branch   => $branch,
1420                     }
1421                 );
1422             }
1423         }
1424
1425         logaction(
1426             "CIRCULATION", "ISSUE",
1427             $borrower->{'borrowernumber'},
1428             $biblio->{'itemnumber'}
1429         ) if C4::Context->preference("IssueLog");
1430     }
1431     return $issue;
1432 }
1433
1434 =head2 GetLoanLength
1435
1436   my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1437
1438 Get loan length for an itemtype, a borrower type and a branch
1439
1440 =cut
1441
1442 sub GetLoanLength {
1443     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1444     my $dbh = C4::Context->dbh;
1445     my $sth = $dbh->prepare(qq{
1446         SELECT issuelength, lengthunit, renewalperiod
1447         FROM issuingrules
1448         WHERE   categorycode=?
1449             AND itemtype=?
1450             AND branchcode=?
1451             AND issuelength IS NOT NULL
1452     });
1453
1454     # try to find issuelength & return the 1st available.
1455     # check with borrowertype, itemtype and branchcode, then without one of those parameters
1456     $sth->execute( $borrowertype, $itemtype, $branchcode );
1457     my $loanlength = $sth->fetchrow_hashref;
1458
1459     return $loanlength
1460       if defined($loanlength) && defined $loanlength->{issuelength};
1461
1462     $sth->execute( $borrowertype, '*', $branchcode );
1463     $loanlength = $sth->fetchrow_hashref;
1464     return $loanlength
1465       if defined($loanlength) && defined $loanlength->{issuelength};
1466
1467     $sth->execute( '*', $itemtype, $branchcode );
1468     $loanlength = $sth->fetchrow_hashref;
1469     return $loanlength
1470       if defined($loanlength) && defined $loanlength->{issuelength};
1471
1472     $sth->execute( '*', '*', $branchcode );
1473     $loanlength = $sth->fetchrow_hashref;
1474     return $loanlength
1475       if defined($loanlength) && defined $loanlength->{issuelength};
1476
1477     $sth->execute( $borrowertype, $itemtype, '*' );
1478     $loanlength = $sth->fetchrow_hashref;
1479     return $loanlength
1480       if defined($loanlength) && defined $loanlength->{issuelength};
1481
1482     $sth->execute( $borrowertype, '*', '*' );
1483     $loanlength = $sth->fetchrow_hashref;
1484     return $loanlength
1485       if defined($loanlength) && defined $loanlength->{issuelength};
1486
1487     $sth->execute( '*', $itemtype, '*' );
1488     $loanlength = $sth->fetchrow_hashref;
1489     return $loanlength
1490       if defined($loanlength) && defined $loanlength->{issuelength};
1491
1492     $sth->execute( '*', '*', '*' );
1493     $loanlength = $sth->fetchrow_hashref;
1494     return $loanlength
1495       if defined($loanlength) && defined $loanlength->{issuelength};
1496
1497     # if no rule is set => 0 day (hardcoded)
1498     return {
1499         issuelength => 0,
1500         renewalperiod => 0,
1501         lengthunit => 'days',
1502     };
1503
1504 }
1505
1506
1507 =head2 GetHardDueDate
1508
1509   my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1510
1511 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1512
1513 =cut
1514
1515 sub GetHardDueDate {
1516     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1517
1518     my $rule = GetIssuingRule( $borrowertype, $itemtype, $branchcode );
1519
1520     if ( defined( $rule ) ) {
1521         if ( $rule->{hardduedate} ) {
1522             return (dt_from_string($rule->{hardduedate}, 'iso'),$rule->{hardduedatecompare});
1523         } else {
1524             return (undef, undef);
1525         }
1526     }
1527 }
1528
1529 =head2 GetIssuingRule
1530
1531   my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1532
1533 FIXME - This is a copy-paste of GetLoanLength
1534 as a stop-gap.  Do not wish to change API for GetLoanLength
1535 this close to release.
1536
1537 Get the issuing rule for an itemtype, a borrower type and a branch
1538 Returns a hashref from the issuingrules table.
1539
1540 =cut
1541
1542 sub GetIssuingRule {
1543     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1544     my $dbh = C4::Context->dbh;
1545     my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=?"  );
1546     my $irule;
1547
1548     $sth->execute( $borrowertype, $itemtype, $branchcode );
1549     $irule = $sth->fetchrow_hashref;
1550     return $irule if defined($irule) ;
1551
1552     $sth->execute( $borrowertype, "*", $branchcode );
1553     $irule = $sth->fetchrow_hashref;
1554     return $irule if defined($irule) ;
1555
1556     $sth->execute( "*", $itemtype, $branchcode );
1557     $irule = $sth->fetchrow_hashref;
1558     return $irule if defined($irule) ;
1559
1560     $sth->execute( "*", "*", $branchcode );
1561     $irule = $sth->fetchrow_hashref;
1562     return $irule if defined($irule) ;
1563
1564     $sth->execute( $borrowertype, $itemtype, "*" );
1565     $irule = $sth->fetchrow_hashref;
1566     return $irule if defined($irule) ;
1567
1568     $sth->execute( $borrowertype, "*", "*" );
1569     $irule = $sth->fetchrow_hashref;
1570     return $irule if defined($irule) ;
1571
1572     $sth->execute( "*", $itemtype, "*" );
1573     $irule = $sth->fetchrow_hashref;
1574     return $irule if defined($irule) ;
1575
1576     $sth->execute( "*", "*", "*" );
1577     $irule = $sth->fetchrow_hashref;
1578     return $irule if defined($irule) ;
1579
1580     # if no rule matches,
1581     return;
1582 }
1583
1584 =head2 GetBranchBorrowerCircRule
1585
1586   my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1587
1588 Retrieves circulation rule attributes that apply to the given
1589 branch and patron category, regardless of item type.
1590 The return value is a hashref containing the following key:
1591
1592 maxissueqty - maximum number of loans that a
1593 patron of the given category can have at the given
1594 branch.  If the value is undef, no limit.
1595
1596 maxonsiteissueqty - maximum of on-site checkouts that a
1597 patron of the given category can have at the given
1598 branch.  If the value is undef, no limit.
1599
1600 This will first check for a specific branch and
1601 category match from branch_borrower_circ_rules.
1602
1603 If no rule is found, it will then check default_branch_circ_rules
1604 (same branch, default category).  If no rule is found,
1605 it will then check default_borrower_circ_rules (default
1606 branch, same category), then failing that, default_circ_rules
1607 (default branch, default category).
1608
1609 If no rule has been found in the database, it will default to
1610 the buillt in rule:
1611
1612 maxissueqty - undef
1613 maxonsiteissueqty - undef
1614
1615 C<$branchcode> and C<$categorycode> should contain the
1616 literal branch code and patron category code, respectively - no
1617 wildcards.
1618
1619 =cut
1620
1621 sub GetBranchBorrowerCircRule {
1622     my ( $branchcode, $categorycode ) = @_;
1623
1624     my $rules;
1625     my $dbh = C4::Context->dbh();
1626     $rules = $dbh->selectrow_hashref( q|
1627         SELECT maxissueqty, maxonsiteissueqty
1628         FROM branch_borrower_circ_rules
1629         WHERE branchcode = ?
1630         AND   categorycode = ?
1631     |, {}, $branchcode, $categorycode ) ;
1632     return $rules if $rules;
1633
1634     # try same branch, default borrower category
1635     $rules = $dbh->selectrow_hashref( q|
1636         SELECT maxissueqty, maxonsiteissueqty
1637         FROM default_branch_circ_rules
1638         WHERE branchcode = ?
1639     |, {}, $branchcode ) ;
1640     return $rules if $rules;
1641
1642     # try default branch, same borrower category
1643     $rules = $dbh->selectrow_hashref( q|
1644         SELECT maxissueqty, maxonsiteissueqty
1645         FROM default_borrower_circ_rules
1646         WHERE categorycode = ?
1647     |, {}, $categorycode ) ;
1648     return $rules if $rules;
1649
1650     # try default branch, default borrower category
1651     $rules = $dbh->selectrow_hashref( q|
1652         SELECT maxissueqty, maxonsiteissueqty
1653         FROM default_circ_rules
1654     |, {} );
1655     return $rules if $rules;
1656
1657     # built-in default circulation rule
1658     return {
1659         maxissueqty => undef,
1660         maxonsiteissueqty => undef,
1661     };
1662 }
1663
1664 =head2 GetBranchItemRule
1665
1666   my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1667
1668 Retrieves circulation rule attributes that apply to the given
1669 branch and item type, regardless of patron category.
1670
1671 The return value is a hashref containing the following keys:
1672
1673 holdallowed => Hold policy for this branch and itemtype. Possible values:
1674   0: No holds allowed.
1675   1: Holds allowed only by patrons that have the same homebranch as the item.
1676   2: Holds allowed from any patron.
1677
1678 returnbranch => branch to which to return item.  Possible values:
1679   noreturn: do not return, let item remain where checked in (floating collections)
1680   homebranch: return to item's home branch
1681   holdingbranch: return to issuer branch
1682
1683 This searches branchitemrules in the following order:
1684
1685   * Same branchcode and itemtype
1686   * Same branchcode, itemtype '*'
1687   * branchcode '*', same itemtype
1688   * branchcode and itemtype '*'
1689
1690 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1691
1692 =cut
1693
1694 sub GetBranchItemRule {
1695     my ( $branchcode, $itemtype ) = @_;
1696     my $dbh = C4::Context->dbh();
1697     my $result = {};
1698
1699     my @attempts = (
1700         ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1701             FROM branch_item_rules
1702             WHERE branchcode = ?
1703               AND itemtype = ?', $branchcode, $itemtype],
1704         ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1705             FROM default_branch_circ_rules
1706             WHERE branchcode = ?', $branchcode],
1707         ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1708             FROM default_branch_item_rules
1709             WHERE itemtype = ?', $itemtype],
1710         ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1711             FROM default_circ_rules'],
1712     );
1713
1714     foreach my $attempt (@attempts) {
1715         my ($query, @bind_params) = @{$attempt};
1716         my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1717           or next;
1718
1719         # Since branch/category and branch/itemtype use the same per-branch
1720         # defaults tables, we have to check that the key we want is set, not
1721         # just that a row was returned
1722         $result->{'holdallowed'}  = $search_result->{'holdallowed'}  unless ( defined $result->{'holdallowed'} );
1723         $result->{'hold_fulfillment_policy'} = $search_result->{'hold_fulfillment_policy'} unless ( defined $result->{'hold_fulfillment_policy'} );
1724         $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1725     }
1726
1727     # built-in default circulation rule
1728     $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1729     $result->{'hold_fulfillment_policy'} = 'any' unless ( defined $result->{'hold_fulfillment_policy'} );
1730     $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1731
1732     return $result;
1733 }
1734
1735 =head2 AddReturn
1736
1737   ($doreturn, $messages, $iteminformation, $borrower) =
1738       &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1739
1740 Returns a book.
1741
1742 =over 4
1743
1744 =item C<$barcode> is the bar code of the book being returned.
1745
1746 =item C<$branch> is the code of the branch where the book is being returned.
1747
1748 =item C<$exemptfine> indicates that overdue charges for the item will be
1749 removed. Optional.
1750
1751 =item C<$dropbox> indicates that the check-in date is assumed to be
1752 yesterday, or the last non-holiday as defined in C4::Calendar .  If
1753 overdue charges are applied and C<$dropbox> is true, the last charge
1754 will be removed.  This assumes that the fines accrual script has run
1755 for _today_. Optional.
1756
1757 =item C<$return_date> allows the default return date to be overridden
1758 by the given return date. Optional.
1759
1760 =back
1761
1762 C<&AddReturn> returns a list of four items:
1763
1764 C<$doreturn> is true iff the return succeeded.
1765
1766 C<$messages> is a reference-to-hash giving feedback on the operation.
1767 The keys of the hash are:
1768
1769 =over 4
1770
1771 =item C<BadBarcode>
1772
1773 No item with this barcode exists. The value is C<$barcode>.
1774
1775 =item C<NotIssued>
1776
1777 The book is not currently on loan. The value is C<$barcode>.
1778
1779 =item C<IsPermanent>
1780
1781 The book's home branch is a permanent collection. If you have borrowed
1782 this book, you are not allowed to return it. The value is the code for
1783 the book's home branch.
1784
1785 =item C<withdrawn>
1786
1787 This book has been withdrawn/cancelled. The value should be ignored.
1788
1789 =item C<Wrongbranch>
1790
1791 This book has was returned to the wrong branch.  The value is a hashref
1792 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1793 contain the branchcode of the incorrect and correct return library, respectively.
1794
1795 =item C<ResFound>
1796
1797 The item was reserved. The value is a reference-to-hash whose keys are
1798 fields from the reserves table of the Koha database, and
1799 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1800 either C<Waiting>, C<Reserved>, or 0.
1801
1802 =item C<WasReturned>
1803
1804 Value 1 if return is successful.
1805
1806 =item C<NeedsTransfer>
1807
1808 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
1809
1810 =back
1811
1812 C<$iteminformation> is a reference-to-hash, giving information about the
1813 returned item from the issues table.
1814
1815 C<$borrower> is a reference-to-hash, giving information about the
1816 patron who last borrowed the book.
1817
1818 =cut
1819
1820 sub AddReturn {
1821     my ( $barcode, $branch, $exemptfine, $dropbox, $return_date, $dropboxdate ) = @_;
1822
1823     if ($branch and not Koha::Libraries->find($branch)) {
1824         warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
1825         undef $branch;
1826     }
1827     $branch = C4::Context->userenv->{'branch'} unless $branch;  # we trust userenv to be a safe fallback/default
1828     my $messages;
1829     my $borrower;
1830     my $biblio;
1831     my $doreturn       = 1;
1832     my $validTransfert = 0;
1833     my $stat_type = 'return';
1834
1835     # get information on item
1836     my $itemnumber = GetItemnumberFromBarcode( $barcode );
1837     unless ($itemnumber) {
1838         return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower.  bail out.
1839     }
1840     my $issue  = GetItemIssue($itemnumber);
1841     if ($issue and $issue->{borrowernumber}) {
1842         $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1843             or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '$issue->{borrowernumber}'\n"
1844                 . Dumper($issue) . "\n";
1845     } else {
1846         $messages->{'NotIssued'} = $barcode;
1847         # even though item is not on loan, it may still be transferred;  therefore, get current branch info
1848         $doreturn = 0;
1849         # No issue, no borrowernumber.  ONLY if $doreturn, *might* you have a $borrower later.
1850         # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1851         if (C4::Context->preference("RecordLocalUseOnReturn")) {
1852            $messages->{'LocalUse'} = 1;
1853            $stat_type = 'localuse';
1854         }
1855     }
1856
1857     my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1858
1859     if ( $item->{'location'} eq 'PROC' ) {
1860         if ( C4::Context->preference("InProcessingToShelvingCart") ) {
1861             $item->{'location'} = 'CART';
1862         }
1863         else {
1864             $item->{location} = $item->{permanent_location};
1865         }
1866
1867         ModItem( $item, $item->{'biblionumber'}, $item->{'itemnumber'} );
1868     }
1869
1870         # full item data, but no borrowernumber or checkout info (no issue)
1871         # we know GetItem should work because GetItemnumberFromBarcode worked
1872     my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1873         # get the proper branch to which to return the item
1874     my $returnbranch = $item->{$hbr} || $branch ;
1875         # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1876
1877     my $borrowernumber = $borrower->{'borrowernumber'} || undef;    # we don't know if we had a borrower or not
1878
1879     my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1880     if ($yaml) {
1881         $yaml = "$yaml\n\n";  # YAML is anal on ending \n. Surplus does not hurt
1882         my $rules;
1883         eval { $rules = YAML::Load($yaml); };
1884         if ($@) {
1885             warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1886         }
1887         else {
1888             foreach my $key ( keys %$rules ) {
1889                 if ( $item->{notforloan} eq $key ) {
1890                     $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
1891                     ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
1892                     last;
1893                 }
1894             }
1895         }
1896     }
1897
1898
1899     # check if the book is in a permanent collection....
1900     # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
1901     if ( $returnbranch ) {
1902         my $branches = GetBranches();    # a potentially expensive call for a non-feature.
1903         $branches->{$returnbranch}->{PE} and $messages->{'IsPermanent'} = $returnbranch;
1904     }
1905
1906     # check if the return is allowed at this branch
1907     my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1908     unless ($returnallowed){
1909         $messages->{'Wrongbranch'} = {
1910             Wrongbranch => $branch,
1911             Rightbranch => $message
1912         };
1913         $doreturn = 0;
1914         return ( $doreturn, $messages, $issue, $borrower );
1915     }
1916
1917     if ( $item->{'withdrawn'} ) { # book has been cancelled
1918         $messages->{'withdrawn'} = 1;
1919         $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1920     }
1921
1922     # case of a return of document (deal with issues and holdingbranch)
1923     my $today = DateTime->now( time_zone => C4::Context->tz() );
1924
1925     if ($doreturn) {
1926         my $datedue = $issue->{date_due};
1927         $borrower or warn "AddReturn without current borrower";
1928                 my $circControlBranch;
1929         if ($dropbox) {
1930             # define circControlBranch only if dropbox mode is set
1931             # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1932             # FIXME: check issuedate > returndate, factoring in holidays
1933
1934             $circControlBranch = _GetCircControlBranch($item,$borrower);
1935             $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $dropboxdate ) == -1 ? 1 : 0;
1936         }
1937
1938         if ($borrowernumber) {
1939             if ( ( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'} ) || $return_date ) {
1940                 _CalculateAndUpdateFine( { issue => $issue, item => $item, borrower => $borrower, return_date => $return_date } );
1941             }
1942
1943             eval {
1944                 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
1945                     $circControlBranch, $return_date, $borrower->{'privacy'} );
1946             };
1947             if ( $@ ) {
1948                 $messages->{'Wrongbranch'} = {
1949                     Wrongbranch => $branch,
1950                     Rightbranch => $message
1951                 };
1952                 carp $@;
1953                 return ( 0, { WasReturned => 0 }, $issue, $borrower );
1954             }
1955
1956             # FIXME is the "= 1" right?  This could be the borrower hash.
1957             $messages->{'WasReturned'} = 1;
1958
1959         }
1960
1961         ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1962     }
1963
1964     # the holdingbranch is updated if the document is returned to another location.
1965     # this is always done regardless of whether the item was on loan or not
1966     my $item_holding_branch = $item->{ holdingbranch };
1967     if ($item->{'holdingbranch'} ne $branch) {
1968         UpdateHoldingbranch($branch, $item->{'itemnumber'});
1969         $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1970     }
1971     ModDateLastSeen( $item->{'itemnumber'} );
1972
1973     # check if we have a transfer for this document
1974     my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1975
1976     # if we have a transfer to do, we update the line of transfers with the datearrived
1977     my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
1978     if ($datesent) {
1979         if ( $tobranch eq $branch ) {
1980             my $sth = C4::Context->dbh->prepare(
1981                 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1982             );
1983             $sth->execute( $item->{'itemnumber'} );
1984             # if we have a reservation with valid transfer, we can set it's status to 'W'
1985             ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1986             C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1987         } else {
1988             $messages->{'WrongTransfer'}     = $tobranch;
1989             $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1990         }
1991         $validTransfert = 1;
1992     } else {
1993         ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1994     }
1995
1996     # fix up the accounts.....
1997     if ( $item->{'itemlost'} ) {
1998         $messages->{'WasLost'} = 1;
1999
2000         if ( $item->{'itemlost'} ) {
2001             if (
2002                 Koha::RefundLostItemFeeRules->should_refund(
2003                     {
2004                         current_branch      => C4::Context->userenv->{branch},
2005                         item_home_branch    => $item->{homebranch},
2006                         item_holding_branch => $item_holding_branch
2007                     }
2008                 )
2009               )
2010             {
2011                 _FixAccountForLostAndReturned( $item->{'itemnumber'}, $borrowernumber, $barcode );
2012                 $messages->{'LostItemFeeRefunded'} = 1;
2013             }
2014         }
2015     }
2016
2017     # fix up the overdues in accounts...
2018     if ($borrowernumber) {
2019         my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
2020         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!";  # zero is OK, check defined
2021
2022         if ( $issue->{overdue} && $issue->{date_due} ) {
2023         # fix fine days
2024             $today = $dropboxdate if $dropbox;
2025             my ($debardate,$reminder) = _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
2026             if ($reminder){
2027                 $messages->{'PrevDebarred'} = $debardate;
2028             } else {
2029                 $messages->{'Debarred'} = $debardate if $debardate;
2030             }
2031         # there's no overdue on the item but borrower had been previously debarred
2032         } elsif ( $issue->{date_due} and $borrower->{'debarred'} ) {
2033              if ( $borrower->{debarred} eq "9999-12-31") {
2034                 $messages->{'ForeverDebarred'} = $borrower->{'debarred'};
2035              } else {
2036                   my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2037                   $borrower_debar_dt->truncate(to => 'day');
2038                   my $today_dt = $today->clone()->truncate(to => 'day');
2039                   if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2040                       $messages->{'PrevDebarred'} = $borrower->{'debarred'};
2041                   }
2042              }
2043         }
2044     }
2045
2046     # find reserves.....
2047     # if we don't have a reserve with the status W, we launch the Checkreserves routine
2048     my ($resfound, $resrec);
2049     my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2050     ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
2051     if ($resfound) {
2052           $resrec->{'ResFound'} = $resfound;
2053         $messages->{'ResFound'} = $resrec;
2054     }
2055
2056     # Record the fact that this book was returned.
2057     # FIXME itemtype should record item level type, not bibliolevel type
2058     UpdateStats({
2059                 branch => $branch,
2060                 type => $stat_type,
2061                 itemnumber => $item->{'itemnumber'},
2062                 itemtype => $biblio->{'itemtype'},
2063                 borrowernumber => $borrowernumber,
2064                 ccode => $item->{'ccode'}}
2065     );
2066
2067     # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
2068     my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2069     my %conditions = (
2070         branchcode   => $branch,
2071         categorycode => $borrower->{categorycode},
2072         item_type    => $item->{itype},
2073         notification => 'CHECKIN',
2074     );
2075     if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2076         SendCirculationAlert({
2077             type     => 'CHECKIN',
2078             item     => $item,
2079             borrower => $borrower,
2080             branch   => $branch,
2081         });
2082     }
2083
2084     logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2085         if C4::Context->preference("ReturnLog");
2086
2087     # Remove any OVERDUES related debarment if the borrower has no overdues
2088     if ( $borrowernumber
2089       && $borrower->{'debarred'}
2090       && C4::Context->preference('AutoRemoveOverduesRestrictions')
2091       && !C4::Members::HasOverdues( $borrowernumber )
2092       && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2093     ) {
2094         DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2095     }
2096
2097     # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2098     if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2099         if  (C4::Context->preference("AutomaticItemReturn"    ) or
2100             (C4::Context->preference("UseBranchTransferLimits") and
2101              ! IsBranchTransferAllowed($branch, $returnbranch, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2102            )) {
2103             $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $returnbranch;
2104             $debug and warn "item: " . Dumper($item);
2105             ModItemTransfer($item->{'itemnumber'}, $branch, $returnbranch);
2106             $messages->{'WasTransfered'} = 1;
2107         } else {
2108             $messages->{'NeedsTransfer'} = $returnbranch;
2109         }
2110     }
2111
2112     return ( $doreturn, $messages, $issue, $borrower );
2113 }
2114
2115 =head2 MarkIssueReturned
2116
2117   MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2118
2119 Unconditionally marks an issue as being returned by
2120 moving the C<issues> row to C<old_issues> and
2121 setting C<returndate> to the current date, or
2122 the last non-holiday date of the branccode specified in
2123 C<dropbox_branch> .  Assumes you've already checked that
2124 it's safe to do this, i.e. last non-holiday > issuedate.
2125
2126 if C<$returndate> is specified (in iso format), it is used as the date
2127 of the return. It is ignored when a dropbox_branch is passed in.
2128
2129 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2130 the old_issue is immediately anonymised
2131
2132 Ideally, this function would be internal to C<C4::Circulation>,
2133 not exported, but it is currently needed by one
2134 routine in C<C4::Accounts>.
2135
2136 =cut
2137
2138 sub MarkIssueReturned {
2139     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2140
2141     my $anonymouspatron;
2142     if ( $privacy == 2 ) {
2143         # The default of 0 will not work due to foreign key constraints
2144         # The anonymisation will fail if AnonymousPatron is not a valid entry
2145         # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2146         # Note that a warning should appear on the about page (System information tab).
2147         $anonymouspatron = C4::Context->preference('AnonymousPatron');
2148         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."
2149             unless C4::Members::GetMember( borrowernumber => $anonymouspatron );
2150     }
2151     my $dbh   = C4::Context->dbh;
2152     my $query = 'UPDATE issues SET returndate=';
2153     my @bind;
2154     if ($dropbox_branch) {
2155         my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2156         my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2157         $query .= ' ? ';
2158         push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2159     } elsif ($returndate) {
2160         $query .= ' ? ';
2161         push @bind, $returndate;
2162     } else {
2163         $query .= ' now() ';
2164     }
2165     $query .= ' WHERE  borrowernumber = ?  AND itemnumber = ?';
2166     push @bind, $borrowernumber, $itemnumber;
2167     # FIXME transaction
2168     my $sth_upd  = $dbh->prepare($query);
2169     $sth_upd->execute(@bind);
2170     my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
2171                                   WHERE borrowernumber = ?
2172                                   AND itemnumber = ?');
2173     $sth_copy->execute($borrowernumber, $itemnumber);
2174     # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2175     if ( $privacy == 2) {
2176         my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
2177                                   WHERE borrowernumber = ?
2178                                   AND itemnumber = ?");
2179        $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
2180     }
2181     my $sth_del  = $dbh->prepare("DELETE FROM issues
2182                                   WHERE borrowernumber = ?
2183                                   AND itemnumber = ?");
2184     $sth_del->execute($borrowernumber, $itemnumber);
2185
2186     ModItem( { 'onloan' => undef }, undef, $itemnumber );
2187
2188     if ( C4::Context->preference('StoreLastBorrower') ) {
2189         my $item = Koha::Items->find( $itemnumber );
2190         my $patron = Koha::Patrons->find( $borrowernumber );
2191         $item->last_returned_by( $patron );
2192     }
2193 }
2194
2195 =head2 _debar_user_on_return
2196
2197     _debar_user_on_return($borrower, $item, $datedue, today);
2198
2199 C<$borrower> borrower hashref
2200
2201 C<$item> item hashref
2202
2203 C<$datedue> date due DateTime object
2204
2205 C<$today> DateTime object representing the return time
2206
2207 Internal function, called only by AddReturn that calculates and updates
2208  the user fine days, and debars him if necessary.
2209
2210 Should only be called for overdue returns
2211
2212 =cut
2213
2214 sub _debar_user_on_return {
2215     my ( $borrower, $item, $dt_due, $dt_today ) = @_;
2216
2217     my $branchcode = _GetCircControlBranch( $item, $borrower );
2218
2219     my $circcontrol = C4::Context->preference('CircControl');
2220     my $issuingrule =
2221       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2222     my $finedays = $issuingrule->{finedays};
2223     my $unit     = $issuingrule->{lengthunit};
2224     my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $dt_today, $branchcode);
2225
2226     if ($finedays) {
2227
2228         # finedays is in days, so hourly loans must multiply by 24
2229         # thus 1 hour late equals 1 day suspension * finedays rate
2230         $finedays = $finedays * 24 if ( $unit eq 'hours' );
2231
2232         # grace period is measured in the same units as the loan
2233         my $grace =
2234           DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
2235
2236         my $deltadays = DateTime::Duration->new(
2237             days => $chargeable_units
2238         );
2239         if ( $deltadays->subtract($grace)->is_positive() ) {
2240             my $suspension_days = $deltadays * $finedays;
2241
2242             # If the max suspension days is < than the suspension days
2243             # the suspension days is limited to this maximum period.
2244             my $max_sd = $issuingrule->{maxsuspensiondays};
2245             if ( defined $max_sd ) {
2246                 $max_sd = DateTime::Duration->new( days => $max_sd );
2247                 $suspension_days = $max_sd
2248                   if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2249             }
2250
2251             my $new_debar_dt =
2252               $dt_today->clone()->add_duration( $suspension_days );
2253
2254             Koha::Patron::Debarments::AddUniqueDebarment({
2255                 borrowernumber => $borrower->{borrowernumber},
2256                 expiration     => $new_debar_dt->ymd(),
2257                 type           => 'SUSPENSION',
2258             });
2259             # if borrower was already debarred but does not get an extra debarment
2260             my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
2261             if ( $borrower->{debarred} eq $patron->is_debarred ) {
2262                 return ($borrower->{debarred},1);
2263             }
2264             return $new_debar_dt->ymd();
2265         }
2266     }
2267     return;
2268 }
2269
2270 =head2 _FixOverduesOnReturn
2271
2272    &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2273
2274 C<$brn> borrowernumber
2275
2276 C<$itm> itemnumber
2277
2278 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2279 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2280
2281 Internal function, called only by AddReturn
2282
2283 =cut
2284
2285 sub _FixOverduesOnReturn {
2286     my ($borrowernumber, $item);
2287     unless ($borrowernumber = shift) {
2288         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2289         return;
2290     }
2291     unless ($item = shift) {
2292         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2293         return;
2294     }
2295     my ($exemptfine, $dropbox) = @_;
2296     my $dbh = C4::Context->dbh;
2297
2298     # check for overdue fine
2299     my $sth = $dbh->prepare(
2300 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2301     );
2302     $sth->execute( $borrowernumber, $item );
2303
2304     # alter fine to show that the book has been returned
2305     my $data = $sth->fetchrow_hashref;
2306     return 0 unless $data;    # no warning, there's just nothing to fix
2307
2308     my $uquery;
2309     my @bind = ($data->{'accountlines_id'});
2310     if ($exemptfine) {
2311         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2312         if (C4::Context->preference("FinesLog")) {
2313             &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2314         }
2315     } elsif ($dropbox && $data->{lastincrement}) {
2316         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2317         my $amt = $data->{amount} - $data->{lastincrement} ;
2318         if (C4::Context->preference("FinesLog")) {
2319             &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2320         }
2321          $uquery = "update accountlines set accounttype='F' ";
2322          if($outstanding  >= 0 && $amt >=0) {
2323             $uquery .= ", amount = ? , amountoutstanding=? ";
2324             unshift @bind, ($amt, $outstanding) ;
2325         }
2326     } else {
2327         $uquery = "update accountlines set accounttype='F' ";
2328     }
2329     $uquery .= " where (accountlines_id = ?)";
2330     my $usth = $dbh->prepare($uquery);
2331     return $usth->execute(@bind);
2332 }
2333
2334 =head2 _FixAccountForLostAndReturned
2335
2336   &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2337
2338 Calculates the charge for a book lost and returned.
2339
2340 Internal function, not exported, called only by AddReturn.
2341
2342 FIXME: This function reflects how inscrutable fines logic is.  Fix both.
2343 FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.
2344
2345 =cut
2346
2347 sub _FixAccountForLostAndReturned {
2348     my $itemnumber     = shift or return;
2349     my $borrowernumber = @_ ? shift : undef;
2350     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
2351     my $dbh = C4::Context->dbh;
2352     # check for charge made for lost book
2353     my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2354     $sth->execute($itemnumber);
2355     my $data = $sth->fetchrow_hashref;
2356     $data or return;    # bail if there is nothing to do
2357     $data->{accounttype} eq 'W' and return;    # Written off
2358
2359     # writeoff this amount
2360     my $offset;
2361     my $amount = $data->{'amount'};
2362     my $acctno = $data->{'accountno'};
2363     my $amountleft;                                             # Starts off undef/zero.
2364     if ($data->{'amountoutstanding'} == $amount) {
2365         $offset     = $data->{'amount'};
2366         $amountleft = 0;                                        # Hey, it's zero here, too.
2367     } else {
2368         $offset     = $amount - $data->{'amountoutstanding'};   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2369         $amountleft = $data->{'amountoutstanding'} - $amount;   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2370     }
2371     my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2372         WHERE (accountlines_id = ?)");
2373     $usth->execute($data->{'accountlines_id'});      # We might be adjusting an account for some OTHER borrowernumber now.  Not the one we passed in.
2374     #check if any credit is left if so writeoff other accounts
2375     my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2376     $amountleft *= -1 if ($amountleft < 0);
2377     if ($amountleft > 0) {
2378         my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2379                             AND (amountoutstanding >0) ORDER BY date");     # might want to order by amountoustanding ASC (pay smallest first)
2380         $msth->execute($data->{'borrowernumber'});
2381         # offset transactions
2382         my $newamtos;
2383         my $accdata;
2384         while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2385             if ($accdata->{'amountoutstanding'} < $amountleft) {
2386                 $newamtos = 0;
2387                 $amountleft -= $accdata->{'amountoutstanding'};
2388             }  else {
2389                 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2390                 $amountleft = 0;
2391             }
2392             my $thisacct = $accdata->{'accountlines_id'};
2393             # FIXME: move prepares outside while loop!
2394             my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2395                     WHERE (accountlines_id = ?)");
2396             $usth->execute($newamtos,$thisacct);
2397             $usth = $dbh->prepare("INSERT INTO accountoffsets
2398                 (borrowernumber, accountno, offsetaccount,  offsetamount)
2399                 VALUES
2400                 (?,?,?,?)");
2401             $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2402         }
2403     }
2404     $amountleft *= -1 if ($amountleft > 0);
2405     my $desc = "Item Returned " . $item_id;
2406     $usth = $dbh->prepare("INSERT INTO accountlines
2407         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2408         VALUES (?,?,now(),?,?,'CR',?)");
2409     $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2410     if ($borrowernumber) {
2411         # FIXME: same as query above.  use 1 sth for both
2412         $usth = $dbh->prepare("INSERT INTO accountoffsets
2413             (borrowernumber, accountno, offsetaccount,  offsetamount)
2414             VALUES (?,?,?,?)");
2415         $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2416     }
2417     ModItem({ paidfor => '' }, undef, $itemnumber);
2418     return;
2419 }
2420
2421 =head2 _GetCircControlBranch
2422
2423    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2424
2425 Internal function :
2426
2427 Return the library code to be used to determine which circulation
2428 policy applies to a transaction.  Looks up the CircControl and
2429 HomeOrHoldingBranch system preferences.
2430
2431 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2432
2433 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2434
2435 =cut
2436
2437 sub _GetCircControlBranch {
2438     my ($item, $borrower) = @_;
2439     my $circcontrol = C4::Context->preference('CircControl');
2440     my $branch;
2441
2442     if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2443         $branch= C4::Context->userenv->{'branch'};
2444     } elsif ($circcontrol eq 'PatronLibrary') {
2445         $branch=$borrower->{branchcode};
2446     } else {
2447         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2448         $branch = $item->{$branchfield};
2449         # default to item home branch if holdingbranch is used
2450         # and is not defined
2451         if (!defined($branch) && $branchfield eq 'holdingbranch') {
2452             $branch = $item->{homebranch};
2453         }
2454     }
2455     return $branch;
2456 }
2457
2458
2459
2460
2461
2462
2463 =head2 GetItemIssue
2464
2465   $issue = &GetItemIssue($itemnumber);
2466
2467 Returns patron currently having a book, or undef if not checked out.
2468
2469 C<$itemnumber> is the itemnumber.
2470
2471 C<$issue> is a hashref of the row from the issues table.
2472
2473 =cut
2474
2475 sub GetItemIssue {
2476     my ($itemnumber) = @_;
2477     return unless $itemnumber;
2478     my $sth = C4::Context->dbh->prepare(
2479         "SELECT items.*, issues.*
2480         FROM issues
2481         LEFT JOIN items ON issues.itemnumber=items.itemnumber
2482         WHERE issues.itemnumber=?");
2483     $sth->execute($itemnumber);
2484     my $data = $sth->fetchrow_hashref;
2485     return unless $data;
2486     $data->{issuedate_sql} = $data->{issuedate};
2487     $data->{date_due_sql} = $data->{date_due};
2488     $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2489     $data->{issuedate}->truncate(to => 'minute');
2490     $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2491     $data->{date_due}->truncate(to => 'minute');
2492     my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2493     $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2494     return $data;
2495 }
2496
2497 =head2 GetOpenIssue
2498
2499   $issue = GetOpenIssue( $itemnumber );
2500
2501 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2502
2503 C<$itemnumber> is the item's itemnumber
2504
2505 Returns a hashref
2506
2507 =cut
2508
2509 sub GetOpenIssue {
2510   my ( $itemnumber ) = @_;
2511   return unless $itemnumber;
2512   my $dbh = C4::Context->dbh;
2513   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2514   $sth->execute( $itemnumber );
2515   return $sth->fetchrow_hashref();
2516
2517 }
2518
2519 =head2 GetIssues
2520
2521     $issues = GetIssues({});    # return all issues!
2522     $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
2523
2524 Returns all pending issues that match given criteria.
2525 Returns a arrayref or undef if an error occurs.
2526
2527 Allowed criteria are:
2528
2529 =over 2
2530
2531 =item * borrowernumber
2532
2533 =item * biblionumber
2534
2535 =item * itemnumber
2536
2537 =back
2538
2539 =cut
2540
2541 sub GetIssues {
2542     my ($criteria) = @_;
2543
2544     # Build filters
2545     my @filters;
2546     my @allowed = qw(borrowernumber biblionumber itemnumber);
2547     foreach (@allowed) {
2548         if (defined $criteria->{$_}) {
2549             push @filters, {
2550                 field => $_,
2551                 value => $criteria->{$_},
2552             };
2553         }
2554     }
2555
2556     # Do we need to join other tables ?
2557     my %join;
2558     if (defined $criteria->{biblionumber}) {
2559         $join{items} = 1;
2560     }
2561
2562     # Build SQL query
2563     my $where = '';
2564     if (@filters) {
2565         $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
2566     }
2567     my $query = q{
2568         SELECT issues.*
2569         FROM issues
2570     };
2571     if (defined $join{items}) {
2572         $query .= q{
2573             LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
2574         };
2575     }
2576     $query .= $where;
2577
2578     # Execute SQL query
2579     my $dbh = C4::Context->dbh;
2580     my $sth = $dbh->prepare($query);
2581     my $rv = $sth->execute(map { $_->{value} } @filters);
2582
2583     return $rv ? $sth->fetchall_arrayref({}) : undef;
2584 }
2585
2586 =head2 GetItemIssues
2587
2588   $issues = &GetItemIssues($itemnumber, $history);
2589
2590 Returns patrons that have issued a book
2591
2592 C<$itemnumber> is the itemnumber
2593 C<$history> is false if you just want the current "issuer" (if any)
2594 and true if you want issues history from old_issues also.
2595
2596 Returns reference to an array of hashes
2597
2598 =cut
2599
2600 sub GetItemIssues {
2601     my ( $itemnumber, $history ) = @_;
2602
2603     my $today = DateTime->now( time_zome => C4::Context->tz);  # get today date
2604     $today->truncate( to => 'minute' );
2605     my $sql = "SELECT * FROM issues
2606               JOIN borrowers USING (borrowernumber)
2607               JOIN items     USING (itemnumber)
2608               WHERE issues.itemnumber = ? ";
2609     if ($history) {
2610         $sql .= "UNION ALL
2611                  SELECT * FROM old_issues
2612                  LEFT JOIN borrowers USING (borrowernumber)
2613                  JOIN items USING (itemnumber)
2614                  WHERE old_issues.itemnumber = ? ";
2615     }
2616     $sql .= "ORDER BY date_due DESC";
2617     my $sth = C4::Context->dbh->prepare($sql);
2618     if ($history) {
2619         $sth->execute($itemnumber, $itemnumber);
2620     } else {
2621         $sth->execute($itemnumber);
2622     }
2623     my $results = $sth->fetchall_arrayref({});
2624     foreach (@$results) {
2625         my $date_due = dt_from_string($_->{date_due},'sql');
2626         $date_due->truncate( to => 'minute' );
2627
2628         $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2629     }
2630     return $results;
2631 }
2632
2633 =head2 GetBiblioIssues
2634
2635   $issues = GetBiblioIssues($biblionumber);
2636
2637 this function get all issues from a biblionumber.
2638
2639 Return:
2640 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2641 tables issues and the firstname,surname & cardnumber from borrowers.
2642
2643 =cut
2644
2645 sub GetBiblioIssues {
2646     my $biblionumber = shift;
2647     return unless $biblionumber;
2648     my $dbh   = C4::Context->dbh;
2649     my $query = "
2650         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2651         FROM issues
2652             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2653             LEFT JOIN items ON issues.itemnumber = items.itemnumber
2654             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2655             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2656         WHERE biblio.biblionumber = ?
2657         UNION ALL
2658         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2659         FROM old_issues
2660             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2661             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2662             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2663             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2664         WHERE biblio.biblionumber = ?
2665         ORDER BY timestamp
2666     ";
2667     my $sth = $dbh->prepare($query);
2668     $sth->execute($biblionumber, $biblionumber);
2669
2670     my @issues;
2671     while ( my $data = $sth->fetchrow_hashref ) {
2672         push @issues, $data;
2673     }
2674     return \@issues;
2675 }
2676
2677 =head2 GetUpcomingDueIssues
2678
2679   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2680
2681 =cut
2682
2683 sub GetUpcomingDueIssues {
2684     my $params = shift;
2685
2686     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2687     my $dbh = C4::Context->dbh;
2688
2689     my $statement = <<END_SQL;
2690 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2691 FROM issues
2692 LEFT JOIN items USING (itemnumber)
2693 LEFT OUTER JOIN branches USING (branchcode)
2694 WHERE returndate is NULL
2695 HAVING days_until_due >= 0 AND days_until_due <= ?
2696 END_SQL
2697
2698     my @bind_parameters = ( $params->{'days_in_advance'} );
2699
2700     my $sth = $dbh->prepare( $statement );
2701     $sth->execute( @bind_parameters );
2702     my $upcoming_dues = $sth->fetchall_arrayref({});
2703
2704     return $upcoming_dues;
2705 }
2706
2707 =head2 CanBookBeRenewed
2708
2709   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2710
2711 Find out whether a borrowed item may be renewed.
2712
2713 C<$borrowernumber> is the borrower number of the patron who currently
2714 has the item on loan.
2715
2716 C<$itemnumber> is the number of the item to renew.
2717
2718 C<$override_limit>, if supplied with a true value, causes
2719 the limit on the number of times that the loan can be renewed
2720 (as controlled by the item type) to be ignored. Overriding also allows
2721 to renew sooner than "No renewal before" and to manually renew loans
2722 that are automatically renewed.
2723
2724 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2725 item must currently be on loan to the specified borrower; renewals
2726 must be allowed for the item's type; and the borrower must not have
2727 already renewed the loan. $error will contain the reason the renewal can not proceed
2728
2729 =cut
2730
2731 sub CanBookBeRenewed {
2732     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2733
2734     my $dbh    = C4::Context->dbh;
2735     my $renews = 1;
2736
2737     my $item      = GetItem($itemnumber)      or return ( 0, 'no_item' );
2738     my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
2739     return ( 0, 'onsite_checkout' ) if $itemissue->{onsite_checkout};
2740
2741     $borrowernumber ||= $itemissue->{borrowernumber};
2742     my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2743       or return;
2744
2745     my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2746
2747     # This item can fill one or more unfilled reserve, can those unfilled reserves
2748     # all be filled by other available items?
2749     if ( $resfound
2750         && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2751     {
2752         my $schema = Koha::Database->new()->schema();
2753
2754         my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2755         if ($item_holds) {
2756             # There is an item level hold on this item, no other item can fill the hold
2757             $resfound = 1;
2758         }
2759         else {
2760
2761             # Get all other items that could possibly fill reserves
2762             my @itemnumbers = $schema->resultset('Item')->search(
2763                 {
2764                     biblionumber => $resrec->{biblionumber},
2765                     onloan       => undef,
2766                     notforloan   => 0,
2767                     -not         => { itemnumber => $itemnumber }
2768                 },
2769                 { columns => 'itemnumber' }
2770             )->get_column('itemnumber')->all();
2771
2772             # Get all other reserves that could have been filled by this item
2773             my @borrowernumbers;
2774             while (1) {
2775                 my ( $reserve_found, $reserve, undef ) =
2776                   C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2777
2778                 if ($reserve_found) {
2779                     push( @borrowernumbers, $reserve->{borrowernumber} );
2780                 }
2781                 else {
2782                     last;
2783                 }
2784             }
2785
2786             # If the count of the union of the lists of reservable items for each borrower
2787             # is equal or greater than the number of borrowers, we know that all reserves
2788             # can be filled with available items. We can get the union of the sets simply
2789             # by pushing all the elements onto an array and removing the duplicates.
2790             my @reservable;
2791             foreach my $b (@borrowernumbers) {
2792                 my ($borr) = C4::Members::GetMemberDetails($b);
2793                 foreach my $i (@itemnumbers) {
2794                     my $item = GetItem($i);
2795                     if (   IsAvailableForItemLevelRequest( $item, $borr )
2796                         && CanItemBeReserved( $b, $i )
2797                         && !IsItemOnHoldAndFound($i) )
2798                     {
2799                         push( @reservable, $i );
2800                     }
2801                 }
2802             }
2803
2804             @reservable = uniq(@reservable);
2805
2806             if ( @reservable >= @borrowernumbers ) {
2807                 $resfound = 0;
2808             }
2809         }
2810     }
2811     return ( 0, "on_reserve" ) if $resfound;    # '' when no hold was found
2812
2813     return ( 1, undef ) if $override_limit;
2814
2815     my $branchcode = _GetCircControlBranch( $item, $borrower );
2816     my $issuingrule =
2817       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2818
2819     return ( 0, "too_many" )
2820       if $issuingrule->{renewalsallowed} <= $itemissue->{renewals};
2821
2822     my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2823     my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2824     my $restricted = Koha::Patrons->find( $borrowernumber )->is_debarred;
2825     my $hasoverdues = C4::Members::HasOverdues($borrowernumber);
2826
2827     if ( $restricted and $restrictionblockrenewing ) {
2828         return ( 0, 'restriction');
2829     } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($itemissue->{overdue} and $overduesblockrenewing eq 'blockitem') ) {
2830         return ( 0, 'overdue');
2831     }
2832
2833     if ( defined $issuingrule->{norenewalbefore}
2834         and $issuingrule->{norenewalbefore} ne "" )
2835     {
2836
2837         # Calculate soonest renewal by subtracting 'No renewal before' from due date
2838         my $soonestrenewal =
2839           $itemissue->{date_due}->clone()
2840           ->subtract(
2841             $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
2842
2843         # Depending on syspref reset the exact time, only check the date
2844         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2845             and $issuingrule->{lengthunit} eq 'days' )
2846         {
2847             $soonestrenewal->truncate( to => 'day' );
2848         }
2849
2850         if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
2851         {
2852             return ( 0, "auto_too_soon" ) if $itemissue->{auto_renew};
2853             return ( 0, "too_soon" );
2854         }
2855         elsif ( $itemissue->{auto_renew} ) {
2856             return ( 0, "auto_renew" );
2857         }
2858     }
2859
2860     # Fallback for automatic renewals:
2861     # If norenewalbefore is undef, don't renew before due date.
2862     elsif ( $itemissue->{auto_renew} ) {
2863         my $now = dt_from_string;
2864         return ( 0, "auto_renew" )
2865           if $now >= $itemissue->{date_due};
2866         return ( 0, "auto_too_soon" );
2867     }
2868
2869     return ( 1, undef );
2870 }
2871
2872 =head2 AddRenewal
2873
2874   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2875
2876 Renews a loan.
2877
2878 C<$borrowernumber> is the borrower number of the patron who currently
2879 has the item.
2880
2881 C<$itemnumber> is the number of the item to renew.
2882
2883 C<$branch> is the library where the renewal took place (if any).
2884            The library that controls the circ policies for the renewal is retrieved from the issues record.
2885
2886 C<$datedue> can be a DateTime object used to set the due date.
2887
2888 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2889 this parameter is not supplied, lastreneweddate is set to the current date.
2890
2891 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2892 from the book's item type.
2893
2894 =cut
2895
2896 sub AddRenewal {
2897     my $borrowernumber  = shift;
2898     my $itemnumber      = shift or return;
2899     my $branch          = shift;
2900     my $datedue         = shift;
2901     my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2902
2903     my $item   = GetItem($itemnumber) or return;
2904     my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
2905
2906     my $dbh = C4::Context->dbh;
2907
2908     # Find the issues record for this book
2909     my $issuedata  = GetItemIssue($itemnumber);
2910
2911     return unless ( $issuedata );
2912
2913     $borrowernumber ||= $issuedata->{borrowernumber};
2914
2915     if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2916         carp 'Invalid date passed to AddRenewal.';
2917         return;
2918     }
2919
2920     my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
2921
2922     if ( C4::Context->preference('CalculateFinesOnReturn') && $issuedata->{overdue} ) {
2923         _CalculateAndUpdateFine( { issue => $issuedata, item => $item, borrower => $borrower } );
2924     }
2925     _FixOverduesOnReturn( $borrowernumber, $itemnumber );
2926
2927     # If the due date wasn't specified, calculate it by adding the
2928     # book's loan length to today's date or the current due date
2929     # based on the value of the RenewalPeriodBase syspref.
2930     unless ($datedue) {
2931
2932         my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2933
2934         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2935                                         dt_from_string( $issuedata->{date_due} ) :
2936                                         DateTime->now( time_zone => C4::Context->tz());
2937         $datedue =  CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
2938     }
2939
2940     # Update the issues record to have the new due date, and a new count
2941     # of how many times it has been renewed.
2942     my $renews = $issuedata->{'renewals'} + 1;
2943     my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2944                             WHERE borrowernumber=?
2945                             AND itemnumber=?"
2946     );
2947
2948     $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2949
2950     # Update the renewal count on the item, and tell zebra to reindex
2951     $renews = $biblio->{'renewals'} + 1;
2952     ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2953
2954     # Charge a new rental fee, if applicable?
2955     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2956     if ( $charge > 0 ) {
2957         my $accountno = getnextacctno( $borrowernumber );
2958         my $item = GetBiblioFromItemNumber($itemnumber);
2959         my $manager_id = 0;
2960         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2961         $sth = $dbh->prepare(
2962                 "INSERT INTO accountlines
2963                     (date, borrowernumber, accountno, amount, manager_id,
2964                     description,accounttype, amountoutstanding, itemnumber)
2965                     VALUES (now(),?,?,?,?,?,?,?,?)"
2966         );
2967         $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2968             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2969             'Rent', $charge, $itemnumber );
2970     }
2971
2972     # Send a renewal slip according to checkout alert preferencei
2973     if ( C4::Context->preference('RenewalSendNotice') eq '1' ) {
2974         $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
2975         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2976         my %conditions        = (
2977             branchcode   => $branch,
2978             categorycode => $borrower->{categorycode},
2979             item_type    => $item->{itype},
2980             notification => 'CHECKOUT',
2981         );
2982         if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
2983             SendCirculationAlert(
2984                 {
2985                     type     => 'RENEWAL',
2986                     item     => $item,
2987                     borrower => $borrower,
2988                     branch   => $branch,
2989                 }
2990             );
2991         }
2992     }
2993
2994     # Remove any OVERDUES related debarment if the borrower has no overdues
2995     $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
2996     if ( $borrowernumber
2997       && $borrower->{'debarred'}
2998       && !C4::Members::HasOverdues( $borrowernumber )
2999       && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
3000     ) {
3001         DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
3002     }
3003
3004     # Log the renewal
3005     UpdateStats({branch => $branch,
3006                 type => 'renew',
3007                 amount => $charge,
3008                 itemnumber => $itemnumber,
3009                 itemtype => $item->{itype},
3010                 borrowernumber => $borrowernumber,
3011                 ccode => $item->{'ccode'}}
3012                 );
3013         return $datedue;
3014 }
3015
3016 sub GetRenewCount {
3017     # check renewal status
3018     my ( $bornum, $itemno ) = @_;
3019     my $dbh           = C4::Context->dbh;
3020     my $renewcount    = 0;
3021     my $renewsallowed = 0;
3022     my $renewsleft    = 0;
3023
3024     my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
3025     my $item     = GetItem($itemno);
3026
3027     # Look in the issues table for this item, lent to this borrower,
3028     # and not yet returned.
3029
3030     # FIXME - I think this function could be redone to use only one SQL call.
3031     my $sth = $dbh->prepare(
3032         "select * from issues
3033                                 where (borrowernumber = ?)
3034                                 and (itemnumber = ?)"
3035     );
3036     $sth->execute( $bornum, $itemno );
3037     my $data = $sth->fetchrow_hashref;
3038     $renewcount = $data->{'renewals'} if $data->{'renewals'};
3039     # $item and $borrower should be calculated
3040     my $branchcode = _GetCircControlBranch($item, $borrower);
3041
3042     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
3043
3044     $renewsallowed = $issuingrule->{'renewalsallowed'};
3045     $renewsleft    = $renewsallowed - $renewcount;
3046     if($renewsleft < 0){ $renewsleft = 0; }
3047     return ( $renewcount, $renewsallowed, $renewsleft );
3048 }
3049
3050 =head2 GetSoonestRenewDate
3051
3052   $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3053
3054 Find out the soonest possible renew date of a borrowed item.
3055
3056 C<$borrowernumber> is the borrower number of the patron who currently
3057 has the item on loan.
3058
3059 C<$itemnumber> is the number of the item to renew.
3060
3061 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3062 renew date, based on the value "No renewal before" of the applicable
3063 issuing rule. Returns the current date if the item can already be
3064 renewed, and returns undefined if the borrower, loan, or item
3065 cannot be found.
3066
3067 =cut
3068
3069 sub GetSoonestRenewDate {
3070     my ( $borrowernumber, $itemnumber ) = @_;
3071
3072     my $dbh = C4::Context->dbh;
3073
3074     my $item      = GetItem($itemnumber)      or return;
3075     my $itemissue = GetItemIssue($itemnumber) or return;
3076
3077     $borrowernumber ||= $itemissue->{borrowernumber};
3078     my $borrower = C4::Members::GetMemberDetails($borrowernumber)
3079       or return;
3080
3081     my $branchcode = _GetCircControlBranch( $item, $borrower );
3082     my $issuingrule =
3083       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
3084
3085     my $now = dt_from_string;
3086
3087     if ( defined $issuingrule->{norenewalbefore}
3088         and $issuingrule->{norenewalbefore} ne "" )
3089     {
3090         my $soonestrenewal =
3091           $itemissue->{date_due}->clone()
3092           ->subtract(
3093             $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
3094
3095         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3096             and $issuingrule->{lengthunit} eq 'days' )
3097         {
3098             $soonestrenewal->truncate( to => 'day' );
3099         }
3100         return $soonestrenewal if $now < $soonestrenewal;
3101     }
3102     return $now;
3103 }
3104
3105 =head2 GetIssuingCharges
3106
3107   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3108
3109 Calculate how much it would cost for a given patron to borrow a given
3110 item, including any applicable discounts.
3111
3112 C<$itemnumber> is the item number of item the patron wishes to borrow.
3113
3114 C<$borrowernumber> is the patron's borrower number.
3115
3116 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3117 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3118 if it's a video).
3119
3120 =cut
3121
3122 sub GetIssuingCharges {
3123
3124     # calculate charges due
3125     my ( $itemnumber, $borrowernumber ) = @_;
3126     my $charge = 0;
3127     my $dbh    = C4::Context->dbh;
3128     my $item_type;
3129
3130     # Get the book's item type and rental charge (via its biblioitem).
3131     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3132         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3133     $charge_query .= (C4::Context->preference('item-level_itypes'))
3134         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3135         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3136
3137     $charge_query .= ' WHERE items.itemnumber =?';
3138
3139     my $sth = $dbh->prepare($charge_query);
3140     $sth->execute($itemnumber);
3141     if ( my $item_data = $sth->fetchrow_hashref ) {
3142         $item_type = $item_data->{itemtype};
3143         $charge    = $item_data->{rentalcharge};
3144         my $branch = C4::Context::mybranch();
3145         my $discount_query = q|SELECT rentaldiscount,
3146             issuingrules.itemtype, issuingrules.branchcode
3147             FROM borrowers
3148             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3149             WHERE borrowers.borrowernumber = ?
3150             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3151             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3152         my $discount_sth = $dbh->prepare($discount_query);
3153         $discount_sth->execute( $borrowernumber, $item_type, $branch );
3154         my $discount_rules = $discount_sth->fetchall_arrayref({});
3155         if (@{$discount_rules}) {
3156             # We may have multiple rules so get the most specific
3157             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3158             $charge = ( $charge * ( 100 - $discount ) ) / 100;
3159         }
3160     }
3161
3162     return ( $charge, $item_type );
3163 }
3164
3165 # Select most appropriate discount rule from those returned
3166 sub _get_discount_from_rule {
3167     my ($rules_ref, $branch, $itemtype) = @_;
3168     my $discount;
3169
3170     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3171         $discount = $rules_ref->[0]->{rentaldiscount};
3172         return (defined $discount) ? $discount : 0;
3173     }
3174     # could have up to 4 does one match $branch and $itemtype
3175     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3176     if (@d) {
3177         $discount = $d[0]->{rentaldiscount};
3178         return (defined $discount) ? $discount : 0;
3179     }
3180     # do we have item type + all branches
3181     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3182     if (@d) {
3183         $discount = $d[0]->{rentaldiscount};
3184         return (defined $discount) ? $discount : 0;
3185     }
3186     # do we all item types + this branch
3187     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3188     if (@d) {
3189         $discount = $d[0]->{rentaldiscount};
3190         return (defined $discount) ? $discount : 0;
3191     }
3192     # so all and all (surely we wont get here)
3193     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3194     if (@d) {
3195         $discount = $d[0]->{rentaldiscount};
3196         return (defined $discount) ? $discount : 0;
3197     }
3198     # none of the above
3199     return 0;
3200 }
3201
3202 =head2 AddIssuingCharge
3203
3204   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3205
3206 =cut
3207
3208 sub AddIssuingCharge {
3209     my ( $itemnumber, $borrowernumber, $charge ) = @_;
3210     my $dbh = C4::Context->dbh;
3211     my $nextaccntno = getnextacctno( $borrowernumber );
3212     my $manager_id = 0;
3213     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3214     my $query ="
3215         INSERT INTO accountlines
3216             (borrowernumber, itemnumber, accountno,
3217             date, amount, description, accounttype,
3218             amountoutstanding, manager_id)
3219         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3220     ";
3221     my $sth = $dbh->prepare($query);
3222     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3223 }
3224
3225 =head2 GetTransfers
3226
3227   GetTransfers($itemnumber);
3228
3229 =cut
3230
3231 sub GetTransfers {
3232     my ($itemnumber) = @_;
3233
3234     my $dbh = C4::Context->dbh;
3235
3236     my $query = '
3237         SELECT datesent,
3238                frombranch,
3239                tobranch
3240         FROM branchtransfers
3241         WHERE itemnumber = ?
3242           AND datearrived IS NULL
3243         ';
3244     my $sth = $dbh->prepare($query);
3245     $sth->execute($itemnumber);
3246     my @row = $sth->fetchrow_array();
3247     return @row;
3248 }
3249
3250 =head2 GetTransfersFromTo
3251
3252   @results = GetTransfersFromTo($frombranch,$tobranch);
3253
3254 Returns the list of pending transfers between $from and $to branch
3255
3256 =cut
3257
3258 sub GetTransfersFromTo {
3259     my ( $frombranch, $tobranch ) = @_;
3260     return unless ( $frombranch && $tobranch );
3261     my $dbh   = C4::Context->dbh;
3262     my $query = "
3263         SELECT itemnumber,datesent,frombranch
3264         FROM   branchtransfers
3265         WHERE  frombranch=?
3266           AND  tobranch=?
3267           AND datearrived IS NULL
3268     ";
3269     my $sth = $dbh->prepare($query);
3270     $sth->execute( $frombranch, $tobranch );
3271     my @gettransfers;
3272
3273     while ( my $data = $sth->fetchrow_hashref ) {
3274         push @gettransfers, $data;
3275     }
3276     return (@gettransfers);
3277 }
3278
3279 =head2 DeleteTransfer
3280
3281   &DeleteTransfer($itemnumber);
3282
3283 =cut
3284
3285 sub DeleteTransfer {
3286     my ($itemnumber) = @_;
3287     return unless $itemnumber;
3288     my $dbh          = C4::Context->dbh;
3289     my $sth          = $dbh->prepare(
3290         "DELETE FROM branchtransfers
3291          WHERE itemnumber=?
3292          AND datearrived IS NULL "
3293     );
3294     return $sth->execute($itemnumber);
3295 }
3296
3297 =head2 AnonymiseIssueHistory
3298
3299   ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3300
3301 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3302 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3303
3304 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3305 setting (force delete).
3306
3307 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3308
3309 =cut
3310
3311 sub AnonymiseIssueHistory {
3312     my $date           = shift;
3313     my $borrowernumber = shift;
3314     my $dbh            = C4::Context->dbh;
3315     my $query          = "
3316         UPDATE old_issues
3317         SET    borrowernumber = ?
3318         WHERE  returndate < ?
3319           AND borrowernumber IS NOT NULL
3320     ";
3321
3322     # The default of 0 does not work due to foreign key constraints
3323     # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
3324     # Set it to undef (NULL)
3325     my $anonymouspatron = C4::Context->preference('AnonymousPatron') || undef;
3326     my @bind_params = ($anonymouspatron, $date);
3327     if (defined $borrowernumber) {
3328        $query .= " AND borrowernumber = ?";
3329        push @bind_params, $borrowernumber;
3330     } else {
3331        $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3332     }
3333     my $sth = $dbh->prepare($query);
3334     $sth->execute(@bind_params);
3335     my $anonymisation_err = $dbh->err;
3336     my $rows_affected = $sth->rows;  ### doublecheck row count return function
3337     return ($rows_affected, $anonymisation_err);
3338 }
3339
3340 =head2 SendCirculationAlert
3341
3342 Send out a C<check-in> or C<checkout> alert using the messaging system.
3343
3344 B<Parameters>:
3345
3346 =over 4
3347
3348 =item type
3349
3350 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3351
3352 =item item
3353
3354 Hashref of information about the item being checked in or out.
3355
3356 =item borrower
3357
3358 Hashref of information about the borrower of the item.
3359
3360 =item branch
3361
3362 The branchcode from where the checkout or check-in took place.
3363
3364 =back
3365
3366 B<Example>:
3367
3368     SendCirculationAlert({
3369         type     => 'CHECKOUT',
3370         item     => $item,
3371         borrower => $borrower,
3372         branch   => $branch,
3373     });
3374
3375 =cut
3376
3377 sub SendCirculationAlert {
3378     my ($opts) = @_;
3379     my ($type, $item, $borrower, $branch) =
3380         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3381     my %message_name = (
3382         CHECKIN  => 'Item_Check_in',
3383         CHECKOUT => 'Item_Checkout',
3384         RENEWAL  => 'Item_Checkout',
3385     );
3386     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3387         borrowernumber => $borrower->{borrowernumber},
3388         message_name   => $message_name{$type},
3389     });
3390     my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3391
3392     my @transports = keys %{ $borrower_preferences->{transports} };
3393     # warn "no transports" unless @transports;
3394     for (@transports) {
3395         # warn "transport: $_";
3396         my $message = C4::Message->find_last_message($borrower, $type, $_);
3397         if (!$message) {
3398             #warn "create new message";
3399             my $letter =  C4::Letters::GetPreparedLetter (
3400                 module => 'circulation',
3401                 letter_code => $type,
3402                 branchcode => $branch,
3403                 message_transport_type => $_,
3404                 tables => {
3405                     $issues_table => $item->{itemnumber},
3406                     'items'       => $item->{itemnumber},
3407                     'biblio'      => $item->{biblionumber},
3408                     'biblioitems' => $item->{biblionumber},
3409                     'borrowers'   => $borrower,
3410                     'branches'    => $branch,
3411                 }
3412             ) or next;
3413             C4::Message->enqueue($letter, $borrower, $_);
3414         } else {
3415             #warn "append to old message";
3416             my $letter =  C4::Letters::GetPreparedLetter (
3417                 module => 'circulation',
3418                 letter_code => $type,
3419                 branchcode => $branch,
3420                 message_transport_type => $_,
3421                 tables => {
3422                     $issues_table => $item->{itemnumber},
3423                     'items'       => $item->{itemnumber},
3424                     'biblio'      => $item->{biblionumber},
3425                     'biblioitems' => $item->{biblionumber},
3426                     'borrowers'   => $borrower,
3427                     'branches'    => $branch,
3428                 }
3429             ) or next;
3430             $message->append($letter);
3431             $message->update;
3432         }
3433     }
3434
3435     return;
3436 }
3437
3438 =head2 updateWrongTransfer
3439
3440   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3441
3442 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
3443
3444 =cut
3445
3446 sub updateWrongTransfer {
3447         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3448         my $dbh = C4::Context->dbh;
3449 # first step validate the actual line of transfert .
3450         my $sth =
3451                 $dbh->prepare(
3452                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3453                 );
3454                 $sth->execute($FromLibrary,$itemNumber);
3455
3456 # second step create a new line of branchtransfer to the right location .
3457         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3458
3459 #third step changing holdingbranch of item
3460         UpdateHoldingbranch($FromLibrary,$itemNumber);
3461 }
3462
3463 =head2 UpdateHoldingbranch
3464
3465   $items = UpdateHoldingbranch($branch,$itmenumber);
3466
3467 Simple methode for updating hodlingbranch in items BDD line
3468
3469 =cut
3470
3471 sub UpdateHoldingbranch {
3472         my ( $branch,$itemnumber ) = @_;
3473     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3474 }
3475
3476 =head2 CalcDateDue
3477
3478 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3479
3480 this function calculates the due date given the start date and configured circulation rules,
3481 checking against the holidays calendar as per the 'useDaysMode' syspref.
3482 C<$startdate>   = DateTime object representing start date of loan period (assumed to be today)
3483 C<$itemtype>  = itemtype code of item in question
3484 C<$branch>  = location whose calendar to use
3485 C<$borrower> = Borrower object
3486 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3487
3488 =cut
3489
3490 sub CalcDateDue {
3491     my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3492
3493     $isrenewal ||= 0;
3494
3495     # loanlength now a href
3496     my $loanlength =
3497             GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3498
3499     my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3500             ? qq{renewalperiod}
3501             : qq{issuelength};
3502
3503     my $datedue;
3504     if ( $startdate ) {
3505         if (ref $startdate ne 'DateTime' ) {
3506             $datedue = dt_from_string($datedue);
3507         } else {
3508             $datedue = $startdate->clone;
3509         }
3510     } else {
3511         $datedue =
3512           DateTime->now( time_zone => C4::Context->tz() )
3513           ->truncate( to => 'minute' );
3514     }
3515
3516
3517     # calculate the datedue as normal
3518     if ( C4::Context->preference('useDaysMode') eq 'Days' )
3519     {    # ignoring calendar
3520         if ( $loanlength->{lengthunit} eq 'hours' ) {
3521             $datedue->add( hours => $loanlength->{$length_key} );
3522         } else {    # days
3523             $datedue->add( days => $loanlength->{$length_key} );
3524             $datedue->set_hour(23);
3525             $datedue->set_minute(59);
3526         }
3527     } else {
3528         my $dur;
3529         if ($loanlength->{lengthunit} eq 'hours') {
3530             $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3531         }
3532         else { # days
3533             $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3534         }
3535         my $calendar = Koha::Calendar->new( branchcode => $branch );
3536         $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3537         if ($loanlength->{lengthunit} eq 'days') {
3538             $datedue->set_hour(23);
3539             $datedue->set_minute(59);
3540         }
3541     }
3542
3543     # if Hard Due Dates are used, retrieve them and apply as necessary
3544     my ( $hardduedate, $hardduedatecompare ) =
3545       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3546     if ($hardduedate) {    # hardduedates are currently dates
3547         $hardduedate->truncate( to => 'minute' );
3548         $hardduedate->set_hour(23);
3549         $hardduedate->set_minute(59);
3550         my $cmp = DateTime->compare( $hardduedate, $datedue );
3551
3552 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3553 # if the calculated date is before the 'after' Hard Due Date (floor), override
3554 # if the hard due date is set to 'exactly', overrride
3555         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3556             $datedue = $hardduedate->clone;
3557         }
3558
3559         # in all other cases, keep the date due as it is
3560
3561     }
3562
3563     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3564     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3565         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3566         if( $expiry_dt ) { #skip empty expiry date..
3567             $expiry_dt->set( hour => 23, minute => 59);
3568             my $d1= $datedue->clone->set_time_zone('floating');
3569             if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3570                 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3571             }
3572         }
3573     }
3574
3575     return $datedue;
3576 }
3577
3578
3579 sub CheckValidBarcode{
3580 my ($barcode) = @_;
3581 my $dbh = C4::Context->dbh;
3582 my $query=qq|SELECT count(*)
3583              FROM items
3584              WHERE barcode=?
3585             |;
3586 my $sth = $dbh->prepare($query);
3587 $sth->execute($barcode);
3588 my $exist=$sth->fetchrow ;
3589 return $exist;
3590 }
3591
3592 =head2 IsBranchTransferAllowed
3593
3594   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3595
3596 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3597
3598 =cut
3599
3600 sub IsBranchTransferAllowed {
3601         my ( $toBranch, $fromBranch, $code ) = @_;
3602
3603         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3604
3605         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3606         my $dbh = C4::Context->dbh;
3607
3608         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3609         $sth->execute( $toBranch, $fromBranch, $code );
3610         my $limit = $sth->fetchrow_hashref();
3611
3612         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3613         if ( $limit->{'limitId'} ) {
3614                 return 0;
3615         } else {
3616                 return 1;
3617         }
3618 }
3619
3620 =head2 CreateBranchTransferLimit
3621
3622   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3623
3624 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3625
3626 =cut
3627
3628 sub CreateBranchTransferLimit {
3629    my ( $toBranch, $fromBranch, $code ) = @_;
3630    return unless defined($toBranch) && defined($fromBranch);
3631    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3632
3633    my $dbh = C4::Context->dbh;
3634
3635    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3636    return $sth->execute( $code, $toBranch, $fromBranch );
3637 }
3638
3639 =head2 DeleteBranchTransferLimits
3640
3641     my $result = DeleteBranchTransferLimits($frombranch);
3642
3643 Deletes all the library transfer limits for one library.  Returns the
3644 number of limits deleted, 0e0 if no limits were deleted, or undef if
3645 no arguments are supplied.
3646
3647 =cut
3648
3649 sub DeleteBranchTransferLimits {
3650     my $branch = shift;
3651     return unless defined $branch;
3652     my $dbh    = C4::Context->dbh;
3653     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3654     return $sth->execute($branch);
3655 }
3656
3657 sub ReturnLostItem{
3658     my ( $borrowernumber, $itemnum ) = @_;
3659
3660     MarkIssueReturned( $borrowernumber, $itemnum );
3661     my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3662     my $item = C4::Items::GetItem( $itemnum );
3663     my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3664     my @datearr = localtime(time);
3665     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3666     my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3667     ModItem({ paidfor =>  $old_note."Paid for by $bor $date" }, undef, $itemnum);
3668 }
3669
3670
3671 sub LostItem{
3672     my ($itemnumber, $mark_returned) = @_;
3673
3674     my $dbh = C4::Context->dbh();
3675     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3676                            FROM issues
3677                            JOIN items USING (itemnumber)
3678                            JOIN biblio USING (biblionumber)
3679                            WHERE issues.itemnumber=?");
3680     $sth->execute($itemnumber);
3681     my $issues=$sth->fetchrow_hashref();
3682
3683     # If a borrower lost the item, add a replacement cost to the their record
3684     if ( my $borrowernumber = $issues->{borrowernumber} ){
3685         my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3686
3687         if (C4::Context->preference('WhenLostForgiveFine')){
3688             my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3689             defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!";  # zero is OK, check defined
3690         }
3691         if (C4::Context->preference('WhenLostChargeReplacementFee')){
3692             C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3693             #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3694             #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3695         }
3696
3697         MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3698     }
3699 }
3700
3701 sub GetOfflineOperations {
3702     my $dbh = C4::Context->dbh;
3703     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3704     $sth->execute(C4::Context->userenv->{'branch'});
3705     my $results = $sth->fetchall_arrayref({});
3706     return $results;
3707 }
3708
3709 sub GetOfflineOperation {
3710     my $operationid = shift;
3711     return unless $operationid;
3712     my $dbh = C4::Context->dbh;
3713     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3714     $sth->execute( $operationid );
3715     return $sth->fetchrow_hashref;
3716 }
3717
3718 sub AddOfflineOperation {
3719     my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3720     my $dbh = C4::Context->dbh;
3721     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3722     $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3723     return "Added.";
3724 }
3725
3726 sub DeleteOfflineOperation {
3727     my $dbh = C4::Context->dbh;
3728     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3729     $sth->execute( shift );
3730     return "Deleted.";
3731 }
3732
3733 sub ProcessOfflineOperation {
3734     my $operation = shift;
3735
3736     my $report;
3737     if ( $operation->{action} eq 'return' ) {
3738         $report = ProcessOfflineReturn( $operation );
3739     } elsif ( $operation->{action} eq 'issue' ) {
3740         $report = ProcessOfflineIssue( $operation );
3741     } elsif ( $operation->{action} eq 'payment' ) {
3742         $report = ProcessOfflinePayment( $operation );
3743     }
3744
3745     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3746
3747     return $report;
3748 }
3749
3750 sub ProcessOfflineReturn {
3751     my $operation = shift;
3752
3753     my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3754
3755     if ( $itemnumber ) {
3756         my $issue = GetOpenIssue( $itemnumber );
3757         if ( $issue ) {
3758             MarkIssueReturned(
3759                 $issue->{borrowernumber},
3760                 $itemnumber,
3761                 undef,
3762                 $operation->{timestamp},
3763             );
3764             ModItem(
3765                 { renewals => 0, onloan => undef },
3766                 $issue->{'biblionumber'},
3767                 $itemnumber
3768             );
3769             return "Success.";
3770         } else {
3771             return "Item not issued.";
3772         }
3773     } else {
3774         return "Item not found.";
3775     }
3776 }
3777
3778 sub ProcessOfflineIssue {
3779     my $operation = shift;
3780
3781     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3782
3783     if ( $borrower->{borrowernumber} ) {
3784         my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3785         unless ($itemnumber) {
3786             return "Barcode not found.";
3787         }
3788         my $issue = GetOpenIssue( $itemnumber );
3789
3790         if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3791             MarkIssueReturned(
3792                 $issue->{borrowernumber},
3793                 $itemnumber,
3794                 undef,
3795                 $operation->{timestamp},
3796             );
3797         }
3798         AddIssue(
3799             $borrower,
3800             $operation->{'barcode'},
3801             undef,
3802             1,
3803             $operation->{timestamp},
3804             undef,
3805         );
3806         return "Success.";
3807     } else {
3808         return "Borrower not found.";
3809     }
3810 }
3811
3812 sub ProcessOfflinePayment {
3813     my $operation = shift;
3814
3815     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3816     my $amount = $operation->{amount};
3817
3818     recordpayment( $borrower->{borrowernumber}, $amount );
3819
3820     return "Success."
3821 }
3822
3823
3824 =head2 TransferSlip
3825
3826   TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3827
3828   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3829
3830 =cut
3831
3832 sub TransferSlip {
3833     my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3834
3835     my $item =  GetItem( $itemnumber, $barcode )
3836       or return;
3837
3838     return C4::Letters::GetPreparedLetter (
3839         module => 'circulation',
3840         letter_code => 'TRANSFERSLIP',
3841         branchcode => $branch,
3842         tables => {
3843             'branches'    => $to_branch,
3844             'biblio'      => $item->{biblionumber},
3845             'items'       => $item,
3846         },
3847     );
3848 }
3849
3850 =head2 CheckIfIssuedToPatron
3851
3852   CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3853
3854   Return 1 if any record item is issued to patron, otherwise return 0
3855
3856 =cut
3857
3858 sub CheckIfIssuedToPatron {
3859     my ($borrowernumber, $biblionumber) = @_;
3860
3861     my $dbh = C4::Context->dbh;
3862     my $query = q|
3863         SELECT COUNT(*) FROM issues
3864         LEFT JOIN items ON items.itemnumber = issues.itemnumber
3865         WHERE items.biblionumber = ?
3866         AND issues.borrowernumber = ?
3867     |;
3868     my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3869     return 1 if $is_issued;
3870     return;
3871 }
3872
3873 =head2 IsItemIssued
3874
3875   IsItemIssued( $itemnumber )
3876
3877   Return 1 if the item is on loan, otherwise return 0
3878
3879 =cut
3880
3881 sub IsItemIssued {
3882     my $itemnumber = shift;
3883     my $dbh = C4::Context->dbh;
3884     my $sth = $dbh->prepare(q{
3885         SELECT COUNT(*)
3886         FROM issues
3887         WHERE itemnumber = ?
3888     });
3889     $sth->execute($itemnumber);
3890     return $sth->fetchrow;
3891 }
3892
3893 =head2 GetAgeRestriction
3894
3895   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3896   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3897
3898   if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
3899   if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3900
3901 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3902 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3903 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3904          Negative days mean the borrower has gone past the age restriction age.
3905
3906 =cut
3907
3908 sub GetAgeRestriction {
3909     my ($record_restrictions, $borrower) = @_;
3910     my $markers = C4::Context->preference('AgeRestrictionMarker');
3911
3912     # Split $record_restrictions to something like FSK 16 or PEGI 6
3913     my @values = split ' ', uc($record_restrictions);
3914     return unless @values;
3915
3916     # Search first occurrence of one of the markers
3917     my @markers = split /\|/, uc($markers);
3918     return unless @markers;
3919
3920     my $index            = 0;
3921     my $restriction_year = 0;
3922     for my $value (@values) {
3923         $index++;
3924         for my $marker (@markers) {
3925             $marker =~ s/^\s+//;    #remove leading spaces
3926             $marker =~ s/\s+$//;    #remove trailing spaces
3927             if ( $marker eq $value ) {
3928                 if ( $index <= $#values ) {
3929                     $restriction_year += $values[$index];
3930                 }
3931                 last;
3932             }
3933             elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3934
3935                 # Perhaps it is something like "K16" (as in Finland)
3936                 $restriction_year += $1;
3937                 last;
3938             }
3939         }
3940         last if ( $restriction_year > 0 );
3941     }
3942
3943     #Check if the borrower is age restricted for this material and for how long.
3944     if ($restriction_year && $borrower) {
3945         if ( $borrower->{'dateofbirth'} ) {
3946             my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3947             $alloweddate[0] += $restriction_year;
3948
3949             #Prevent runime eror on leap year (invalid date)
3950             if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3951                 $alloweddate[2] = 28;
3952             }
3953
3954             #Get how many days the borrower has to reach the age restriction
3955             my @Today = split /-/, DateTime->today->ymd();
3956             my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
3957             #Negative days means the borrower went past the age restriction age
3958             return ($restriction_year, $daysToAgeRestriction);
3959         }
3960     }
3961
3962     return ($restriction_year);
3963 }
3964
3965
3966 =head2 GetPendingOnSiteCheckouts
3967
3968 =cut
3969
3970 sub GetPendingOnSiteCheckouts {
3971     my $dbh = C4::Context->dbh;
3972     return $dbh->selectall_arrayref(q|
3973         SELECT
3974           items.barcode,
3975           items.biblionumber,
3976           items.itemnumber,
3977           items.itemnotes,
3978           items.itemcallnumber,
3979           items.location,
3980           issues.date_due,
3981           issues.branchcode,
3982           issues.date_due < NOW() AS is_overdue,
3983           biblio.author,
3984           biblio.title,
3985           borrowers.firstname,
3986           borrowers.surname,
3987           borrowers.cardnumber,
3988           borrowers.borrowernumber
3989         FROM items
3990         LEFT JOIN issues ON items.itemnumber = issues.itemnumber
3991         LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
3992         LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
3993         WHERE issues.onsite_checkout = 1
3994     |, { Slice => {} } );
3995 }
3996
3997 sub GetTopIssues {
3998     my ($params) = @_;
3999
4000     my ($count, $branch, $itemtype, $ccode, $newness)
4001         = @$params{qw(count branch itemtype ccode newness)};
4002
4003     my $dbh = C4::Context->dbh;
4004     my $query = q{
4005         SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4006           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4007           i.ccode, SUM(i.issues) AS count
4008         FROM biblio b
4009         LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4010         LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4011     };
4012
4013     my (@where_strs, @where_args);
4014
4015     if ($branch) {
4016         push @where_strs, 'i.homebranch = ?';
4017         push @where_args, $branch;
4018     }
4019     if ($itemtype) {
4020         if (C4::Context->preference('item-level_itypes')){
4021             push @where_strs, 'i.itype = ?';
4022             push @where_args, $itemtype;
4023         } else {
4024             push @where_strs, 'bi.itemtype = ?';
4025             push @where_args, $itemtype;
4026         }
4027     }
4028     if ($ccode) {
4029         push @where_strs, 'i.ccode = ?';
4030         push @where_args, $ccode;
4031     }
4032     if ($newness) {
4033         push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4034         push @where_args, $newness;
4035     }
4036
4037     if (@where_strs) {
4038         $query .= 'WHERE ' . join(' AND ', @where_strs);
4039     }
4040
4041     $query .= q{
4042         GROUP BY b.biblionumber
4043         HAVING count > 0
4044         ORDER BY count DESC
4045     };
4046
4047     $count = int($count);
4048     if ($count > 0) {
4049         $query .= "LIMIT $count";
4050     }
4051
4052     my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4053
4054     return @$rows;
4055 }
4056
4057 sub _CalculateAndUpdateFine {
4058     my ($params) = @_;
4059
4060     my $borrower    = $params->{borrower};
4061     my $item        = $params->{item};
4062     my $issue       = $params->{issue};
4063     my $return_date = $params->{return_date};
4064
4065     unless ($borrower) { carp "No borrower passed in!" && return; }
4066     unless ($item)     { carp "No item passed in!"     && return; }
4067     unless ($issue)    { carp "No issue passed in!"    && return; }
4068
4069     my $datedue = $issue->{date_due};
4070
4071     # we only need to calculate and change the fines if we want to do that on return
4072     # Should be on for hourly loans
4073     my $control = C4::Context->preference('CircControl');
4074     my $control_branchcode =
4075         ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4076       : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
4077       :                                     $issue->{branchcode};
4078
4079     my $date_returned = $return_date ? dt_from_string($return_date) : dt_from_string();
4080
4081     my ( $amount, $type, $unitcounttotal ) =
4082       C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4083
4084     $type ||= q{};
4085
4086     if ( C4::Context->preference('finesMode') eq 'production' ) {
4087         if ( $amount > 0 ) {
4088             C4::Overdues::UpdateFine({
4089                 issue_id       => $issue->{issue_id},
4090                 itemnumber     => $issue->{itemnumber},
4091                 borrowernumber => $issue->{borrowernumber},
4092                 amount         => $amount,
4093                 type           => $type,
4094                 due            => output_pref($datedue),
4095             });
4096         }
4097         elsif ($return_date) {
4098
4099             # Backdated returns may have fines that shouldn't exist,
4100             # so in this case, we need to drop those fines to 0
4101
4102             C4::Overdues::UpdateFine({
4103                 issue_id       => $issue->{issue_id},
4104                 itemnumber     => $issue->{itemnumber},
4105                 borrowernumber => $issue->{borrowernumber},
4106                 amount         => 0,
4107                 type           => $type,
4108                 due            => output_pref($datedue),
4109             });
4110         }
4111     }
4112 }
4113
4114 1;
4115
4116 __END__
4117
4118 =head1 AUTHOR
4119
4120 Koha Development Team <http://koha-community.org/>
4121
4122 =cut