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             my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
2416             if ( $borrower->{debarred} eq $patron->is_debarred ) {
2417                 return ($borrower->{debarred},1);
2418             }
2419             return $new_debar_dt->ymd();
2420         }
2421     }
2422     return;
2423 }
2424
2425 =head2 _FixOverduesOnReturn
2426
2427    &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2428
2429 C<$brn> borrowernumber
2430
2431 C<$itm> itemnumber
2432
2433 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2434 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2435
2436 Internal function, called only by AddReturn
2437
2438 =cut
2439
2440 sub _FixOverduesOnReturn {
2441     my ($borrowernumber, $item);
2442     unless ($borrowernumber = shift) {
2443         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2444         return;
2445     }
2446     unless ($item = shift) {
2447         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2448         return;
2449     }
2450     my ($exemptfine, $dropbox) = @_;
2451     my $dbh = C4::Context->dbh;
2452
2453     # check for overdue fine
2454     my $sth = $dbh->prepare(
2455 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2456     );
2457     $sth->execute( $borrowernumber, $item );
2458
2459     # alter fine to show that the book has been returned
2460     my $data = $sth->fetchrow_hashref;
2461     return 0 unless $data;    # no warning, there's just nothing to fix
2462
2463     my $uquery;
2464     my @bind = ($data->{'accountlines_id'});
2465     if ($exemptfine) {
2466         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2467         if (C4::Context->preference("FinesLog")) {
2468             &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2469         }
2470     } elsif ($dropbox && $data->{lastincrement}) {
2471         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2472         my $amt = $data->{amount} - $data->{lastincrement} ;
2473         if (C4::Context->preference("FinesLog")) {
2474             &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2475         }
2476          $uquery = "update accountlines set accounttype='F' ";
2477          if($outstanding  >= 0 && $amt >=0) {
2478             $uquery .= ", amount = ? , amountoutstanding=? ";
2479             unshift @bind, ($amt, $outstanding) ;
2480         }
2481     } else {
2482         $uquery = "update accountlines set accounttype='F' ";
2483     }
2484     $uquery .= " where (accountlines_id = ?)";
2485     my $usth = $dbh->prepare($uquery);
2486     return $usth->execute(@bind);
2487 }
2488
2489 =head2 _FixAccountForLostAndReturned
2490
2491   &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2492
2493 Calculates the charge for a book lost and returned.
2494
2495 Internal function, not exported, called only by AddReturn.
2496
2497 FIXME: This function reflects how inscrutable fines logic is.  Fix both.
2498 FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.
2499
2500 =cut
2501
2502 sub _FixAccountForLostAndReturned {
2503     my $itemnumber     = shift or return;
2504     my $borrowernumber = @_ ? shift : undef;
2505     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
2506     my $dbh = C4::Context->dbh;
2507     # check for charge made for lost book
2508     my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2509     $sth->execute($itemnumber);
2510     my $data = $sth->fetchrow_hashref;
2511     $data or return;    # bail if there is nothing to do
2512     $data->{accounttype} eq 'W' and return;    # Written off
2513
2514     # writeoff this amount
2515     my $offset;
2516     my $amount = $data->{'amount'};
2517     my $acctno = $data->{'accountno'};
2518     my $amountleft;                                             # Starts off undef/zero.
2519     if ($data->{'amountoutstanding'} == $amount) {
2520         $offset     = $data->{'amount'};
2521         $amountleft = 0;                                        # Hey, it's zero here, too.
2522     } else {
2523         $offset     = $amount - $data->{'amountoutstanding'};   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2524         $amountleft = $data->{'amountoutstanding'} - $amount;   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2525     }
2526     my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2527         WHERE (accountlines_id = ?)");
2528     $usth->execute($data->{'accountlines_id'});      # We might be adjusting an account for some OTHER borrowernumber now.  Not the one we passed in.
2529     #check if any credit is left if so writeoff other accounts
2530     my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2531     $amountleft *= -1 if ($amountleft < 0);
2532     if ($amountleft > 0) {
2533         my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2534                             AND (amountoutstanding >0) ORDER BY date");     # might want to order by amountoustanding ASC (pay smallest first)
2535         $msth->execute($data->{'borrowernumber'});
2536         # offset transactions
2537         my $newamtos;
2538         my $accdata;
2539         while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2540             if ($accdata->{'amountoutstanding'} < $amountleft) {
2541                 $newamtos = 0;
2542                 $amountleft -= $accdata->{'amountoutstanding'};
2543             }  else {
2544                 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2545                 $amountleft = 0;
2546             }
2547             my $thisacct = $accdata->{'accountlines_id'};
2548             # FIXME: move prepares outside while loop!
2549             my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2550                     WHERE (accountlines_id = ?)");
2551             $usth->execute($newamtos,$thisacct);
2552             $usth = $dbh->prepare("INSERT INTO accountoffsets
2553                 (borrowernumber, accountno, offsetaccount,  offsetamount)
2554                 VALUES
2555                 (?,?,?,?)");
2556             $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2557         }
2558     }
2559     $amountleft *= -1 if ($amountleft > 0);
2560     my $desc = "Item Returned " . $item_id;
2561     $usth = $dbh->prepare("INSERT INTO accountlines
2562         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2563         VALUES (?,?,now(),?,?,'CR',?)");
2564     $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2565     if ($borrowernumber) {
2566         # FIXME: same as query above.  use 1 sth for both
2567         $usth = $dbh->prepare("INSERT INTO accountoffsets
2568             (borrowernumber, accountno, offsetaccount,  offsetamount)
2569             VALUES (?,?,?,?)");
2570         $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2571     }
2572     ModItem({ paidfor => '' }, undef, $itemnumber);
2573     return;
2574 }
2575
2576 =head2 _GetCircControlBranch
2577
2578    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2579
2580 Internal function :
2581
2582 Return the library code to be used to determine which circulation
2583 policy applies to a transaction.  Looks up the CircControl and
2584 HomeOrHoldingBranch system preferences.
2585
2586 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2587
2588 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2589
2590 =cut
2591
2592 sub _GetCircControlBranch {
2593     my ($item, $borrower) = @_;
2594     my $circcontrol = C4::Context->preference('CircControl');
2595     my $branch;
2596
2597     if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2598         $branch= C4::Context->userenv->{'branch'};
2599     } elsif ($circcontrol eq 'PatronLibrary') {
2600         $branch=$borrower->{branchcode};
2601     } else {
2602         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2603         $branch = $item->{$branchfield};
2604         # default to item home branch if holdingbranch is used
2605         # and is not defined
2606         if (!defined($branch) && $branchfield eq 'holdingbranch') {
2607             $branch = $item->{homebranch};
2608         }
2609     }
2610     return $branch;
2611 }
2612
2613
2614
2615
2616
2617
2618 =head2 GetItemIssue
2619
2620   $issue = &GetItemIssue($itemnumber);
2621
2622 Returns patron currently having a book, or undef if not checked out.
2623
2624 C<$itemnumber> is the itemnumber.
2625
2626 C<$issue> is a hashref of the row from the issues table.
2627
2628 =cut
2629
2630 sub GetItemIssue {
2631     my ($itemnumber) = @_;
2632     return unless $itemnumber;
2633     my $sth = C4::Context->dbh->prepare(
2634         "SELECT items.*, issues.*
2635         FROM issues
2636         LEFT JOIN items ON issues.itemnumber=items.itemnumber
2637         WHERE issues.itemnumber=?");
2638     $sth->execute($itemnumber);
2639     my $data = $sth->fetchrow_hashref;
2640     return unless $data;
2641     $data->{issuedate_sql} = $data->{issuedate};
2642     $data->{date_due_sql} = $data->{date_due};
2643     $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2644     $data->{issuedate}->truncate(to => 'minute');
2645     $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2646     $data->{date_due}->truncate(to => 'minute');
2647     my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2648     $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2649     return $data;
2650 }
2651
2652 =head2 GetOpenIssue
2653
2654   $issue = GetOpenIssue( $itemnumber );
2655
2656 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2657
2658 C<$itemnumber> is the item's itemnumber
2659
2660 Returns a hashref
2661
2662 =cut
2663
2664 sub GetOpenIssue {
2665   my ( $itemnumber ) = @_;
2666   return unless $itemnumber;
2667   my $dbh = C4::Context->dbh;
2668   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2669   $sth->execute( $itemnumber );
2670   return $sth->fetchrow_hashref();
2671
2672 }
2673
2674 =head2 GetIssues
2675
2676     $issues = GetIssues({});    # return all issues!
2677     $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
2678
2679 Returns all pending issues that match given criteria.
2680 Returns a arrayref or undef if an error occurs.
2681
2682 Allowed criteria are:
2683
2684 =over 2
2685
2686 =item * borrowernumber
2687
2688 =item * biblionumber
2689
2690 =item * itemnumber
2691
2692 =back
2693
2694 =cut
2695
2696 sub GetIssues {
2697     my ($criteria) = @_;
2698
2699     # Build filters
2700     my @filters;
2701     my @allowed = qw(borrowernumber biblionumber itemnumber);
2702     foreach (@allowed) {
2703         if (defined $criteria->{$_}) {
2704             push @filters, {
2705                 field => $_,
2706                 value => $criteria->{$_},
2707             };
2708         }
2709     }
2710
2711     # Do we need to join other tables ?
2712     my %join;
2713     if (defined $criteria->{biblionumber}) {
2714         $join{items} = 1;
2715     }
2716
2717     # Build SQL query
2718     my $where = '';
2719     if (@filters) {
2720         $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
2721     }
2722     my $query = q{
2723         SELECT issues.*
2724         FROM issues
2725     };
2726     if (defined $join{items}) {
2727         $query .= q{
2728             LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
2729         };
2730     }
2731     $query .= $where;
2732
2733     # Execute SQL query
2734     my $dbh = C4::Context->dbh;
2735     my $sth = $dbh->prepare($query);
2736     my $rv = $sth->execute(map { $_->{value} } @filters);
2737
2738     return $rv ? $sth->fetchall_arrayref({}) : undef;
2739 }
2740
2741 =head2 GetItemIssues
2742
2743   $issues = &GetItemIssues($itemnumber, $history);
2744
2745 Returns patrons that have issued a book
2746
2747 C<$itemnumber> is the itemnumber
2748 C<$history> is false if you just want the current "issuer" (if any)
2749 and true if you want issues history from old_issues also.
2750
2751 Returns reference to an array of hashes
2752
2753 =cut
2754
2755 sub GetItemIssues {
2756     my ( $itemnumber, $history ) = @_;
2757
2758     my $today = DateTime->now( time_zome => C4::Context->tz);  # get today date
2759     $today->truncate( to => 'minute' );
2760     my $sql = "SELECT * FROM issues
2761               JOIN borrowers USING (borrowernumber)
2762               JOIN items     USING (itemnumber)
2763               WHERE issues.itemnumber = ? ";
2764     if ($history) {
2765         $sql .= "UNION ALL
2766                  SELECT * FROM old_issues
2767                  LEFT JOIN borrowers USING (borrowernumber)
2768                  JOIN items USING (itemnumber)
2769                  WHERE old_issues.itemnumber = ? ";
2770     }
2771     $sql .= "ORDER BY date_due DESC";
2772     my $sth = C4::Context->dbh->prepare($sql);
2773     if ($history) {
2774         $sth->execute($itemnumber, $itemnumber);
2775     } else {
2776         $sth->execute($itemnumber);
2777     }
2778     my $results = $sth->fetchall_arrayref({});
2779     foreach (@$results) {
2780         my $date_due = dt_from_string($_->{date_due},'sql');
2781         $date_due->truncate( to => 'minute' );
2782
2783         $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2784     }
2785     return $results;
2786 }
2787
2788 =head2 GetBiblioIssues
2789
2790   $issues = GetBiblioIssues($biblionumber);
2791
2792 this function get all issues from a biblionumber.
2793
2794 Return:
2795 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2796 tables issues and the firstname,surname & cardnumber from borrowers.
2797
2798 =cut
2799
2800 sub GetBiblioIssues {
2801     my $biblionumber = shift;
2802     return unless $biblionumber;
2803     my $dbh   = C4::Context->dbh;
2804     my $query = "
2805         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2806         FROM issues
2807             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2808             LEFT JOIN items ON issues.itemnumber = items.itemnumber
2809             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2810             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2811         WHERE biblio.biblionumber = ?
2812         UNION ALL
2813         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2814         FROM old_issues
2815             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2816             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2817             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2818             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2819         WHERE biblio.biblionumber = ?
2820         ORDER BY timestamp
2821     ";
2822     my $sth = $dbh->prepare($query);
2823     $sth->execute($biblionumber, $biblionumber);
2824
2825     my @issues;
2826     while ( my $data = $sth->fetchrow_hashref ) {
2827         push @issues, $data;
2828     }
2829     return \@issues;
2830 }
2831
2832 =head2 GetUpcomingDueIssues
2833
2834   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2835
2836 =cut
2837
2838 sub GetUpcomingDueIssues {
2839     my $params = shift;
2840
2841     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2842     my $dbh = C4::Context->dbh;
2843
2844     my $statement = <<END_SQL;
2845 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2846 FROM issues
2847 LEFT JOIN items USING (itemnumber)
2848 LEFT OUTER JOIN branches USING (branchcode)
2849 WHERE returndate is NULL
2850 HAVING days_until_due >= 0 AND days_until_due <= ?
2851 END_SQL
2852
2853     my @bind_parameters = ( $params->{'days_in_advance'} );
2854
2855     my $sth = $dbh->prepare( $statement );
2856     $sth->execute( @bind_parameters );
2857     my $upcoming_dues = $sth->fetchall_arrayref({});
2858
2859     return $upcoming_dues;
2860 }
2861
2862 =head2 CanBookBeRenewed
2863
2864   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2865
2866 Find out whether a borrowed item may be renewed.
2867
2868 C<$borrowernumber> is the borrower number of the patron who currently
2869 has the item on loan.
2870
2871 C<$itemnumber> is the number of the item to renew.
2872
2873 C<$override_limit>, if supplied with a true value, causes
2874 the limit on the number of times that the loan can be renewed
2875 (as controlled by the item type) to be ignored. Overriding also allows
2876 to renew sooner than "No renewal before" and to manually renew loans
2877 that are automatically renewed.
2878
2879 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2880 item must currently be on loan to the specified borrower; renewals
2881 must be allowed for the item's type; and the borrower must not have
2882 already renewed the loan. $error will contain the reason the renewal can not proceed
2883
2884 =cut
2885
2886 sub CanBookBeRenewed {
2887     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2888
2889     my $dbh    = C4::Context->dbh;
2890     my $renews = 1;
2891
2892     my $item      = GetItem($itemnumber)      or return ( 0, 'no_item' );
2893     my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
2894     return ( 0, 'onsite_checkout' ) if $itemissue->{onsite_checkout};
2895
2896     $borrowernumber ||= $itemissue->{borrowernumber};
2897     my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2898       or return;
2899
2900     my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2901
2902     # This item can fill one or more unfilled reserve, can those unfilled reserves
2903     # all be filled by other available items?
2904     if ( $resfound
2905         && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2906     {
2907         my $schema = Koha::Database->new()->schema();
2908
2909         my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2910         if ($item_holds) {
2911             # There is an item level hold on this item, no other item can fill the hold
2912             $resfound = 1;
2913         }
2914         else {
2915
2916             # Get all other items that could possibly fill reserves
2917             my @itemnumbers = $schema->resultset('Item')->search(
2918                 {
2919                     biblionumber => $resrec->{biblionumber},
2920                     onloan       => undef,
2921                     notforloan   => 0,
2922                     -not         => { itemnumber => $itemnumber }
2923                 },
2924                 { columns => 'itemnumber' }
2925             )->get_column('itemnumber')->all();
2926
2927             # Get all other reserves that could have been filled by this item
2928             my @borrowernumbers;
2929             while (1) {
2930                 my ( $reserve_found, $reserve, undef ) =
2931                   C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2932
2933                 if ($reserve_found) {
2934                     push( @borrowernumbers, $reserve->{borrowernumber} );
2935                 }
2936                 else {
2937                     last;
2938                 }
2939             }
2940
2941             # If the count of the union of the lists of reservable items for each borrower
2942             # is equal or greater than the number of borrowers, we know that all reserves
2943             # can be filled with available items. We can get the union of the sets simply
2944             # by pushing all the elements onto an array and removing the duplicates.
2945             my @reservable;
2946             foreach my $b (@borrowernumbers) {
2947                 my ($borr) = C4::Members::GetMemberDetails($b);
2948                 foreach my $i (@itemnumbers) {
2949                     my $item = GetItem($i);
2950                     if (   IsAvailableForItemLevelRequest( $item, $borr )
2951                         && CanItemBeReserved( $b, $i )
2952                         && !IsItemOnHoldAndFound($i) )
2953                     {
2954                         push( @reservable, $i );
2955                     }
2956                 }
2957             }
2958
2959             @reservable = uniq(@reservable);
2960
2961             if ( @reservable >= @borrowernumbers ) {
2962                 $resfound = 0;
2963             }
2964         }
2965     }
2966     return ( 0, "on_reserve" ) if $resfound;    # '' when no hold was found
2967
2968     return ( 1, undef ) if $override_limit;
2969
2970     my $branchcode = _GetCircControlBranch( $item, $borrower );
2971     my $issuingrule =
2972       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2973
2974     return ( 0, "too_many" )
2975       if $issuingrule->{renewalsallowed} <= $itemissue->{renewals};
2976
2977     my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2978     my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2979     my $restricted = Koha::Patrons->find( $borrowernumber )->is_debarred;
2980     my $hasoverdues = C4::Members::HasOverdues($borrowernumber);
2981
2982     if ( $restricted and $restrictionblockrenewing ) {
2983         return ( 0, 'restriction');
2984     } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($itemissue->{overdue} and $overduesblockrenewing eq 'blockitem') ) {
2985         return ( 0, 'overdue');
2986     }
2987
2988     if ( defined $issuingrule->{norenewalbefore}
2989         and $issuingrule->{norenewalbefore} ne "" )
2990     {
2991
2992         # Calculate soonest renewal by subtracting 'No renewal before' from due date
2993         my $soonestrenewal =
2994           $itemissue->{date_due}->clone()
2995           ->subtract(
2996             $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
2997
2998         # Depending on syspref reset the exact time, only check the date
2999         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3000             and $issuingrule->{lengthunit} eq 'days' )
3001         {
3002             $soonestrenewal->truncate( to => 'day' );
3003         }
3004
3005         if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
3006         {
3007             return ( 0, "auto_too_soon" ) if $itemissue->{auto_renew};
3008             return ( 0, "too_soon" );
3009         }
3010         elsif ( $itemissue->{auto_renew} ) {
3011             return ( 0, "auto_renew" );
3012         }
3013     }
3014
3015     # Fallback for automatic renewals:
3016     # If norenewalbefore is undef, don't renew before due date.
3017     elsif ( $itemissue->{auto_renew} ) {
3018         my $now = dt_from_string;
3019         return ( 0, "auto_renew" )
3020           if $now >= $itemissue->{date_due};
3021         return ( 0, "auto_too_soon" );
3022     }
3023
3024     return ( 1, undef );
3025 }
3026
3027 =head2 AddRenewal
3028
3029   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
3030
3031 Renews a loan.
3032
3033 C<$borrowernumber> is the borrower number of the patron who currently
3034 has the item.
3035
3036 C<$itemnumber> is the number of the item to renew.
3037
3038 C<$branch> is the library where the renewal took place (if any).
3039            The library that controls the circ policies for the renewal is retrieved from the issues record.
3040
3041 C<$datedue> can be a DateTime object used to set the due date.
3042
3043 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
3044 this parameter is not supplied, lastreneweddate is set to the current date.
3045
3046 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
3047 from the book's item type.
3048
3049 =cut
3050
3051 sub AddRenewal {
3052     my $borrowernumber  = shift;
3053     my $itemnumber      = shift or return;
3054     my $branch          = shift;
3055     my $datedue         = shift;
3056     my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
3057
3058     my $item   = GetItem($itemnumber) or return;
3059     my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
3060
3061     my $dbh = C4::Context->dbh;
3062
3063     # Find the issues record for this book
3064     my $sth =
3065       $dbh->prepare("SELECT * FROM issues WHERE itemnumber = ?");
3066     $sth->execute( $itemnumber );
3067     my $issuedata = $sth->fetchrow_hashref;
3068
3069     return unless ( $issuedata );
3070
3071     $borrowernumber ||= $issuedata->{borrowernumber};
3072
3073     if ( defined $datedue && ref $datedue ne 'DateTime' ) {
3074         carp 'Invalid date passed to AddRenewal.';
3075         return;
3076     }
3077
3078     # If the due date wasn't specified, calculate it by adding the
3079     # book's loan length to today's date or the current due date
3080     # based on the value of the RenewalPeriodBase syspref.
3081     unless ($datedue) {
3082
3083         my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
3084         my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
3085
3086         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
3087                                         dt_from_string( $issuedata->{date_due} ) :
3088                                         DateTime->now( time_zone => C4::Context->tz());
3089         $datedue =  CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
3090     }
3091
3092     # Update the issues record to have the new due date, and a new count
3093     # of how many times it has been renewed.
3094     my $renews = $issuedata->{'renewals'} + 1;
3095     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
3096                             WHERE borrowernumber=?
3097                             AND itemnumber=?"
3098     );
3099
3100     $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
3101
3102     # Update the renewal count on the item, and tell zebra to reindex
3103     $renews = $biblio->{'renewals'} + 1;
3104     ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
3105
3106     # Charge a new rental fee, if applicable?
3107     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
3108     if ( $charge > 0 ) {
3109         my $accountno = getnextacctno( $borrowernumber );
3110         my $item = GetBiblioFromItemNumber($itemnumber);
3111         my $manager_id = 0;
3112         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3113         $sth = $dbh->prepare(
3114                 "INSERT INTO accountlines
3115                     (date, borrowernumber, accountno, amount, manager_id,
3116                     description,accounttype, amountoutstanding, itemnumber)
3117                     VALUES (now(),?,?,?,?,?,?,?,?)"
3118         );
3119         $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
3120             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
3121             'Rent', $charge, $itemnumber );
3122     }
3123
3124     # Send a renewal slip according to checkout alert preferencei
3125     if ( C4::Context->preference('RenewalSendNotice') eq '1') {
3126         my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
3127         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
3128         my %conditions = (
3129                 branchcode   => $branch,
3130                 categorycode => $borrower->{categorycode},
3131                 item_type    => $item->{itype},
3132                 notification => 'CHECKOUT',
3133         );
3134         if ($circulation_alert->is_enabled_for(\%conditions)) {
3135                 SendCirculationAlert({
3136                         type     => 'RENEWAL',
3137                         item     => $item,
3138                 borrower => $borrower,
3139                 branch   => $branch,
3140                 });
3141         }
3142     }
3143
3144     # Remove any OVERDUES related debarment if the borrower has no overdues
3145     my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
3146     if ( $borrowernumber
3147       && $borrower->{'debarred'}
3148       && !C4::Members::HasOverdues( $borrowernumber )
3149       && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
3150     ) {
3151         DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
3152     }
3153
3154     # Log the renewal
3155     UpdateStats({branch => $branch,
3156                 type => 'renew',
3157                 amount => $charge,
3158                 itemnumber => $itemnumber,
3159                 itemtype => $item->{itype},
3160                 borrowernumber => $borrowernumber,
3161                 ccode => $item->{'ccode'}}
3162                 );
3163         return $datedue;
3164 }
3165
3166 sub GetRenewCount {
3167     # check renewal status
3168     my ( $bornum, $itemno ) = @_;
3169     my $dbh           = C4::Context->dbh;
3170     my $renewcount    = 0;
3171     my $renewsallowed = 0;
3172     my $renewsleft    = 0;
3173
3174     my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
3175     my $item     = GetItem($itemno);
3176
3177     # Look in the issues table for this item, lent to this borrower,
3178     # and not yet returned.
3179
3180     # FIXME - I think this function could be redone to use only one SQL call.
3181     my $sth = $dbh->prepare(
3182         "select * from issues
3183                                 where (borrowernumber = ?)
3184                                 and (itemnumber = ?)"
3185     );
3186     $sth->execute( $bornum, $itemno );
3187     my $data = $sth->fetchrow_hashref;
3188     $renewcount = $data->{'renewals'} if $data->{'renewals'};
3189     # $item and $borrower should be calculated
3190     my $branchcode = _GetCircControlBranch($item, $borrower);
3191
3192     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
3193
3194     $renewsallowed = $issuingrule->{'renewalsallowed'};
3195     $renewsleft    = $renewsallowed - $renewcount;
3196     if($renewsleft < 0){ $renewsleft = 0; }
3197     return ( $renewcount, $renewsallowed, $renewsleft );
3198 }
3199
3200 =head2 GetSoonestRenewDate
3201
3202   $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3203
3204 Find out the soonest possible renew date of a borrowed item.
3205
3206 C<$borrowernumber> is the borrower number of the patron who currently
3207 has the item on loan.
3208
3209 C<$itemnumber> is the number of the item to renew.
3210
3211 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3212 renew date, based on the value "No renewal before" of the applicable
3213 issuing rule. Returns the current date if the item can already be
3214 renewed, and returns undefined if the borrower, loan, or item
3215 cannot be found.
3216
3217 =cut
3218
3219 sub GetSoonestRenewDate {
3220     my ( $borrowernumber, $itemnumber ) = @_;
3221
3222     my $dbh = C4::Context->dbh;
3223
3224     my $item      = GetItem($itemnumber)      or return;
3225     my $itemissue = GetItemIssue($itemnumber) or return;
3226
3227     $borrowernumber ||= $itemissue->{borrowernumber};
3228     my $borrower = C4::Members::GetMemberDetails($borrowernumber)
3229       or return;
3230
3231     my $branchcode = _GetCircControlBranch( $item, $borrower );
3232     my $issuingrule =
3233       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
3234
3235     my $now = dt_from_string;
3236
3237     if ( defined $issuingrule->{norenewalbefore}
3238         and $issuingrule->{norenewalbefore} ne "" )
3239     {
3240         my $soonestrenewal =
3241           $itemissue->{date_due}->clone()
3242           ->subtract(
3243             $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
3244
3245         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3246             and $issuingrule->{lengthunit} eq 'days' )
3247         {
3248             $soonestrenewal->truncate( to => 'day' );
3249         }
3250         return $soonestrenewal if $now < $soonestrenewal;
3251     }
3252     return $now;
3253 }
3254
3255 =head2 GetIssuingCharges
3256
3257   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3258
3259 Calculate how much it would cost for a given patron to borrow a given
3260 item, including any applicable discounts.
3261
3262 C<$itemnumber> is the item number of item the patron wishes to borrow.
3263
3264 C<$borrowernumber> is the patron's borrower number.
3265
3266 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3267 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3268 if it's a video).
3269
3270 =cut
3271
3272 sub GetIssuingCharges {
3273
3274     # calculate charges due
3275     my ( $itemnumber, $borrowernumber ) = @_;
3276     my $charge = 0;
3277     my $dbh    = C4::Context->dbh;
3278     my $item_type;
3279
3280     # Get the book's item type and rental charge (via its biblioitem).
3281     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3282         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3283     $charge_query .= (C4::Context->preference('item-level_itypes'))
3284         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3285         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3286
3287     $charge_query .= ' WHERE items.itemnumber =?';
3288
3289     my $sth = $dbh->prepare($charge_query);
3290     $sth->execute($itemnumber);
3291     if ( my $item_data = $sth->fetchrow_hashref ) {
3292         $item_type = $item_data->{itemtype};
3293         $charge    = $item_data->{rentalcharge};
3294         my $branch = C4::Branch::mybranch();
3295         my $discount_query = q|SELECT rentaldiscount,
3296             issuingrules.itemtype, issuingrules.branchcode
3297             FROM borrowers
3298             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3299             WHERE borrowers.borrowernumber = ?
3300             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3301             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3302         my $discount_sth = $dbh->prepare($discount_query);
3303         $discount_sth->execute( $borrowernumber, $item_type, $branch );
3304         my $discount_rules = $discount_sth->fetchall_arrayref({});
3305         if (@{$discount_rules}) {
3306             # We may have multiple rules so get the most specific
3307             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3308             $charge = ( $charge * ( 100 - $discount ) ) / 100;
3309         }
3310     }
3311
3312     return ( $charge, $item_type );
3313 }
3314
3315 # Select most appropriate discount rule from those returned
3316 sub _get_discount_from_rule {
3317     my ($rules_ref, $branch, $itemtype) = @_;
3318     my $discount;
3319
3320     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3321         $discount = $rules_ref->[0]->{rentaldiscount};
3322         return (defined $discount) ? $discount : 0;
3323     }
3324     # could have up to 4 does one match $branch and $itemtype
3325     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3326     if (@d) {
3327         $discount = $d[0]->{rentaldiscount};
3328         return (defined $discount) ? $discount : 0;
3329     }
3330     # do we have item type + all branches
3331     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3332     if (@d) {
3333         $discount = $d[0]->{rentaldiscount};
3334         return (defined $discount) ? $discount : 0;
3335     }
3336     # do we all item types + this branch
3337     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3338     if (@d) {
3339         $discount = $d[0]->{rentaldiscount};
3340         return (defined $discount) ? $discount : 0;
3341     }
3342     # so all and all (surely we wont get here)
3343     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3344     if (@d) {
3345         $discount = $d[0]->{rentaldiscount};
3346         return (defined $discount) ? $discount : 0;
3347     }
3348     # none of the above
3349     return 0;
3350 }
3351
3352 =head2 AddIssuingCharge
3353
3354   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3355
3356 =cut
3357
3358 sub AddIssuingCharge {
3359     my ( $itemnumber, $borrowernumber, $charge ) = @_;
3360     my $dbh = C4::Context->dbh;
3361     my $nextaccntno = getnextacctno( $borrowernumber );
3362     my $manager_id = 0;
3363     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3364     my $query ="
3365         INSERT INTO accountlines
3366             (borrowernumber, itemnumber, accountno,
3367             date, amount, description, accounttype,
3368             amountoutstanding, manager_id)
3369         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3370     ";
3371     my $sth = $dbh->prepare($query);
3372     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3373 }
3374
3375 =head2 GetTransfers
3376
3377   GetTransfers($itemnumber);
3378
3379 =cut
3380
3381 sub GetTransfers {
3382     my ($itemnumber) = @_;
3383
3384     my $dbh = C4::Context->dbh;
3385
3386     my $query = '
3387         SELECT datesent,
3388                frombranch,
3389                tobranch
3390         FROM branchtransfers
3391         WHERE itemnumber = ?
3392           AND datearrived IS NULL
3393         ';
3394     my $sth = $dbh->prepare($query);
3395     $sth->execute($itemnumber);
3396     my @row = $sth->fetchrow_array();
3397     return @row;
3398 }
3399
3400 =head2 GetTransfersFromTo
3401
3402   @results = GetTransfersFromTo($frombranch,$tobranch);
3403
3404 Returns the list of pending transfers between $from and $to branch
3405
3406 =cut
3407
3408 sub GetTransfersFromTo {
3409     my ( $frombranch, $tobranch ) = @_;
3410     return unless ( $frombranch && $tobranch );
3411     my $dbh   = C4::Context->dbh;
3412     my $query = "
3413         SELECT itemnumber,datesent,frombranch
3414         FROM   branchtransfers
3415         WHERE  frombranch=?
3416           AND  tobranch=?
3417           AND datearrived IS NULL
3418     ";
3419     my $sth = $dbh->prepare($query);
3420     $sth->execute( $frombranch, $tobranch );
3421     my @gettransfers;
3422
3423     while ( my $data = $sth->fetchrow_hashref ) {
3424         push @gettransfers, $data;
3425     }
3426     return (@gettransfers);
3427 }
3428
3429 =head2 DeleteTransfer
3430
3431   &DeleteTransfer($itemnumber);
3432
3433 =cut
3434
3435 sub DeleteTransfer {
3436     my ($itemnumber) = @_;
3437     return unless $itemnumber;
3438     my $dbh          = C4::Context->dbh;
3439     my $sth          = $dbh->prepare(
3440         "DELETE FROM branchtransfers
3441          WHERE itemnumber=?
3442          AND datearrived IS NULL "
3443     );
3444     return $sth->execute($itemnumber);
3445 }
3446
3447 =head2 AnonymiseIssueHistory
3448
3449   ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3450
3451 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3452 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3453
3454 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3455 setting (force delete).
3456
3457 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3458
3459 =cut
3460
3461 sub AnonymiseIssueHistory {
3462     my $date           = shift;
3463     my $borrowernumber = shift;
3464     my $dbh            = C4::Context->dbh;
3465     my $query          = "
3466         UPDATE old_issues
3467         SET    borrowernumber = ?
3468         WHERE  returndate < ?
3469           AND borrowernumber IS NOT NULL
3470     ";
3471
3472     # The default of 0 does not work due to foreign key constraints
3473     # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
3474     # Set it to undef (NULL)
3475     my $anonymouspatron = C4::Context->preference('AnonymousPatron') || undef;
3476     my @bind_params = ($anonymouspatron, $date);
3477     if (defined $borrowernumber) {
3478        $query .= " AND borrowernumber = ?";
3479        push @bind_params, $borrowernumber;
3480     } else {
3481        $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3482     }
3483     my $sth = $dbh->prepare($query);
3484     $sth->execute(@bind_params);
3485     my $anonymisation_err = $dbh->err;
3486     my $rows_affected = $sth->rows;  ### doublecheck row count return function
3487     return ($rows_affected, $anonymisation_err);
3488 }
3489
3490 =head2 SendCirculationAlert
3491
3492 Send out a C<check-in> or C<checkout> alert using the messaging system.
3493
3494 B<Parameters>:
3495
3496 =over 4
3497
3498 =item type
3499
3500 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3501
3502 =item item
3503
3504 Hashref of information about the item being checked in or out.
3505
3506 =item borrower
3507
3508 Hashref of information about the borrower of the item.
3509
3510 =item branch
3511
3512 The branchcode from where the checkout or check-in took place.
3513
3514 =back
3515
3516 B<Example>:
3517
3518     SendCirculationAlert({
3519         type     => 'CHECKOUT',
3520         item     => $item,
3521         borrower => $borrower,
3522         branch   => $branch,
3523     });
3524
3525 =cut
3526
3527 sub SendCirculationAlert {
3528     my ($opts) = @_;
3529     my ($type, $item, $borrower, $branch) =
3530         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3531     my %message_name = (
3532         CHECKIN  => 'Item_Check_in',
3533         CHECKOUT => 'Item_Checkout',
3534         RENEWAL  => 'Item_Checkout',
3535     );
3536     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3537         borrowernumber => $borrower->{borrowernumber},
3538         message_name   => $message_name{$type},
3539     });
3540     my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3541
3542     my @transports = keys %{ $borrower_preferences->{transports} };
3543     # warn "no transports" unless @transports;
3544     for (@transports) {
3545         # warn "transport: $_";
3546         my $message = C4::Message->find_last_message($borrower, $type, $_);
3547         if (!$message) {
3548             #warn "create new message";
3549             my $letter =  C4::Letters::GetPreparedLetter (
3550                 module => 'circulation',
3551                 letter_code => $type,
3552                 branchcode => $branch,
3553                 message_transport_type => $_,
3554                 tables => {
3555                     $issues_table => $item->{itemnumber},
3556                     'items'       => $item->{itemnumber},
3557                     'biblio'      => $item->{biblionumber},
3558                     'biblioitems' => $item->{biblionumber},
3559                     'borrowers'   => $borrower,
3560                     'branches'    => $branch,
3561                 }
3562             ) or next;
3563             C4::Message->enqueue($letter, $borrower, $_);
3564         } else {
3565             #warn "append to old message";
3566             my $letter =  C4::Letters::GetPreparedLetter (
3567                 module => 'circulation',
3568                 letter_code => $type,
3569                 branchcode => $branch,
3570                 message_transport_type => $_,
3571                 tables => {
3572                     $issues_table => $item->{itemnumber},
3573                     'items'       => $item->{itemnumber},
3574                     'biblio'      => $item->{biblionumber},
3575                     'biblioitems' => $item->{biblionumber},
3576                     'borrowers'   => $borrower,
3577                     'branches'    => $branch,
3578                 }
3579             ) or next;
3580             $message->append($letter);
3581             $message->update;
3582         }
3583     }
3584
3585     return;
3586 }
3587
3588 =head2 updateWrongTransfer
3589
3590   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3591
3592 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
3593
3594 =cut
3595
3596 sub updateWrongTransfer {
3597         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3598         my $dbh = C4::Context->dbh;
3599 # first step validate the actual line of transfert .
3600         my $sth =
3601                 $dbh->prepare(
3602                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3603                 );
3604                 $sth->execute($FromLibrary,$itemNumber);
3605
3606 # second step create a new line of branchtransfer to the right location .
3607         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3608
3609 #third step changing holdingbranch of item
3610         UpdateHoldingbranch($FromLibrary,$itemNumber);
3611 }
3612
3613 =head2 UpdateHoldingbranch
3614
3615   $items = UpdateHoldingbranch($branch,$itmenumber);
3616
3617 Simple methode for updating hodlingbranch in items BDD line
3618
3619 =cut
3620
3621 sub UpdateHoldingbranch {
3622         my ( $branch,$itemnumber ) = @_;
3623     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3624 }
3625
3626 =head2 CalcDateDue
3627
3628 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3629
3630 this function calculates the due date given the start date and configured circulation rules,
3631 checking against the holidays calendar as per the 'useDaysMode' syspref.
3632 C<$startdate>   = DateTime object representing start date of loan period (assumed to be today)
3633 C<$itemtype>  = itemtype code of item in question
3634 C<$branch>  = location whose calendar to use
3635 C<$borrower> = Borrower object
3636 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3637
3638 =cut
3639
3640 sub CalcDateDue {
3641     my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3642
3643     $isrenewal ||= 0;
3644
3645     # loanlength now a href
3646     my $loanlength =
3647             GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3648
3649     my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3650             ? qq{renewalperiod}
3651             : qq{issuelength};
3652
3653     my $datedue;
3654     if ( $startdate ) {
3655         if (ref $startdate ne 'DateTime' ) {
3656             $datedue = dt_from_string($datedue);
3657         } else {
3658             $datedue = $startdate->clone;
3659         }
3660     } else {
3661         $datedue =
3662           DateTime->now( time_zone => C4::Context->tz() )
3663           ->truncate( to => 'minute' );
3664     }
3665
3666
3667     # calculate the datedue as normal
3668     if ( C4::Context->preference('useDaysMode') eq 'Days' )
3669     {    # ignoring calendar
3670         if ( $loanlength->{lengthunit} eq 'hours' ) {
3671             $datedue->add( hours => $loanlength->{$length_key} );
3672         } else {    # days
3673             $datedue->add( days => $loanlength->{$length_key} );
3674             $datedue->set_hour(23);
3675             $datedue->set_minute(59);
3676         }
3677     } else {
3678         my $dur;
3679         if ($loanlength->{lengthunit} eq 'hours') {
3680             $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3681         }
3682         else { # days
3683             $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3684         }
3685         my $calendar = Koha::Calendar->new( branchcode => $branch );
3686         $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3687         if ($loanlength->{lengthunit} eq 'days') {
3688             $datedue->set_hour(23);
3689             $datedue->set_minute(59);
3690         }
3691     }
3692
3693     # if Hard Due Dates are used, retrieve them and apply as necessary
3694     my ( $hardduedate, $hardduedatecompare ) =
3695       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3696     if ($hardduedate) {    # hardduedates are currently dates
3697         $hardduedate->truncate( to => 'minute' );
3698         $hardduedate->set_hour(23);
3699         $hardduedate->set_minute(59);
3700         my $cmp = DateTime->compare( $hardduedate, $datedue );
3701
3702 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3703 # if the calculated date is before the 'after' Hard Due Date (floor), override
3704 # if the hard due date is set to 'exactly', overrride
3705         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3706             $datedue = $hardduedate->clone;
3707         }
3708
3709         # in all other cases, keep the date due as it is
3710
3711     }
3712
3713     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3714     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3715         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3716         if( $expiry_dt ) { #skip empty expiry date..
3717             $expiry_dt->set( hour => 23, minute => 59);
3718             my $d1= $datedue->clone->set_time_zone('floating');
3719             if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3720                 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3721             }
3722         }
3723     }
3724
3725     return $datedue;
3726 }
3727
3728
3729 sub CheckValidBarcode{
3730 my ($barcode) = @_;
3731 my $dbh = C4::Context->dbh;
3732 my $query=qq|SELECT count(*)
3733              FROM items
3734              WHERE barcode=?
3735             |;
3736 my $sth = $dbh->prepare($query);
3737 $sth->execute($barcode);
3738 my $exist=$sth->fetchrow ;
3739 return $exist;
3740 }
3741
3742 =head2 IsBranchTransferAllowed
3743
3744   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3745
3746 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3747
3748 =cut
3749
3750 sub IsBranchTransferAllowed {
3751         my ( $toBranch, $fromBranch, $code ) = @_;
3752
3753         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3754
3755         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3756         my $dbh = C4::Context->dbh;
3757
3758         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3759         $sth->execute( $toBranch, $fromBranch, $code );
3760         my $limit = $sth->fetchrow_hashref();
3761
3762         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3763         if ( $limit->{'limitId'} ) {
3764                 return 0;
3765         } else {
3766                 return 1;
3767         }
3768 }
3769
3770 =head2 CreateBranchTransferLimit
3771
3772   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3773
3774 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3775
3776 =cut
3777
3778 sub CreateBranchTransferLimit {
3779    my ( $toBranch, $fromBranch, $code ) = @_;
3780    return unless defined($toBranch) && defined($fromBranch);
3781    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3782
3783    my $dbh = C4::Context->dbh;
3784
3785    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3786    return $sth->execute( $code, $toBranch, $fromBranch );
3787 }
3788
3789 =head2 DeleteBranchTransferLimits
3790
3791     my $result = DeleteBranchTransferLimits($frombranch);
3792
3793 Deletes all the library transfer limits for one library.  Returns the
3794 number of limits deleted, 0e0 if no limits were deleted, or undef if
3795 no arguments are supplied.
3796
3797 =cut
3798
3799 sub DeleteBranchTransferLimits {
3800     my $branch = shift;
3801     return unless defined $branch;
3802     my $dbh    = C4::Context->dbh;
3803     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3804     return $sth->execute($branch);
3805 }
3806
3807 sub ReturnLostItem{
3808     my ( $borrowernumber, $itemnum ) = @_;
3809
3810     MarkIssueReturned( $borrowernumber, $itemnum );
3811     my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3812     my $item = C4::Items::GetItem( $itemnum );
3813     my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3814     my @datearr = localtime(time);
3815     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3816     my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3817     ModItem({ paidfor =>  $old_note."Paid for by $bor $date" }, undef, $itemnum);
3818 }
3819
3820
3821 sub LostItem{
3822     my ($itemnumber, $mark_returned) = @_;
3823
3824     my $dbh = C4::Context->dbh();
3825     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3826                            FROM issues
3827                            JOIN items USING (itemnumber)
3828                            JOIN biblio USING (biblionumber)
3829                            WHERE issues.itemnumber=?");
3830     $sth->execute($itemnumber);
3831     my $issues=$sth->fetchrow_hashref();
3832
3833     # If a borrower lost the item, add a replacement cost to the their record
3834     if ( my $borrowernumber = $issues->{borrowernumber} ){
3835         my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3836
3837         if (C4::Context->preference('WhenLostForgiveFine')){
3838             my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3839             defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!";  # zero is OK, check defined
3840         }
3841         if (C4::Context->preference('WhenLostChargeReplacementFee')){
3842             C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3843             #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3844             #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3845         }
3846
3847         MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3848     }
3849 }
3850
3851 sub GetOfflineOperations {
3852     my $dbh = C4::Context->dbh;
3853     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3854     $sth->execute(C4::Context->userenv->{'branch'});
3855     my $results = $sth->fetchall_arrayref({});
3856     return $results;
3857 }
3858
3859 sub GetOfflineOperation {
3860     my $operationid = shift;
3861     return unless $operationid;
3862     my $dbh = C4::Context->dbh;
3863     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3864     $sth->execute( $operationid );
3865     return $sth->fetchrow_hashref;
3866 }
3867
3868 sub AddOfflineOperation {
3869     my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3870     my $dbh = C4::Context->dbh;
3871     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3872     $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3873     return "Added.";
3874 }
3875
3876 sub DeleteOfflineOperation {
3877     my $dbh = C4::Context->dbh;
3878     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3879     $sth->execute( shift );
3880     return "Deleted.";
3881 }
3882
3883 sub ProcessOfflineOperation {
3884     my $operation = shift;
3885
3886     my $report;
3887     if ( $operation->{action} eq 'return' ) {
3888         $report = ProcessOfflineReturn( $operation );
3889     } elsif ( $operation->{action} eq 'issue' ) {
3890         $report = ProcessOfflineIssue( $operation );
3891     } elsif ( $operation->{action} eq 'payment' ) {
3892         $report = ProcessOfflinePayment( $operation );
3893     }
3894
3895     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3896
3897     return $report;
3898 }
3899
3900 sub ProcessOfflineReturn {
3901     my $operation = shift;
3902
3903     my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3904
3905     if ( $itemnumber ) {
3906         my $issue = GetOpenIssue( $itemnumber );
3907         if ( $issue ) {
3908             MarkIssueReturned(
3909                 $issue->{borrowernumber},
3910                 $itemnumber,
3911                 undef,
3912                 $operation->{timestamp},
3913             );
3914             ModItem(
3915                 { renewals => 0, onloan => undef },
3916                 $issue->{'biblionumber'},
3917                 $itemnumber
3918             );
3919             return "Success.";
3920         } else {
3921             return "Item not issued.";
3922         }
3923     } else {
3924         return "Item not found.";
3925     }
3926 }
3927
3928 sub ProcessOfflineIssue {
3929     my $operation = shift;
3930
3931     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3932
3933     if ( $borrower->{borrowernumber} ) {
3934         my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3935         unless ($itemnumber) {
3936             return "Barcode not found.";
3937         }
3938         my $issue = GetOpenIssue( $itemnumber );
3939
3940         if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3941             MarkIssueReturned(
3942                 $issue->{borrowernumber},
3943                 $itemnumber,
3944                 undef,
3945                 $operation->{timestamp},
3946             );
3947         }
3948         AddIssue(
3949             $borrower,
3950             $operation->{'barcode'},
3951             undef,
3952             1,
3953             $operation->{timestamp},
3954             undef,
3955         );
3956         return "Success.";
3957     } else {
3958         return "Borrower not found.";
3959     }
3960 }
3961
3962 sub ProcessOfflinePayment {
3963     my $operation = shift;
3964
3965     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3966     my $amount = $operation->{amount};
3967
3968     recordpayment( $borrower->{borrowernumber}, $amount );
3969
3970     return "Success."
3971 }
3972
3973
3974 =head2 TransferSlip
3975
3976   TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3977
3978   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3979
3980 =cut
3981
3982 sub TransferSlip {
3983     my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3984
3985     my $item =  GetItem( $itemnumber, $barcode )
3986       or return;
3987
3988     return C4::Letters::GetPreparedLetter (
3989         module => 'circulation',
3990         letter_code => 'TRANSFERSLIP',
3991         branchcode => $branch,
3992         tables => {
3993             'branches'    => $to_branch,
3994             'biblio'      => $item->{biblionumber},
3995             'items'       => $item,
3996         },
3997     );
3998 }
3999
4000 =head2 CheckIfIssuedToPatron
4001
4002   CheckIfIssuedToPatron($borrowernumber, $biblionumber)
4003
4004   Return 1 if any record item is issued to patron, otherwise return 0
4005
4006 =cut
4007
4008 sub CheckIfIssuedToPatron {
4009     my ($borrowernumber, $biblionumber) = @_;
4010
4011     my $dbh = C4::Context->dbh;
4012     my $query = q|
4013         SELECT COUNT(*) FROM issues
4014         LEFT JOIN items ON items.itemnumber = issues.itemnumber
4015         WHERE items.biblionumber = ?
4016         AND issues.borrowernumber = ?
4017     |;
4018     my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
4019     return 1 if $is_issued;
4020     return;
4021 }
4022
4023 =head2 IsItemIssued
4024
4025   IsItemIssued( $itemnumber )
4026
4027   Return 1 if the item is on loan, otherwise return 0
4028
4029 =cut
4030
4031 sub IsItemIssued {
4032     my $itemnumber = shift;
4033     my $dbh = C4::Context->dbh;
4034     my $sth = $dbh->prepare(q{
4035         SELECT COUNT(*)
4036         FROM issues
4037         WHERE itemnumber = ?
4038     });
4039     $sth->execute($itemnumber);
4040     return $sth->fetchrow;
4041 }
4042
4043 =head2 GetAgeRestriction
4044
4045   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
4046   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
4047
4048   if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
4049   if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
4050
4051 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
4052 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
4053 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
4054          Negative days mean the borrower has gone past the age restriction age.
4055
4056 =cut
4057
4058 sub GetAgeRestriction {
4059     my ($record_restrictions, $borrower) = @_;
4060     my $markers = C4::Context->preference('AgeRestrictionMarker');
4061
4062     # Split $record_restrictions to something like FSK 16 or PEGI 6
4063     my @values = split ' ', uc($record_restrictions);
4064     return unless @values;
4065
4066     # Search first occurrence of one of the markers
4067     my @markers = split /\|/, uc($markers);
4068     return unless @markers;
4069
4070     my $index            = 0;
4071     my $restriction_year = 0;
4072     for my $value (@values) {
4073         $index++;
4074         for my $marker (@markers) {
4075             $marker =~ s/^\s+//;    #remove leading spaces
4076             $marker =~ s/\s+$//;    #remove trailing spaces
4077             if ( $marker eq $value ) {
4078                 if ( $index <= $#values ) {
4079                     $restriction_year += $values[$index];
4080                 }
4081                 last;
4082             }
4083             elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
4084
4085                 # Perhaps it is something like "K16" (as in Finland)
4086                 $restriction_year += $1;
4087                 last;
4088             }
4089         }
4090         last if ( $restriction_year > 0 );
4091     }
4092
4093     #Check if the borrower is age restricted for this material and for how long.
4094     if ($restriction_year && $borrower) {
4095         if ( $borrower->{'dateofbirth'} ) {
4096             my @alloweddate = split /-/, $borrower->{'dateofbirth'};
4097             $alloweddate[0] += $restriction_year;
4098
4099             #Prevent runime eror on leap year (invalid date)
4100             if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
4101                 $alloweddate[2] = 28;
4102             }
4103
4104             #Get how many days the borrower has to reach the age restriction
4105             my @Today = split /-/, DateTime->today->ymd();
4106             my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
4107             #Negative days means the borrower went past the age restriction age
4108             return ($restriction_year, $daysToAgeRestriction);
4109         }
4110     }
4111
4112     return ($restriction_year);
4113 }
4114
4115
4116 =head2 GetPendingOnSiteCheckouts
4117
4118 =cut
4119
4120 sub GetPendingOnSiteCheckouts {
4121     my $dbh = C4::Context->dbh;
4122     return $dbh->selectall_arrayref(q|
4123         SELECT
4124           items.barcode,
4125           items.biblionumber,
4126           items.itemnumber,
4127           items.itemnotes,
4128           items.itemcallnumber,
4129           items.location,
4130           issues.date_due,
4131           issues.branchcode,
4132           issues.date_due < NOW() AS is_overdue,
4133           biblio.author,
4134           biblio.title,
4135           borrowers.firstname,
4136           borrowers.surname,
4137           borrowers.cardnumber,
4138           borrowers.borrowernumber
4139         FROM items
4140         LEFT JOIN issues ON items.itemnumber = issues.itemnumber
4141         LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
4142         LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
4143         WHERE issues.onsite_checkout = 1
4144     |, { Slice => {} } );
4145 }
4146
4147 sub GetTopIssues {
4148     my ($params) = @_;
4149
4150     my ($count, $branch, $itemtype, $ccode, $newness)
4151         = @$params{qw(count branch itemtype ccode newness)};
4152
4153     my $dbh = C4::Context->dbh;
4154     my $query = q{
4155         SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4156           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4157           i.ccode, SUM(i.issues) AS count
4158         FROM biblio b
4159         LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4160         LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4161     };
4162
4163     my (@where_strs, @where_args);
4164
4165     if ($branch) {
4166         push @where_strs, 'i.homebranch = ?';
4167         push @where_args, $branch;
4168     }
4169     if ($itemtype) {
4170         if (C4::Context->preference('item-level_itypes')){
4171             push @where_strs, 'i.itype = ?';
4172             push @where_args, $itemtype;
4173         } else {
4174             push @where_strs, 'bi.itemtype = ?';
4175             push @where_args, $itemtype;
4176         }
4177     }
4178     if ($ccode) {
4179         push @where_strs, 'i.ccode = ?';
4180         push @where_args, $ccode;
4181     }
4182     if ($newness) {
4183         push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4184         push @where_args, $newness;
4185     }
4186
4187     if (@where_strs) {
4188         $query .= 'WHERE ' . join(' AND ', @where_strs);
4189     }
4190
4191     $query .= q{
4192         GROUP BY b.biblionumber
4193         HAVING count > 0
4194         ORDER BY count DESC
4195     };
4196
4197     $count = int($count);
4198     if ($count > 0) {
4199         $query .= "LIMIT $count";
4200     }
4201
4202     my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4203
4204     return @$rows;
4205 }
4206
4207 1;
4208 __END__
4209
4210 =head1 AUTHOR
4211
4212 Koha Development Team <http://koha-community.org/>
4213
4214 =cut
4215