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