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     my $dbh = C4::Context->dbh;
3188     my $nextaccntno = getnextacctno( $borrowernumber );
3189     my $manager_id = 0;
3190     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3191     my $query ="
3192         INSERT INTO accountlines
3193             (borrowernumber, itemnumber, accountno,
3194             date, amount, description, accounttype,
3195             amountoutstanding, manager_id)
3196         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3197     ";
3198     my $sth = $dbh->prepare($query);
3199     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3200 }
3201
3202 =head2 GetTransfers
3203
3204   GetTransfers($itemnumber);
3205
3206 =cut
3207
3208 sub GetTransfers {
3209     my ($itemnumber) = @_;
3210
3211     my $dbh = C4::Context->dbh;
3212
3213     my $query = '
3214         SELECT datesent,
3215                frombranch,
3216                tobranch,
3217                branchtransfer_id
3218         FROM branchtransfers
3219         WHERE itemnumber = ?
3220           AND datearrived IS NULL
3221         ';
3222     my $sth = $dbh->prepare($query);
3223     $sth->execute($itemnumber);
3224     my @row = $sth->fetchrow_array();
3225     return @row;
3226 }
3227
3228 =head2 GetTransfersFromTo
3229
3230   @results = GetTransfersFromTo($frombranch,$tobranch);
3231
3232 Returns the list of pending transfers between $from and $to branch
3233
3234 =cut
3235
3236 sub GetTransfersFromTo {
3237     my ( $frombranch, $tobranch ) = @_;
3238     return unless ( $frombranch && $tobranch );
3239     my $dbh   = C4::Context->dbh;
3240     my $query = "
3241         SELECT branchtransfer_id,itemnumber,datesent,frombranch
3242         FROM   branchtransfers
3243         WHERE  frombranch=?
3244           AND  tobranch=?
3245           AND datearrived IS NULL
3246     ";
3247     my $sth = $dbh->prepare($query);
3248     $sth->execute( $frombranch, $tobranch );
3249     my @gettransfers;
3250
3251     while ( my $data = $sth->fetchrow_hashref ) {
3252         push @gettransfers, $data;
3253     }
3254     return (@gettransfers);
3255 }
3256
3257 =head2 DeleteTransfer
3258
3259   &DeleteTransfer($itemnumber);
3260
3261 =cut
3262
3263 sub DeleteTransfer {
3264     my ($itemnumber) = @_;
3265     return unless $itemnumber;
3266     my $dbh          = C4::Context->dbh;
3267     my $sth          = $dbh->prepare(
3268         "DELETE FROM branchtransfers
3269          WHERE itemnumber=?
3270          AND datearrived IS NULL "
3271     );
3272     return $sth->execute($itemnumber);
3273 }
3274
3275 =head2 SendCirculationAlert
3276
3277 Send out a C<check-in> or C<checkout> alert using the messaging system.
3278
3279 B<Parameters>:
3280
3281 =over 4
3282
3283 =item type
3284
3285 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3286
3287 =item item
3288
3289 Hashref of information about the item being checked in or out.
3290
3291 =item borrower
3292
3293 Hashref of information about the borrower of the item.
3294
3295 =item branch
3296
3297 The branchcode from where the checkout or check-in took place.
3298
3299 =back
3300
3301 B<Example>:
3302
3303     SendCirculationAlert({
3304         type     => 'CHECKOUT',
3305         item     => $item,
3306         borrower => $borrower,
3307         branch   => $branch,
3308     });
3309
3310 =cut
3311
3312 sub SendCirculationAlert {
3313     my ($opts) = @_;
3314     my ($type, $item, $borrower, $branch) =
3315         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3316     my %message_name = (
3317         CHECKIN  => 'Item_Check_in',
3318         CHECKOUT => 'Item_Checkout',
3319         RENEWAL  => 'Item_Checkout',
3320     );
3321     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3322         borrowernumber => $borrower->{borrowernumber},
3323         message_name   => $message_name{$type},
3324     });
3325     my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3326
3327     my $schema = Koha::Database->new->schema;
3328     my @transports = keys %{ $borrower_preferences->{transports} };
3329
3330     # From the MySQL doc:
3331     # LOCK TABLES is not transaction-safe and implicitly commits any active transaction before attempting to lock the tables.
3332     # If the LOCK/UNLOCK statements are executed from tests, the current transaction will be committed.
3333     # To avoid that we need to guess if this code is execute from tests or not (yes it is a bit hacky)
3334     my $do_not_lock = ( exists $ENV{_} && $ENV{_} =~ m|prove| ) || $ENV{KOHA_NO_TABLE_LOCKS};
3335
3336     for my $mtt (@transports) {
3337         my $letter =  C4::Letters::GetPreparedLetter (
3338             module => 'circulation',
3339             letter_code => $type,
3340             branchcode => $branch,
3341             message_transport_type => $mtt,
3342             lang => $borrower->{lang},
3343             tables => {
3344                 $issues_table => $item->{itemnumber},
3345                 'items'       => $item->{itemnumber},
3346                 'biblio'      => $item->{biblionumber},
3347                 'biblioitems' => $item->{biblionumber},
3348                 'borrowers'   => $borrower,
3349                 'branches'    => $branch,
3350             }
3351         ) or next;
3352
3353         $schema->storage->txn_begin;
3354         C4::Context->dbh->do(q|LOCK TABLE message_queue READ|) unless $do_not_lock;
3355         C4::Context->dbh->do(q|LOCK TABLE message_queue WRITE|) unless $do_not_lock;
3356         my $message = C4::Message->find_last_message($borrower, $type, $mtt);
3357         unless ( $message ) {
3358             C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3359             C4::Message->enqueue($letter, $borrower, $mtt);
3360         } else {
3361             $message->append($letter);
3362             $message->update;
3363         }
3364         C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3365         $schema->storage->txn_commit;
3366     }
3367
3368     return;
3369 }
3370
3371 =head2 updateWrongTransfer
3372
3373   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3374
3375 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
3376
3377 =cut
3378
3379 sub updateWrongTransfer {
3380         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3381         my $dbh = C4::Context->dbh;
3382 # first step validate the actual line of transfert .
3383         my $sth =
3384                 $dbh->prepare(
3385                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3386                 );
3387                 $sth->execute($FromLibrary,$itemNumber);
3388
3389 # second step create a new line of branchtransfer to the right location .
3390         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3391
3392 #third step changing holdingbranch of item
3393         UpdateHoldingbranch($FromLibrary,$itemNumber);
3394 }
3395
3396 =head2 UpdateHoldingbranch
3397
3398   $items = UpdateHoldingbranch($branch,$itmenumber);
3399
3400 Simple methode for updating hodlingbranch in items BDD line
3401
3402 =cut
3403
3404 sub UpdateHoldingbranch {
3405         my ( $branch,$itemnumber ) = @_;
3406     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3407 }
3408
3409 =head2 CalcDateDue
3410
3411 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3412
3413 this function calculates the due date given the start date and configured circulation rules,
3414 checking against the holidays calendar as per the 'useDaysMode' syspref.
3415 C<$startdate>   = DateTime object representing start date of loan period (assumed to be today)
3416 C<$itemtype>  = itemtype code of item in question
3417 C<$branch>  = location whose calendar to use
3418 C<$borrower> = Borrower object
3419 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3420
3421 =cut
3422
3423 sub CalcDateDue {
3424     my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3425
3426     $isrenewal ||= 0;
3427
3428     # loanlength now a href
3429     my $loanlength =
3430             GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3431
3432     my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3433             ? qq{renewalperiod}
3434             : qq{issuelength};
3435
3436     my $datedue;
3437     if ( $startdate ) {
3438         if (ref $startdate ne 'DateTime' ) {
3439             $datedue = dt_from_string($datedue);
3440         } else {
3441             $datedue = $startdate->clone;
3442         }
3443     } else {
3444         $datedue =
3445           DateTime->now( time_zone => C4::Context->tz() )
3446           ->truncate( to => 'minute' );
3447     }
3448
3449
3450     # calculate the datedue as normal
3451     if ( C4::Context->preference('useDaysMode') eq 'Days' )
3452     {    # ignoring calendar
3453         if ( $loanlength->{lengthunit} eq 'hours' ) {
3454             $datedue->add( hours => $loanlength->{$length_key} );
3455         } else {    # days
3456             $datedue->add( days => $loanlength->{$length_key} );
3457             $datedue->set_hour(23);
3458             $datedue->set_minute(59);
3459         }
3460     } else {
3461         my $dur;
3462         if ($loanlength->{lengthunit} eq 'hours') {
3463             $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3464         }
3465         else { # days
3466             $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3467         }
3468         my $calendar = Koha::Calendar->new( branchcode => $branch );
3469         $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3470         if ($loanlength->{lengthunit} eq 'days') {
3471             $datedue->set_hour(23);
3472             $datedue->set_minute(59);
3473         }
3474     }
3475
3476     # if Hard Due Dates are used, retrieve them and apply as necessary
3477     my ( $hardduedate, $hardduedatecompare ) =
3478       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3479     if ($hardduedate) {    # hardduedates are currently dates
3480         $hardduedate->truncate( to => 'minute' );
3481         $hardduedate->set_hour(23);
3482         $hardduedate->set_minute(59);
3483         my $cmp = DateTime->compare( $hardduedate, $datedue );
3484
3485 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3486 # if the calculated date is before the 'after' Hard Due Date (floor), override
3487 # if the hard due date is set to 'exactly', overrride
3488         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3489             $datedue = $hardduedate->clone;
3490         }
3491
3492         # in all other cases, keep the date due as it is
3493
3494     }
3495
3496     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3497     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3498         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3499         if( $expiry_dt ) { #skip empty expiry date..
3500             $expiry_dt->set( hour => 23, minute => 59);
3501             my $d1= $datedue->clone->set_time_zone('floating');
3502             if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3503                 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3504             }
3505         }
3506         if ( C4::Context->preference('useDaysMode') ne 'Days' ) {
3507           my $calendar = Koha::Calendar->new( branchcode => $branch );
3508           if ( $calendar->is_holiday($datedue) ) {
3509               # Don't return on a closed day
3510               $datedue = $calendar->prev_open_day( $datedue );
3511           }
3512         }
3513     }
3514
3515     return $datedue;
3516 }
3517
3518
3519 sub CheckValidBarcode{
3520 my ($barcode) = @_;
3521 my $dbh = C4::Context->dbh;
3522 my $query=qq|SELECT count(*)
3523              FROM items
3524              WHERE barcode=?
3525             |;
3526 my $sth = $dbh->prepare($query);
3527 $sth->execute($barcode);
3528 my $exist=$sth->fetchrow ;
3529 return $exist;
3530 }
3531
3532 =head2 IsBranchTransferAllowed
3533
3534   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3535
3536 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3537
3538 =cut
3539
3540 sub IsBranchTransferAllowed {
3541         my ( $toBranch, $fromBranch, $code ) = @_;
3542
3543         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3544
3545         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3546         my $dbh = C4::Context->dbh;
3547
3548         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3549         $sth->execute( $toBranch, $fromBranch, $code );
3550         my $limit = $sth->fetchrow_hashref();
3551
3552         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3553         if ( $limit->{'limitId'} ) {
3554                 return 0;
3555         } else {
3556                 return 1;
3557         }
3558 }
3559
3560 =head2 CreateBranchTransferLimit
3561
3562   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3563
3564 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3565
3566 =cut
3567
3568 sub CreateBranchTransferLimit {
3569    my ( $toBranch, $fromBranch, $code ) = @_;
3570    return unless defined($toBranch) && defined($fromBranch);
3571    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3572
3573    my $dbh = C4::Context->dbh;
3574
3575    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3576    return $sth->execute( $code, $toBranch, $fromBranch );
3577 }
3578
3579 =head2 DeleteBranchTransferLimits
3580
3581     my $result = DeleteBranchTransferLimits($frombranch);
3582
3583 Deletes all the library transfer limits for one library.  Returns the
3584 number of limits deleted, 0e0 if no limits were deleted, or undef if
3585 no arguments are supplied.
3586
3587 =cut
3588
3589 sub DeleteBranchTransferLimits {
3590     my $branch = shift;
3591     return unless defined $branch;
3592     my $dbh    = C4::Context->dbh;
3593     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3594     return $sth->execute($branch);
3595 }
3596
3597 sub ReturnLostItem{
3598     my ( $borrowernumber, $itemnum ) = @_;
3599
3600     MarkIssueReturned( $borrowernumber, $itemnum );
3601     my $patron = Koha::Patrons->find( $borrowernumber );
3602     my $item = C4::Items::GetItem( $itemnum );
3603     my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3604     my @datearr = localtime(time);
3605     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3606     my $bor = $patron->firstname . ' ' . $patron->surname . ' ' . $patron->cardnumber;
3607     ModItem({ paidfor =>  $old_note."Paid for by $bor $date" }, undef, $itemnum);
3608 }
3609
3610
3611 sub LostItem{
3612     my ($itemnumber, $mark_returned) = @_;
3613
3614     my $dbh = C4::Context->dbh();
3615     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3616                            FROM issues
3617                            JOIN items USING (itemnumber)
3618                            JOIN biblio USING (biblionumber)
3619                            WHERE issues.itemnumber=?");
3620     $sth->execute($itemnumber);
3621     my $issues=$sth->fetchrow_hashref();
3622
3623     # If a borrower lost the item, add a replacement cost to the their record
3624     if ( my $borrowernumber = $issues->{borrowernumber} ){
3625         my $patron = Koha::Patrons->find( $borrowernumber );
3626
3627         if (C4::Context->preference('WhenLostForgiveFine')){
3628             my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3629             defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!";  # zero is OK, check defined
3630         }
3631         if (C4::Context->preference('WhenLostChargeReplacementFee')){
3632             C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3633             #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3634             #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3635         }
3636
3637         MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$patron->privacy) if $mark_returned;
3638     }
3639 }
3640
3641 sub GetOfflineOperations {
3642     my $dbh = C4::Context->dbh;
3643     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3644     $sth->execute(C4::Context->userenv->{'branch'});
3645     my $results = $sth->fetchall_arrayref({});
3646     return $results;
3647 }
3648
3649 sub GetOfflineOperation {
3650     my $operationid = shift;
3651     return unless $operationid;
3652     my $dbh = C4::Context->dbh;
3653     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3654     $sth->execute( $operationid );
3655     return $sth->fetchrow_hashref;
3656 }
3657
3658 sub AddOfflineOperation {
3659     my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3660     my $dbh = C4::Context->dbh;
3661     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3662     $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3663     return "Added.";
3664 }
3665
3666 sub DeleteOfflineOperation {
3667     my $dbh = C4::Context->dbh;
3668     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3669     $sth->execute( shift );
3670     return "Deleted.";
3671 }
3672
3673 sub ProcessOfflineOperation {
3674     my $operation = shift;
3675
3676     my $report;
3677     if ( $operation->{action} eq 'return' ) {
3678         $report = ProcessOfflineReturn( $operation );
3679     } elsif ( $operation->{action} eq 'issue' ) {
3680         $report = ProcessOfflineIssue( $operation );
3681     } elsif ( $operation->{action} eq 'payment' ) {
3682         $report = ProcessOfflinePayment( $operation );
3683     }
3684
3685     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3686
3687     return $report;
3688 }
3689
3690 sub ProcessOfflineReturn {
3691     my $operation = shift;
3692
3693     my $item = Koha::Items->find({barcode => $operation->{barcode}});
3694
3695     if ( $item ) {
3696         my $itemnumber = $item->itemnumber;
3697         my $issue = GetOpenIssue( $itemnumber );
3698         if ( $issue ) {
3699             MarkIssueReturned(
3700                 $issue->{borrowernumber},
3701                 $itemnumber,
3702                 undef,
3703                 $operation->{timestamp},
3704             );
3705             ModItem(
3706                 { renewals => 0, onloan => undef },
3707                 $issue->{'biblionumber'},
3708                 $itemnumber
3709             );
3710             return "Success.";
3711         } else {
3712             return "Item not issued.";
3713         }
3714     } else {
3715         return "Item not found.";
3716     }
3717 }
3718
3719 sub ProcessOfflineIssue {
3720     my $operation = shift;
3721
3722     my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} } );
3723
3724     if ( $patron ) {
3725         my $item = Koha::Items->find({ barcode => $operation->{barcode} });
3726         unless ($item) {
3727             return "Barcode not found.";
3728         }
3729         my $itemnumber = $item->itemnumber;
3730         my $issue = GetOpenIssue( $itemnumber );
3731
3732         if ( $issue and ( $issue->{borrowernumber} ne $patron->borrowernumber ) ) { # Item already issued to another patron mark it returned
3733             MarkIssueReturned(
3734                 $issue->{borrowernumber},
3735                 $itemnumber,
3736                 undef,
3737                 $operation->{timestamp},
3738             );
3739         }
3740         AddIssue(
3741             $patron->unblessed,
3742             $operation->{'barcode'},
3743             undef,
3744             1,
3745             $operation->{timestamp},
3746             undef,
3747         );
3748         return "Success.";
3749     } else {
3750         return "Borrower not found.";
3751     }
3752 }
3753
3754 sub ProcessOfflinePayment {
3755     my $operation = shift;
3756
3757     my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} });
3758     my $amount = $operation->{amount};
3759
3760     Koha::Account->new( { patron_id => $patron->id } )->pay( { amount => $amount } );
3761
3762     return "Success."
3763 }
3764
3765
3766 =head2 TransferSlip
3767
3768   TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3769
3770   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3771
3772 =cut
3773
3774 sub TransferSlip {
3775     my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3776
3777     my $item =  GetItem( $itemnumber, $barcode )
3778       or return;
3779
3780     return C4::Letters::GetPreparedLetter (
3781         module => 'circulation',
3782         letter_code => 'TRANSFERSLIP',
3783         branchcode => $branch,
3784         tables => {
3785             'branches'    => $to_branch,
3786             'biblio'      => $item->{biblionumber},
3787             'items'       => $item,
3788         },
3789     );
3790 }
3791
3792 =head2 CheckIfIssuedToPatron
3793
3794   CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3795
3796   Return 1 if any record item is issued to patron, otherwise return 0
3797
3798 =cut
3799
3800 sub CheckIfIssuedToPatron {
3801     my ($borrowernumber, $biblionumber) = @_;
3802
3803     my $dbh = C4::Context->dbh;
3804     my $query = q|
3805         SELECT COUNT(*) FROM issues
3806         LEFT JOIN items ON items.itemnumber = issues.itemnumber
3807         WHERE items.biblionumber = ?
3808         AND issues.borrowernumber = ?
3809     |;
3810     my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3811     return 1 if $is_issued;
3812     return;
3813 }
3814
3815 =head2 IsItemIssued
3816
3817   IsItemIssued( $itemnumber )
3818
3819   Return 1 if the item is on loan, otherwise return 0
3820
3821 =cut
3822
3823 sub IsItemIssued {
3824     my $itemnumber = shift;
3825     my $dbh = C4::Context->dbh;
3826     my $sth = $dbh->prepare(q{
3827         SELECT COUNT(*)
3828         FROM issues
3829         WHERE itemnumber = ?
3830     });
3831     $sth->execute($itemnumber);
3832     return $sth->fetchrow;
3833 }
3834
3835 =head2 GetAgeRestriction
3836
3837   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3838   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3839
3840   if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as they are older or as old as the agerestriction }
3841   if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3842
3843 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3844 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3845 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3846          Negative days mean the borrower has gone past the age restriction age.
3847
3848 =cut
3849
3850 sub GetAgeRestriction {
3851     my ($record_restrictions, $borrower) = @_;
3852     my $markers = C4::Context->preference('AgeRestrictionMarker');
3853
3854     # Split $record_restrictions to something like FSK 16 or PEGI 6
3855     my @values = split ' ', uc($record_restrictions);
3856     return unless @values;
3857
3858     # Search first occurrence of one of the markers
3859     my @markers = split /\|/, uc($markers);
3860     return unless @markers;
3861
3862     my $index            = 0;
3863     my $restriction_year = 0;
3864     for my $value (@values) {
3865         $index++;
3866         for my $marker (@markers) {
3867             $marker =~ s/^\s+//;    #remove leading spaces
3868             $marker =~ s/\s+$//;    #remove trailing spaces
3869             if ( $marker eq $value ) {
3870                 if ( $index <= $#values ) {
3871                     $restriction_year += $values[$index];
3872                 }
3873                 last;
3874             }
3875             elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3876
3877                 # Perhaps it is something like "K16" (as in Finland)
3878                 $restriction_year += $1;
3879                 last;
3880             }
3881         }
3882         last if ( $restriction_year > 0 );
3883     }
3884
3885     #Check if the borrower is age restricted for this material and for how long.
3886     if ($restriction_year && $borrower) {
3887         if ( $borrower->{'dateofbirth'} ) {
3888             my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3889             $alloweddate[0] += $restriction_year;
3890
3891             #Prevent runime eror on leap year (invalid date)
3892             if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3893                 $alloweddate[2] = 28;
3894             }
3895
3896             #Get how many days the borrower has to reach the age restriction
3897             my @Today = split /-/, DateTime->today->ymd();
3898             my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
3899             #Negative days means the borrower went past the age restriction age
3900             return ($restriction_year, $daysToAgeRestriction);
3901         }
3902     }
3903
3904     return ($restriction_year);
3905 }
3906
3907
3908 =head2 GetPendingOnSiteCheckouts
3909
3910 =cut
3911
3912 sub GetPendingOnSiteCheckouts {
3913     my $dbh = C4::Context->dbh;
3914     return $dbh->selectall_arrayref(q|
3915         SELECT
3916           items.barcode,
3917           items.biblionumber,
3918           items.itemnumber,
3919           items.itemnotes,
3920           items.itemcallnumber,
3921           items.location,
3922           issues.date_due,
3923           issues.branchcode,
3924           issues.date_due < NOW() AS is_overdue,
3925           biblio.author,
3926           biblio.title,
3927           borrowers.firstname,
3928           borrowers.surname,
3929           borrowers.cardnumber,
3930           borrowers.borrowernumber
3931         FROM items
3932         LEFT JOIN issues ON items.itemnumber = issues.itemnumber
3933         LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
3934         LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
3935         WHERE issues.onsite_checkout = 1
3936     |, { Slice => {} } );
3937 }
3938
3939 sub GetTopIssues {
3940     my ($params) = @_;
3941
3942     my ($count, $branch, $itemtype, $ccode, $newness)
3943         = @$params{qw(count branch itemtype ccode newness)};
3944
3945     my $dbh = C4::Context->dbh;
3946     my $query = q{
3947         SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
3948           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
3949           i.ccode, SUM(i.issues) AS count
3950         FROM biblio b
3951         LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
3952         LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
3953     };
3954
3955     my (@where_strs, @where_args);
3956
3957     if ($branch) {
3958         push @where_strs, 'i.homebranch = ?';
3959         push @where_args, $branch;
3960     }
3961     if ($itemtype) {
3962         if (C4::Context->preference('item-level_itypes')){
3963             push @where_strs, 'i.itype = ?';
3964             push @where_args, $itemtype;
3965         } else {
3966             push @where_strs, 'bi.itemtype = ?';
3967             push @where_args, $itemtype;
3968         }
3969     }
3970     if ($ccode) {
3971         push @where_strs, 'i.ccode = ?';
3972         push @where_args, $ccode;
3973     }
3974     if ($newness) {
3975         push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
3976         push @where_args, $newness;
3977     }
3978
3979     if (@where_strs) {
3980         $query .= 'WHERE ' . join(' AND ', @where_strs);
3981     }
3982
3983     $query .= q{
3984         GROUP BY b.biblionumber
3985         HAVING count > 0
3986         ORDER BY count DESC
3987     };
3988
3989     $count = int($count);
3990     if ($count > 0) {
3991         $query .= "LIMIT $count";
3992     }
3993
3994     my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
3995
3996     return @$rows;
3997 }
3998
3999 sub _CalculateAndUpdateFine {
4000     my ($params) = @_;
4001
4002     my $borrower    = $params->{borrower};
4003     my $item        = $params->{item};
4004     my $issue       = $params->{issue};
4005     my $return_date = $params->{return_date};
4006
4007     unless ($borrower) { carp "No borrower passed in!" && return; }
4008     unless ($item)     { carp "No item passed in!"     && return; }
4009     unless ($issue)    { carp "No issue passed in!"    && return; }
4010
4011     my $datedue = dt_from_string( $issue->date_due );
4012
4013     # we only need to calculate and change the fines if we want to do that on return
4014     # Should be on for hourly loans
4015     my $control = C4::Context->preference('CircControl');
4016     my $control_branchcode =
4017         ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4018       : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
4019       :                                     $issue->branchcode;
4020
4021     my $date_returned = $return_date ? dt_from_string($return_date) : dt_from_string();
4022
4023     my ( $amount, $type, $unitcounttotal ) =
4024       C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4025
4026     $type ||= q{};
4027
4028     if ( C4::Context->preference('finesMode') eq 'production' ) {
4029         if ( $amount > 0 ) {
4030             C4::Overdues::UpdateFine({
4031                 issue_id       => $issue->issue_id,
4032                 itemnumber     => $issue->itemnumber,
4033                 borrowernumber => $issue->borrowernumber,
4034                 amount         => $amount,
4035                 type           => $type,
4036                 due            => output_pref($datedue),
4037             });
4038         }
4039         elsif ($return_date) {
4040
4041             # Backdated returns may have fines that shouldn't exist,
4042             # so in this case, we need to drop those fines to 0
4043
4044             C4::Overdues::UpdateFine({
4045                 issue_id       => $issue->issue_id,
4046                 itemnumber     => $issue->itemnumber,
4047                 borrowernumber => $issue->borrowernumber,
4048                 amount         => 0,
4049                 type           => $type,
4050                 due            => output_pref($datedue),
4051             });
4052         }
4053     }
4054 }
4055
4056 1;
4057
4058 __END__
4059
4060 =head1 AUTHOR
4061
4062 Koha Development Team <http://koha-community.org/>
4063
4064 =cut