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