C4/Circulation.pm

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