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 C4::Context;
  25 use C4::Stats;
  26 use C4::Reserves;
  27 use C4::Koha;
  28 use C4::Biblio;
  29 use C4::Items;
  30 use C4::Members;
  31 use C4::Dates;
  32 use C4::Calendar;
  33 use C4::Accounts;
  34 use C4::ItemCirculationAlertPreference;
  35 use C4::Dates qw(format_date);
  36 use C4::Message;
  37 use C4::Debug;
  38 use Date::Calc qw(
  39   Today
  40   Today_and_Now
  41   Add_Delta_YM
  42   Add_Delta_DHMS
  43   Date_to_Days
  44   Day_of_Week
  45   Add_Delta_Days
  46 );
  47 use POSIX qw(strftime);
  48 use C4::Branch; # GetBranches
  49 use C4::Log; # logaction
  50
  51 use Data::Dumper;
  52
  53 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  54
  55 BEGIN {
  56         require Exporter;
  57         $VERSION = 3.02;        # for version checking
  58         @ISA    = qw(Exporter);
  59
  60         # FIXME subs that should probably be elsewhere
  61         push @EXPORT, qw(
  62                 &FixOverduesOnReturn
  63                 &barcodedecode
  64         );
  65
  66         # subs to deal with issuing a book
  67         push @EXPORT, qw(
  68                 &CanBookBeIssued
  69                 &CanBookBeRenewed
  70                 &AddIssue
  71                 &AddRenewal
  72                 &GetRenewCount
  73                 &GetItemIssue
  74                 &GetItemIssues
  75                 &GetBorrowerIssues
  76                 &GetIssuingCharges
  77                 &GetIssuingRule
  78         &GetBranchBorrowerCircRule
  79         &GetBranchItemRule
  80                 &GetBiblioIssues
  81                 &GetOpenIssue
  82                 &AnonymiseIssueHistory
  83         );
  84
  85         # subs to deal with returns
  86         push @EXPORT, qw(
  87                 &AddReturn
  88         &MarkIssueReturned
  89         );
  90
  91         # subs to deal with transfers
  92         push @EXPORT, qw(
  93                 &transferbook
  94                 &GetTransfers
  95                 &GetTransfersFromTo
  96                 &updateWrongTransfer
  97                 &DeleteTransfer
  98                 &IsBranchTransferAllowed
  99                 &CreateBranchTransferLimit
 100                 &DeleteBranchTransferLimits
 101         );
 102 }
 103
 104 =head1 NAME
 105
 106 C4::Circulation - Koha circulation module
 107
 108 =head1 SYNOPSIS
 109
 110 use C4::Circulation;
 111
 112 =head1 DESCRIPTION
 113
 114 The functions in this module deal with circulation, issues, and
 115 returns, as well as general information about the library.
 116 Also deals with stocktaking.
 117
 118 =head1 FUNCTIONS
 119
 120 =head2 barcodedecode
 121
 122   $str = &barcodedecode($barcode, [$filter]);
 123
 124 Generic filter function for barcode string.
 125 Called on every circ if the System Pref itemBarcodeInputFilter is set.
 126 Will do some manipulation of the barcode for systems that deliver a barcode
 127 to circulation.pl that differs from the barcode stored for the item.
 128 For proper functioning of this filter, calling the function on the
 129 correct barcode string (items.barcode) should return an unaltered barcode.
 130
 131 The optional $filter argument is to allow for testing or explicit
 132 behavior that ignores the System Pref.  Valid values are the same as the
 133 System Pref options.
 134
 135 =cut
 136
 137 # FIXME -- the &decode fcn below should be wrapped into this one.
 138 # FIXME -- these plugins should be moved out of Circulation.pm
 139 #
 140 sub barcodedecode {
 141     my ($barcode, $filter) = @_;
 142     my $branch = C4::Branch::mybranch();
 143     $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
 144     $filter or return $barcode;     # ensure filter is defined, else return untouched barcode
 145         if ($filter eq 'whitespace') {
 146                 $barcode =~ s/\s//g;
 147         } elsif ($filter eq 'cuecat') {
 148                 chomp($barcode);
 149             my @fields = split( /\./, $barcode );
 150             my @results = map( decode($_), @fields[ 1 .. $#fields ] );
 151             ($#results == 2) and return $results[2];
 152         } elsif ($filter eq 'T-prefix') {
 153                 if ($barcode =~ /^[Tt](\d)/) {
 154                         (defined($1) and $1 eq '0') and return $barcode;
 155             $barcode = substr($barcode, 2) + 0;     # FIXME: probably should be substr($barcode, 1)
 156                 }
 157         return sprintf("T%07d", $barcode);
 158         # FIXME: $barcode could be "T1", causing warning: substr outside of string
 159         # Why drop the nonzero digit after the T?
 160         # Why pass non-digits (or empty string) to "T%07d"?
 161         } elsif ($filter eq 'libsuite8') {
 162                 unless($barcode =~ m/^($branch)-/i){    #if barcode starts with branch code its in Koha style. Skip it.
 163                         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
 164                                 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
 165                         }else{
 166                                 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
 167                         }
 168                 }
 169         }
 170     return $barcode;    # return barcode, modified or not
 171 }
 172
 173 =head2 decode
 174
 175   $str = &decode($chunk);
 176
 177 Decodes a segment of a string emitted by a CueCat barcode scanner and
 178 returns it.
 179
 180 FIXME: Should be replaced with Barcode::Cuecat from CPAN
 181 or Javascript based decoding on the client side.
 182
 183 =cut
 184
 185 sub decode {
 186     my ($encoded) = @_;
 187     my $seq =
 188       'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
 189     my @s = map { index( $seq, $_ ); } split( //, $encoded );
 190     my $l = ( $#s + 1 ) % 4;
 191     if ($l) {
 192         if ( $l == 1 ) {
 193             # warn "Error: Cuecat decode parsing failed!";
 194             return;
 195         }
 196         $l = 4 - $l;
 197         $#s += $l;
 198     }
 199     my $r = '';
 200     while ( $#s >= 0 ) {
 201         my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
 202         $r .=
 203             chr( ( $n >> 16 ) ^ 67 )
 204          .chr( ( $n >> 8 & 255 ) ^ 67 )
 205          .chr( ( $n & 255 ) ^ 67 );
 206         @s = @s[ 4 .. $#s ];
 207     }
 208     $r = substr( $r, 0, length($r) - $l );
 209     return $r;
 210 }
 211
 212 =head2 transferbook
 213
 214   ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
 215                                             $barcode, $ignore_reserves);
 216
 217 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
 218
 219 C<$newbranch> is the code for the branch to which the item should be transferred.
 220
 221 C<$barcode> is the barcode of the item to be transferred.
 222
 223 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
 224 Otherwise, if an item is reserved, the transfer fails.
 225
 226 Returns three values:
 227
 228 =over
 229
 230 =item $dotransfer
 231
 232 is true if the transfer was successful.
 233
 234 =item $messages
 235
 236 is a reference-to-hash which may have any of the following keys:
 237
 238 =over
 239
 240 =item C<BadBarcode>
 241
 242 There is no item in the catalog with the given barcode. The value is C<$barcode>.
 243
 244 =item C<IsPermanent>
 245
 246 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.
 247
 248 =item C<DestinationEqualsHolding>
 249
 250 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.
 251
 252 =item C<WasReturned>
 253
 254 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.
 255
 256 =item C<ResFound>
 257
 258 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>.
 259
 260 =item C<WasTransferred>
 261
 262 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
 263
 264 =back
 265
 266 =back
 267
 268 =cut
 269
 270 sub transferbook {
 271     my ( $tbr, $barcode, $ignoreRs ) = @_;
 272     my $messages;
 273     my $dotransfer      = 1;
 274     my $branches        = GetBranches();
 275     my $itemnumber = GetItemnumberFromBarcode( $barcode );
 276     my $issue      = GetItemIssue($itemnumber);
 277     my $biblio = GetBiblioFromItemNumber($itemnumber);
 278
 279     # bad barcode..
 280     if ( not $itemnumber ) {
 281         $messages->{'BadBarcode'} = $barcode;
 282         $dotransfer = 0;
 283     }
 284
 285     # get branches of book...
 286     my $hbr = $biblio->{'homebranch'};
 287     my $fbr = $biblio->{'holdingbranch'};
 288
 289     # if using Branch Transfer Limits
 290     if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
 291         if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
 292             if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
 293                 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
 294                 $dotransfer = 0;
 295             }
 296         } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
 297             $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
 298             $dotransfer = 0;
 299         }
 300     }
 301
 302     # if is permanent...
 303     if ( $hbr && $branches->{$hbr}->{'PE'} ) {
 304         $messages->{'IsPermanent'} = $hbr;
 305         $dotransfer = 0;
 306     }
 307
 308     # can't transfer book if is already there....
 309     if ( $fbr eq $tbr ) {
 310         $messages->{'DestinationEqualsHolding'} = 1;
 311         $dotransfer = 0;
 312     }
 313
 314     # check if it is still issued to someone, return it...
 315     if ($issue->{borrowernumber}) {
 316         AddReturn( $barcode, $fbr );
 317         $messages->{'WasReturned'} = $issue->{borrowernumber};
 318     }
 319
 320     # find reserves.....
 321     # That'll save a database query.
 322     my ( $resfound, $resrec ) =
 323       CheckReserves( $itemnumber );
 324     if ( $resfound and not $ignoreRs ) {
 325         $resrec->{'ResFound'} = $resfound;
 326
 327         #         $messages->{'ResFound'} = $resrec;
 328         $dotransfer = 1;
 329     }
 330
 331     #actually do the transfer....
 332     if ($dotransfer) {
 333         ModItemTransfer( $itemnumber, $fbr, $tbr );
 334
 335         # don't need to update MARC anymore, we do it in batch now
 336         $messages->{'WasTransfered'} = 1;
 337
 338     }
 339     ModDateLastSeen( $itemnumber );
 340     return ( $dotransfer, $messages, $biblio );
 341 }
 342
 343
 344 sub TooMany {
 345     my $borrower        = shift;
 346     my $biblionumber = shift;
 347         my $item                = shift;
 348     my $cat_borrower    = $borrower->{'categorycode'};
 349     my $dbh             = C4::Context->dbh;
 350         my $branch;
 351         # Get which branchcode we need
 352         $branch = _GetCircControlBranch($item,$borrower);
 353         my $type = (C4::Context->preference('item-level_itypes'))
 354                         ? $item->{'itype'}         # item-level
 355                         : $item->{'itemtype'};     # biblio-level
 356
 357     # given branch, patron category, and item type, determine
 358     # applicable issuing rule
 359     my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
 360
 361     # if a rule is found and has a loan limit set, count
 362     # how many loans the patron already has that meet that
 363     # rule
 364     if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
 365         my @bind_params;
 366         my $count_query = "SELECT COUNT(*) FROM issues
 367                            JOIN items USING (itemnumber) ";
 368
 369         my $rule_itemtype = $issuing_rule->{itemtype};
 370         if ($rule_itemtype eq "*") {
 371             # matching rule has the default item type, so count only
 372             # those existing loans that don't fall under a more
 373             # specific rule
 374             if (C4::Context->preference('item-level_itypes')) {
 375                 $count_query .= " WHERE items.itype NOT IN (
 376                                     SELECT itemtype FROM issuingrules
 377                                     WHERE branchcode = ?
 378                                     AND   (categorycode = ? OR categorycode = ?)
 379                                     AND   itemtype <> '*'
 380                                   ) ";
 381             } else {
 382                 $count_query .= " JOIN  biblioitems USING (biblionumber)
 383                                   WHERE biblioitems.itemtype NOT IN (
 384                                     SELECT itemtype FROM issuingrules
 385                                     WHERE branchcode = ?
 386                                     AND   (categorycode = ? OR categorycode = ?)
 387                                     AND   itemtype <> '*'
 388                                   ) ";
 389             }
 390             push @bind_params, $issuing_rule->{branchcode};
 391             push @bind_params, $issuing_rule->{categorycode};
 392             push @bind_params, $cat_borrower;
 393         } else {
 394             # rule has specific item type, so count loans of that
 395             # specific item type
 396             if (C4::Context->preference('item-level_itypes')) {
 397                 $count_query .= " WHERE items.itype = ? ";
 398             } else {
 399                 $count_query .= " JOIN  biblioitems USING (biblionumber)
 400                                   WHERE biblioitems.itemtype= ? ";
 401             }
 402             push @bind_params, $type;
 403         }
 404
 405         $count_query .= " AND borrowernumber = ? ";
 406         push @bind_params, $borrower->{'borrowernumber'};
 407         my $rule_branch = $issuing_rule->{branchcode};
 408         if ($rule_branch ne "*") {
 409             if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
 410                 $count_query .= " AND issues.branchcode = ? ";
 411                 push @bind_params, $branch;
 412             } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
 413                 ; # if branch is the patron's home branch, then count all loans by patron
 414             } else {
 415                 $count_query .= " AND items.homebranch = ? ";
 416                 push @bind_params, $branch;
 417             }
 418         }
 419
 420         my $count_sth = $dbh->prepare($count_query);
 421         $count_sth->execute(@bind_params);
 422         my ($current_loan_count) = $count_sth->fetchrow_array;
 423
 424         my $max_loans_allowed = $issuing_rule->{'maxissueqty'};
 425         if ($current_loan_count >= $max_loans_allowed) {
 426             return ($current_loan_count, $max_loans_allowed);
 427         }
 428     }
 429
 430     # Now count total loans against the limit for the branch
 431     my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
 432     if (defined($branch_borrower_circ_rule->{maxissueqty})) {
 433         my @bind_params = ();
 434         my $branch_count_query = "SELECT COUNT(*) FROM issues
 435                                   JOIN items USING (itemnumber)
 436                                   WHERE borrowernumber = ? ";
 437         push @bind_params, $borrower->{borrowernumber};
 438
 439         if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
 440             $branch_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             $branch_count_query .= " AND items.homebranch = ? ";
 446             push @bind_params, $branch;
 447         }
 448         my $branch_count_sth = $dbh->prepare($branch_count_query);
 449         $branch_count_sth->execute(@bind_params);
 450         my ($current_loan_count) = $branch_count_sth->fetchrow_array;
 451
 452         my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty};
 453         if ($current_loan_count >= $max_loans_allowed) {
 454             return ($current_loan_count, $max_loans_allowed);
 455         }
 456     }
 457
 458     # OK, the patron can issue !!!
 459     return;
 460 }
 461
 462 =head2 itemissues
 463
 464   @issues = &itemissues($biblioitemnumber, $biblio);
 465
 466 Looks up information about who has borrowed the bookZ<>(s) with the
 467 given biblioitemnumber.
 468
 469 C<$biblio> is ignored.
 470
 471 C<&itemissues> returns an array of references-to-hash. The keys
 472 include the fields from the C<items> table in the Koha database.
 473 Additional keys include:
 474
 475 =over 4
 476
 477 =item C<date_due>
 478
 479 If the item is currently on loan, this gives the due date.
 480
 481 If the item is not on loan, then this is either "Available" or
 482 "Cancelled", if the item has been withdrawn.
 483
 484 =item C<card>
 485
 486 If the item is currently on loan, this gives the card number of the
 487 patron who currently has the item.
 488
 489 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
 490
 491 These give the timestamp for the last three times the item was
 492 borrowed.
 493
 494 =item C<card0>, C<card1>, C<card2>
 495
 496 The card number of the last three patrons who borrowed this item.
 497
 498 =item C<borrower0>, C<borrower1>, C<borrower2>
 499
 500 The borrower number of the last three patrons who borrowed this item.
 501
 502 =back
 503
 504 =cut
 505
 506 #'
 507 sub itemissues {
 508     my ( $bibitem, $biblio ) = @_;
 509     my $dbh = C4::Context->dbh;
 510     my $sth =
 511       $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
 512       || die $dbh->errstr;
 513     my $i = 0;
 514     my @results;
 515
 516     $sth->execute($bibitem) || die $sth->errstr;
 517
 518     while ( my $data = $sth->fetchrow_hashref ) {
 519
 520         # Find out who currently has this item.
 521         # FIXME - Wouldn't it be better to do this as a left join of
 522         # some sort? Currently, this code assumes that if
 523         # fetchrow_hashref() fails, then the book is on the shelf.
 524         # fetchrow_hashref() can fail for any number of reasons (e.g.,
 525         # database server crash), not just because no items match the
 526         # search criteria.
 527         my $sth2 = $dbh->prepare(
 528             "SELECT * FROM issues
 529                 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 530                 WHERE itemnumber = ?
 531             "
 532         );
 533
 534         $sth2->execute( $data->{'itemnumber'} );
 535         if ( my $data2 = $sth2->fetchrow_hashref ) {
 536             $data->{'date_due'} = $data2->{'date_due'};
 537             $data->{'card'}     = $data2->{'cardnumber'};
 538             $data->{'borrower'} = $data2->{'borrowernumber'};
 539         }
 540         else {
 541             $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
 542         }
 543
 544
 545         # Find the last 3 people who borrowed this item.
 546         $sth2 = $dbh->prepare(
 547             "SELECT * FROM old_issues
 548                 LEFT JOIN borrowers ON  issues.borrowernumber = borrowers.borrowernumber
 549                 WHERE itemnumber = ?
 550                 ORDER BY returndate DESC,timestamp DESC"
 551         );
 552
 553         $sth2->execute( $data->{'itemnumber'} );
 554         for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
 555         {    # FIXME : error if there is less than 3 pple borrowing this item
 556             if ( my $data2 = $sth2->fetchrow_hashref ) {
 557                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
 558                 $data->{"card$i2"}      = $data2->{'cardnumber'};
 559                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
 560             }    # if
 561         }    # for
 562
 563         $results[$i] = $data;
 564         $i++;
 565     }
 566
 567     return (@results);
 568 }
 569
 570 =head2 CanBookBeIssued
 571
 572   ( $issuingimpossible, $needsconfirmation ) =  CanBookBeIssued( $borrower,
 573                                       $barcode, $duedatespec, $inprocess );
 574
 575 Check if a book can be issued.
 576
 577 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
 578
 579 =over 4
 580
 581 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
 582
 583 =item C<$barcode> is the bar code of the book being issued.
 584
 585 =item C<$duedatespec> is a C4::Dates object.
 586
 587 =item C<$inprocess>
 588
 589 =back
 590
 591 Returns :
 592
 593 =over 4
 594
 595 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
 596 Possible values are :
 597
 598 =back
 599
 600 =head3 INVALID_DATE
 601
 602 sticky due date is invalid
 603
 604 =head3 GNA
 605
 606 borrower gone with no address
 607
 608 =head3 CARD_LOST
 609
 610 borrower declared it's card lost
 611
 612 =head3 DEBARRED
 613
 614 borrower debarred
 615
 616 =head3 UNKNOWN_BARCODE
 617
 618 barcode unknown
 619
 620 =head3 NOT_FOR_LOAN
 621
 622 item is not for loan
 623
 624 =head3 WTHDRAWN
 625
 626 item withdrawn.
 627
 628 =head3 RESTRICTED
 629
 630 item is restricted (set by ??)
 631
 632 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
 633 could be prevented, but ones that can be overriden by the operator.
 634
 635 Possible values are :
 636
 637 =head3 DEBT
 638
 639 borrower has debts.
 640
 641 =head3 RENEW_ISSUE
 642
 643 renewing, not issuing
 644
 645 =head3 ISSUED_TO_ANOTHER
 646
 647 issued to someone else.
 648
 649 =head3 RESERVED
 650
 651 reserved for someone else.
 652
 653 =head3 INVALID_DATE
 654
 655 sticky due date is invalid or due date in the past
 656
 657 =head3 TOO_MANY
 658
 659 if the borrower borrows to much things
 660
 661 =cut
 662
 663 sub CanBookBeIssued {
 664     my ( $borrower, $barcode, $duedate, $inprocess ) = @_;
 665     my %needsconfirmation;    # filled with problems that needs confirmations
 666     my %issuingimpossible;    # filled with problems that causes the issue to be IMPOSSIBLE
 667     my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
 668     my $issue = GetItemIssue($item->{itemnumber});
 669         my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
 670         $item->{'itemtype'}=$item->{'itype'};
 671     my $dbh             = C4::Context->dbh;
 672
 673     # MANDATORY CHECKS - unless item exists, nothing else matters
 674     unless ( $item->{barcode} ) {
 675         $issuingimpossible{UNKNOWN_BARCODE} = 1;
 676     }
 677         return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
 678
 679     #
 680     # DUE DATE is OK ? -- should already have checked.
 681     #
 682     unless ( $duedate ) {
 683         my $issuedate = strftime( "%Y-%m-%d", localtime );
 684
 685         my $branch = _GetCircControlBranch($item,$borrower);
 686         my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
 687         my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch );
 688         $duedate = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch, $borrower );
 689
 690         # Offline circ calls AddIssue directly, doesn't run through here
 691         #  So issuingimpossible should be ok.
 692     }
 693     if ($duedate) {
 694         $needsconfirmation{INVALID_DATE} = $duedate->output('syspref')
 695           unless $duedate->output('iso') ge C4::Dates->today('iso');
 696     } else {
 697         $issuingimpossible{INVALID_DATE} = $duedate->output('syspref');
 698     }
 699
 700     #
 701     # BORROWER STATUS
 702     #
 703     if ( $borrower->{'category_type'} eq 'X' && (  $item->{barcode}  )) {
 704         # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1  .
 705         &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
 706         ModDateLastSeen( $item->{'itemnumber'} );
 707         return( { STATS => 1 }, {});
 708     }
 709     if ( $borrower->{flags}->{GNA} ) {
 710         $issuingimpossible{GNA} = 1;
 711     }
 712     if ( $borrower->{flags}->{'LOST'} ) {
 713         $issuingimpossible{CARD_LOST} = 1;
 714     }
 715     if ( $borrower->{flags}->{'DBARRED'} ) {
 716         $issuingimpossible{DEBARRED} = 1;
 717     }
 718     if ( $borrower->{'dateexpiry'} eq '0000-00-00') {
 719         $issuingimpossible{EXPIRED} = 1;
 720     } else {
 721         my @expirydate=  split /-/,$borrower->{'dateexpiry'};
 722         if($expirydate[0]==0 || $expirydate[1]==0|| $expirydate[2]==0 ||
 723             Date_to_Days(Today) > Date_to_Days( @expirydate )) {
 724             $issuingimpossible{EXPIRED} = 1;
 725         }
 726     }
 727     #
 728     # BORROWER STATUS
 729     #
 730
 731     # DEBTS
 732     my ($amount) =
 733       C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') );
 734     my $amountlimit = C4::Context->preference("noissuescharge");
 735     my $allowfineoverride = C4::Context->preference("AllowFineOverride");
 736     my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
 737     if ( C4::Context->preference("IssuingInProcess") ) {
 738         if ( $amount > $amountlimit && !$inprocess && !$allowfineoverride) {
 739             $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
 740         } elsif ( $amount > $amountlimit && !$inprocess && $allowfineoverride) {
 741             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
 742         } elsif ( $allfinesneedoverride && $amount > 0 && $amount <= $amountlimit && !$inprocess ) {
 743             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
 744         }
 745     }
 746     else {
 747         if ( $amount > $amountlimit && $allowfineoverride ) {
 748             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
 749         } elsif ( $amount > $amountlimit && !$allowfineoverride) {
 750             $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
 751         } elsif ( $amount > 0 && $allfinesneedoverride ) {
 752             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
 753         }
 754     }
 755
 756     my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
 757     if ($blocktype == -1) {
 758         ## patron has outstanding overdue loans
 759             if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
 760                 $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
 761             }
 762             elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
 763                 $needsconfirmation{USERBLOCKEDOVERDUE} = $count;
 764             }
 765     } elsif($blocktype == 1) {
 766         # patron has accrued fine days
 767         $issuingimpossible{USERBLOCKEDREMAINING} = $count;
 768     }
 769
 770 #
 771     # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
 772     #
 773         my ($current_loan_count, $max_loans_allowed) = TooMany( $borrower, $item->{biblionumber}, $item );
 774     # if TooMany max_loans_allowed returns 0 the user doesn't have permission to check out this book
 775     if ($max_loans_allowed eq 0) {
 776         $needsconfirmation{PATRON_CANT} = 1;
 777     } else {
 778         if($max_loans_allowed){
 779             $needsconfirmation{TOO_MANY} = 1;
 780             $needsconfirmation{current_loan_count} = $current_loan_count;
 781             $needsconfirmation{max_loans_allowed} = $max_loans_allowed;
 782         }
 783     }
 784
 785     #
 786     # ITEM CHECKING
 787     #
 788     if (   $item->{'notforloan'}
 789         && $item->{'notforloan'} > 0 )
 790     {
 791         if(!C4::Context->preference("AllowNotForLoanOverride")){
 792             $issuingimpossible{NOT_FOR_LOAN} = 1;
 793         }else{
 794             $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 795         }
 796     }
 797     elsif ( !$item->{'notforloan'} ){
 798         # we have to check itemtypes.notforloan also
 799         if (C4::Context->preference('item-level_itypes')){
 800             # this should probably be a subroutine
 801             my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
 802             $sth->execute($item->{'itemtype'});
 803             my $notforloan=$sth->fetchrow_hashref();
 804             $sth->finish();
 805             if ($notforloan->{'notforloan'}) {
 806                 if (!C4::Context->preference("AllowNotForLoanOverride")) {
 807                     $issuingimpossible{NOT_FOR_LOAN} = 1;
 808                 } else {
 809                     $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 810                 }
 811             }
 812         }
 813         elsif ($biblioitem->{'notforloan'} == 1){
 814             if (!C4::Context->preference("AllowNotForLoanOverride")) {
 815                 $issuingimpossible{NOT_FOR_LOAN} = 1;
 816             } else {
 817                 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 818             }
 819         }
 820     }
 821     if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
 822     {
 823         $issuingimpossible{WTHDRAWN} = 1;
 824     }
 825     if (   $item->{'restricted'}
 826         && $item->{'restricted'} == 1 )
 827     {
 828         $issuingimpossible{RESTRICTED} = 1;
 829     }
 830     if ( C4::Context->preference("IndependantBranches") ) {
 831         my $userenv = C4::Context->userenv;
 832         if ( ($userenv) && ( $userenv->{flags} % 2 != 1 ) ) {
 833             $issuingimpossible{ITEMNOTSAMEBRANCH} = 1
 834               if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
 835             $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
 836               if ( $borrower->{'branchcode'} ne $userenv->{branch} );
 837         }
 838     }
 839
 840     #
 841     # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
 842     #
 843     if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
 844     {
 845
 846         # Already issued to current borrower. Ask whether the loan should
 847         # be renewed.
 848         my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
 849             $borrower->{'borrowernumber'},
 850             $item->{'itemnumber'}
 851         );
 852         if ( $CanBookBeRenewed == 0 ) {    # no more renewals allowed
 853             $issuingimpossible{NO_MORE_RENEWALS} = 1;
 854         }
 855         else {
 856             $needsconfirmation{RENEW_ISSUE} = 1;
 857         }
 858     }
 859     elsif ($issue->{borrowernumber}) {
 860
 861         # issued to someone else
 862         my $currborinfo =    C4::Members::GetMemberDetails( $issue->{borrowernumber} );
 863
 864 #        warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
 865         $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
 866         $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
 867         $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
 868         $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
 869         $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
 870     }
 871
 872     # See if the item is on reserve.
 873     my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
 874     if ($restype) {
 875                 my $resbor = $res->{'borrowernumber'};
 876                 my ( $resborrower ) = C4::Members::GetMemberDetails( $resbor, 0 );
 877                 my $branches  = GetBranches();
 878                 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
 879         if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
 880         {
 881             # The item is on reserve and waiting, but has been
 882             # reserved by some other patron.
 883             $needsconfirmation{RESERVE_WAITING} = 1;
 884             $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
 885             $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
 886             $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
 887             $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
 888             $needsconfirmation{'resbranchname'} = $branchname;
 889             $needsconfirmation{'reswaitingdate'} = format_date($res->{'waitingdate'});
 890         }
 891         elsif ( $restype eq "Reserved" ) {
 892             # The item is on reserve for someone else.
 893             $needsconfirmation{RESERVED} = 1;
 894             $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
 895             $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
 896             $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
 897             $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
 898             $needsconfirmation{'resbranchname'} = $branchname;
 899             $needsconfirmation{'resreservedate'} = format_date($res->{'reservedate'});
 900         }
 901     }
 902         return ( \%issuingimpossible, \%needsconfirmation );
 903 }
 904
 905 =head2 AddIssue
 906
 907   &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
 908
 909 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
 910
 911 =over 4
 912
 913 =item C<$borrower> is a hash with borrower informations (from GetMemberDetails).
 914
 915 =item C<$barcode> is the barcode of the item being issued.
 916
 917 =item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional).
 918 Calculated if empty.
 919
 920 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
 921
 922 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
 923 Defaults to today.  Unlike C<$datedue>, NOT a C4::Dates object, unfortunately.
 924
 925 AddIssue does the following things :
 926
 927   - step 01: check that there is a borrowernumber & a barcode provided
 928   - check for RENEWAL (book issued & being issued to the same patron)
 929       - renewal YES = Calculate Charge & renew
 930       - renewal NO  =
 931           * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
 932           * RESERVE PLACED ?
 933               - fill reserve if reserve to this patron
 934               - cancel reserve or not, otherwise
 935           * TRANSFERT PENDING ?
 936               - complete the transfert
 937           * ISSUE THE BOOK
 938
 939 =back
 940
 941 =cut
 942
 943 sub AddIssue {
 944     my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_;
 945     my $dbh = C4::Context->dbh;
 946         my $barcodecheck=CheckValidBarcode($barcode);
 947     # $issuedate defaults to today.
 948     if ( ! defined $issuedate ) {
 949         $issuedate = strftime( "%Y-%m-%d", localtime );
 950         # TODO: for hourly circ, this will need to be a C4::Dates object
 951         # and all calls to AddIssue including issuedate will need to pass a Dates object.
 952     }
 953         if ($borrower and $barcode and $barcodecheck ne '0'){
 954                 # find which item we issue
 955                 my $item = GetItem('', $barcode) or return undef;       # if we don't get an Item, abort.
 956                 my $branch = _GetCircControlBranch($item,$borrower);
 957
 958                 # get actual issuing if there is one
 959                 my $actualissue = GetItemIssue( $item->{itemnumber});
 960
 961                 # get biblioinformation for this item
 962                 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
 963
 964                 #
 965                 # check if we just renew the issue.
 966                 #
 967                 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
 968                         $datedue = AddRenewal(
 969                                 $borrower->{'borrowernumber'},
 970                                 $item->{'itemnumber'},
 971                                 $branch,
 972                                 $datedue,
 973                 $issuedate, # here interpreted as the renewal date
 974                         );
 975                 }
 976                 else {
 977         # it's NOT a renewal
 978                         if ( $actualissue->{borrowernumber}) {
 979                                 # This book is currently on loan, but not to the person
 980                                 # who wants to borrow it now. mark it returned before issuing to the new borrower
 981                                 AddReturn(
 982                                         $item->{'barcode'},
 983                                         C4::Context->userenv->{'branch'}
 984                                 );
 985                         }
 986
 987                         # See if the item is on reserve.
 988                         my ( $restype, $res ) =
 989                           C4::Reserves::CheckReserves( $item->{'itemnumber'} );
 990                         if ($restype) {
 991                                 my $resbor = $res->{'borrowernumber'};
 992                                 if ( $resbor eq $borrower->{'borrowernumber'} ) {
 993                                         # The item is reserved by the current patron
 994                                         ModReserveFill($res);
 995                                 }
 996                                 elsif ( $restype eq "Waiting" ) {
 997                                         # warn "Waiting";
 998                                         # The item is on reserve and waiting, but has been
 999                                         # reserved by some other patron.
1000                                 }
1001                                 elsif ( $restype eq "Reserved" ) {
1002                                         # warn "Reserved";
1003                                         # The item is reserved by someone else.
1004                                         if ($cancelreserve) { # cancel reserves on this item
1005                                                 CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
1006                                         }
1007                                 }
1008                                 if ($cancelreserve) {
1009                                         CancelReserve($res->{'biblionumber'}, 0, $res->{'borrowernumber'});
1010                                 }
1011                                 else {
1012                                         # set waiting reserve to first in reserve queue as book isn't waiting now
1013                                         ModReserve(1,
1014                                                 $res->{'biblionumber'},
1015                                                 $res->{'borrowernumber'},
1016                                                 $res->{'branchcode'}
1017                                         );
1018                                 }
1019                         }
1020
1021                         # Starting process for transfer job (checking transfert and validate it if we have one)
1022             my ($datesent) = GetTransfers($item->{'itemnumber'});
1023             if ($datesent) {
1024         #       updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1025                 my $sth =
1026                     $dbh->prepare(
1027                     "UPDATE branchtransfers
1028                         SET datearrived = now(),
1029                         tobranch = ?,
1030                         comments = 'Forced branchtransfer'
1031                     WHERE itemnumber= ? AND datearrived IS NULL"
1032                     );
1033                 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
1034             }
1035
1036         # Record in the database the fact that the book was issued.
1037         my $sth =
1038           $dbh->prepare(
1039                 "INSERT INTO issues
1040                     (borrowernumber, itemnumber,issuedate, date_due, branchcode)
1041                 VALUES (?,?,?,?,?)"
1042           );
1043         unless ($datedue) {
1044             my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1045             my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch );
1046             $datedue = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch, $borrower );
1047
1048         }
1049         $sth->execute(
1050             $borrower->{'borrowernumber'},      # borrowernumber
1051             $item->{'itemnumber'},              # itemnumber
1052             $issuedate,                         # issuedate
1053             $datedue->output('iso'),            # date_due
1054             C4::Context->userenv->{'branch'}    # branchcode
1055         );
1056         $sth->finish;
1057         if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1058           CartToShelf( $item->{'itemnumber'} );
1059         }
1060         $item->{'issues'}++;
1061         ModItem({ issues           => $item->{'issues'},
1062                   holdingbranch    => C4::Context->userenv->{'branch'},
1063                   itemlost         => 0,
1064                   datelastborrowed => C4::Dates->new()->output('iso'),
1065                   onloan           => $datedue->output('iso'),
1066                 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1067         ModDateLastSeen( $item->{'itemnumber'} );
1068
1069         # If it costs to borrow this book, charge it to the patron's account.
1070         my ( $charge, $itemtype ) = GetIssuingCharges(
1071             $item->{'itemnumber'},
1072             $borrower->{'borrowernumber'}
1073         );
1074         if ( $charge > 0 ) {
1075             AddIssuingCharge(
1076                 $item->{'itemnumber'},
1077                 $borrower->{'borrowernumber'}, $charge
1078             );
1079             $item->{'charge'} = $charge;
1080         }
1081
1082         # Record the fact that this book was issued.
1083         &UpdateStats(
1084             C4::Context->userenv->{'branch'},
1085             'issue', $charge,
1086             ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
1087             $item->{'itype'}, $borrower->{'borrowernumber'}
1088         );
1089
1090         # Send a checkout slip.
1091         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1092         my %conditions = (
1093             branchcode   => $branch,
1094             categorycode => $borrower->{categorycode},
1095             item_type    => $item->{itype},
1096             notification => 'CHECKOUT',
1097         );
1098         if ($circulation_alert->is_enabled_for(\%conditions)) {
1099             SendCirculationAlert({
1100                 type     => 'CHECKOUT',
1101                 item     => $item,
1102                 borrower => $borrower,
1103                 branch   => $branch,
1104             });
1105         }
1106     }
1107
1108     logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1109         if C4::Context->preference("IssueLog");
1110   }
1111   return ($datedue);    # not necessarily the same as when it came in!
1112 }
1113
1114 =head2 GetLoanLength
1115
1116   my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1117
1118 Get loan length for an itemtype, a borrower type and a branch
1119
1120 =cut
1121
1122 sub GetLoanLength {
1123     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1124     my $dbh = C4::Context->dbh;
1125     my $sth =
1126       $dbh->prepare(
1127 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1128       );
1129 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1130 # try to find issuelength & return the 1st available.
1131 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1132     $sth->execute( $borrowertype, $itemtype, $branchcode );
1133     my $loanlength = $sth->fetchrow_hashref;
1134     return $loanlength->{issuelength}
1135       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1136
1137     $sth->execute( $borrowertype, "*", $branchcode );
1138     $loanlength = $sth->fetchrow_hashref;
1139     return $loanlength->{issuelength}
1140       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1141
1142     $sth->execute( "*", $itemtype, $branchcode );
1143     $loanlength = $sth->fetchrow_hashref;
1144     return $loanlength->{issuelength}
1145       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1146
1147     $sth->execute( "*", "*", $branchcode );
1148     $loanlength = $sth->fetchrow_hashref;
1149     return $loanlength->{issuelength}
1150       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1151
1152     $sth->execute( $borrowertype, $itemtype, "*" );
1153     $loanlength = $sth->fetchrow_hashref;
1154     return $loanlength->{issuelength}
1155       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1156
1157     $sth->execute( $borrowertype, "*", "*" );
1158     $loanlength = $sth->fetchrow_hashref;
1159     return $loanlength->{issuelength}
1160       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1161
1162     $sth->execute( "*", $itemtype, "*" );
1163     $loanlength = $sth->fetchrow_hashref;
1164     return $loanlength->{issuelength}
1165       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1166
1167     $sth->execute( "*", "*", "*" );
1168     $loanlength = $sth->fetchrow_hashref;
1169     return $loanlength->{issuelength}
1170       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1171
1172     # if no rule is set => 21 days (hardcoded)
1173     return 21;
1174 }
1175
1176 =head2 GetIssuingRule
1177
1178   my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1179
1180 FIXME - This is a copy-paste of GetLoanLength
1181 as a stop-gap.  Do not wish to change API for GetLoanLength
1182 this close to release, however, Overdues::GetIssuingRules is broken.
1183
1184 Get the issuing rule for an itemtype, a borrower type and a branch
1185 Returns a hashref from the issuingrules table.
1186
1187 =cut
1188
1189 sub GetIssuingRule {
1190     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1191     my $dbh = C4::Context->dbh;
1192     my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"  );
1193     my $irule;
1194
1195         $sth->execute( $borrowertype, $itemtype, $branchcode );
1196     $irule = $sth->fetchrow_hashref;
1197     return $irule if defined($irule) ;
1198
1199     $sth->execute( $borrowertype, "*", $branchcode );
1200     $irule = $sth->fetchrow_hashref;
1201     return $irule if defined($irule) ;
1202
1203     $sth->execute( "*", $itemtype, $branchcode );
1204     $irule = $sth->fetchrow_hashref;
1205     return $irule if defined($irule) ;
1206
1207     $sth->execute( "*", "*", $branchcode );
1208     $irule = $sth->fetchrow_hashref;
1209     return $irule if defined($irule) ;
1210
1211     $sth->execute( $borrowertype, $itemtype, "*" );
1212     $irule = $sth->fetchrow_hashref;
1213     return $irule if defined($irule) ;
1214
1215     $sth->execute( $borrowertype, "*", "*" );
1216     $irule = $sth->fetchrow_hashref;
1217     return $irule if defined($irule) ;
1218
1219     $sth->execute( "*", $itemtype, "*" );
1220     $irule = $sth->fetchrow_hashref;
1221     return $irule if defined($irule) ;
1222
1223     $sth->execute( "*", "*", "*" );
1224     $irule = $sth->fetchrow_hashref;
1225     return $irule if defined($irule) ;
1226
1227     # if no rule matches,
1228     return undef;
1229 }
1230
1231 =head2 GetBranchBorrowerCircRule
1232
1233   my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1234
1235 Retrieves circulation rule attributes that apply to the given
1236 branch and patron category, regardless of item type.
1237 The return value is a hashref containing the following key:
1238
1239 maxissueqty - maximum number of loans that a
1240 patron of the given category can have at the given
1241 branch.  If the value is undef, no limit.
1242
1243 This will first check for a specific branch and
1244 category match from branch_borrower_circ_rules.
1245
1246 If no rule is found, it will then check default_branch_circ_rules
1247 (same branch, default category).  If no rule is found,
1248 it will then check default_borrower_circ_rules (default
1249 branch, same category), then failing that, default_circ_rules
1250 (default branch, default category).
1251
1252 If no rule has been found in the database, it will default to
1253 the buillt in rule:
1254
1255 maxissueqty - undef
1256
1257 C<$branchcode> and C<$categorycode> should contain the
1258 literal branch code and patron category code, respectively - no
1259 wildcards.
1260
1261 =cut
1262
1263 sub GetBranchBorrowerCircRule {
1264     my $branchcode = shift;
1265     my $categorycode = shift;
1266
1267     my $branch_cat_query = "SELECT maxissueqty
1268                             FROM branch_borrower_circ_rules
1269                             WHERE branchcode = ?
1270                             AND   categorycode = ?";
1271     my $dbh = C4::Context->dbh();
1272     my $sth = $dbh->prepare($branch_cat_query);
1273     $sth->execute($branchcode, $categorycode);
1274     my $result;
1275     if ($result = $sth->fetchrow_hashref()) {
1276         return $result;
1277     }
1278
1279     # try same branch, default borrower category
1280     my $branch_query = "SELECT maxissueqty
1281                         FROM default_branch_circ_rules
1282                         WHERE branchcode = ?";
1283     $sth = $dbh->prepare($branch_query);
1284     $sth->execute($branchcode);
1285     if ($result = $sth->fetchrow_hashref()) {
1286         return $result;
1287     }
1288
1289     # try default branch, same borrower category
1290     my $category_query = "SELECT maxissueqty
1291                           FROM default_borrower_circ_rules
1292                           WHERE categorycode = ?";
1293     $sth = $dbh->prepare($category_query);
1294     $sth->execute($categorycode);
1295     if ($result = $sth->fetchrow_hashref()) {
1296         return $result;
1297     }
1298
1299     # try default branch, default borrower category
1300     my $default_query = "SELECT maxissueqty
1301                           FROM default_circ_rules";
1302     $sth = $dbh->prepare($default_query);
1303     $sth->execute();
1304     if ($result = $sth->fetchrow_hashref()) {
1305         return $result;
1306     }
1307
1308     # built-in default circulation rule
1309     return {
1310         maxissueqty => undef,
1311     };
1312 }
1313
1314 =head2 GetBranchItemRule
1315
1316   my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1317
1318 Retrieves circulation rule attributes that apply to the given
1319 branch and item type, regardless of patron category.
1320
1321 The return value is a hashref containing the following key:
1322
1323 holdallowed => Hold policy for this branch and itemtype. Possible values:
1324   0: No holds allowed.
1325   1: Holds allowed only by patrons that have the same homebranch as the item.
1326   2: Holds allowed from any patron.
1327
1328 This searches branchitemrules in the following order:
1329
1330   * Same branchcode and itemtype
1331   * Same branchcode, itemtype '*'
1332   * branchcode '*', same itemtype
1333   * branchcode and itemtype '*'
1334
1335 Neither C<$branchcode> nor C<$categorycode> should be '*'.
1336
1337 =cut
1338
1339 sub GetBranchItemRule {
1340     my ( $branchcode, $itemtype ) = @_;
1341     my $dbh = C4::Context->dbh();
1342     my $result = {};
1343
1344     my @attempts = (
1345         ['SELECT holdallowed
1346             FROM branch_item_rules
1347             WHERE branchcode = ?
1348               AND itemtype = ?', $branchcode, $itemtype],
1349         ['SELECT holdallowed
1350             FROM default_branch_circ_rules
1351             WHERE branchcode = ?', $branchcode],
1352         ['SELECT holdallowed
1353             FROM default_branch_item_rules
1354             WHERE itemtype = ?', $itemtype],
1355         ['SELECT holdallowed
1356             FROM default_circ_rules'],
1357     );
1358
1359     foreach my $attempt (@attempts) {
1360         my ($query, @bind_params) = @{$attempt};
1361
1362         # Since branch/category and branch/itemtype use the same per-branch
1363         # defaults tables, we have to check that the key we want is set, not
1364         # just that a row was returned
1365         return $result if ( defined( $result->{'holdallowed'} = $dbh->selectrow_array( $query, {}, @bind_params ) ) );
1366     }
1367
1368     # built-in default circulation rule
1369     return {
1370         holdallowed => 2,
1371     };
1372 }
1373
1374 =head2 AddReturn
1375
1376   ($doreturn, $messages, $iteminformation, $borrower) =
1377       &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1378
1379 Returns a book.
1380
1381 =over 4
1382
1383 =item C<$barcode> is the bar code of the book being returned.
1384
1385 =item C<$branch> is the code of the branch where the book is being returned.
1386
1387 =item C<$exemptfine> indicates that overdue charges for the item will be
1388 removed.
1389
1390 =item C<$dropbox> indicates that the check-in date is assumed to be
1391 yesterday, or the last non-holiday as defined in C4::Calendar .  If
1392 overdue charges are applied and C<$dropbox> is true, the last charge
1393 will be removed.  This assumes that the fines accrual script has run
1394 for _today_.
1395
1396 =back
1397
1398 C<&AddReturn> returns a list of four items:
1399
1400 C<$doreturn> is true iff the return succeeded.
1401
1402 C<$messages> is a reference-to-hash giving feedback on the operation.
1403 The keys of the hash are:
1404
1405 =over 4
1406
1407 =item C<BadBarcode>
1408
1409 No item with this barcode exists. The value is C<$barcode>.
1410
1411 =item C<NotIssued>
1412
1413 The book is not currently on loan. The value is C<$barcode>.
1414
1415 =item C<IsPermanent>
1416
1417 The book's home branch is a permanent collection. If you have borrowed
1418 this book, you are not allowed to return it. The value is the code for
1419 the book's home branch.
1420
1421 =item C<wthdrawn>
1422
1423 This book has been withdrawn/cancelled. The value should be ignored.
1424
1425 =item C<Wrongbranch>
1426
1427 This book has was returned to the wrong branch.  The value is a hashref
1428 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1429 contain the branchcode of the incorrect and correct return library, respectively.
1430
1431 =item C<ResFound>
1432
1433 The item was reserved. The value is a reference-to-hash whose keys are
1434 fields from the reserves table of the Koha database, and
1435 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1436 either C<Waiting>, C<Reserved>, or 0.
1437
1438 =back
1439
1440 C<$iteminformation> is a reference-to-hash, giving information about the
1441 returned item from the issues table.
1442
1443 C<$borrower> is a reference-to-hash, giving information about the
1444 patron who last borrowed the book.
1445
1446 =cut
1447
1448 sub AddReturn {
1449     my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1450     if ($branch and not GetBranchDetail($branch)) {
1451         warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
1452         undef $branch;
1453     }
1454     $branch = C4::Context->userenv->{'branch'} unless $branch;  # we trust userenv to be a safe fallback/default
1455     my $messages;
1456     my $borrower;
1457     my $biblio;
1458     my $doreturn       = 1;
1459     my $validTransfert = 0;
1460
1461     # get information on item
1462     my $itemnumber = GetItemnumberFromBarcode( $barcode );
1463     unless ($itemnumber) {
1464         return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower.  bail out.
1465     }
1466     my $issue  = GetItemIssue($itemnumber);
1467 #   warn Dumper($iteminformation);
1468     if ($issue and $issue->{borrowernumber}) {
1469         $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1470             or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existant borrowernumber '$issue->{borrowernumber}'\n"
1471                 . Dumper($issue) . "\n";
1472     } else {
1473         $messages->{'NotIssued'} = $barcode;
1474         # even though item is not on loan, it may still be transferred;  therefore, get current branch info
1475         $doreturn = 0;
1476         # No issue, no borrowernumber.  ONLY if $doreturn, *might* you have a $borrower later.
1477     }
1478
1479     my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1480         # full item data, but no borrowernumber or checkout info (no issue)
1481         # we know GetItem should work because GetItemnumberFromBarcode worked
1482     my $hbr      = C4::Context->preference("HomeOrHoldingBranchReturn") || "homebranch";
1483     $hbr = $item->{$hbr} || '';
1484         # item must be from items table -- issues table has branchcode and issuingbranch, not homebranch nor holdingbranch
1485
1486     my $borrowernumber = $borrower->{'borrowernumber'} || undef;    # we don't know if we had a borrower or not
1487
1488     # check if the book is in a permanent collection....
1489     # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
1490     if ( $hbr ) {
1491         my $branches = GetBranches();    # a potentially expensive call for a non-feature.
1492         $branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr;
1493     }
1494
1495     # if indy branches and returning to different branch, refuse the return
1496     if ($hbr ne $branch && C4::Context->preference("IndependantBranches")){
1497         $messages->{'Wrongbranch'} = {
1498             Wrongbranch => $branch,
1499             Rightbranch => $hbr,
1500         };
1501         $doreturn = 0;
1502         # bailing out here - in this case, current desired behavior
1503         # is to act as if no return ever happened at all.
1504         # FIXME - even in an indy branches situation, there should
1505         # still be an option for the library to accept the item
1506         # and transfer it to its owning library.
1507         return ( $doreturn, $messages, $issue, $borrower );
1508     }
1509
1510     if ( $item->{'wthdrawn'} ) { # book has been cancelled
1511         $messages->{'wthdrawn'} = 1;
1512         $doreturn = 0;
1513     }
1514
1515     # case of a return of document (deal with issues and holdingbranch)
1516     if ($doreturn) {
1517         $borrower or warn "AddReturn without current borrower";
1518                 my $circControlBranch;
1519         if ($dropbox) {
1520             # define circControlBranch only if dropbox mode is set
1521             # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1522             # FIXME: check issuedate > returndate, factoring in holidays
1523             $circControlBranch = _GetCircControlBranch($item,$borrower) unless ( $item->{'issuedate'} eq C4::Dates->today('iso') );;
1524         }
1525
1526         if ($borrowernumber) {
1527             MarkIssueReturned($borrowernumber, $item->{'itemnumber'}, $circControlBranch, '', $borrower->{'privacy'});
1528             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?  This could be the borrower hash.
1529         }
1530
1531         ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1532     }
1533
1534     # the holdingbranch is updated if the document is returned to another location.
1535     # this is always done regardless of whether the item was on loan or not
1536     if ($item->{'holdingbranch'} ne $branch) {
1537         UpdateHoldingbranch($branch, $item->{'itemnumber'});
1538         $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1539     }
1540     ModDateLastSeen( $item->{'itemnumber'} );
1541
1542     # check if we have a transfer for this document
1543     my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1544
1545     # if we have a transfer to do, we update the line of transfers with the datearrived
1546     if ($datesent) {
1547         if ( $tobranch eq $branch ) {
1548             my $sth = C4::Context->dbh->prepare(
1549                 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1550             );
1551             $sth->execute( $item->{'itemnumber'} );
1552             # if we have a reservation with valid transfer, we can set it's status to 'W'
1553             C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1554         } else {
1555             $messages->{'WrongTransfer'}     = $tobranch;
1556             $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1557         }
1558         $validTransfert = 1;
1559     }
1560
1561     # fix up the accounts.....
1562     if ($item->{'itemlost'}) {
1563         _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode);    # can tolerate undef $borrowernumber
1564         $messages->{'WasLost'} = 1;
1565     }
1566
1567     # fix up the overdues in accounts...
1568     if ($borrowernumber) {
1569         my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1570         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!";  # zero is OK, check defined
1571     }
1572
1573     # find reserves.....
1574     # if we don't have a reserve with the status W, we launch the Checkreserves routine
1575     my ($resfound, $resrec) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1576     if ($resfound) {
1577           $resrec->{'ResFound'} = $resfound;
1578         $messages->{'ResFound'} = $resrec;
1579     }
1580
1581     # update stats?
1582     # Record the fact that this book was returned.
1583     UpdateStats(
1584         $branch, 'return', '0', '',
1585         $item->{'itemnumber'},
1586         $biblio->{'itemtype'},
1587         $borrowernumber
1588     );
1589
1590     # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
1591     my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1592     my %conditions = (
1593         branchcode   => $branch,
1594         categorycode => $borrower->{categorycode},
1595         item_type    => $item->{itype},
1596         notification => 'CHECKIN',
1597     );
1598     if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
1599         SendCirculationAlert({
1600             type     => 'CHECKIN',
1601             item     => $item,
1602             borrower => $borrower,
1603             branch   => $branch,
1604         });
1605     }
1606
1607     logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'})
1608         if C4::Context->preference("ReturnLog");
1609
1610     # FIXME: make this comment intelligible.
1611     #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1612     #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1613
1614     if ($doreturn and ($branch ne $hbr) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) ){
1615         if ( C4::Context->preference("AutomaticItemReturn"    ) or
1616             (C4::Context->preference("UseBranchTransferLimits") and
1617              ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} )
1618            )) {
1619             $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
1620             $debug and warn "item: " . Dumper($item);
1621             ModItemTransfer($item->{'itemnumber'}, $branch, $hbr);
1622             $messages->{'WasTransfered'} = 1;
1623         } else {
1624             $messages->{'NeedsTransfer'} = 1;   # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
1625         }
1626     }
1627     return ( $doreturn, $messages, $issue, $borrower );
1628 }
1629
1630 =head2 MarkIssueReturned
1631
1632   MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
1633
1634 Unconditionally marks an issue as being returned by
1635 moving the C<issues> row to C<old_issues> and
1636 setting C<returndate> to the current date, or
1637 the last non-holiday date of the branccode specified in
1638 C<dropbox_branch> .  Assumes you've already checked that
1639 it's safe to do this, i.e. last non-holiday > issuedate.
1640
1641 if C<$returndate> is specified (in iso format), it is used as the date
1642 of the return. It is ignored when a dropbox_branch is passed in.
1643
1644 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
1645 the old_issue is immediately anonymised
1646
1647 Ideally, this function would be internal to C<C4::Circulation>,
1648 not exported, but it is currently needed by one
1649 routine in C<C4::Accounts>.
1650
1651 =cut
1652
1653 sub MarkIssueReturned {
1654     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
1655     my $dbh   = C4::Context->dbh;
1656     my $query = "UPDATE issues SET returndate=";
1657     my @bind;
1658     if ($dropbox_branch) {
1659         my $calendar = C4::Calendar->new( branchcode => $dropbox_branch );
1660         my $dropboxdate = $calendar->addDate( C4::Dates->new(), -1 );
1661         $query .= " ? ";
1662         push @bind, $dropboxdate->output('iso');
1663     } elsif ($returndate) {
1664         $query .= " ? ";
1665         push @bind, $returndate;
1666     } else {
1667         $query .= " now() ";
1668     }
1669     $query .= " WHERE  borrowernumber = ?  AND itemnumber = ?";
1670     push @bind, $borrowernumber, $itemnumber;
1671     # FIXME transaction
1672     my $sth_upd  = $dbh->prepare($query);
1673     $sth_upd->execute(@bind);
1674     my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1675                                   WHERE borrowernumber = ?
1676                                   AND itemnumber = ?");
1677     $sth_copy->execute($borrowernumber, $itemnumber);
1678     # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
1679     if ( $privacy == 2) {
1680         # The default of 0 does not work due to foreign key constraints
1681         # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
1682         my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
1683         my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
1684                                   WHERE borrowernumber = ?
1685                                   AND itemnumber = ?");
1686        $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
1687     }
1688     my $sth_del  = $dbh->prepare("DELETE FROM issues
1689                                   WHERE borrowernumber = ?
1690                                   AND itemnumber = ?");
1691     $sth_del->execute($borrowernumber, $itemnumber);
1692 }
1693
1694 =head2 _FixOverduesOnReturn
1695
1696    &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1697
1698 C<$brn> borrowernumber
1699
1700 C<$itm> itemnumber
1701
1702 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1703 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1704
1705 Internal function, called only by AddReturn
1706
1707 =cut
1708
1709 sub _FixOverduesOnReturn {
1710     my ($borrowernumber, $item);
1711     unless ($borrowernumber = shift) {
1712         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
1713         return;
1714     }
1715     unless ($item = shift) {
1716         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
1717         return;
1718     }
1719     my ($exemptfine, $dropbox) = @_;
1720     my $dbh = C4::Context->dbh;
1721
1722     # check for overdue fine
1723     my $sth = $dbh->prepare(
1724 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1725     );
1726     $sth->execute( $borrowernumber, $item );
1727
1728     # alter fine to show that the book has been returned
1729     my $data = $sth->fetchrow_hashref;
1730     return 0 unless $data;    # no warning, there's just nothing to fix
1731
1732     my $uquery;
1733     my @bind = ($borrowernumber, $item, $data->{'accountno'});
1734     if ($exemptfine) {
1735         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1736         if (C4::Context->preference("FinesLog")) {
1737             &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1738         }
1739     } elsif ($dropbox && $data->{lastincrement}) {
1740         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1741         my $amt = $data->{amount} - $data->{lastincrement} ;
1742         if (C4::Context->preference("FinesLog")) {
1743             &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1744         }
1745          $uquery = "update accountlines set accounttype='F' ";
1746          if($outstanding  >= 0 && $amt >=0) {
1747             $uquery .= ", amount = ? , amountoutstanding=? ";
1748             unshift @bind, ($amt, $outstanding) ;
1749         }
1750     } else {
1751         $uquery = "update accountlines set accounttype='F' ";
1752     }
1753     $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1754     my $usth = $dbh->prepare($uquery);
1755     return $usth->execute(@bind);
1756 }
1757
1758 =head2 _FixAccountForLostAndReturned
1759
1760   &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
1761
1762 Calculates the charge for a book lost and returned.
1763
1764 Internal function, not exported, called only by AddReturn.
1765
1766 FIXME: This function reflects how inscrutable fines logic is.  Fix both.
1767 FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.
1768
1769 =cut
1770
1771 sub _FixAccountForLostAndReturned {
1772     my $itemnumber     = shift or return;
1773     my $borrowernumber = @_ ? shift : undef;
1774     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
1775     my $dbh = C4::Context->dbh;
1776     # check for charge made for lost book
1777     my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1778     $sth->execute($itemnumber);
1779     my $data = $sth->fetchrow_hashref;
1780     $data or return;    # bail if there is nothing to do
1781
1782     # writeoff this amount
1783     my $offset;
1784     my $amount = $data->{'amount'};
1785     my $acctno = $data->{'accountno'};
1786     my $amountleft;                                             # Starts off undef/zero.
1787     if ($data->{'amountoutstanding'} == $amount) {
1788         $offset     = $data->{'amount'};
1789         $amountleft = 0;                                        # Hey, it's zero here, too.
1790     } else {
1791         $offset     = $amount - $data->{'amountoutstanding'};   # Um, isn't this the same as ZERO?  We just tested those two things are ==
1792         $amountleft = $data->{'amountoutstanding'} - $amount;   # Um, isn't this the same as ZERO?  We just tested those two things are ==
1793     }
1794     my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1795         WHERE (borrowernumber = ?)
1796         AND (itemnumber = ?) AND (accountno = ?) ");
1797     $usth->execute($data->{'borrowernumber'},$itemnumber,$acctno);      # We might be adjusting an account for some OTHER borrowernumber now.  Not the one we passed in.
1798     #check if any credit is left if so writeoff other accounts
1799     my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1800     $amountleft *= -1 if ($amountleft < 0);
1801     if ($amountleft > 0) {
1802         my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1803                             AND (amountoutstanding >0) ORDER BY date");     # might want to order by amountoustanding ASC (pay smallest first)
1804         $msth->execute($data->{'borrowernumber'});
1805         # offset transactions
1806         my $newamtos;
1807         my $accdata;
1808         while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1809             if ($accdata->{'amountoutstanding'} < $amountleft) {
1810                 $newamtos = 0;
1811                 $amountleft -= $accdata->{'amountoutstanding'};
1812             }  else {
1813                 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1814                 $amountleft = 0;
1815             }
1816             my $thisacct = $accdata->{'accountno'};
1817             # FIXME: move prepares outside while loop!
1818             my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1819                     WHERE (borrowernumber = ?)
1820                     AND (accountno=?)");
1821             $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');    # FIXME: '$thisacct' is a string literal!
1822             $usth = $dbh->prepare("INSERT INTO accountoffsets
1823                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1824                 VALUES
1825                 (?,?,?,?)");
1826             $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1827         }
1828         $msth->finish;  # $msth might actually have data left
1829     }
1830     $amountleft *= -1 if ($amountleft > 0);
1831     my $desc = "Item Returned " . $item_id;
1832     $usth = $dbh->prepare("INSERT INTO accountlines
1833         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1834         VALUES (?,?,now(),?,?,'CR',?)");
1835     $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1836     if ($borrowernumber) {
1837         # FIXME: same as query above.  use 1 sth for both
1838         $usth = $dbh->prepare("INSERT INTO accountoffsets
1839             (borrowernumber, accountno, offsetaccount,  offsetamount)
1840             VALUES (?,?,?,?)");
1841         $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
1842     }
1843     ModItem({ paidfor => '' }, undef, $itemnumber);
1844     return;
1845 }
1846
1847 =head2 _GetCircControlBranch
1848
1849    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
1850
1851 Internal function :
1852
1853 Return the library code to be used to determine which circulation
1854 policy applies to a transaction.  Looks up the CircControl and
1855 HomeOrHoldingBranch system preferences.
1856
1857 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
1858
1859 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
1860
1861 =cut
1862
1863 sub _GetCircControlBranch {
1864     my ($item, $borrower) = @_;
1865     my $circcontrol = C4::Context->preference('CircControl');
1866     my $branch;
1867
1868     if ($circcontrol eq 'PickupLibrary') {
1869         $branch= C4::Context->userenv->{'branch'};
1870     } elsif ($circcontrol eq 'PatronLibrary') {
1871         $branch=$borrower->{branchcode};
1872     } else {
1873         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
1874         $branch = $item->{$branchfield};
1875         # default to item home branch if holdingbranch is used
1876         # and is not defined
1877         if (!defined($branch) && $branchfield eq 'holdingbranch') {
1878             $branch = $item->{homebranch};
1879         }
1880     }
1881     return $branch;
1882 }
1883
1884
1885
1886
1887
1888
1889 =head2 GetItemIssue
1890
1891   $issue = &GetItemIssue($itemnumber);
1892
1893 Returns patron currently having a book, or undef if not checked out.
1894
1895 C<$itemnumber> is the itemnumber.
1896
1897 C<$issue> is a hashref of the row from the issues table.
1898
1899 =cut
1900
1901 sub GetItemIssue {
1902     my ($itemnumber) = @_;
1903     return unless $itemnumber;
1904     my $sth = C4::Context->dbh->prepare(
1905         "SELECT *
1906         FROM issues
1907         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1908         WHERE issues.itemnumber=?");
1909     $sth->execute($itemnumber);
1910     my $data = $sth->fetchrow_hashref;
1911     return unless $data;
1912     $data->{'overdue'} = ($data->{'date_due'} lt C4::Dates->today('iso')) ? 1 : 0;
1913     return ($data);
1914 }
1915
1916 =head2 GetOpenIssue
1917
1918   $issue = GetOpenIssue( $itemnumber );
1919
1920 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
1921
1922 C<$itemnumber> is the item's itemnumber
1923
1924 Returns a hashref
1925
1926 =cut
1927
1928 sub GetOpenIssue {
1929   my ( $itemnumber ) = @_;
1930
1931   my $dbh = C4::Context->dbh;
1932   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
1933   $sth->execute( $itemnumber );
1934   my $issue = $sth->fetchrow_hashref();
1935   return $issue;
1936 }
1937
1938 =head2 GetItemIssues
1939
1940   $issues = &GetItemIssues($itemnumber, $history);
1941
1942 Returns patrons that have issued a book
1943
1944 C<$itemnumber> is the itemnumber
1945 C<$history> is false if you just want the current "issuer" (if any)
1946 and true if you want issues history from old_issues also.
1947
1948 Returns reference to an array of hashes
1949
1950 =cut
1951
1952 sub GetItemIssues {
1953     my ( $itemnumber, $history ) = @_;
1954
1955     my $today = C4::Dates->today('iso');  # get today date
1956     my $sql = "SELECT * FROM issues
1957               JOIN borrowers USING (borrowernumber)
1958               JOIN items     USING (itemnumber)
1959               WHERE issues.itemnumber = ? ";
1960     if ($history) {
1961         $sql .= "UNION ALL
1962                  SELECT * FROM old_issues
1963                  LEFT JOIN borrowers USING (borrowernumber)
1964                  JOIN items USING (itemnumber)
1965                  WHERE old_issues.itemnumber = ? ";
1966     }
1967     $sql .= "ORDER BY date_due DESC";
1968     my $sth = C4::Context->dbh->prepare($sql);
1969     if ($history) {
1970         $sth->execute($itemnumber, $itemnumber);
1971     } else {
1972         $sth->execute($itemnumber);
1973     }
1974     my $results = $sth->fetchall_arrayref({});
1975     foreach (@$results) {
1976         $_->{'overdue'} = ($_->{'date_due'} lt $today) ? 1 : 0;
1977     }
1978     return $results;
1979 }
1980
1981 =head2 GetBiblioIssues
1982
1983   $issues = GetBiblioIssues($biblionumber);
1984
1985 this function get all issues from a biblionumber.
1986
1987 Return:
1988 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1989 tables issues and the firstname,surname & cardnumber from borrowers.
1990
1991 =cut
1992
1993 sub GetBiblioIssues {
1994     my $biblionumber = shift;
1995     return undef unless $biblionumber;
1996     my $dbh   = C4::Context->dbh;
1997     my $query = "
1998         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1999         FROM issues
2000             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2001             LEFT JOIN items ON issues.itemnumber = items.itemnumber
2002             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2003             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2004         WHERE biblio.biblionumber = ?
2005         UNION ALL
2006         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2007         FROM old_issues
2008             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2009             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2010             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2011             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2012         WHERE biblio.biblionumber = ?
2013         ORDER BY timestamp
2014     ";
2015     my $sth = $dbh->prepare($query);
2016     $sth->execute($biblionumber, $biblionumber);
2017
2018     my @issues;
2019     while ( my $data = $sth->fetchrow_hashref ) {
2020         push @issues, $data;
2021     }
2022     return \@issues;
2023 }
2024
2025 =head2 GetUpcomingDueIssues
2026
2027   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2028
2029 =cut
2030
2031 sub GetUpcomingDueIssues {
2032     my $params = shift;
2033
2034     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2035     my $dbh = C4::Context->dbh;
2036
2037     my $statement = <<END_SQL;
2038 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due
2039 FROM issues
2040 LEFT JOIN items USING (itemnumber)
2041 WhERE returndate is NULL
2042 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
2043 END_SQL
2044
2045     my @bind_parameters = ( $params->{'days_in_advance'} );
2046
2047     my $sth = $dbh->prepare( $statement );
2048     $sth->execute( @bind_parameters );
2049     my $upcoming_dues = $sth->fetchall_arrayref({});
2050     $sth->finish;
2051
2052     return $upcoming_dues;
2053 }
2054
2055 =head2 CanBookBeRenewed
2056
2057   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2058
2059 Find out whether a borrowed item may be renewed.
2060
2061 C<$dbh> is a DBI handle to the Koha database.
2062
2063 C<$borrowernumber> is the borrower number of the patron who currently
2064 has the item on loan.
2065
2066 C<$itemnumber> is the number of the item to renew.
2067
2068 C<$override_limit>, if supplied with a true value, causes
2069 the limit on the number of times that the loan can be renewed
2070 (as controlled by the item type) to be ignored.
2071
2072 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
2073 item must currently be on loan to the specified borrower; renewals
2074 must be allowed for the item's type; and the borrower must not have
2075 already renewed the loan. $error will contain the reason the renewal can not proceed
2076
2077 =cut
2078
2079 sub CanBookBeRenewed {
2080
2081     # check renewal status
2082     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2083     my $dbh       = C4::Context->dbh;
2084     my $renews    = 1;
2085     my $renewokay = 0;
2086         my $error;
2087
2088     # Look in the issues table for this item, lent to this borrower,
2089     # and not yet returned.
2090
2091     # Look in the issues table for this item, lent to this borrower,
2092     # and not yet returned.
2093     my %branch = (
2094             'ItemHomeLibrary' => 'items.homebranch',
2095             'PickupLibrary'   => 'items.holdingbranch',
2096             'PatronLibrary'   => 'borrowers.branchcode'
2097             );
2098     my $controlbranch = $branch{C4::Context->preference('CircControl')};
2099     my $itype         = C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype';
2100
2101     my $sthcount = $dbh->prepare("
2102                    SELECT
2103                     borrowers.categorycode, biblioitems.itemtype, issues.renewals, renewalsallowed, $controlbranch
2104                    FROM  issuingrules,
2105                    issues
2106                    LEFT JOIN items USING (itemnumber)
2107                    LEFT JOIN borrowers USING (borrowernumber)
2108                    LEFT JOIN biblioitems USING (biblioitemnumber)
2109
2110                    WHERE
2111                     (issuingrules.categorycode = borrowers.categorycode OR issuingrules.categorycode = '*')
2112                    AND
2113                     (issuingrules.itemtype = $itype OR issuingrules.itemtype = '*')
2114                    AND
2115                     (issuingrules.branchcode = $controlbranch OR issuingrules.branchcode = '*')
2116                    AND
2117                     borrowernumber = ?
2118                    AND
2119                     itemnumber = ?
2120                    ORDER BY
2121                     issuingrules.categorycode desc,
2122                     issuingrules.itemtype desc,
2123                     issuingrules.branchcode desc
2124                    LIMIT 1;
2125                   ");
2126
2127     $sthcount->execute( $borrowernumber, $itemnumber );
2128     if ( my $data1 = $sthcount->fetchrow_hashref ) {
2129
2130         if ( ( $data1->{renewalsallowed} && $data1->{renewalsallowed} > $data1->{renewals} ) || $override_limit ) {
2131             $renewokay = 1;
2132         }
2133         else {
2134                         $error="too_many";
2135                 }
2136
2137         my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
2138         if ($resfound) {
2139             $renewokay = 0;
2140                         $error="on_reserve"
2141         }
2142
2143     }
2144     return ($renewokay,$error);
2145 }
2146
2147 =head2 AddRenewal
2148
2149   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2150
2151 Renews a loan.
2152
2153 C<$borrowernumber> is the borrower number of the patron who currently
2154 has the item.
2155
2156 C<$itemnumber> is the number of the item to renew.
2157
2158 C<$branch> is the library where the renewal took place (if any).
2159            The library that controls the circ policies for the renewal is retrieved from the issues record.
2160
2161 C<$datedue> can be a C4::Dates object used to set the due date.
2162
2163 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2164 this parameter is not supplied, lastreneweddate is set to the current date.
2165
2166 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2167 from the book's item type.
2168
2169 =cut
2170
2171 sub AddRenewal {
2172     my $borrowernumber  = shift or return undef;
2173     my $itemnumber      = shift or return undef;
2174     my $branch          = shift;
2175     my $datedue         = shift;
2176     my $lastreneweddate = shift || C4::Dates->new()->output('iso');
2177     my $item   = GetItem($itemnumber) or return undef;
2178     my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
2179
2180     my $dbh = C4::Context->dbh;
2181     # Find the issues record for this book
2182     my $sth =
2183       $dbh->prepare("SELECT * FROM issues
2184                         WHERE borrowernumber=?
2185                         AND itemnumber=?"
2186       );
2187     $sth->execute( $borrowernumber, $itemnumber );
2188     my $issuedata = $sth->fetchrow_hashref;
2189     $sth->finish;
2190     if($datedue && ! $datedue->output('iso')){
2191         warn "Invalid date passed to AddRenewal.";
2192         return undef;
2193     }
2194     # If the due date wasn't specified, calculate it by adding the
2195     # book's loan length to today's date or the current due date
2196     # based on the value of the RenewalPeriodBase syspref.
2197     unless ($datedue) {
2198
2199         my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
2200         my $loanlength = GetLoanLength(
2201                     $borrower->{'categorycode'},
2202                     (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
2203                                 $issuedata->{'branchcode'}  );   # that's the circ control branch.
2204
2205         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2206                                         C4::Dates->new($issuedata->{date_due}, 'iso') :
2207                                         C4::Dates->new();
2208         $datedue =  CalcDateDue($datedue,$loanlength,$issuedata->{'branchcode'},$borrower);
2209     }
2210
2211     # Update the issues record to have the new due date, and a new count
2212     # of how many times it has been renewed.
2213     my $renews = $issuedata->{'renewals'} + 1;
2214     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2215                             WHERE borrowernumber=?
2216                             AND itemnumber=?"
2217     );
2218     $sth->execute( $datedue->output('iso'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2219     $sth->finish;
2220
2221     # Update the renewal count on the item, and tell zebra to reindex
2222     $renews = $biblio->{'renewals'} + 1;
2223     ModItem({ renewals => $renews, onloan => $datedue->output('iso') }, $biblio->{'biblionumber'}, $itemnumber);
2224
2225     # Charge a new rental fee, if applicable?
2226     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2227     if ( $charge > 0 ) {
2228         my $accountno = getnextacctno( $borrowernumber );
2229         my $item = GetBiblioFromItemNumber($itemnumber);
2230         $sth = $dbh->prepare(
2231                 "INSERT INTO accountlines
2232                     (date,
2233                                         borrowernumber, accountno, amount,
2234                     description,
2235                                         accounttype, amountoutstanding, itemnumber
2236                                         )
2237                     VALUES (now(),?,?,?,?,?,?,?)"
2238         );
2239         $sth->execute( $borrowernumber, $accountno, $charge,
2240             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2241             'Rent', $charge, $itemnumber );
2242         $sth->finish;
2243     }
2244     # Log the renewal
2245     UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2246         return $datedue;
2247 }
2248
2249 sub GetRenewCount {
2250     # check renewal status
2251     my ( $bornum, $itemno ) = @_;
2252     my $dbh           = C4::Context->dbh;
2253     my $renewcount    = 0;
2254     my $renewsallowed = 0;
2255     my $renewsleft    = 0;
2256
2257     my $borrower = C4::Members::GetMemberDetails($bornum);
2258     my $item     = GetItem($itemno);
2259
2260     # Look in the issues table for this item, lent to this borrower,
2261     # and not yet returned.
2262
2263     # FIXME - I think this function could be redone to use only one SQL call.
2264     my $sth = $dbh->prepare(
2265         "select * from issues
2266                                 where (borrowernumber = ?)
2267                                 and (itemnumber = ?)"
2268     );
2269     $sth->execute( $bornum, $itemno );
2270     my $data = $sth->fetchrow_hashref;
2271     $renewcount = $data->{'renewals'} if $data->{'renewals'};
2272     $sth->finish;
2273     # $item and $borrower should be calculated
2274     my $branchcode = _GetCircControlBranch($item, $borrower);
2275
2276     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2277
2278     $renewsallowed = $issuingrule->{'renewalsallowed'};
2279     $renewsleft    = $renewsallowed - $renewcount;
2280     if($renewsleft < 0){ $renewsleft = 0; }
2281     return ( $renewcount, $renewsallowed, $renewsleft );
2282 }
2283
2284 =head2 GetIssuingCharges
2285
2286   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2287
2288 Calculate how much it would cost for a given patron to borrow a given
2289 item, including any applicable discounts.
2290
2291 C<$itemnumber> is the item number of item the patron wishes to borrow.
2292
2293 C<$borrowernumber> is the patron's borrower number.
2294
2295 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2296 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2297 if it's a video).
2298
2299 =cut
2300
2301 sub GetIssuingCharges {
2302
2303     # calculate charges due
2304     my ( $itemnumber, $borrowernumber ) = @_;
2305     my $charge = 0;
2306     my $dbh    = C4::Context->dbh;
2307     my $item_type;
2308
2309     # Get the book's item type and rental charge (via its biblioitem).
2310     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
2311         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
2312     $charge_query .= (C4::Context->preference('item-level_itypes'))
2313         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
2314         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
2315
2316     $charge_query .= ' WHERE items.itemnumber =?';
2317
2318     my $sth = $dbh->prepare($charge_query);
2319     $sth->execute($itemnumber);
2320     if ( my $item_data = $sth->fetchrow_hashref ) {
2321         $item_type = $item_data->{itemtype};
2322         $charge    = $item_data->{rentalcharge};
2323         my $branch = C4::Branch::mybranch();
2324         my $discount_query = q|SELECT rentaldiscount,
2325             issuingrules.itemtype, issuingrules.branchcode
2326             FROM borrowers
2327             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2328             WHERE borrowers.borrowernumber = ?
2329             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
2330             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
2331         my $discount_sth = $dbh->prepare($discount_query);
2332         $discount_sth->execute( $borrowernumber, $item_type, $branch );
2333         my $discount_rules = $discount_sth->fetchall_arrayref({});
2334         if (@{$discount_rules}) {
2335             # We may have multiple rules so get the most specific
2336             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
2337             $charge = ( $charge * ( 100 - $discount ) ) / 100;
2338         }
2339     }
2340
2341     $sth->finish; # we havent _explicitly_ fetched all rows
2342     return ( $charge, $item_type );
2343 }
2344
2345 # Select most appropriate discount rule from those returned
2346 sub _get_discount_from_rule {
2347     my ($rules_ref, $branch, $itemtype) = @_;
2348     my $discount;
2349
2350     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
2351         $discount = $rules_ref->[0]->{rentaldiscount};
2352         return (defined $discount) ? $discount : 0;
2353     }
2354     # could have up to 4 does one match $branch and $itemtype
2355     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
2356     if (@d) {
2357         $discount = $d[0]->{rentaldiscount};
2358         return (defined $discount) ? $discount : 0;
2359     }
2360     # do we have item type + all branches
2361     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
2362     if (@d) {
2363         $discount = $d[0]->{rentaldiscount};
2364         return (defined $discount) ? $discount : 0;
2365     }
2366     # do we all item types + this branch
2367     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
2368     if (@d) {
2369         $discount = $d[0]->{rentaldiscount};
2370         return (defined $discount) ? $discount : 0;
2371     }
2372     # so all and all (surely we wont get here)
2373     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
2374     if (@d) {
2375         $discount = $d[0]->{rentaldiscount};
2376         return (defined $discount) ? $discount : 0;
2377     }
2378     # none of the above
2379     return 0;
2380 }
2381
2382 =head2 AddIssuingCharge
2383
2384   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2385
2386 =cut
2387
2388 sub AddIssuingCharge {
2389     my ( $itemnumber, $borrowernumber, $charge ) = @_;
2390     my $dbh = C4::Context->dbh;
2391     my $nextaccntno = getnextacctno( $borrowernumber );
2392     my $query ="
2393         INSERT INTO accountlines
2394             (borrowernumber, itemnumber, accountno,
2395             date, amount, description, accounttype,
2396             amountoutstanding)
2397         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2398     ";
2399     my $sth = $dbh->prepare($query);
2400     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2401     $sth->finish;
2402 }
2403
2404 =head2 GetTransfers
2405
2406   GetTransfers($itemnumber);
2407
2408 =cut
2409
2410 sub GetTransfers {
2411     my ($itemnumber) = @_;
2412
2413     my $dbh = C4::Context->dbh;
2414
2415     my $query = '
2416         SELECT datesent,
2417                frombranch,
2418                tobranch
2419         FROM branchtransfers
2420         WHERE itemnumber = ?
2421           AND datearrived IS NULL
2422         ';
2423     my $sth = $dbh->prepare($query);
2424     $sth->execute($itemnumber);
2425     my @row = $sth->fetchrow_array();
2426     $sth->finish;
2427     return @row;
2428 }
2429
2430 =head2 GetTransfersFromTo
2431
2432   @results = GetTransfersFromTo($frombranch,$tobranch);
2433
2434 Returns the list of pending transfers between $from and $to branch
2435
2436 =cut
2437
2438 sub GetTransfersFromTo {
2439     my ( $frombranch, $tobranch ) = @_;
2440     return unless ( $frombranch && $tobranch );
2441     my $dbh   = C4::Context->dbh;
2442     my $query = "
2443         SELECT itemnumber,datesent,frombranch
2444         FROM   branchtransfers
2445         WHERE  frombranch=?
2446           AND  tobranch=?
2447           AND datearrived IS NULL
2448     ";
2449     my $sth = $dbh->prepare($query);
2450     $sth->execute( $frombranch, $tobranch );
2451     my @gettransfers;
2452
2453     while ( my $data = $sth->fetchrow_hashref ) {
2454         push @gettransfers, $data;
2455     }
2456     $sth->finish;
2457     return (@gettransfers);
2458 }
2459
2460 =head2 DeleteTransfer
2461
2462   &DeleteTransfer($itemnumber);
2463
2464 =cut
2465
2466 sub DeleteTransfer {
2467     my ($itemnumber) = @_;
2468     my $dbh          = C4::Context->dbh;
2469     my $sth          = $dbh->prepare(
2470         "DELETE FROM branchtransfers
2471          WHERE itemnumber=?
2472          AND datearrived IS NULL "
2473     );
2474     $sth->execute($itemnumber);
2475     $sth->finish;
2476 }
2477
2478 =head2 AnonymiseIssueHistory
2479
2480   $rows = AnonymiseIssueHistory($date,$borrowernumber)
2481
2482 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2483 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2484
2485 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
2486 setting (force delete).
2487
2488 return the number of affected rows.
2489
2490 =cut
2491
2492 sub AnonymiseIssueHistory {
2493     my $date           = shift;
2494     my $borrowernumber = shift;
2495     my $dbh            = C4::Context->dbh;
2496     my $query          = "
2497         UPDATE old_issues
2498         SET    borrowernumber = ?
2499         WHERE  returndate < ?
2500           AND borrowernumber IS NOT NULL
2501     ";
2502
2503     # The default of 0 does not work due to foreign key constraints
2504     # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
2505     my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
2506     my @bind_params = ($anonymouspatron, $date);
2507     if (defined $borrowernumber) {
2508        $query .= " AND borrowernumber = ?";
2509        push @bind_params, $borrowernumber;
2510     } else {
2511        $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
2512     }
2513     my $sth = $dbh->prepare($query);
2514     $sth->execute(@bind_params);
2515     my $rows_affected = $sth->rows;  ### doublecheck row count return function
2516     return $rows_affected;
2517 }
2518
2519 =head2 SendCirculationAlert
2520
2521 Send out a C<check-in> or C<checkout> alert using the messaging system.
2522
2523 B<Parameters>:
2524
2525 =over 4
2526
2527 =item type
2528
2529 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
2530
2531 =item item
2532
2533 Hashref of information about the item being checked in or out.
2534
2535 =item borrower
2536
2537 Hashref of information about the borrower of the item.
2538
2539 =item branch
2540
2541 The branchcode from where the checkout or check-in took place.
2542
2543 =back
2544
2545 B<Example>:
2546
2547     SendCirculationAlert({
2548         type     => 'CHECKOUT',
2549         item     => $item,
2550         borrower => $borrower,
2551         branch   => $branch,
2552     });
2553
2554 =cut
2555
2556 sub SendCirculationAlert {
2557     my ($opts) = @_;
2558     my ($type, $item, $borrower, $branch) =
2559         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
2560     my %message_name = (
2561         CHECKIN  => 'Item Check-in',
2562         CHECKOUT => 'Item Checkout',
2563     );
2564     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
2565         borrowernumber => $borrower->{borrowernumber},
2566         message_name   => $message_name{$type},
2567     });
2568     my $letter = C4::Letters::getletter('circulation', $type);
2569     C4::Letters::parseletter($letter, 'biblio',      $item->{biblionumber});
2570     C4::Letters::parseletter($letter, 'biblioitems', $item->{biblionumber});
2571     C4::Letters::parseletter($letter, 'borrowers',   $borrower->{borrowernumber});
2572     C4::Letters::parseletter($letter, 'branches',    $branch);
2573     my @transports = @{ $borrower_preferences->{transports} };
2574     # warn "no transports" unless @transports;
2575     for (@transports) {
2576         # warn "transport: $_";
2577         my $message = C4::Message->find_last_message($borrower, $type, $_);
2578         if (!$message) {
2579             #warn "create new message";
2580             C4::Message->enqueue($letter, $borrower, $_);
2581         } else {
2582             #warn "append to old message";
2583             $message->append($letter);
2584             $message->update;
2585         }
2586     }
2587     $letter;
2588 }
2589
2590 =head2 updateWrongTransfer
2591
2592   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2593
2594 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
2595
2596 =cut
2597
2598 sub updateWrongTransfer {
2599         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2600         my $dbh = C4::Context->dbh;
2601 # first step validate the actual line of transfert .
2602         my $sth =
2603                 $dbh->prepare(
2604                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2605                 );
2606                 $sth->execute($FromLibrary,$itemNumber);
2607                 $sth->finish;
2608
2609 # second step create a new line of branchtransfer to the right location .
2610         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2611
2612 #third step changing holdingbranch of item
2613         UpdateHoldingbranch($FromLibrary,$itemNumber);
2614 }
2615
2616 =head2 UpdateHoldingbranch
2617
2618   $items = UpdateHoldingbranch($branch,$itmenumber);
2619
2620 Simple methode for updating hodlingbranch in items BDD line
2621
2622 =cut
2623
2624 sub UpdateHoldingbranch {
2625         my ( $branch,$itemnumber ) = @_;
2626     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2627 }
2628
2629 =head2 CalcDateDue
2630
2631 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2632 this function calculates the due date given the loan length ,
2633 checking against the holidays calendar as per the 'useDaysMode' syspref.
2634 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2635 C<$branch>  = location whose calendar to use
2636 C<$loanlength>  = loan length prior to adjustment
2637 =cut
2638
2639 sub CalcDateDue {
2640         my ($startdate,$loanlength,$branch,$borrower) = @_;
2641         my $datedue;
2642
2643         if(C4::Context->preference('useDaysMode') eq 'Days') {  # ignoring calendar
2644                 my $timedue = time + ($loanlength) * 86400;
2645         #FIXME - assumes now even though we take a startdate
2646                 my @datearr  = localtime($timedue);
2647                 $datedue = C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2648         } else {
2649                 my $calendar = C4::Calendar->new(  branchcode => $branch );
2650                 $datedue = $calendar->addDate($startdate, $loanlength);
2651         }
2652
2653         # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
2654         if ( C4::Context->preference('ReturnBeforeExpiry') && $datedue->output('iso') gt $borrower->{dateexpiry} ) {
2655             $datedue = C4::Dates->new( $borrower->{dateexpiry}, 'iso' );
2656         }
2657
2658         # if ceilingDueDate ON the datedue can't be after the ceiling date
2659         if ( C4::Context->preference('ceilingDueDate')
2660              && ( C4::Context->preference('ceilingDueDate') =~ C4::Dates->regexp('syspref') ) ) {
2661             my $ceilingDate = C4::Dates->new( C4::Context->preference('ceilingDueDate') );
2662             if ( $datedue->output( 'iso' ) gt $ceilingDate->output( 'iso' ) ) {
2663                 $datedue = $ceilingDate;
2664             }
2665         }
2666
2667         return $datedue;
2668 }
2669
2670 =head2 CheckValidDatedue
2671
2672   $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2673
2674 This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2675 To be replaced by CalcDateDue() once C4::Calendar use is tested.
2676
2677 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2678 C<$date_due>   = returndate calculate with no day check
2679 C<$itemnumber>  = itemnumber
2680 C<$branchcode>  = location of issue (affected by 'CircControl' syspref)
2681 C<$loanlength>  = loan length prior to adjustment
2682
2683 =cut
2684
2685 sub CheckValidDatedue {
2686 my ($date_due,$itemnumber,$branchcode)=@_;
2687 my @datedue=split('-',$date_due->output('iso'));
2688 my $years=$datedue[0];
2689 my $month=$datedue[1];
2690 my $day=$datedue[2];
2691 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2692 my $dow;
2693 for (my $i=0;$i<2;$i++){
2694     $dow=Day_of_Week($years,$month,$day);
2695     ($dow=0) if ($dow>6);
2696     my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2697     my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2698     my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2699         if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2700         $i=0;
2701         (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2702         }
2703     }
2704     my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2705 return $newdatedue;
2706 }
2707
2708
2709 =head2 CheckRepeatableHolidays
2710
2711   $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2712
2713 This function checks if the date due is a repeatable holiday
2714
2715 C<$date_due>   = returndate calculate with no day check
2716 C<$itemnumber>  = itemnumber
2717 C<$branchcode>  = localisation of issue
2718
2719 =cut
2720
2721 sub CheckRepeatableHolidays{
2722 my($itemnumber,$week_day,$branchcode)=@_;
2723 my $dbh = C4::Context->dbh;
2724 my $query = qq|SELECT count(*)
2725         FROM repeatable_holidays
2726         WHERE branchcode=?
2727         AND weekday=?|;
2728 my $sth = $dbh->prepare($query);
2729 $sth->execute($branchcode,$week_day);
2730 my $result=$sth->fetchrow;
2731 $sth->finish;
2732 return $result;
2733 }
2734
2735
2736 =head2 CheckSpecialHolidays
2737
2738   $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2739
2740 This function check if the date is a special holiday
2741
2742 C<$years>   = the years of datedue
2743 C<$month>   = the month of datedue
2744 C<$day>     = the day of datedue
2745 C<$itemnumber>  = itemnumber
2746 C<$branchcode>  = localisation of issue
2747
2748 =cut
2749
2750 sub CheckSpecialHolidays{
2751 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2752 my $dbh = C4::Context->dbh;
2753 my $query=qq|SELECT count(*)
2754              FROM `special_holidays`
2755              WHERE year=?
2756              AND month=?
2757              AND day=?
2758              AND branchcode=?
2759             |;
2760 my $sth = $dbh->prepare($query);
2761 $sth->execute($years,$month,$day,$branchcode);
2762 my $countspecial=$sth->fetchrow ;
2763 $sth->finish;
2764 return $countspecial;
2765 }
2766
2767 =head2 CheckRepeatableSpecialHolidays
2768
2769   $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2770
2771 This function check if the date is a repeatble special holidays
2772
2773 C<$month>   = the month of datedue
2774 C<$day>     = the day of datedue
2775 C<$itemnumber>  = itemnumber
2776 C<$branchcode>  = localisation of issue
2777
2778 =cut
2779
2780 sub CheckRepeatableSpecialHolidays{
2781 my ($month,$day,$itemnumber,$branchcode) = @_;
2782 my $dbh = C4::Context->dbh;
2783 my $query=qq|SELECT count(*)
2784              FROM `repeatable_holidays`
2785              WHERE month=?
2786              AND day=?
2787              AND branchcode=?
2788             |;
2789 my $sth = $dbh->prepare($query);
2790 $sth->execute($month,$day,$branchcode);
2791 my $countspecial=$sth->fetchrow ;
2792 $sth->finish;
2793 return $countspecial;
2794 }
2795
2796
2797
2798 sub CheckValidBarcode{
2799 my ($barcode) = @_;
2800 my $dbh = C4::Context->dbh;
2801 my $query=qq|SELECT count(*)
2802              FROM items
2803              WHERE barcode=?
2804             |;
2805 my $sth = $dbh->prepare($query);
2806 $sth->execute($barcode);
2807 my $exist=$sth->fetchrow ;
2808 $sth->finish;
2809 return $exist;
2810 }
2811
2812 =head2 IsBranchTransferAllowed
2813
2814   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
2815
2816 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
2817
2818 =cut
2819
2820 sub IsBranchTransferAllowed {
2821         my ( $toBranch, $fromBranch, $code ) = @_;
2822
2823         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
2824
2825         my $limitType = C4::Context->preference("BranchTransferLimitsType");
2826         my $dbh = C4::Context->dbh;
2827
2828         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
2829         $sth->execute( $toBranch, $fromBranch, $code );
2830         my $limit = $sth->fetchrow_hashref();
2831
2832         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
2833         if ( $limit->{'limitId'} ) {
2834                 return 0;
2835         } else {
2836                 return 1;
2837         }
2838 }
2839
2840 =head2 CreateBranchTransferLimit
2841
2842   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
2843
2844 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
2845
2846 =cut
2847
2848 sub CreateBranchTransferLimit {
2849    my ( $toBranch, $fromBranch, $code ) = @_;
2850
2851    my $limitType = C4::Context->preference("BranchTransferLimitsType");
2852
2853    my $dbh = C4::Context->dbh;
2854
2855    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
2856    $sth->execute( $code, $toBranch, $fromBranch );
2857 }
2858
2859 =head2 DeleteBranchTransferLimits
2860
2861   DeleteBranchTransferLimits();
2862
2863 =cut
2864
2865 sub DeleteBranchTransferLimits {
2866    my $dbh = C4::Context->dbh;
2867    my $sth = $dbh->prepare("TRUNCATE TABLE branch_transfer_limits");
2868    $sth->execute();
2869 }
2870
2871
2872   1;
2873
2874 __END__
2875
2876 =head1 AUTHOR
2877
2878 Koha Development Team <http://koha-community.org/>
2879
2880 =cut
2881