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