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