koha-dev.rot13.org Git - koha_ffzg/blob - C4/Circulation.pm

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