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