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