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