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