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     # CHECKPREVCHECKOUT: CHECK IF ITEM HAS EVER BEEN LENT TO PATRON
 947     #
 948     my $patron = Koha::Patrons->find($borrower->{borrowernumber});
 949     my $wants_check = $patron->wants_check_for_previous_checkout;
 950     $needsconfirmation{PREVISSUE} = 1
 951         if ($wants_check and $patron->do_check_for_previous_checkout($item));
 952
 953     #
 954     # ITEM CHECKING
 955     #
 956     if ( $item->{'notforloan'} )
 957     {
 958         if(!C4::Context->preference("AllowNotForLoanOverride")){
 959             $issuingimpossible{NOT_FOR_LOAN} = 1;
 960             $issuingimpossible{item_notforloan} = $item->{'notforloan'};
 961         }else{
 962             $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 963             $needsconfirmation{item_notforloan} = $item->{'notforloan'};
 964         }
 965     }
 966     else {
 967         # we have to check itemtypes.notforloan also
 968         if (C4::Context->preference('item-level_itypes')){
 969             # this should probably be a subroutine
 970             my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
 971             $sth->execute($item->{'itemtype'});
 972             my $notforloan=$sth->fetchrow_hashref();
 973             if ($notforloan->{'notforloan'}) {
 974                 if (!C4::Context->preference("AllowNotForLoanOverride")) {
 975                     $issuingimpossible{NOT_FOR_LOAN} = 1;
 976                     $issuingimpossible{itemtype_notforloan} = $item->{'itype'};
 977                 } else {
 978                     $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 979                     $needsconfirmation{itemtype_notforloan} = $item->{'itype'};
 980                 }
 981             }
 982         }
 983         elsif ($biblioitem->{'notforloan'} == 1){
 984             if (!C4::Context->preference("AllowNotForLoanOverride")) {
 985                 $issuingimpossible{NOT_FOR_LOAN} = 1;
 986                 $issuingimpossible{itemtype_notforloan} = $biblioitem->{'itemtype'};
 987             } else {
 988                 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 989                 $needsconfirmation{itemtype_notforloan} = $biblioitem->{'itemtype'};
 990             }
 991         }
 992     }
 993     if ( $item->{'withdrawn'} && $item->{'withdrawn'} > 0 )
 994     {
 995         $issuingimpossible{WTHDRAWN} = 1;
 996     }
 997     if (   $item->{'restricted'}
 998         && $item->{'restricted'} == 1 )
 999     {
1000         $issuingimpossible{RESTRICTED} = 1;
1001     }
1002     if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
1003         my $code = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
1004         $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
1005         $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
1006     }
1007     if ( C4::Context->preference("IndependentBranches") ) {
1008         my $userenv = C4::Context->userenv;
1009         unless ( C4::Context->IsSuperLibrarian() ) {
1010             if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
1011                 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
1012                 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
1013             }
1014             $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
1015               if ( $borrower->{'branchcode'} ne $userenv->{branch} );
1016         }
1017     }
1018     #
1019     # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
1020     #
1021     my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
1022
1023     if ( $rentalConfirmation ){
1024         my ($rentalCharge) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
1025         if ( $rentalCharge > 0 ){
1026             $rentalCharge = sprintf("%.02f", $rentalCharge);
1027             $needsconfirmation{RENTALCHARGE} = $rentalCharge;
1028         }
1029     }
1030
1031     #
1032     # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
1033     #
1034     if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} ){
1035
1036         # Already issued to current borrower. Ask whether the loan should
1037         # be renewed.
1038         my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
1039             $borrower->{'borrowernumber'},
1040             $item->{'itemnumber'}
1041         );
1042         if ( $CanBookBeRenewed == 0 ) {    # no more renewals allowed
1043             if ( $renewerror eq 'onsite_checkout' ) {
1044                 $issuingimpossible{NO_RENEWAL_FOR_ONSITE_CHECKOUTS} = 1;
1045             }
1046             else {
1047                 $issuingimpossible{NO_MORE_RENEWALS} = 1;
1048             }
1049         }
1050         else {
1051             $needsconfirmation{RENEW_ISSUE} = 1;
1052         }
1053     }
1054     elsif ($issue->{borrowernumber}) {
1055
1056         # issued to someone else
1057         my $currborinfo =    C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
1058
1059
1060         my ( $can_be_returned, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
1061
1062         unless ( $can_be_returned ) {
1063             $issuingimpossible{RETURN_IMPOSSIBLE} = 1;
1064             $issuingimpossible{branch_to_return} = $message;
1065         } else {
1066             $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
1067             $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
1068             $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
1069             $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
1070             $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
1071         }
1072     }
1073
1074     unless ( $ignore_reserves ) {
1075         # See if the item is on reserve.
1076         my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1077         if ($restype) {
1078             my $resbor = $res->{'borrowernumber'};
1079             if ( $resbor ne $borrower->{'borrowernumber'} ) {
1080                 my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
1081                 my $branchname = GetBranchName( $res->{'branchcode'} );
1082                 if ( $restype eq "Waiting" )
1083                 {
1084                     # The item is on reserve and waiting, but has been
1085                     # reserved by some other patron.
1086                     $needsconfirmation{RESERVE_WAITING} = 1;
1087                     $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
1088                     $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
1089                     $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1090                     $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1091                     $needsconfirmation{'resbranchname'} = $branchname;
1092                     $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
1093                 }
1094                 elsif ( $restype eq "Reserved" ) {
1095                     # The item is on reserve for someone else.
1096                     $needsconfirmation{RESERVED} = 1;
1097                     $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
1098                     $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
1099                     $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1100                     $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1101                     $needsconfirmation{'resbranchname'} = $branchname;
1102                     $needsconfirmation{'resreservedate'} = $res->{'reservedate'};
1103                 }
1104             }
1105         }
1106     }
1107
1108     ## CHECK AGE RESTRICTION
1109     my $agerestriction  = $biblioitem->{'agerestriction'};
1110     my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
1111     if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1112         if ( C4::Context->preference('AgeRestrictionOverride') ) {
1113             $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1114         }
1115         else {
1116             $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1117         }
1118     }
1119
1120     ## check for high holds decreasing loan period
1121     if ( C4::Context->preference('decreaseLoanHighHolds') ) {
1122         my $check = checkHighHolds( $item, $borrower );
1123
1124         if ( $check->{exceeded} ) {
1125             if ($override_high_holds) {
1126                 $alerts{HIGHHOLDS} = {
1127                     num_holds  => $check->{outstanding},
1128                     duration   => $check->{duration},
1129                     returndate => output_pref( $check->{due_date} ),
1130                 };
1131             }
1132             else {
1133                 $needsconfirmation{HIGHHOLDS} = {
1134                     num_holds  => $check->{outstanding},
1135                     duration   => $check->{duration},
1136                     returndate => output_pref( $check->{due_date} ),
1137                 };
1138             }
1139         }
1140     }
1141
1142     if (
1143         !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1144         # don't do the multiple loans per bib check if we've
1145         # already determined that we've got a loan on the same item
1146         !$issuingimpossible{NO_MORE_RENEWALS} &&
1147         !$needsconfirmation{RENEW_ISSUE}
1148     ) {
1149         # Check if borrower has already issued an item from the same biblio
1150         # Only if it's not a subscription
1151         my $biblionumber = $item->{biblionumber};
1152         require C4::Serials;
1153         my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1154         unless ($is_a_subscription) {
1155             my $issues = GetIssues( {
1156                 borrowernumber => $borrower->{borrowernumber},
1157                 biblionumber   => $biblionumber,
1158             } );
1159             my @issues = $issues ? @$issues : ();
1160             # if we get here, we don't already have a loan on this item,
1161             # so if there are any loans on this bib, ask for confirmation
1162             if (scalar @issues > 0) {
1163                 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1164             }
1165         }
1166     }
1167
1168     return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1169 }
1170
1171 =head2 CanBookBeReturned
1172
1173   ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1174
1175 Check whether the item can be returned to the provided branch
1176
1177 =over 4
1178
1179 =item C<$item> is a hash of item information as returned from GetItem
1180
1181 =item C<$branch> is the branchcode where the return is taking place
1182
1183 =back
1184
1185 Returns:
1186
1187 =over 4
1188
1189 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1190
1191 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1192
1193 =back
1194
1195 =cut
1196
1197 sub CanBookBeReturned {
1198   my ($item, $branch) = @_;
1199   my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1200
1201   # assume return is allowed to start
1202   my $allowed = 1;
1203   my $message;
1204
1205   # identify all cases where return is forbidden
1206   if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1207      $allowed = 0;
1208      $message = $item->{'homebranch'};
1209   } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1210      $allowed = 0;
1211      $message = $item->{'holdingbranch'};
1212   } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1213      $allowed = 0;
1214      $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1215   }
1216
1217   return ($allowed, $message);
1218 }
1219
1220 =head2 CheckHighHolds
1221
1222     used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1223     decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1224     has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1225
1226 =cut
1227
1228 sub checkHighHolds {
1229     my ( $item, $borrower ) = @_;
1230     my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1231     my $branch = _GetCircControlBranch( $item, $borrower );
1232
1233     my $return_data = {
1234         exceeded    => 0,
1235         outstanding => 0,
1236         duration    => 0,
1237         due_date    => undef,
1238     };
1239
1240     my $holds = Koha::Holds->search( { biblionumber => $item->{'biblionumber'} } );
1241
1242     if ( $holds->count() ) {
1243         $return_data->{outstanding} = $holds->count();
1244
1245         my $decreaseLoanHighHoldsControl        = C4::Context->preference('decreaseLoanHighHoldsControl');
1246         my $decreaseLoanHighHoldsValue          = C4::Context->preference('decreaseLoanHighHoldsValue');
1247         my $decreaseLoanHighHoldsIgnoreStatuses = C4::Context->preference('decreaseLoanHighHoldsIgnoreStatuses');
1248
1249         my @decreaseLoanHighHoldsIgnoreStatuses = split( /,/, $decreaseLoanHighHoldsIgnoreStatuses );
1250
1251         if ( $decreaseLoanHighHoldsControl eq 'static' ) {
1252
1253             # static means just more than a given number of holds on the record
1254
1255             # If the number of holds is less than the threshold, we can stop here
1256             if ( $holds->count() < $decreaseLoanHighHoldsValue ) {
1257                 return $return_data;
1258             }
1259         }
1260         elsif ( $decreaseLoanHighHoldsControl eq 'dynamic' ) {
1261
1262             # dynamic means X more than the number of holdable items on the record
1263
1264             # let's get the items
1265             my @items = $holds->next()->biblio()->items();
1266
1267             # Remove any items with status defined to be ignored even if the would not make item unholdable
1268             foreach my $status (@decreaseLoanHighHoldsIgnoreStatuses) {
1269                 @items = grep { !$_->$status } @items;
1270             }
1271
1272             # Remove any items that are not holdable for this patron
1273             @items = grep { CanItemBeReserved( $borrower->{borrowernumber}, $_->itemnumber ) eq 'OK' } @items;
1274
1275             my $items_count = scalar @items;
1276
1277             my $threshold = $items_count + $decreaseLoanHighHoldsValue;
1278
1279             # If the number of holds is less than the count of items we have
1280             # plus the number of holds allowed above that count, we can stop here
1281             if ( $holds->count() <= $threshold ) {
1282                 return $return_data;
1283             }
1284         }
1285
1286         my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1287
1288         my $calendar = Koha::Calendar->new( branchcode => $branch );
1289
1290         my $itype =
1291           ( C4::Context->preference('item-level_itypes') )
1292           ? $biblio->{'itype'}
1293           : $biblio->{'itemtype'};
1294
1295         my $orig_due = C4::Circulation::CalcDateDue( $issuedate, $itype, $branch, $borrower );
1296
1297         my $decreaseLoanHighHoldsDuration = C4::Context->preference('decreaseLoanHighHoldsDuration');
1298
1299         my $reduced_datedue = $calendar->addDate( $issuedate, $decreaseLoanHighHoldsDuration );
1300
1301         if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1302             $return_data->{exceeded} = 1;
1303             $return_data->{duration} = $decreaseLoanHighHoldsDuration;
1304             $return_data->{due_date} = $reduced_datedue;
1305         }
1306     }
1307
1308     return $return_data;
1309 }
1310
1311 =head2 AddIssue
1312
1313   &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1314
1315 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1316
1317 =over 4
1318
1319 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).
1320
1321 =item C<$barcode> is the barcode of the item being issued.
1322
1323 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1324 Calculated if empty.
1325
1326 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1327
1328 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1329 Defaults to today.  Unlike C<$datedue>, NOT a DateTime object, unfortunately.
1330
1331 AddIssue does the following things :
1332
1333   - step 01: check that there is a borrowernumber & a barcode provided
1334   - check for RENEWAL (book issued & being issued to the same patron)
1335       - renewal YES = Calculate Charge & renew
1336       - renewal NO  =
1337           * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1338           * RESERVE PLACED ?
1339               - fill reserve if reserve to this patron
1340               - cancel reserve or not, otherwise
1341           * TRANSFERT PENDING ?
1342               - complete the transfert
1343           * ISSUE THE BOOK
1344
1345 =back
1346
1347 =cut
1348
1349 sub AddIssue {
1350     my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1351
1352     my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1353     my $auto_renew = $params && $params->{auto_renew};
1354     my $dbh          = C4::Context->dbh;
1355     my $barcodecheck = CheckValidBarcode($barcode);
1356
1357     my $issue;
1358
1359     if ( $datedue && ref $datedue ne 'DateTime' ) {
1360         $datedue = dt_from_string($datedue);
1361     }
1362
1363     # $issuedate defaults to today.
1364     if ( !defined $issuedate ) {
1365         $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1366     }
1367     else {
1368         if ( ref $issuedate ne 'DateTime' ) {
1369             $issuedate = dt_from_string($issuedate);
1370
1371         }
1372     }
1373
1374     # Stop here if the patron or barcode doesn't exist
1375     if ( $borrower && $barcode && $barcodecheck ) {
1376         # find which item we issue
1377         my $item = GetItem( '', $barcode )
1378           or return;    # if we don't get an Item, abort.
1379
1380         my $branch = _GetCircControlBranch( $item, $borrower );
1381
1382         # get actual issuing if there is one
1383         my $actualissue = GetItemIssue( $item->{itemnumber} );
1384
1385         # get biblioinformation for this item
1386         my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1387
1388         # check if we just renew the issue.
1389         if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
1390             $datedue = AddRenewal(
1391                 $borrower->{'borrowernumber'},
1392                 $item->{'itemnumber'},
1393                 $branch,
1394                 $datedue,
1395                 $issuedate,    # here interpreted as the renewal date
1396             );
1397         }
1398         else {
1399             # it's NOT a renewal
1400             if ( $actualissue->{borrowernumber} ) {
1401                 # This book is currently on loan, but not to the person
1402                 # who wants to borrow it now. mark it returned before issuing to the new borrower
1403                 my ( $allowed, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
1404                 return unless $allowed;
1405                 AddReturn( $item->{'barcode'}, C4::Context->userenv->{'branch'} );
1406             }
1407
1408             MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1409
1410             # Starting process for transfer job (checking transfert and validate it if we have one)
1411             my ($datesent) = GetTransfers( $item->{'itemnumber'} );
1412             if ($datesent) {
1413                 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1414                 my $sth = $dbh->prepare(
1415                     "UPDATE branchtransfers
1416                         SET datearrived = now(),
1417                         tobranch = ?,
1418                         comments = 'Forced branchtransfer'
1419                     WHERE itemnumber= ? AND datearrived IS NULL"
1420                 );
1421                 $sth->execute( C4::Context->userenv->{'branch'},
1422                     $item->{'itemnumber'} );
1423             }
1424
1425             # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1426             unless ($auto_renew) {
1427                 my $issuingrule = GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branch );
1428                 $auto_renew = $issuingrule->{auto_renew};
1429             }
1430
1431             # Record in the database the fact that the book was issued.
1432             unless ($datedue) {
1433                 my $itype =
1434                   ( C4::Context->preference('item-level_itypes') )
1435                   ? $biblio->{'itype'}
1436                   : $biblio->{'itemtype'};
1437                 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1438
1439             }
1440             $datedue->truncate( to => 'minute' );
1441
1442             $issue = Koha::Database->new()->schema()->resultset('Issue')->create(
1443                 {
1444                     borrowernumber => $borrower->{'borrowernumber'},
1445                     itemnumber     => $item->{'itemnumber'},
1446                     issuedate      => $issuedate->strftime('%Y-%m-%d %H:%M:%S'),
1447                     date_due       => $datedue->strftime('%Y-%m-%d %H:%M:%S'),
1448                     branchcode     => C4::Context->userenv->{'branch'},
1449                     onsite_checkout => $onsite_checkout,
1450                     auto_renew      => $auto_renew ? 1 : 0
1451                 }
1452               );
1453
1454             if ( C4::Context->preference('ReturnToShelvingCart') ) {
1455                 # ReturnToShelvingCart is on, anything issued should be taken off the cart.
1456                 CartToShelf( $item->{'itemnumber'} );
1457             }
1458             $item->{'issues'}++;
1459             if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1460                 UpdateTotalIssues( $item->{'biblionumber'}, 1 );
1461             }
1462
1463             ## If item was lost, it has now been found, reverse any list item charges if necessary.
1464             if ( $item->{'itemlost'} ) {
1465                 if (
1466                     Koha::RefundLostItemFeeRules->should_refund(
1467                         {
1468                             current_branch      => C4::Context->userenv->{branch},
1469                             item_home_branch    => $item->{homebranch},
1470                             item_holding_branch => $item->{holdingbranch}
1471                         }
1472                     )
1473                   )
1474                 {
1475                     _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef,
1476                         $item->{'barcode'} );
1477                 }
1478             }
1479
1480             ModItem(
1481                 {
1482                     issues        => $item->{'issues'},
1483                     holdingbranch => C4::Context->userenv->{'branch'},
1484                     itemlost      => 0,
1485                     onloan        => $datedue->ymd(),
1486                     datelastborrowed => DateTime->now( time_zone => C4::Context->tz() )->ymd(),
1487                 },
1488                 $item->{'biblionumber'},
1489                 $item->{'itemnumber'}
1490             );
1491             ModDateLastSeen( $item->{'itemnumber'} );
1492
1493            # If it costs to borrow this book, charge it to the patron's account.
1494             my ( $charge, $itemtype ) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
1495             if ( $charge > 0 ) {
1496                 AddIssuingCharge( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge );
1497                 $item->{'charge'} = $charge;
1498             }
1499
1500             # Record the fact that this book was issued.
1501             &UpdateStats(
1502                 {
1503                     branch => C4::Context->userenv->{'branch'},
1504                     type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1505                     amount         => $charge,
1506                     other          => ( $sipmode ? "SIP-$sipmode" : '' ),
1507                     itemnumber     => $item->{'itemnumber'},
1508                     itemtype       => $item->{'itype'},
1509                     borrowernumber => $borrower->{'borrowernumber'},
1510                     ccode          => $item->{'ccode'}
1511                 }
1512             );
1513
1514             # Send a checkout slip.
1515             my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1516             my %conditions        = (
1517                 branchcode   => $branch,
1518                 categorycode => $borrower->{categorycode},
1519                 item_type    => $item->{itype},
1520                 notification => 'CHECKOUT',
1521             );
1522             if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
1523                 SendCirculationAlert(
1524                     {
1525                         type     => 'CHECKOUT',
1526                         item     => $item,
1527                         borrower => $borrower,
1528                         branch   => $branch,
1529                     }
1530                 );
1531             }
1532         }
1533
1534         logaction(
1535             "CIRCULATION", "ISSUE",
1536             $borrower->{'borrowernumber'},
1537             $biblio->{'itemnumber'}
1538         ) if C4::Context->preference("IssueLog");
1539     }
1540     return $issue;
1541 }
1542
1543 =head2 GetLoanLength
1544
1545   my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1546
1547 Get loan length for an itemtype, a borrower type and a branch
1548
1549 =cut
1550
1551 sub GetLoanLength {
1552     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1553     my $dbh = C4::Context->dbh;
1554     my $sth = $dbh->prepare(qq{
1555         SELECT issuelength, lengthunit, renewalperiod
1556         FROM issuingrules
1557         WHERE   categorycode=?
1558             AND itemtype=?
1559             AND branchcode=?
1560             AND issuelength IS NOT NULL
1561     });
1562
1563     # try to find issuelength & return the 1st available.
1564     # check with borrowertype, itemtype and branchcode, then without one of those parameters
1565     $sth->execute( $borrowertype, $itemtype, $branchcode );
1566     my $loanlength = $sth->fetchrow_hashref;
1567
1568     return $loanlength
1569       if defined($loanlength) && defined $loanlength->{issuelength};
1570
1571     $sth->execute( $borrowertype, '*', $branchcode );
1572     $loanlength = $sth->fetchrow_hashref;
1573     return $loanlength
1574       if defined($loanlength) && defined $loanlength->{issuelength};
1575
1576     $sth->execute( '*', $itemtype, $branchcode );
1577     $loanlength = $sth->fetchrow_hashref;
1578     return $loanlength
1579       if defined($loanlength) && defined $loanlength->{issuelength};
1580
1581     $sth->execute( '*', '*', $branchcode );
1582     $loanlength = $sth->fetchrow_hashref;
1583     return $loanlength
1584       if defined($loanlength) && defined $loanlength->{issuelength};
1585
1586     $sth->execute( $borrowertype, $itemtype, '*' );
1587     $loanlength = $sth->fetchrow_hashref;
1588     return $loanlength
1589       if defined($loanlength) && defined $loanlength->{issuelength};
1590
1591     $sth->execute( $borrowertype, '*', '*' );
1592     $loanlength = $sth->fetchrow_hashref;
1593     return $loanlength
1594       if defined($loanlength) && defined $loanlength->{issuelength};
1595
1596     $sth->execute( '*', $itemtype, '*' );
1597     $loanlength = $sth->fetchrow_hashref;
1598     return $loanlength
1599       if defined($loanlength) && defined $loanlength->{issuelength};
1600
1601     $sth->execute( '*', '*', '*' );
1602     $loanlength = $sth->fetchrow_hashref;
1603     return $loanlength
1604       if defined($loanlength) && defined $loanlength->{issuelength};
1605
1606     # if no rule is set => 0 day (hardcoded)
1607     return {
1608         issuelength => 0,
1609         renewalperiod => 0,
1610         lengthunit => 'days',
1611     };
1612
1613 }
1614
1615
1616 =head2 GetHardDueDate
1617
1618   my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1619
1620 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1621
1622 =cut
1623
1624 sub GetHardDueDate {
1625     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1626
1627     my $rule = GetIssuingRule( $borrowertype, $itemtype, $branchcode );
1628
1629     if ( defined( $rule ) ) {
1630         if ( $rule->{hardduedate} ) {
1631             return (dt_from_string($rule->{hardduedate}, 'iso'),$rule->{hardduedatecompare});
1632         } else {
1633             return (undef, undef);
1634         }
1635     }
1636 }
1637
1638 =head2 GetIssuingRule
1639
1640   my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1641
1642 FIXME - This is a copy-paste of GetLoanLength
1643 as a stop-gap.  Do not wish to change API for GetLoanLength
1644 this close to release.
1645
1646 Get the issuing rule for an itemtype, a borrower type and a branch
1647 Returns a hashref from the issuingrules table.
1648
1649 =cut
1650
1651 sub GetIssuingRule {
1652     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1653     my $dbh = C4::Context->dbh;
1654     my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=?"  );
1655     my $irule;
1656
1657     $sth->execute( $borrowertype, $itemtype, $branchcode );
1658     $irule = $sth->fetchrow_hashref;
1659     return $irule if defined($irule) ;
1660
1661     $sth->execute( $borrowertype, "*", $branchcode );
1662     $irule = $sth->fetchrow_hashref;
1663     return $irule if defined($irule) ;
1664
1665     $sth->execute( "*", $itemtype, $branchcode );
1666     $irule = $sth->fetchrow_hashref;
1667     return $irule if defined($irule) ;
1668
1669     $sth->execute( "*", "*", $branchcode );
1670     $irule = $sth->fetchrow_hashref;
1671     return $irule if defined($irule) ;
1672
1673     $sth->execute( $borrowertype, $itemtype, "*" );
1674     $irule = $sth->fetchrow_hashref;
1675     return $irule if defined($irule) ;
1676
1677     $sth->execute( $borrowertype, "*", "*" );
1678     $irule = $sth->fetchrow_hashref;
1679     return $irule if defined($irule) ;
1680
1681     $sth->execute( "*", $itemtype, "*" );
1682     $irule = $sth->fetchrow_hashref;
1683     return $irule if defined($irule) ;
1684
1685     $sth->execute( "*", "*", "*" );
1686     $irule = $sth->fetchrow_hashref;
1687     return $irule if defined($irule) ;
1688
1689     # if no rule matches,
1690     return;
1691 }
1692
1693 =head2 GetBranchBorrowerCircRule
1694
1695   my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1696
1697 Retrieves circulation rule attributes that apply to the given
1698 branch and patron category, regardless of item type.
1699 The return value is a hashref containing the following key:
1700
1701 maxissueqty - maximum number of loans that a
1702 patron of the given category can have at the given
1703 branch.  If the value is undef, no limit.
1704
1705 maxonsiteissueqty - maximum of on-site checkouts that a
1706 patron of the given category can have at the given
1707 branch.  If the value is undef, no limit.
1708
1709 This will first check for a specific branch and
1710 category match from branch_borrower_circ_rules.
1711
1712 If no rule is found, it will then check default_branch_circ_rules
1713 (same branch, default category).  If no rule is found,
1714 it will then check default_borrower_circ_rules (default
1715 branch, same category), then failing that, default_circ_rules
1716 (default branch, default category).
1717
1718 If no rule has been found in the database, it will default to
1719 the buillt in rule:
1720
1721 maxissueqty - undef
1722 maxonsiteissueqty - undef
1723
1724 C<$branchcode> and C<$categorycode> should contain the
1725 literal branch code and patron category code, respectively - no
1726 wildcards.
1727
1728 =cut
1729
1730 sub GetBranchBorrowerCircRule {
1731     my ( $branchcode, $categorycode ) = @_;
1732
1733     my $rules;
1734     my $dbh = C4::Context->dbh();
1735     $rules = $dbh->selectrow_hashref( q|
1736         SELECT maxissueqty, maxonsiteissueqty
1737         FROM branch_borrower_circ_rules
1738         WHERE branchcode = ?
1739         AND   categorycode = ?
1740     |, {}, $branchcode, $categorycode ) ;
1741     return $rules if $rules;
1742
1743     # try same branch, default borrower category
1744     $rules = $dbh->selectrow_hashref( q|
1745         SELECT maxissueqty, maxonsiteissueqty
1746         FROM default_branch_circ_rules
1747         WHERE branchcode = ?
1748     |, {}, $branchcode ) ;
1749     return $rules if $rules;
1750
1751     # try default branch, same borrower category
1752     $rules = $dbh->selectrow_hashref( q|
1753         SELECT maxissueqty, maxonsiteissueqty
1754         FROM default_borrower_circ_rules
1755         WHERE categorycode = ?
1756     |, {}, $categorycode ) ;
1757     return $rules if $rules;
1758
1759     # try default branch, default borrower category
1760     $rules = $dbh->selectrow_hashref( q|
1761         SELECT maxissueqty, maxonsiteissueqty
1762         FROM default_circ_rules
1763     |, {} );
1764     return $rules if $rules;
1765
1766     # built-in default circulation rule
1767     return {
1768         maxissueqty => undef,
1769         maxonsiteissueqty => undef,
1770     };
1771 }
1772
1773 =head2 GetBranchItemRule
1774
1775   my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1776
1777 Retrieves circulation rule attributes that apply to the given
1778 branch and item type, regardless of patron category.
1779
1780 The return value is a hashref containing the following keys:
1781
1782 holdallowed => Hold policy for this branch and itemtype. Possible values:
1783   0: No holds allowed.
1784   1: Holds allowed only by patrons that have the same homebranch as the item.
1785   2: Holds allowed from any patron.
1786
1787 returnbranch => branch to which to return item.  Possible values:
1788   noreturn: do not return, let item remain where checked in (floating collections)
1789   homebranch: return to item's home branch
1790   holdingbranch: return to issuer branch
1791
1792 This searches branchitemrules in the following order:
1793
1794   * Same branchcode and itemtype
1795   * Same branchcode, itemtype '*'
1796   * branchcode '*', same itemtype
1797   * branchcode and itemtype '*'
1798
1799 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1800
1801 =cut
1802
1803 sub GetBranchItemRule {
1804     my ( $branchcode, $itemtype ) = @_;
1805     my $dbh = C4::Context->dbh();
1806     my $result = {};
1807
1808     my @attempts = (
1809         ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1810             FROM branch_item_rules
1811             WHERE branchcode = ?
1812               AND itemtype = ?', $branchcode, $itemtype],
1813         ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1814             FROM default_branch_circ_rules
1815             WHERE branchcode = ?', $branchcode],
1816         ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1817             FROM default_branch_item_rules
1818             WHERE itemtype = ?', $itemtype],
1819         ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1820             FROM default_circ_rules'],
1821     );
1822
1823     foreach my $attempt (@attempts) {
1824         my ($query, @bind_params) = @{$attempt};
1825         my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1826           or next;
1827
1828         # Since branch/category and branch/itemtype use the same per-branch
1829         # defaults tables, we have to check that the key we want is set, not
1830         # just that a row was returned
1831         $result->{'holdallowed'}  = $search_result->{'holdallowed'}  unless ( defined $result->{'holdallowed'} );
1832         $result->{'hold_fulfillment_policy'} = $search_result->{'hold_fulfillment_policy'} unless ( defined $result->{'hold_fulfillment_policy'} );
1833         $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1834     }
1835
1836     # built-in default circulation rule
1837     $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1838     $result->{'hold_fulfillment_policy'} = 'any' unless ( defined $result->{'hold_fulfillment_policy'} );
1839     $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1840
1841     return $result;
1842 }
1843
1844 =head2 AddReturn
1845
1846   ($doreturn, $messages, $iteminformation, $borrower) =
1847       &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1848
1849 Returns a book.
1850
1851 =over 4
1852
1853 =item C<$barcode> is the bar code of the book being returned.
1854
1855 =item C<$branch> is the code of the branch where the book is being returned.
1856
1857 =item C<$exemptfine> indicates that overdue charges for the item will be
1858 removed. Optional.
1859
1860 =item C<$dropbox> indicates that the check-in date is assumed to be
1861 yesterday, or the last non-holiday as defined in C4::Calendar .  If
1862 overdue charges are applied and C<$dropbox> is true, the last charge
1863 will be removed.  This assumes that the fines accrual script has run
1864 for _today_. Optional.
1865
1866 =item C<$return_date> allows the default return date to be overridden
1867 by the given return date. Optional.
1868
1869 =back
1870
1871 C<&AddReturn> returns a list of four items:
1872
1873 C<$doreturn> is true iff the return succeeded.
1874
1875 C<$messages> is a reference-to-hash giving feedback on the operation.
1876 The keys of the hash are:
1877
1878 =over 4
1879
1880 =item C<BadBarcode>
1881
1882 No item with this barcode exists. The value is C<$barcode>.
1883
1884 =item C<NotIssued>
1885
1886 The book is not currently on loan. The value is C<$barcode>.
1887
1888 =item C<IsPermanent>
1889
1890 The book's home branch is a permanent collection. If you have borrowed
1891 this book, you are not allowed to return it. The value is the code for
1892 the book's home branch.
1893
1894 =item C<withdrawn>
1895
1896 This book has been withdrawn/cancelled. The value should be ignored.
1897
1898 =item C<Wrongbranch>
1899
1900 This book has was returned to the wrong branch.  The value is a hashref
1901 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1902 contain the branchcode of the incorrect and correct return library, respectively.
1903
1904 =item C<ResFound>
1905
1906 The item was reserved. The value is a reference-to-hash whose keys are
1907 fields from the reserves table of the Koha database, and
1908 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1909 either C<Waiting>, C<Reserved>, or 0.
1910
1911 =item C<WasReturned>
1912
1913 Value 1 if return is successful.
1914
1915 =item C<NeedsTransfer>
1916
1917 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
1918
1919 =back
1920
1921 C<$iteminformation> is a reference-to-hash, giving information about the
1922 returned item from the issues table.
1923
1924 C<$borrower> is a reference-to-hash, giving information about the
1925 patron who last borrowed the book.
1926
1927 =cut
1928
1929 sub AddReturn {
1930     my ( $barcode, $branch, $exemptfine, $dropbox, $return_date, $dropboxdate ) = @_;
1931
1932     if ($branch and not Koha::Libraries->find($branch)) {
1933         warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
1934         undef $branch;
1935     }
1936     $branch = C4::Context->userenv->{'branch'} unless $branch;  # we trust userenv to be a safe fallback/default
1937     my $messages;
1938     my $borrower;
1939     my $biblio;
1940     my $doreturn       = 1;
1941     my $validTransfert = 0;
1942     my $stat_type = 'return';
1943
1944     # get information on item
1945     my $itemnumber = GetItemnumberFromBarcode( $barcode );
1946     unless ($itemnumber) {
1947         return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower.  bail out.
1948     }
1949     my $issue  = GetItemIssue($itemnumber);
1950     if ($issue and $issue->{borrowernumber}) {
1951         $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1952             or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '$issue->{borrowernumber}'\n"
1953                 . Dumper($issue) . "\n";
1954     } else {
1955         $messages->{'NotIssued'} = $barcode;
1956         # even though item is not on loan, it may still be transferred;  therefore, get current branch info
1957         $doreturn = 0;
1958         # No issue, no borrowernumber.  ONLY if $doreturn, *might* you have a $borrower later.
1959         # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1960         if (C4::Context->preference("RecordLocalUseOnReturn")) {
1961            $messages->{'LocalUse'} = 1;
1962            $stat_type = 'localuse';
1963         }
1964     }
1965
1966     my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1967
1968     if ( $item->{'location'} eq 'PROC' ) {
1969         if ( C4::Context->preference("InProcessingToShelvingCart") ) {
1970             $item->{'location'} = 'CART';
1971         }
1972         else {
1973             $item->{location} = $item->{permanent_location};
1974         }
1975
1976         ModItem( $item, $item->{'biblionumber'}, $item->{'itemnumber'} );
1977     }
1978
1979         # full item data, but no borrowernumber or checkout info (no issue)
1980         # we know GetItem should work because GetItemnumberFromBarcode worked
1981     my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1982         # get the proper branch to which to return the item
1983     my $returnbranch = $item->{$hbr} || $branch ;
1984         # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1985
1986     my $borrowernumber = $borrower->{'borrowernumber'} || undef;    # we don't know if we had a borrower or not
1987
1988     my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1989     if ($yaml) {
1990         $yaml = "$yaml\n\n";  # YAML is anal on ending \n. Surplus does not hurt
1991         my $rules;
1992         eval { $rules = YAML::Load($yaml); };
1993         if ($@) {
1994             warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1995         }
1996         else {
1997             foreach my $key ( keys %$rules ) {
1998                 if ( $item->{notforloan} eq $key ) {
1999                     $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
2000                     ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
2001                     last;
2002                 }
2003             }
2004         }
2005     }
2006
2007
2008     # check if the book is in a permanent collection....
2009     # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
2010     if ( $returnbranch ) {
2011         my $branches = GetBranches();    # a potentially expensive call for a non-feature.
2012         $branches->{$returnbranch}->{PE} and $messages->{'IsPermanent'} = $returnbranch;
2013     }
2014
2015     # check if the return is allowed at this branch
2016     my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
2017     unless ($returnallowed){
2018         $messages->{'Wrongbranch'} = {
2019             Wrongbranch => $branch,
2020             Rightbranch => $message
2021         };
2022         $doreturn = 0;
2023         return ( $doreturn, $messages, $issue, $borrower );
2024     }
2025
2026     if ( $item->{'withdrawn'} ) { # book has been cancelled
2027         $messages->{'withdrawn'} = 1;
2028         $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
2029     }
2030
2031     # case of a return of document (deal with issues and holdingbranch)
2032     my $today = DateTime->now( time_zone => C4::Context->tz() );
2033
2034     if ($doreturn) {
2035         my $datedue = $issue->{date_due};
2036         $borrower or warn "AddReturn without current borrower";
2037                 my $circControlBranch;
2038         if ($dropbox) {
2039             # define circControlBranch only if dropbox mode is set
2040             # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
2041             # FIXME: check issuedate > returndate, factoring in holidays
2042
2043             $circControlBranch = _GetCircControlBranch($item,$borrower);
2044             $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $dropboxdate ) == -1 ? 1 : 0;
2045         }
2046
2047         if ($borrowernumber) {
2048             if ( ( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'} ) || $return_date ) {
2049                 # we only need to calculate and change the fines if we want to do that on return
2050                 # Should be on for hourly loans
2051                 my $control = C4::Context->preference('CircControl');
2052                 my $control_branchcode =
2053                     ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
2054                   : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
2055                   :                                     $issue->{branchcode};
2056
2057                 my $date_returned =
2058                   $return_date ? dt_from_string($return_date) : $today;
2059
2060                 my ( $amount, $type, $unitcounttotal ) =
2061                   C4::Overdues::CalcFine( $item, $borrower->{categorycode},
2062                     $control_branchcode, $datedue, $date_returned );
2063
2064                 $type ||= q{};
2065
2066                 if ( C4::Context->preference('finesMode') eq 'production' ) {
2067                     if ( $amount > 0 ) {
2068                         C4::Overdues::UpdateFine(
2069                             {
2070                                 issue_id       => $issue->{issue_id},
2071                                 itemnumber     => $issue->{itemnumber},
2072                                 borrowernumber => $issue->{borrowernumber},
2073                                 amount         => $amount,
2074                                 type           => $type,
2075                                 due            => output_pref($datedue),
2076                             }
2077                         );
2078                     }
2079                     elsif ($return_date) {
2080
2081                         # Backdated returns may have fines that shouldn't exist,
2082                         # so in this case, we need to drop those fines to 0
2083
2084                         C4::Overdues::UpdateFine(
2085                             {
2086                                 issue_id       => $issue->{issue_id},
2087                                 itemnumber     => $issue->{itemnumber},
2088                                 borrowernumber => $issue->{borrowernumber},
2089                                 amount         => 0,
2090                                 type           => $type,
2091                                 due            => output_pref($datedue),
2092                             }
2093                         );
2094                     }
2095                 }
2096             }
2097
2098             eval {
2099                 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
2100                     $circControlBranch, $return_date, $borrower->{'privacy'} );
2101             };
2102             if ( $@ ) {
2103                 $messages->{'Wrongbranch'} = {
2104                     Wrongbranch => $branch,
2105                     Rightbranch => $message
2106                 };
2107                 carp $@;
2108                 return ( 0, { WasReturned => 0 }, $issue, $borrower );
2109             }
2110
2111             # FIXME is the "= 1" right?  This could be the borrower hash.
2112             $messages->{'WasReturned'} = 1;
2113
2114         }
2115
2116         ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
2117     }
2118
2119     # the holdingbranch is updated if the document is returned to another location.
2120     # this is always done regardless of whether the item was on loan or not
2121     my $item_holding_branch = $item->{ holdingbranch };
2122     if ($item->{'holdingbranch'} ne $branch) {
2123         UpdateHoldingbranch($branch, $item->{'itemnumber'});
2124         $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
2125     }
2126     ModDateLastSeen( $item->{'itemnumber'} );
2127
2128     # check if we have a transfer for this document
2129     my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
2130
2131     # if we have a transfer to do, we update the line of transfers with the datearrived
2132     my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
2133     if ($datesent) {
2134         if ( $tobranch eq $branch ) {
2135             my $sth = C4::Context->dbh->prepare(
2136                 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
2137             );
2138             $sth->execute( $item->{'itemnumber'} );
2139             # if we have a reservation with valid transfer, we can set it's status to 'W'
2140             ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2141             C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
2142         } else {
2143             $messages->{'WrongTransfer'}     = $tobranch;
2144             $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
2145         }
2146         $validTransfert = 1;
2147     } else {
2148         ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2149     }
2150
2151     # fix up the accounts.....
2152     if ( $item->{'itemlost'} ) {
2153         $messages->{'WasLost'} = 1;
2154
2155         if ( $item->{'itemlost'} ) {
2156             if (
2157                 Koha::RefundLostItemFeeRules->should_refund(
2158                     {
2159                         current_branch      => C4::Context->userenv->{branch},
2160                         item_home_branch    => $item->{homebranch},
2161                         item_holding_branch => $item_holding_branch
2162                     }
2163                 )
2164               )
2165             {
2166                 _FixAccountForLostAndReturned( $item->{'itemnumber'}, $borrowernumber, $barcode );
2167                 $messages->{'LostItemFeeRefunded'} = 1;
2168             }
2169         }
2170     }
2171
2172     # fix up the overdues in accounts...
2173     if ($borrowernumber) {
2174         my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
2175         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!";  # zero is OK, check defined
2176
2177         if ( $issue->{overdue} && $issue->{date_due} ) {
2178         # fix fine days
2179             $today = $dropboxdate if $dropbox;
2180             my ($debardate,$reminder) = _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
2181             if ($reminder){
2182                 $messages->{'PrevDebarred'} = $debardate;
2183             } else {
2184                 $messages->{'Debarred'} = $debardate if $debardate;
2185             }
2186         # there's no overdue on the item but borrower had been previously debarred
2187         } elsif ( $issue->{date_due} and $borrower->{'debarred'} ) {
2188              if ( $borrower->{debarred} eq "9999-12-31") {
2189                 $messages->{'ForeverDebarred'} = $borrower->{'debarred'};
2190              } else {
2191                   my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2192                   $borrower_debar_dt->truncate(to => 'day');
2193                   my $today_dt = $today->clone()->truncate(to => 'day');
2194                   if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2195                       $messages->{'PrevDebarred'} = $borrower->{'debarred'};
2196                   }
2197              }
2198         }
2199     }
2200
2201     # find reserves.....
2202     # if we don't have a reserve with the status W, we launch the Checkreserves routine
2203     my ($resfound, $resrec);
2204     my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2205     ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
2206     if ($resfound) {
2207           $resrec->{'ResFound'} = $resfound;
2208         $messages->{'ResFound'} = $resrec;
2209     }
2210
2211     # Record the fact that this book was returned.
2212     # FIXME itemtype should record item level type, not bibliolevel type
2213     UpdateStats({
2214                 branch => $branch,
2215                 type => $stat_type,
2216                 itemnumber => $item->{'itemnumber'},
2217                 itemtype => $biblio->{'itemtype'},
2218                 borrowernumber => $borrowernumber,
2219                 ccode => $item->{'ccode'}}
2220     );
2221
2222     # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
2223     my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2224     my %conditions = (
2225         branchcode   => $branch,
2226         categorycode => $borrower->{categorycode},
2227         item_type    => $item->{itype},
2228         notification => 'CHECKIN',
2229     );
2230     if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2231         SendCirculationAlert({
2232             type     => 'CHECKIN',
2233             item     => $item,
2234             borrower => $borrower,
2235             branch   => $branch,
2236         });
2237     }
2238
2239     logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2240         if C4::Context->preference("ReturnLog");
2241
2242     # Remove any OVERDUES related debarment if the borrower has no overdues
2243     if ( $borrowernumber
2244       && $borrower->{'debarred'}
2245       && C4::Context->preference('AutoRemoveOverduesRestrictions')
2246       && !C4::Members::HasOverdues( $borrowernumber )
2247       && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2248     ) {
2249         DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2250     }
2251
2252     # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2253     if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2254         if  (C4::Context->preference("AutomaticItemReturn"    ) or
2255             (C4::Context->preference("UseBranchTransferLimits") and
2256              ! IsBranchTransferAllowed($branch, $returnbranch, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2257            )) {
2258             $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $returnbranch;
2259             $debug and warn "item: " . Dumper($item);
2260             ModItemTransfer($item->{'itemnumber'}, $branch, $returnbranch);
2261             $messages->{'WasTransfered'} = 1;
2262         } else {
2263             $messages->{'NeedsTransfer'} = $returnbranch;
2264         }
2265     }
2266
2267     return ( $doreturn, $messages, $issue, $borrower );
2268 }
2269
2270 =head2 MarkIssueReturned
2271
2272   MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2273
2274 Unconditionally marks an issue as being returned by
2275 moving the C<issues> row to C<old_issues> and
2276 setting C<returndate> to the current date, or
2277 the last non-holiday date of the branccode specified in
2278 C<dropbox_branch> .  Assumes you've already checked that
2279 it's safe to do this, i.e. last non-holiday > issuedate.
2280
2281 if C<$returndate> is specified (in iso format), it is used as the date
2282 of the return. It is ignored when a dropbox_branch is passed in.
2283
2284 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2285 the old_issue is immediately anonymised
2286
2287 Ideally, this function would be internal to C<C4::Circulation>,
2288 not exported, but it is currently needed by one
2289 routine in C<C4::Accounts>.
2290
2291 =cut
2292
2293 sub MarkIssueReturned {
2294     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2295
2296     my $anonymouspatron;
2297     if ( $privacy == 2 ) {
2298         # The default of 0 will not work due to foreign key constraints
2299         # The anonymisation will fail if AnonymousPatron is not a valid entry
2300         # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2301         # Note that a warning should appear on the about page (System information tab).
2302         $anonymouspatron = C4::Context->preference('AnonymousPatron');
2303         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."
2304             unless C4::Members::GetMember( borrowernumber => $anonymouspatron );
2305     }
2306     my $dbh   = C4::Context->dbh;
2307     my $query = 'UPDATE issues SET returndate=';
2308     my @bind;
2309     if ($dropbox_branch) {
2310         my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2311         my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2312         $query .= ' ? ';
2313         push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2314     } elsif ($returndate) {
2315         $query .= ' ? ';
2316         push @bind, $returndate;
2317     } else {
2318         $query .= ' now() ';
2319     }
2320     $query .= ' WHERE  borrowernumber = ?  AND itemnumber = ?';
2321     push @bind, $borrowernumber, $itemnumber;
2322     # FIXME transaction
2323     my $sth_upd  = $dbh->prepare($query);
2324     $sth_upd->execute(@bind);
2325     my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
2326                                   WHERE borrowernumber = ?
2327                                   AND itemnumber = ?');
2328     $sth_copy->execute($borrowernumber, $itemnumber);
2329     # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2330     if ( $privacy == 2) {
2331         my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
2332                                   WHERE borrowernumber = ?
2333                                   AND itemnumber = ?");
2334        $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
2335     }
2336     my $sth_del  = $dbh->prepare("DELETE FROM issues
2337                                   WHERE borrowernumber = ?
2338                                   AND itemnumber = ?");
2339     $sth_del->execute($borrowernumber, $itemnumber);
2340
2341     ModItem( { 'onloan' => undef }, undef, $itemnumber );
2342
2343     if ( C4::Context->preference('StoreLastBorrower') ) {
2344         my $item = Koha::Items->find( $itemnumber );
2345         my $patron = Koha::Patrons->find( $borrowernumber );
2346         $item->last_returned_by( $patron );
2347     }
2348 }
2349
2350 =head2 _debar_user_on_return
2351
2352     _debar_user_on_return($borrower, $item, $datedue, today);
2353
2354 C<$borrower> borrower hashref
2355
2356 C<$item> item hashref
2357
2358 C<$datedue> date due DateTime object
2359
2360 C<$today> DateTime object representing the return time
2361
2362 Internal function, called only by AddReturn that calculates and updates
2363  the user fine days, and debars him if necessary.
2364
2365 Should only be called for overdue returns
2366
2367 =cut
2368
2369 sub _debar_user_on_return {
2370     my ( $borrower, $item, $dt_due, $dt_today ) = @_;
2371
2372     my $branchcode = _GetCircControlBranch( $item, $borrower );
2373
2374     my $circcontrol = C4::Context->preference('CircControl');
2375     my $issuingrule =
2376       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2377     my $finedays = $issuingrule->{finedays};
2378     my $unit     = $issuingrule->{lengthunit};
2379     my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $dt_today, $branchcode);
2380
2381     if ($finedays) {
2382
2383         # finedays is in days, so hourly loans must multiply by 24
2384         # thus 1 hour late equals 1 day suspension * finedays rate
2385         $finedays = $finedays * 24 if ( $unit eq 'hours' );
2386
2387         # grace period is measured in the same units as the loan
2388         my $grace =
2389           DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
2390
2391         my $deltadays = DateTime::Duration->new(
2392             days => $chargeable_units
2393         );
2394         if ( $deltadays->subtract($grace)->is_positive() ) {
2395             my $suspension_days = $deltadays * $finedays;
2396
2397             # If the max suspension days is < than the suspension days
2398             # the suspension days is limited to this maximum period.
2399             my $max_sd = $issuingrule->{maxsuspensiondays};
2400             if ( defined $max_sd ) {
2401                 $max_sd = DateTime::Duration->new( days => $max_sd );
2402                 $suspension_days = $max_sd
2403                   if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2404             }
2405
2406             my $new_debar_dt =
2407               $dt_today->clone()->add_duration( $suspension_days );
2408
2409             Koha::Patron::Debarments::AddUniqueDebarment({
2410                 borrowernumber => $borrower->{borrowernumber},
2411                 expiration     => $new_debar_dt->ymd(),
2412                 type           => 'SUSPENSION',
2413             });
2414             # if borrower was already debarred but does not get an extra debarment
2415             if ( $borrower->{debarred} eq Koha::Patron::Debarments::IsDebarred($borrower->{borrowernumber}) ) {
2416                     return ($borrower->{debarred},1);
2417             }
2418             return $new_debar_dt->ymd();
2419         }
2420     }
2421     return;
2422 }
2423
2424 =head2 _FixOverduesOnReturn
2425
2426    &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2427
2428 C<$brn> borrowernumber
2429
2430 C<$itm> itemnumber
2431
2432 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2433 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2434
2435 Internal function, called only by AddReturn
2436
2437 =cut
2438
2439 sub _FixOverduesOnReturn {
2440     my ($borrowernumber, $item);
2441     unless ($borrowernumber = shift) {
2442         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2443         return;
2444     }
2445     unless ($item = shift) {
2446         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2447         return;
2448     }
2449     my ($exemptfine, $dropbox) = @_;
2450     my $dbh = C4::Context->dbh;
2451
2452     # check for overdue fine
2453     my $sth = $dbh->prepare(
2454 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2455     );
2456     $sth->execute( $borrowernumber, $item );
2457
2458     # alter fine to show that the book has been returned
2459     my $data = $sth->fetchrow_hashref;
2460     return 0 unless $data;    # no warning, there's just nothing to fix
2461
2462     my $uquery;
2463     my @bind = ($data->{'accountlines_id'});
2464     if ($exemptfine) {
2465         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2466         if (C4::Context->preference("FinesLog")) {
2467             &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2468         }
2469     } elsif ($dropbox && $data->{lastincrement}) {
2470         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2471         my $amt = $data->{amount} - $data->{lastincrement} ;
2472         if (C4::Context->preference("FinesLog")) {
2473             &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2474         }
2475          $uquery = "update accountlines set accounttype='F' ";
2476          if($outstanding  >= 0 && $amt >=0) {
2477             $uquery .= ", amount = ? , amountoutstanding=? ";
2478             unshift @bind, ($amt, $outstanding) ;
2479         }
2480     } else {
2481         $uquery = "update accountlines set accounttype='F' ";
2482     }
2483     $uquery .= " where (accountlines_id = ?)";
2484     my $usth = $dbh->prepare($uquery);
2485     return $usth->execute(@bind);
2486 }
2487
2488 =head2 _FixAccountForLostAndReturned
2489
2490   &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2491
2492 Calculates the charge for a book lost and returned.
2493
2494 Internal function, not exported, called only by AddReturn.
2495
2496 FIXME: This function reflects how inscrutable fines logic is.  Fix both.
2497 FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.
2498
2499 =cut
2500
2501 sub _FixAccountForLostAndReturned {
2502     my $itemnumber     = shift or return;
2503     my $borrowernumber = @_ ? shift : undef;
2504     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
2505     my $dbh = C4::Context->dbh;
2506     # check for charge made for lost book
2507     my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2508     $sth->execute($itemnumber);
2509     my $data = $sth->fetchrow_hashref;
2510     $data or return;    # bail if there is nothing to do
2511     $data->{accounttype} eq 'W' and return;    # Written off
2512
2513     # writeoff this amount
2514     my $offset;
2515     my $amount = $data->{'amount'};
2516     my $acctno = $data->{'accountno'};
2517     my $amountleft;                                             # Starts off undef/zero.
2518     if ($data->{'amountoutstanding'} == $amount) {
2519         $offset     = $data->{'amount'};
2520         $amountleft = 0;                                        # Hey, it's zero here, too.
2521     } else {
2522         $offset     = $amount - $data->{'amountoutstanding'};   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2523         $amountleft = $data->{'amountoutstanding'} - $amount;   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2524     }
2525     my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2526         WHERE (accountlines_id = ?)");
2527     $usth->execute($data->{'accountlines_id'});      # We might be adjusting an account for some OTHER borrowernumber now.  Not the one we passed in.
2528     #check if any credit is left if so writeoff other accounts
2529     my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2530     $amountleft *= -1 if ($amountleft < 0);
2531     if ($amountleft > 0) {
2532         my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2533                             AND (amountoutstanding >0) ORDER BY date");     # might want to order by amountoustanding ASC (pay smallest first)
2534         $msth->execute($data->{'borrowernumber'});
2535         # offset transactions
2536         my $newamtos;
2537         my $accdata;
2538         while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2539             if ($accdata->{'amountoutstanding'} < $amountleft) {
2540                 $newamtos = 0;
2541                 $amountleft -= $accdata->{'amountoutstanding'};
2542             }  else {
2543                 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2544                 $amountleft = 0;
2545             }
2546             my $thisacct = $accdata->{'accountlines_id'};
2547             # FIXME: move prepares outside while loop!
2548             my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2549                     WHERE (accountlines_id = ?)");
2550             $usth->execute($newamtos,$thisacct);
2551             $usth = $dbh->prepare("INSERT INTO accountoffsets
2552                 (borrowernumber, accountno, offsetaccount,  offsetamount)
2553                 VALUES
2554                 (?,?,?,?)");
2555             $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2556         }
2557     }
2558     $amountleft *= -1 if ($amountleft > 0);
2559     my $desc = "Item Returned " . $item_id;
2560     $usth = $dbh->prepare("INSERT INTO accountlines
2561         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2562         VALUES (?,?,now(),?,?,'CR',?)");
2563     $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2564     if ($borrowernumber) {
2565         # FIXME: same as query above.  use 1 sth for both
2566         $usth = $dbh->prepare("INSERT INTO accountoffsets
2567             (borrowernumber, accountno, offsetaccount,  offsetamount)
2568             VALUES (?,?,?,?)");
2569         $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2570     }
2571     ModItem({ paidfor => '' }, undef, $itemnumber);
2572     return;
2573 }
2574
2575 =head2 _GetCircControlBranch
2576
2577    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2578
2579 Internal function :
2580
2581 Return the library code to be used to determine which circulation
2582 policy applies to a transaction.  Looks up the CircControl and
2583 HomeOrHoldingBranch system preferences.
2584
2585 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2586
2587 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2588
2589 =cut
2590
2591 sub _GetCircControlBranch {
2592     my ($item, $borrower) = @_;
2593     my $circcontrol = C4::Context->preference('CircControl');
2594     my $branch;
2595
2596     if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2597         $branch= C4::Context->userenv->{'branch'};
2598     } elsif ($circcontrol eq 'PatronLibrary') {
2599         $branch=$borrower->{branchcode};
2600     } else {
2601         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2602         $branch = $item->{$branchfield};
2603         # default to item home branch if holdingbranch is used
2604         # and is not defined
2605         if (!defined($branch) && $branchfield eq 'holdingbranch') {
2606             $branch = $item->{homebranch};
2607         }
2608     }
2609     return $branch;
2610 }
2611
2612
2613
2614
2615
2616
2617 =head2 GetItemIssue
2618
2619   $issue = &GetItemIssue($itemnumber);
2620
2621 Returns patron currently having a book, or undef if not checked out.
2622
2623 C<$itemnumber> is the itemnumber.
2624
2625 C<$issue> is a hashref of the row from the issues table.
2626
2627 =cut
2628
2629 sub GetItemIssue {
2630     my ($itemnumber) = @_;
2631     return unless $itemnumber;
2632     my $sth = C4::Context->dbh->prepare(
2633         "SELECT items.*, issues.*
2634         FROM issues
2635         LEFT JOIN items ON issues.itemnumber=items.itemnumber
2636         WHERE issues.itemnumber=?");
2637     $sth->execute($itemnumber);
2638     my $data = $sth->fetchrow_hashref;
2639     return unless $data;
2640     $data->{issuedate_sql} = $data->{issuedate};
2641     $data->{date_due_sql} = $data->{date_due};
2642     $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2643     $data->{issuedate}->truncate(to => 'minute');
2644     $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2645     $data->{date_due}->truncate(to => 'minute');
2646     my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2647     $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2648     return $data;
2649 }
2650
2651 =head2 GetOpenIssue
2652
2653   $issue = GetOpenIssue( $itemnumber );
2654
2655 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2656
2657 C<$itemnumber> is the item's itemnumber
2658
2659 Returns a hashref
2660
2661 =cut
2662
2663 sub GetOpenIssue {
2664   my ( $itemnumber ) = @_;
2665   return unless $itemnumber;
2666   my $dbh = C4::Context->dbh;
2667   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2668   $sth->execute( $itemnumber );
2669   return $sth->fetchrow_hashref();
2670
2671 }
2672
2673 =head2 GetIssues
2674
2675     $issues = GetIssues({});    # return all issues!
2676     $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
2677
2678 Returns all pending issues that match given criteria.
2679 Returns a arrayref or undef if an error occurs.
2680
2681 Allowed criteria are:
2682
2683 =over 2
2684
2685 =item * borrowernumber
2686
2687 =item * biblionumber
2688
2689 =item * itemnumber
2690
2691 =back
2692
2693 =cut
2694
2695 sub GetIssues {
2696     my ($criteria) = @_;
2697
2698     # Build filters
2699     my @filters;
2700     my @allowed = qw(borrowernumber biblionumber itemnumber);
2701     foreach (@allowed) {
2702         if (defined $criteria->{$_}) {
2703             push @filters, {
2704                 field => $_,
2705                 value => $criteria->{$_},
2706             };
2707         }
2708     }
2709
2710     # Do we need to join other tables ?
2711     my %join;
2712     if (defined $criteria->{biblionumber}) {
2713         $join{items} = 1;
2714     }
2715
2716     # Build SQL query
2717     my $where = '';
2718     if (@filters) {
2719         $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
2720     }
2721     my $query = q{
2722         SELECT issues.*
2723         FROM issues
2724     };
2725     if (defined $join{items}) {
2726         $query .= q{
2727             LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
2728         };
2729     }
2730     $query .= $where;
2731
2732     # Execute SQL query
2733     my $dbh = C4::Context->dbh;
2734     my $sth = $dbh->prepare($query);
2735     my $rv = $sth->execute(map { $_->{value} } @filters);
2736
2737     return $rv ? $sth->fetchall_arrayref({}) : undef;
2738 }
2739
2740 =head2 GetItemIssues
2741
2742   $issues = &GetItemIssues($itemnumber, $history);
2743
2744 Returns patrons that have issued a book
2745
2746 C<$itemnumber> is the itemnumber
2747 C<$history> is false if you just want the current "issuer" (if any)
2748 and true if you want issues history from old_issues also.
2749
2750 Returns reference to an array of hashes
2751
2752 =cut
2753
2754 sub GetItemIssues {
2755     my ( $itemnumber, $history ) = @_;
2756
2757     my $today = DateTime->now( time_zome => C4::Context->tz);  # get today date
2758     $today->truncate( to => 'minute' );
2759     my $sql = "SELECT * FROM issues
2760               JOIN borrowers USING (borrowernumber)
2761               JOIN items     USING (itemnumber)
2762               WHERE issues.itemnumber = ? ";
2763     if ($history) {
2764         $sql .= "UNION ALL
2765                  SELECT * FROM old_issues
2766                  LEFT JOIN borrowers USING (borrowernumber)
2767                  JOIN items USING (itemnumber)
2768                  WHERE old_issues.itemnumber = ? ";
2769     }
2770     $sql .= "ORDER BY date_due DESC";
2771     my $sth = C4::Context->dbh->prepare($sql);
2772     if ($history) {
2773         $sth->execute($itemnumber, $itemnumber);
2774     } else {
2775         $sth->execute($itemnumber);
2776     }
2777     my $results = $sth->fetchall_arrayref({});
2778     foreach (@$results) {
2779         my $date_due = dt_from_string($_->{date_due},'sql');
2780         $date_due->truncate( to => 'minute' );
2781
2782         $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2783     }
2784     return $results;
2785 }
2786
2787 =head2 GetBiblioIssues
2788
2789   $issues = GetBiblioIssues($biblionumber);
2790
2791 this function get all issues from a biblionumber.
2792
2793 Return:
2794 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2795 tables issues and the firstname,surname & cardnumber from borrowers.
2796
2797 =cut
2798
2799 sub GetBiblioIssues {
2800     my $biblionumber = shift;
2801     return unless $biblionumber;
2802     my $dbh   = C4::Context->dbh;
2803     my $query = "
2804         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2805         FROM issues
2806             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2807             LEFT JOIN items ON issues.itemnumber = items.itemnumber
2808             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2809             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2810         WHERE biblio.biblionumber = ?
2811         UNION ALL
2812         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2813         FROM old_issues
2814             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2815             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2816             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2817             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2818         WHERE biblio.biblionumber = ?
2819         ORDER BY timestamp
2820     ";
2821     my $sth = $dbh->prepare($query);
2822     $sth->execute($biblionumber, $biblionumber);
2823
2824     my @issues;
2825     while ( my $data = $sth->fetchrow_hashref ) {
2826         push @issues, $data;
2827     }
2828     return \@issues;
2829 }
2830
2831 =head2 GetUpcomingDueIssues
2832
2833   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2834
2835 =cut
2836
2837 sub GetUpcomingDueIssues {
2838     my $params = shift;
2839
2840     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2841     my $dbh = C4::Context->dbh;
2842
2843     my $statement = <<END_SQL;
2844 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2845 FROM issues
2846 LEFT JOIN items USING (itemnumber)
2847 LEFT OUTER JOIN branches USING (branchcode)
2848 WHERE returndate is NULL
2849 HAVING days_until_due >= 0 AND days_until_due <= ?
2850 END_SQL
2851
2852     my @bind_parameters = ( $params->{'days_in_advance'} );
2853
2854     my $sth = $dbh->prepare( $statement );
2855     $sth->execute( @bind_parameters );
2856     my $upcoming_dues = $sth->fetchall_arrayref({});
2857
2858     return $upcoming_dues;
2859 }
2860
2861 =head2 CanBookBeRenewed
2862
2863   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2864
2865 Find out whether a borrowed item may be renewed.
2866
2867 C<$borrowernumber> is the borrower number of the patron who currently
2868 has the item on loan.
2869
2870 C<$itemnumber> is the number of the item to renew.
2871
2872 C<$override_limit>, if supplied with a true value, causes
2873 the limit on the number of times that the loan can be renewed
2874 (as controlled by the item type) to be ignored. Overriding also allows
2875 to renew sooner than "No renewal before" and to manually renew loans
2876 that are automatically renewed.
2877
2878 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2879 item must currently be on loan to the specified borrower; renewals
2880 must be allowed for the item's type; and the borrower must not have
2881 already renewed the loan. $error will contain the reason the renewal can not proceed
2882
2883 =cut
2884
2885 sub CanBookBeRenewed {
2886     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2887
2888     my $dbh    = C4::Context->dbh;
2889     my $renews = 1;
2890
2891     my $item      = GetItem($itemnumber)      or return ( 0, 'no_item' );
2892     my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
2893     return ( 0, 'onsite_checkout' ) if $itemissue->{onsite_checkout};
2894
2895     $borrowernumber ||= $itemissue->{borrowernumber};
2896     my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2897       or return;
2898
2899     my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2900
2901     # This item can fill one or more unfilled reserve, can those unfilled reserves
2902     # all be filled by other available items?
2903     if ( $resfound
2904         && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2905     {
2906         my $schema = Koha::Database->new()->schema();
2907
2908         my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2909         if ($item_holds) {
2910             # There is an item level hold on this item, no other item can fill the hold
2911             $resfound = 1;
2912         }
2913         else {
2914
2915             # Get all other items that could possibly fill reserves
2916             my @itemnumbers = $schema->resultset('Item')->search(
2917                 {
2918                     biblionumber => $resrec->{biblionumber},
2919                     onloan       => undef,
2920                     notforloan   => 0,
2921                     -not         => { itemnumber => $itemnumber }
2922                 },
2923                 { columns => 'itemnumber' }
2924             )->get_column('itemnumber')->all();
2925
2926             # Get all other reserves that could have been filled by this item
2927             my @borrowernumbers;
2928             while (1) {
2929                 my ( $reserve_found, $reserve, undef ) =
2930                   C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2931
2932                 if ($reserve_found) {
2933                     push( @borrowernumbers, $reserve->{borrowernumber} );
2934                 }
2935                 else {
2936                     last;
2937                 }
2938             }
2939
2940             # If the count of the union of the lists of reservable items for each borrower
2941             # is equal or greater than the number of borrowers, we know that all reserves
2942             # can be filled with available items. We can get the union of the sets simply
2943             # by pushing all the elements onto an array and removing the duplicates.
2944             my @reservable;
2945             foreach my $b (@borrowernumbers) {
2946                 my ($borr) = C4::Members::GetMemberDetails($b);
2947                 foreach my $i (@itemnumbers) {
2948                     my $item = GetItem($i);
2949                     if (   IsAvailableForItemLevelRequest( $item, $borr )
2950                         && CanItemBeReserved( $b, $i )
2951                         && !IsItemOnHoldAndFound($i) )
2952                     {
2953                         push( @reservable, $i );
2954                     }
2955                 }
2956             }
2957
2958             @reservable = uniq(@reservable);
2959
2960             if ( @reservable >= @borrowernumbers ) {
2961                 $resfound = 0;
2962             }
2963         }
2964     }
2965     return ( 0, "on_reserve" ) if $resfound;    # '' when no hold was found
2966
2967     return ( 1, undef ) if $override_limit;
2968
2969     my $branchcode = _GetCircControlBranch( $item, $borrower );
2970     my $issuingrule =
2971       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2972
2973     return ( 0, "too_many" )
2974       if $issuingrule->{renewalsallowed} <= $itemissue->{renewals};
2975
2976     my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2977     my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2978     my $restricted = Koha::Patron::Debarments::IsDebarred($borrowernumber);
2979     my $hasoverdues = C4::Members::HasOverdues($borrowernumber);
2980
2981     if ( $restricted and $restrictionblockrenewing ) {
2982         return ( 0, 'restriction');
2983     } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($itemissue->{overdue} and $overduesblockrenewing eq 'blockitem') ) {
2984         return ( 0, 'overdue');
2985     }
2986
2987     if ( defined $issuingrule->{norenewalbefore}
2988         and $issuingrule->{norenewalbefore} ne "" )
2989     {
2990
2991         # Calculate soonest renewal by subtracting 'No renewal before' from due date
2992         my $soonestrenewal =
2993           $itemissue->{date_due}->clone()
2994           ->subtract(
2995             $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
2996
2997         # Depending on syspref reset the exact time, only check the date
2998         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2999             and $issuingrule->{lengthunit} eq 'days' )
3000         {
3001             $soonestrenewal->truncate( to => 'day' );
3002         }
3003
3004         if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
3005         {
3006             return ( 0, "auto_too_soon" ) if $itemissue->{auto_renew};
3007             return ( 0, "too_soon" );
3008         }
3009         elsif ( $itemissue->{auto_renew} ) {
3010             return ( 0, "auto_renew" );
3011         }
3012     }
3013
3014     # Fallback for automatic renewals:
3015     # If norenewalbefore is undef, don't renew before due date.
3016     elsif ( $itemissue->{auto_renew} ) {
3017         my $now = dt_from_string;
3018         return ( 0, "auto_renew" )
3019           if $now >= $itemissue->{date_due};
3020         return ( 0, "auto_too_soon" );
3021     }
3022
3023     return ( 1, undef );
3024 }
3025
3026 =head2 AddRenewal
3027
3028   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
3029
3030 Renews a loan.
3031
3032 C<$borrowernumber> is the borrower number of the patron who currently
3033 has the item.
3034
3035 C<$itemnumber> is the number of the item to renew.
3036
3037 C<$branch> is the library where the renewal took place (if any).
3038            The library that controls the circ policies for the renewal is retrieved from the issues record.
3039
3040 C<$datedue> can be a DateTime object used to set the due date.
3041
3042 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
3043 this parameter is not supplied, lastreneweddate is set to the current date.
3044
3045 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
3046 from the book's item type.
3047
3048 =cut
3049
3050 sub AddRenewal {
3051     my $borrowernumber  = shift;
3052     my $itemnumber      = shift or return;
3053     my $branch          = shift;
3054     my $datedue         = shift;
3055     my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
3056
3057     my $item   = GetItem($itemnumber) or return;
3058     my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
3059
3060     my $dbh = C4::Context->dbh;
3061
3062     # Find the issues record for this book
3063     my $sth =
3064       $dbh->prepare("SELECT * FROM issues WHERE itemnumber = ?");
3065     $sth->execute( $itemnumber );
3066     my $issuedata = $sth->fetchrow_hashref;
3067
3068     return unless ( $issuedata );
3069
3070     $borrowernumber ||= $issuedata->{borrowernumber};
3071
3072     if ( defined $datedue && ref $datedue ne 'DateTime' ) {
3073         carp 'Invalid date passed to AddRenewal.';
3074         return;
3075     }
3076
3077     # If the due date wasn't specified, calculate it by adding the
3078     # book's loan length to today's date or the current due date
3079     # based on the value of the RenewalPeriodBase syspref.
3080     unless ($datedue) {
3081
3082         my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
3083         my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
3084
3085         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
3086                                         dt_from_string( $issuedata->{date_due} ) :
3087                                         DateTime->now( time_zone => C4::Context->tz());
3088         $datedue =  CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
3089     }
3090
3091     # Update the issues record to have the new due date, and a new count
3092     # of how many times it has been renewed.
3093     my $renews = $issuedata->{'renewals'} + 1;
3094     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
3095                             WHERE borrowernumber=?
3096                             AND itemnumber=?"
3097     );
3098
3099     $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
3100
3101     # Update the renewal count on the item, and tell zebra to reindex
3102     $renews = $biblio->{'renewals'} + 1;
3103     ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
3104
3105     # Charge a new rental fee, if applicable?
3106     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
3107     if ( $charge > 0 ) {
3108         my $accountno = getnextacctno( $borrowernumber );
3109         my $item = GetBiblioFromItemNumber($itemnumber);
3110         my $manager_id = 0;
3111         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3112         $sth = $dbh->prepare(
3113                 "INSERT INTO accountlines
3114                     (date, borrowernumber, accountno, amount, manager_id,
3115                     description,accounttype, amountoutstanding, itemnumber)
3116                     VALUES (now(),?,?,?,?,?,?,?,?)"
3117         );
3118         $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
3119             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
3120             'Rent', $charge, $itemnumber );
3121     }
3122
3123     # Send a renewal slip according to checkout alert preferencei
3124     if ( C4::Context->preference('RenewalSendNotice') eq '1') {
3125         my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
3126         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
3127         my %conditions = (
3128                 branchcode   => $branch,
3129                 categorycode => $borrower->{categorycode},
3130                 item_type    => $item->{itype},
3131                 notification => 'CHECKOUT',
3132         );
3133         if ($circulation_alert->is_enabled_for(\%conditions)) {
3134                 SendCirculationAlert({
3135                         type     => 'RENEWAL',
3136                         item     => $item,
3137                 borrower => $borrower,
3138                 branch   => $branch,
3139                 });
3140         }
3141     }
3142
3143     # Remove any OVERDUES related debarment if the borrower has no overdues
3144     my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
3145     if ( $borrowernumber
3146       && $borrower->{'debarred'}
3147       && !C4::Members::HasOverdues( $borrowernumber )
3148       && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
3149     ) {
3150         DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
3151     }
3152
3153     # Log the renewal
3154     UpdateStats({branch => $branch,
3155                 type => 'renew',
3156                 amount => $charge,
3157                 itemnumber => $itemnumber,
3158                 itemtype => $item->{itype},
3159                 borrowernumber => $borrowernumber,
3160                 ccode => $item->{'ccode'}}
3161                 );
3162         return $datedue;
3163 }
3164
3165 sub GetRenewCount {
3166     # check renewal status
3167     my ( $bornum, $itemno ) = @_;
3168     my $dbh           = C4::Context->dbh;
3169     my $renewcount    = 0;
3170     my $renewsallowed = 0;
3171     my $renewsleft    = 0;
3172
3173     my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
3174     my $item     = GetItem($itemno);
3175
3176     # Look in the issues table for this item, lent to this borrower,
3177     # and not yet returned.
3178
3179     # FIXME - I think this function could be redone to use only one SQL call.
3180     my $sth = $dbh->prepare(
3181         "select * from issues
3182                                 where (borrowernumber = ?)
3183                                 and (itemnumber = ?)"
3184     );
3185     $sth->execute( $bornum, $itemno );
3186     my $data = $sth->fetchrow_hashref;
3187     $renewcount = $data->{'renewals'} if $data->{'renewals'};
3188     # $item and $borrower should be calculated
3189     my $branchcode = _GetCircControlBranch($item, $borrower);
3190
3191     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
3192
3193     $renewsallowed = $issuingrule->{'renewalsallowed'};
3194     $renewsleft    = $renewsallowed - $renewcount;
3195     if($renewsleft < 0){ $renewsleft = 0; }
3196     return ( $renewcount, $renewsallowed, $renewsleft );
3197 }
3198
3199 =head2 GetSoonestRenewDate
3200
3201   $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3202
3203 Find out the soonest possible renew date of a borrowed item.
3204
3205 C<$borrowernumber> is the borrower number of the patron who currently
3206 has the item on loan.
3207
3208 C<$itemnumber> is the number of the item to renew.
3209
3210 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3211 renew date, based on the value "No renewal before" of the applicable
3212 issuing rule. Returns the current date if the item can already be
3213 renewed, and returns undefined if the borrower, loan, or item
3214 cannot be found.
3215
3216 =cut
3217
3218 sub GetSoonestRenewDate {
3219     my ( $borrowernumber, $itemnumber ) = @_;
3220
3221     my $dbh = C4::Context->dbh;
3222
3223     my $item      = GetItem($itemnumber)      or return;
3224     my $itemissue = GetItemIssue($itemnumber) or return;
3225
3226     $borrowernumber ||= $itemissue->{borrowernumber};
3227     my $borrower = C4::Members::GetMemberDetails($borrowernumber)
3228       or return;
3229
3230     my $branchcode = _GetCircControlBranch( $item, $borrower );
3231     my $issuingrule =
3232       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
3233
3234     my $now = dt_from_string;
3235
3236     if ( defined $issuingrule->{norenewalbefore}
3237         and $issuingrule->{norenewalbefore} ne "" )
3238     {
3239         my $soonestrenewal =
3240           $itemissue->{date_due}->clone()
3241           ->subtract(
3242             $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
3243
3244         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3245             and $issuingrule->{lengthunit} eq 'days' )
3246         {
3247             $soonestrenewal->truncate( to => 'day' );
3248         }
3249         return $soonestrenewal if $now < $soonestrenewal;
3250     }
3251     return $now;
3252 }
3253
3254 =head2 GetIssuingCharges
3255
3256   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3257
3258 Calculate how much it would cost for a given patron to borrow a given
3259 item, including any applicable discounts.
3260
3261 C<$itemnumber> is the item number of item the patron wishes to borrow.
3262
3263 C<$borrowernumber> is the patron's borrower number.
3264
3265 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3266 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3267 if it's a video).
3268
3269 =cut
3270
3271 sub GetIssuingCharges {
3272
3273     # calculate charges due
3274     my ( $itemnumber, $borrowernumber ) = @_;
3275     my $charge = 0;
3276     my $dbh    = C4::Context->dbh;
3277     my $item_type;
3278
3279     # Get the book's item type and rental charge (via its biblioitem).
3280     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3281         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3282     $charge_query .= (C4::Context->preference('item-level_itypes'))
3283         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3284         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3285
3286     $charge_query .= ' WHERE items.itemnumber =?';
3287
3288     my $sth = $dbh->prepare($charge_query);
3289     $sth->execute($itemnumber);
3290     if ( my $item_data = $sth->fetchrow_hashref ) {
3291         $item_type = $item_data->{itemtype};
3292         $charge    = $item_data->{rentalcharge};
3293         my $branch = C4::Branch::mybranch();
3294         my $discount_query = q|SELECT rentaldiscount,
3295             issuingrules.itemtype, issuingrules.branchcode
3296             FROM borrowers
3297             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3298             WHERE borrowers.borrowernumber = ?
3299             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3300             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3301         my $discount_sth = $dbh->prepare($discount_query);
3302         $discount_sth->execute( $borrowernumber, $item_type, $branch );
3303         my $discount_rules = $discount_sth->fetchall_arrayref({});
3304         if (@{$discount_rules}) {
3305             # We may have multiple rules so get the most specific
3306             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3307             $charge = ( $charge * ( 100 - $discount ) ) / 100;
3308         }
3309     }
3310
3311     return ( $charge, $item_type );
3312 }
3313
3314 # Select most appropriate discount rule from those returned
3315 sub _get_discount_from_rule {
3316     my ($rules_ref, $branch, $itemtype) = @_;
3317     my $discount;
3318
3319     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3320         $discount = $rules_ref->[0]->{rentaldiscount};
3321         return (defined $discount) ? $discount : 0;
3322     }
3323     # could have up to 4 does one match $branch and $itemtype
3324     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3325     if (@d) {
3326         $discount = $d[0]->{rentaldiscount};
3327         return (defined $discount) ? $discount : 0;
3328     }
3329     # do we have item type + all branches
3330     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3331     if (@d) {
3332         $discount = $d[0]->{rentaldiscount};
3333         return (defined $discount) ? $discount : 0;
3334     }
3335     # do we all item types + this branch
3336     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3337     if (@d) {
3338         $discount = $d[0]->{rentaldiscount};
3339         return (defined $discount) ? $discount : 0;
3340     }
3341     # so all and all (surely we wont get here)
3342     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3343     if (@d) {
3344         $discount = $d[0]->{rentaldiscount};
3345         return (defined $discount) ? $discount : 0;
3346     }
3347     # none of the above
3348     return 0;
3349 }
3350
3351 =head2 AddIssuingCharge
3352
3353   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3354
3355 =cut
3356
3357 sub AddIssuingCharge {
3358     my ( $itemnumber, $borrowernumber, $charge ) = @_;
3359     my $dbh = C4::Context->dbh;
3360     my $nextaccntno = getnextacctno( $borrowernumber );
3361     my $manager_id = 0;
3362     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3363     my $query ="
3364         INSERT INTO accountlines
3365             (borrowernumber, itemnumber, accountno,
3366             date, amount, description, accounttype,
3367             amountoutstanding, manager_id)
3368         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3369     ";
3370     my $sth = $dbh->prepare($query);
3371     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3372 }
3373
3374 =head2 GetTransfers
3375
3376   GetTransfers($itemnumber);
3377
3378 =cut
3379
3380 sub GetTransfers {
3381     my ($itemnumber) = @_;
3382
3383     my $dbh = C4::Context->dbh;
3384
3385     my $query = '
3386         SELECT datesent,
3387                frombranch,
3388                tobranch
3389         FROM branchtransfers
3390         WHERE itemnumber = ?
3391           AND datearrived IS NULL
3392         ';
3393     my $sth = $dbh->prepare($query);
3394     $sth->execute($itemnumber);
3395     my @row = $sth->fetchrow_array();
3396     return @row;
3397 }
3398
3399 =head2 GetTransfersFromTo
3400
3401   @results = GetTransfersFromTo($frombranch,$tobranch);
3402
3403 Returns the list of pending transfers between $from and $to branch
3404
3405 =cut
3406
3407 sub GetTransfersFromTo {
3408     my ( $frombranch, $tobranch ) = @_;
3409     return unless ( $frombranch && $tobranch );
3410     my $dbh   = C4::Context->dbh;
3411     my $query = "
3412         SELECT itemnumber,datesent,frombranch
3413         FROM   branchtransfers
3414         WHERE  frombranch=?
3415           AND  tobranch=?
3416           AND datearrived IS NULL
3417     ";
3418     my $sth = $dbh->prepare($query);
3419     $sth->execute( $frombranch, $tobranch );
3420     my @gettransfers;
3421
3422     while ( my $data = $sth->fetchrow_hashref ) {
3423         push @gettransfers, $data;
3424     }
3425     return (@gettransfers);
3426 }
3427
3428 =head2 DeleteTransfer
3429
3430   &DeleteTransfer($itemnumber);
3431
3432 =cut
3433
3434 sub DeleteTransfer {
3435     my ($itemnumber) = @_;
3436     return unless $itemnumber;
3437     my $dbh          = C4::Context->dbh;
3438     my $sth          = $dbh->prepare(
3439         "DELETE FROM branchtransfers
3440          WHERE itemnumber=?
3441          AND datearrived IS NULL "
3442     );
3443     return $sth->execute($itemnumber);
3444 }
3445
3446 =head2 AnonymiseIssueHistory
3447
3448   ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3449
3450 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3451 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3452
3453 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3454 setting (force delete).
3455
3456 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3457
3458 =cut
3459
3460 sub AnonymiseIssueHistory {
3461     my $date           = shift;
3462     my $borrowernumber = shift;
3463     my $dbh            = C4::Context->dbh;
3464     my $query          = "
3465         UPDATE old_issues
3466         SET    borrowernumber = ?
3467         WHERE  returndate < ?
3468           AND borrowernumber IS NOT NULL
3469     ";
3470
3471     # The default of 0 does not work due to foreign key constraints
3472     # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
3473     # Set it to undef (NULL)
3474     my $anonymouspatron = C4::Context->preference('AnonymousPatron') || undef;
3475     my @bind_params = ($anonymouspatron, $date);
3476     if (defined $borrowernumber) {
3477        $query .= " AND borrowernumber = ?";
3478        push @bind_params, $borrowernumber;
3479     } else {
3480        $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3481     }
3482     my $sth = $dbh->prepare($query);
3483     $sth->execute(@bind_params);
3484     my $anonymisation_err = $dbh->err;
3485     my $rows_affected = $sth->rows;  ### doublecheck row count return function
3486     return ($rows_affected, $anonymisation_err);
3487 }
3488
3489 =head2 SendCirculationAlert
3490
3491 Send out a C<check-in> or C<checkout> alert using the messaging system.
3492
3493 B<Parameters>:
3494
3495 =over 4
3496
3497 =item type
3498
3499 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3500
3501 =item item
3502
3503 Hashref of information about the item being checked in or out.
3504
3505 =item borrower
3506
3507 Hashref of information about the borrower of the item.
3508
3509 =item branch
3510
3511 The branchcode from where the checkout or check-in took place.
3512
3513 =back
3514
3515 B<Example>:
3516
3517     SendCirculationAlert({
3518         type     => 'CHECKOUT',
3519         item     => $item,
3520         borrower => $borrower,
3521         branch   => $branch,
3522     });
3523
3524 =cut
3525
3526 sub SendCirculationAlert {
3527     my ($opts) = @_;
3528     my ($type, $item, $borrower, $branch) =
3529         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3530     my %message_name = (
3531         CHECKIN  => 'Item_Check_in',
3532         CHECKOUT => 'Item_Checkout',
3533         RENEWAL  => 'Item_Checkout',
3534     );
3535     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3536         borrowernumber => $borrower->{borrowernumber},
3537         message_name   => $message_name{$type},
3538     });
3539     my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3540
3541     my @transports = keys %{ $borrower_preferences->{transports} };
3542     # warn "no transports" unless @transports;
3543     for (@transports) {
3544         # warn "transport: $_";
3545         my $message = C4::Message->find_last_message($borrower, $type, $_);
3546         if (!$message) {
3547             #warn "create new message";
3548             my $letter =  C4::Letters::GetPreparedLetter (
3549                 module => 'circulation',
3550                 letter_code => $type,
3551                 branchcode => $branch,
3552                 message_transport_type => $_,
3553                 tables => {
3554                     $issues_table => $item->{itemnumber},
3555                     'items'       => $item->{itemnumber},
3556                     'biblio'      => $item->{biblionumber},
3557                     'biblioitems' => $item->{biblionumber},
3558                     'borrowers'   => $borrower,
3559                     'branches'    => $branch,
3560                 }
3561             ) or next;
3562             C4::Message->enqueue($letter, $borrower, $_);
3563         } else {
3564             #warn "append to old message";
3565             my $letter =  C4::Letters::GetPreparedLetter (
3566                 module => 'circulation',
3567                 letter_code => $type,
3568                 branchcode => $branch,
3569                 message_transport_type => $_,
3570                 tables => {
3571                     $issues_table => $item->{itemnumber},
3572                     'items'       => $item->{itemnumber},
3573                     'biblio'      => $item->{biblionumber},
3574                     'biblioitems' => $item->{biblionumber},
3575                     'borrowers'   => $borrower,
3576                     'branches'    => $branch,
3577                 }
3578             ) or next;
3579             $message->append($letter);
3580             $message->update;
3581         }
3582     }
3583
3584     return;
3585 }
3586
3587 =head2 updateWrongTransfer
3588
3589   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3590
3591 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
3592
3593 =cut
3594
3595 sub updateWrongTransfer {
3596         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3597         my $dbh = C4::Context->dbh;
3598 # first step validate the actual line of transfert .
3599         my $sth =
3600                 $dbh->prepare(
3601                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3602                 );
3603                 $sth->execute($FromLibrary,$itemNumber);
3604
3605 # second step create a new line of branchtransfer to the right location .
3606         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3607
3608 #third step changing holdingbranch of item
3609         UpdateHoldingbranch($FromLibrary,$itemNumber);
3610 }
3611
3612 =head2 UpdateHoldingbranch
3613
3614   $items = UpdateHoldingbranch($branch,$itmenumber);
3615
3616 Simple methode for updating hodlingbranch in items BDD line
3617
3618 =cut
3619
3620 sub UpdateHoldingbranch {
3621         my ( $branch,$itemnumber ) = @_;
3622     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3623 }
3624
3625 =head2 CalcDateDue
3626
3627 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3628
3629 this function calculates the due date given the start date and configured circulation rules,
3630 checking against the holidays calendar as per the 'useDaysMode' syspref.
3631 C<$startdate>   = DateTime object representing start date of loan period (assumed to be today)
3632 C<$itemtype>  = itemtype code of item in question
3633 C<$branch>  = location whose calendar to use
3634 C<$borrower> = Borrower object
3635 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3636
3637 =cut
3638
3639 sub CalcDateDue {
3640     my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3641
3642     $isrenewal ||= 0;
3643
3644     # loanlength now a href
3645     my $loanlength =
3646             GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3647
3648     my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3649             ? qq{renewalperiod}
3650             : qq{issuelength};
3651
3652     my $datedue;
3653     if ( $startdate ) {
3654         if (ref $startdate ne 'DateTime' ) {
3655             $datedue = dt_from_string($datedue);
3656         } else {
3657             $datedue = $startdate->clone;
3658         }
3659     } else {
3660         $datedue =
3661           DateTime->now( time_zone => C4::Context->tz() )
3662           ->truncate( to => 'minute' );
3663     }
3664
3665
3666     # calculate the datedue as normal
3667     if ( C4::Context->preference('useDaysMode') eq 'Days' )
3668     {    # ignoring calendar
3669         if ( $loanlength->{lengthunit} eq 'hours' ) {
3670             $datedue->add( hours => $loanlength->{$length_key} );
3671         } else {    # days
3672             $datedue->add( days => $loanlength->{$length_key} );
3673             $datedue->set_hour(23);
3674             $datedue->set_minute(59);
3675         }
3676     } else {
3677         my $dur;
3678         if ($loanlength->{lengthunit} eq 'hours') {
3679             $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3680         }
3681         else { # days
3682             $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3683         }
3684         my $calendar = Koha::Calendar->new( branchcode => $branch );
3685         $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3686         if ($loanlength->{lengthunit} eq 'days') {
3687             $datedue->set_hour(23);
3688             $datedue->set_minute(59);
3689         }
3690     }
3691
3692     # if Hard Due Dates are used, retrieve them and apply as necessary
3693     my ( $hardduedate, $hardduedatecompare ) =
3694       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3695     if ($hardduedate) {    # hardduedates are currently dates
3696         $hardduedate->truncate( to => 'minute' );
3697         $hardduedate->set_hour(23);
3698         $hardduedate->set_minute(59);
3699         my $cmp = DateTime->compare( $hardduedate, $datedue );
3700
3701 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3702 # if the calculated date is before the 'after' Hard Due Date (floor), override
3703 # if the hard due date is set to 'exactly', overrride
3704         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3705             $datedue = $hardduedate->clone;
3706         }
3707
3708         # in all other cases, keep the date due as it is
3709
3710     }
3711
3712     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3713     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3714         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3715         if( $expiry_dt ) { #skip empty expiry date..
3716             $expiry_dt->set( hour => 23, minute => 59);
3717             my $d1= $datedue->clone->set_time_zone('floating');
3718             if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3719                 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3720             }
3721         }
3722     }
3723
3724     return $datedue;
3725 }
3726
3727
3728 sub CheckValidBarcode{
3729 my ($barcode) = @_;
3730 my $dbh = C4::Context->dbh;
3731 my $query=qq|SELECT count(*)
3732              FROM items
3733              WHERE barcode=?
3734             |;
3735 my $sth = $dbh->prepare($query);
3736 $sth->execute($barcode);
3737 my $exist=$sth->fetchrow ;
3738 return $exist;
3739 }
3740
3741 =head2 IsBranchTransferAllowed
3742
3743   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3744
3745 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3746
3747 =cut
3748
3749 sub IsBranchTransferAllowed {
3750         my ( $toBranch, $fromBranch, $code ) = @_;
3751
3752         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3753
3754         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3755         my $dbh = C4::Context->dbh;
3756
3757         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3758         $sth->execute( $toBranch, $fromBranch, $code );
3759         my $limit = $sth->fetchrow_hashref();
3760
3761         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3762         if ( $limit->{'limitId'} ) {
3763                 return 0;
3764         } else {
3765                 return 1;
3766         }
3767 }
3768
3769 =head2 CreateBranchTransferLimit
3770
3771   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3772
3773 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3774
3775 =cut
3776
3777 sub CreateBranchTransferLimit {
3778    my ( $toBranch, $fromBranch, $code ) = @_;
3779    return unless defined($toBranch) && defined($fromBranch);
3780    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3781
3782    my $dbh = C4::Context->dbh;
3783
3784    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3785    return $sth->execute( $code, $toBranch, $fromBranch );
3786 }
3787
3788 =head2 DeleteBranchTransferLimits
3789
3790     my $result = DeleteBranchTransferLimits($frombranch);
3791
3792 Deletes all the library transfer limits for one library.  Returns the
3793 number of limits deleted, 0e0 if no limits were deleted, or undef if
3794 no arguments are supplied.
3795
3796 =cut
3797
3798 sub DeleteBranchTransferLimits {
3799     my $branch = shift;
3800     return unless defined $branch;
3801     my $dbh    = C4::Context->dbh;
3802     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3803     return $sth->execute($branch);
3804 }
3805
3806 sub ReturnLostItem{
3807     my ( $borrowernumber, $itemnum ) = @_;
3808
3809     MarkIssueReturned( $borrowernumber, $itemnum );
3810     my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3811     my $item = C4::Items::GetItem( $itemnum );
3812     my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3813     my @datearr = localtime(time);
3814     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3815     my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3816     ModItem({ paidfor =>  $old_note."Paid for by $bor $date" }, undef, $itemnum);
3817 }
3818
3819
3820 sub LostItem{
3821     my ($itemnumber, $mark_returned) = @_;
3822
3823     my $dbh = C4::Context->dbh();
3824     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3825                            FROM issues
3826                            JOIN items USING (itemnumber)
3827                            JOIN biblio USING (biblionumber)
3828                            WHERE issues.itemnumber=?");
3829     $sth->execute($itemnumber);
3830     my $issues=$sth->fetchrow_hashref();
3831
3832     # If a borrower lost the item, add a replacement cost to the their record
3833     if ( my $borrowernumber = $issues->{borrowernumber} ){
3834         my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3835
3836         if (C4::Context->preference('WhenLostForgiveFine')){
3837             my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3838             defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!";  # zero is OK, check defined
3839         }
3840         if (C4::Context->preference('WhenLostChargeReplacementFee')){
3841             C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3842             #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3843             #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3844         }
3845
3846         MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3847     }
3848 }
3849
3850 sub GetOfflineOperations {
3851     my $dbh = C4::Context->dbh;
3852     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3853     $sth->execute(C4::Context->userenv->{'branch'});
3854     my $results = $sth->fetchall_arrayref({});
3855     return $results;
3856 }
3857
3858 sub GetOfflineOperation {
3859     my $operationid = shift;
3860     return unless $operationid;
3861     my $dbh = C4::Context->dbh;
3862     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3863     $sth->execute( $operationid );
3864     return $sth->fetchrow_hashref;
3865 }
3866
3867 sub AddOfflineOperation {
3868     my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3869     my $dbh = C4::Context->dbh;
3870     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3871     $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3872     return "Added.";
3873 }
3874
3875 sub DeleteOfflineOperation {
3876     my $dbh = C4::Context->dbh;
3877     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3878     $sth->execute( shift );
3879     return "Deleted.";
3880 }
3881
3882 sub ProcessOfflineOperation {
3883     my $operation = shift;
3884
3885     my $report;
3886     if ( $operation->{action} eq 'return' ) {
3887         $report = ProcessOfflineReturn( $operation );
3888     } elsif ( $operation->{action} eq 'issue' ) {
3889         $report = ProcessOfflineIssue( $operation );
3890     } elsif ( $operation->{action} eq 'payment' ) {
3891         $report = ProcessOfflinePayment( $operation );
3892     }
3893
3894     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3895
3896     return $report;
3897 }
3898
3899 sub ProcessOfflineReturn {
3900     my $operation = shift;
3901
3902     my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3903
3904     if ( $itemnumber ) {
3905         my $issue = GetOpenIssue( $itemnumber );
3906         if ( $issue ) {
3907             MarkIssueReturned(
3908                 $issue->{borrowernumber},
3909                 $itemnumber,
3910                 undef,
3911                 $operation->{timestamp},
3912             );
3913             ModItem(
3914                 { renewals => 0, onloan => undef },
3915                 $issue->{'biblionumber'},
3916                 $itemnumber
3917             );
3918             return "Success.";
3919         } else {
3920             return "Item not issued.";
3921         }
3922     } else {
3923         return "Item not found.";
3924     }
3925 }
3926
3927 sub ProcessOfflineIssue {
3928     my $operation = shift;
3929
3930     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3931
3932     if ( $borrower->{borrowernumber} ) {
3933         my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3934         unless ($itemnumber) {
3935             return "Barcode not found.";
3936         }
3937         my $issue = GetOpenIssue( $itemnumber );
3938
3939         if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3940             MarkIssueReturned(
3941                 $issue->{borrowernumber},
3942                 $itemnumber,
3943                 undef,
3944                 $operation->{timestamp},
3945             );
3946         }
3947         AddIssue(
3948             $borrower,
3949             $operation->{'barcode'},
3950             undef,
3951             1,
3952             $operation->{timestamp},
3953             undef,
3954         );
3955         return "Success.";
3956     } else {
3957         return "Borrower not found.";
3958     }
3959 }
3960
3961 sub ProcessOfflinePayment {
3962     my $operation = shift;
3963
3964     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3965     my $amount = $operation->{amount};
3966
3967     recordpayment( $borrower->{borrowernumber}, $amount );
3968
3969     return "Success."
3970 }
3971
3972
3973 =head2 TransferSlip
3974
3975   TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3976
3977   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3978
3979 =cut
3980
3981 sub TransferSlip {
3982     my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3983
3984     my $item =  GetItem( $itemnumber, $barcode )
3985       or return;
3986
3987     return C4::Letters::GetPreparedLetter (
3988         module => 'circulation',
3989         letter_code => 'TRANSFERSLIP',
3990         branchcode => $branch,
3991         tables => {
3992             'branches'    => $to_branch,
3993             'biblio'      => $item->{biblionumber},
3994             'items'       => $item,
3995         },
3996     );
3997 }
3998
3999 =head2 CheckIfIssuedToPatron
4000
4001   CheckIfIssuedToPatron($borrowernumber, $biblionumber)
4002
4003   Return 1 if any record item is issued to patron, otherwise return 0
4004
4005 =cut
4006
4007 sub CheckIfIssuedToPatron {
4008     my ($borrowernumber, $biblionumber) = @_;
4009
4010     my $dbh = C4::Context->dbh;
4011     my $query = q|
4012         SELECT COUNT(*) FROM issues
4013         LEFT JOIN items ON items.itemnumber = issues.itemnumber
4014         WHERE items.biblionumber = ?
4015         AND issues.borrowernumber = ?
4016     |;
4017     my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
4018     return 1 if $is_issued;
4019     return;
4020 }
4021
4022 =head2 IsItemIssued
4023
4024   IsItemIssued( $itemnumber )
4025
4026   Return 1 if the item is on loan, otherwise return 0
4027
4028 =cut
4029
4030 sub IsItemIssued {
4031     my $itemnumber = shift;
4032     my $dbh = C4::Context->dbh;
4033     my $sth = $dbh->prepare(q{
4034         SELECT COUNT(*)
4035         FROM issues
4036         WHERE itemnumber = ?
4037     });
4038     $sth->execute($itemnumber);
4039     return $sth->fetchrow;
4040 }
4041
4042 =head2 GetAgeRestriction
4043
4044   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
4045   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
4046
4047   if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
4048   if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
4049
4050 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
4051 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
4052 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
4053          Negative days mean the borrower has gone past the age restriction age.
4054
4055 =cut
4056
4057 sub GetAgeRestriction {
4058     my ($record_restrictions, $borrower) = @_;
4059     my $markers = C4::Context->preference('AgeRestrictionMarker');
4060
4061     # Split $record_restrictions to something like FSK 16 or PEGI 6
4062     my @values = split ' ', uc($record_restrictions);
4063     return unless @values;
4064
4065     # Search first occurrence of one of the markers
4066     my @markers = split /\|/, uc($markers);
4067     return unless @markers;
4068
4069     my $index            = 0;
4070     my $restriction_year = 0;
4071     for my $value (@values) {
4072         $index++;
4073         for my $marker (@markers) {
4074             $marker =~ s/^\s+//;    #remove leading spaces
4075             $marker =~ s/\s+$//;    #remove trailing spaces
4076             if ( $marker eq $value ) {
4077                 if ( $index <= $#values ) {
4078                     $restriction_year += $values[$index];
4079                 }
4080                 last;
4081             }
4082             elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
4083
4084                 # Perhaps it is something like "K16" (as in Finland)
4085                 $restriction_year += $1;
4086                 last;
4087             }
4088         }
4089         last if ( $restriction_year > 0 );
4090     }
4091
4092     #Check if the borrower is age restricted for this material and for how long.
4093     if ($restriction_year && $borrower) {
4094         if ( $borrower->{'dateofbirth'} ) {
4095             my @alloweddate = split /-/, $borrower->{'dateofbirth'};
4096             $alloweddate[0] += $restriction_year;
4097
4098             #Prevent runime eror on leap year (invalid date)
4099             if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
4100                 $alloweddate[2] = 28;
4101             }
4102
4103             #Get how many days the borrower has to reach the age restriction
4104             my @Today = split /-/, DateTime->today->ymd();
4105             my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
4106             #Negative days means the borrower went past the age restriction age
4107             return ($restriction_year, $daysToAgeRestriction);
4108         }
4109     }
4110
4111     return ($restriction_year);
4112 }
4113
4114
4115 =head2 GetPendingOnSiteCheckouts
4116
4117 =cut
4118
4119 sub GetPendingOnSiteCheckouts {
4120     my $dbh = C4::Context->dbh;
4121     return $dbh->selectall_arrayref(q|
4122         SELECT
4123           items.barcode,
4124           items.biblionumber,
4125           items.itemnumber,
4126           items.itemnotes,
4127           items.itemcallnumber,
4128           items.location,
4129           issues.date_due,
4130           issues.branchcode,
4131           issues.date_due < NOW() AS is_overdue,
4132           biblio.author,
4133           biblio.title,
4134           borrowers.firstname,
4135           borrowers.surname,
4136           borrowers.cardnumber,
4137           borrowers.borrowernumber
4138         FROM items
4139         LEFT JOIN issues ON items.itemnumber = issues.itemnumber
4140         LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
4141         LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
4142         WHERE issues.onsite_checkout = 1
4143     |, { Slice => {} } );
4144 }
4145
4146 sub GetTopIssues {
4147     my ($params) = @_;
4148
4149     my ($count, $branch, $itemtype, $ccode, $newness)
4150         = @$params{qw(count branch itemtype ccode newness)};
4151
4152     my $dbh = C4::Context->dbh;
4153     my $query = q{
4154         SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4155           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4156           i.ccode, SUM(i.issues) AS count
4157         FROM biblio b
4158         LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4159         LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4160     };
4161
4162     my (@where_strs, @where_args);
4163
4164     if ($branch) {
4165         push @where_strs, 'i.homebranch = ?';
4166         push @where_args, $branch;
4167     }
4168     if ($itemtype) {
4169         if (C4::Context->preference('item-level_itypes')){
4170             push @where_strs, 'i.itype = ?';
4171             push @where_args, $itemtype;
4172         } else {
4173             push @where_strs, 'bi.itemtype = ?';
4174             push @where_args, $itemtype;
4175         }
4176     }
4177     if ($ccode) {
4178         push @where_strs, 'i.ccode = ?';
4179         push @where_args, $ccode;
4180     }
4181     if ($newness) {
4182         push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4183         push @where_args, $newness;
4184     }
4185
4186     if (@where_strs) {
4187         $query .= 'WHERE ' . join(' AND ', @where_strs);
4188     }
4189
4190     $query .= q{
4191         GROUP BY b.biblionumber
4192         HAVING count > 0
4193         ORDER BY count DESC
4194     };
4195
4196     $count = int($count);
4197     if ($count > 0) {
4198         $query .= "LIMIT $count";
4199     }
4200
4201     my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4202
4203     return @$rows;
4204 }
4205
4206 1;
4207 __END__
4208
4209 =head1 AUTHOR
4210
4211 Koha Development Team <http://koha-community.org/>
4212
4213 =cut
4214