C4/Circulation.pm

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