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