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