C4/Circulation.pm

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