C4/Circulation.pm

   1 package C4::Circulation;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20
  21 use strict;
  22 #use warnings;  # soon!
  23 use C4::Context;
  24 use C4::Stats;
  25 use C4::Reserves;
  26 use C4::Koha;
  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 Date::Calc qw(
  34   Today
  35   Today_and_Now
  36   Add_Delta_YM
  37   Add_Delta_DHMS
  38   Date_to_Days
  39   Day_of_Week
  40   Add_Delta_Days
  41 );
  42 use POSIX qw(strftime);
  43 use C4::Branch; # GetBranches
  44 use C4::Log; # logaction
  45
  46 use Data::Dumper;
  47
  48 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  49
  50 BEGIN {
  51         require Exporter;
  52         $VERSION = 3.02;        # for version checking
  53         @ISA    = qw(Exporter);
  54
  55         # FIXME subs that should probably be elsewhere
  56         push @EXPORT, qw(
  57                 &FixOverduesOnReturn
  58                 &barcodedecode
  59         );
  60
  61         # subs to deal with issuing a book
  62         push @EXPORT, qw(
  63                 &CanBookBeIssued
  64                 &CanBookBeRenewed
  65                 &AddIssue
  66                 &AddRenewal
  67                 &GetRenewCount
  68                 &GetItemIssue
  69                 &GetItemIssues
  70                 &GetBorrowerIssues
  71                 &GetIssuingCharges
  72                 &GetIssuingRule
  73         &GetBranchBorrowerCircRule
  74                 &GetBiblioIssues
  75                 &AnonymiseIssueHistory
  76         );
  77
  78         # subs to deal with returns
  79         push @EXPORT, qw(
  80                 &AddReturn
  81         &MarkIssueReturned
  82         );
  83
  84         # subs to deal with transfers
  85         push @EXPORT, qw(
  86                 &transferbook
  87                 &GetTransfers
  88                 &GetTransfersFromTo
  89                 &updateWrongTransfer
  90                 &DeleteTransfer
  91         );
  92 }
  93
  94 =head1 NAME
  95
  96 C4::Circulation - Koha circulation module
  97
  98 =head1 SYNOPSIS
  99
 100 use C4::Circulation;
 101
 102 =head1 DESCRIPTION
 103
 104 The functions in this module deal with circulation, issues, and
 105 returns, as well as general information about the library.
 106 Also deals with stocktaking.
 107
 108 =head1 FUNCTIONS
 109
 110 =head2 barcodedecode
 111
 112 =head3 $str = &barcodedecode($barcode);
 113
 114 =over 4
 115
 116 =item Generic filter function for barcode string.
 117 Called on every circ if the System Pref itemBarcodeInputFilter is set.
 118 Will do some manipulation of the barcode for systems that deliver a barcode
 119 to circulation.pl that differs from the barcode stored for the item.
 120 For proper functioning of this filter, calling the function on the
 121 correct barcode string (items.barcode) should return an unaltered barcode.
 122
 123 =back
 124
 125 =cut
 126
 127 # FIXME -- the &decode fcn below should be wrapped into this one.
 128 # FIXME -- these plugins should be moved out of Circulation.pm
 129 #
 130 sub barcodedecode {
 131     my ($barcode) = @_;
 132     my $filter = C4::Context->preference('itemBarcodeInputFilter');
 133         if($filter eq 'whitespace') {
 134                 $barcode =~ s/\s//g;
 135                 return $barcode;
 136         } elsif($filter eq 'cuecat') {
 137                 chomp($barcode);
 138             my @fields = split( /\./, $barcode );
 139             my @results = map( decode($_), @fields[ 1 .. $#fields ] );
 140             if ( $#results == 2 ) {
 141                 return $results[2];
 142             }
 143             else {
 144                 return $barcode;
 145             }
 146         } elsif($filter eq 'T-prefix') {
 147                 if ( $barcode =~ /^[Tt]/) {
 148                         if (substr($barcode,1,1) eq '0') {
 149                                 return $barcode;
 150                         } else {
 151                                 $barcode = substr($barcode,2) + 0 ;
 152                         }
 153                 }
 154                 return sprintf( "T%07d",$barcode);
 155         }
 156 }
 157
 158 =head2 decode
 159
 160 =head3 $str = &decode($chunk);
 161
 162 =over 4
 163
 164 =item Decodes a segment of a string emitted by a CueCat barcode scanner and
 165 returns it.
 166
 167 =back
 168
 169 =cut
 170
 171 sub decode {
 172     my ($encoded) = @_;
 173     my $seq =
 174       'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
 175     my @s = map { index( $seq, $_ ); } split( //, $encoded );
 176     my $l = ( $#s + 1 ) % 4;
 177     if ($l) {
 178         if ( $l == 1 ) {
 179             warn "Error!";
 180             return;
 181         }
 182         $l = 4 - $l;
 183         $#s += $l;
 184     }
 185     my $r = '';
 186     while ( $#s >= 0 ) {
 187         my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
 188         $r .=
 189             chr( ( $n >> 16 ) ^ 67 )
 190          .chr( ( $n >> 8 & 255 ) ^ 67 )
 191          .chr( ( $n & 255 ) ^ 67 );
 192         @s = @s[ 4 .. $#s ];
 193     }
 194     $r = substr( $r, 0, length($r) - $l );
 195     return $r;
 196 }
 197
 198 =head2 transferbook
 199
 200 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves);
 201
 202 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
 203
 204 C<$newbranch> is the code for the branch to which the item should be transferred.
 205
 206 C<$barcode> is the barcode of the item to be transferred.
 207
 208 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
 209 Otherwise, if an item is reserved, the transfer fails.
 210
 211 Returns three values:
 212
 213 =head3 $dotransfer
 214
 215 is true if the transfer was successful.
 216
 217 =head3 $messages
 218
 219 is a reference-to-hash which may have any of the following keys:
 220
 221 =over 4
 222
 223 =item C<BadBarcode>
 224
 225 There is no item in the catalog with the given barcode. The value is C<$barcode>.
 226
 227 =item C<IsPermanent>
 228
 229 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.
 230
 231 =item C<DestinationEqualsHolding>
 232
 233 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.
 234
 235 =item C<WasReturned>
 236
 237 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.
 238
 239 =item C<ResFound>
 240
 241 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>.
 242
 243 =item C<WasTransferred>
 244
 245 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
 246
 247 =back
 248
 249 =cut
 250
 251 sub transferbook {
 252     my ( $tbr, $barcode, $ignoreRs ) = @_;
 253     my $messages;
 254     my $dotransfer      = 1;
 255     my $branches        = GetBranches();
 256     my $itemnumber = GetItemnumberFromBarcode( $barcode );
 257     my $issue      = GetItemIssue($itemnumber);
 258     my $biblio = GetBiblioFromItemNumber($itemnumber);
 259
 260     # bad barcode..
 261     if ( not $itemnumber ) {
 262         $messages->{'BadBarcode'} = $barcode;
 263         $dotransfer = 0;
 264     }
 265
 266     # get branches of book...
 267     my $hbr = $biblio->{'homebranch'};
 268     my $fbr = $biblio->{'holdingbranch'};
 269
 270     # if is permanent...
 271     if ( $hbr && $branches->{$hbr}->{'PE'} ) {
 272         $messages->{'IsPermanent'} = $hbr;
 273     }
 274
 275     # can't transfer book if is already there....
 276     if ( $fbr eq $tbr ) {
 277         $messages->{'DestinationEqualsHolding'} = 1;
 278         $dotransfer = 0;
 279     }
 280
 281     # check if it is still issued to someone, return it...
 282     if ($issue->{borrowernumber}) {
 283         AddReturn( $barcode, $fbr );
 284         $messages->{'WasReturned'} = $issue->{borrowernumber};
 285     }
 286
 287     # find reserves.....
 288     # That'll save a database query.
 289     my ( $resfound, $resrec ) =
 290       CheckReserves( $itemnumber );
 291     if ( $resfound and not $ignoreRs ) {
 292         $resrec->{'ResFound'} = $resfound;
 293
 294         #         $messages->{'ResFound'} = $resrec;
 295         $dotransfer = 1;
 296     }
 297
 298     #actually do the transfer....
 299     if ($dotransfer) {
 300         ModItemTransfer( $itemnumber, $fbr, $tbr );
 301
 302         # don't need to update MARC anymore, we do it in batch now
 303         $messages->{'WasTransfered'} = 1;
 304                 ModDateLastSeen( $itemnumber );
 305     }
 306     return ( $dotransfer, $messages, $biblio );
 307 }
 308
 309
 310 sub TooMany {
 311     my $borrower        = shift;
 312     my $biblionumber = shift;
 313         my $item                = shift;
 314     my $cat_borrower    = $borrower->{'categorycode'};
 315     my $dbh             = C4::Context->dbh;
 316         my $branch;
 317         # Get which branchcode we need
 318         if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
 319                 $branch = C4::Context->userenv->{'branch'};
 320         }
 321         elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
 322         $branch = $borrower->{'branchcode'};
 323         }
 324         else {
 325                 # items home library
 326                 $branch = $item->{'homebranch'};
 327         }
 328         my $type = (C4::Context->preference('item-level_itypes'))
 329                         ? $item->{'itype'}         # item-level
 330                         : $item->{'itemtype'};     # biblio-level
 331
 332     # given branch, patron category, and item type, determine
 333     # applicable issuing rule
 334     my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
 335
 336     # if a rule is found and has a loan limit set, count
 337     # how many loans the patron already has that meet that
 338     # rule
 339     if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
 340         my @bind_params;
 341         my $count_query = "SELECT COUNT(*) FROM issues
 342                            JOIN items USING (itemnumber) ";
 343
 344         my $rule_itemtype = $issuing_rule->{itemtype};
 345         if ($rule_itemtype eq "*") {
 346             # matching rule has the default item type, so count only
 347             # those existing loans that don't fall under a more
 348             # specific rule
 349             if (C4::Context->preference('item-level_itypes')) {
 350                 $count_query .= " WHERE items.itype NOT IN (
 351                                     SELECT itemtype FROM issuingrules
 352                                     WHERE branchcode = ?
 353                                     AND   (categorycode = ? OR categorycode = ?)
 354                                     AND   itemtype <> '*'
 355                                   ) ";
 356             } else {
 357                 $count_query .= " JOIN  biblioitems USING (biblionumber)
 358                                   WHERE biblioitems.itemtype NOT IN (
 359                                     SELECT itemtype FROM issuingrules
 360                                     WHERE branchcode = ?
 361                                     AND   (categorycode = ? OR categorycode = ?)
 362                                     AND   itemtype <> '*'
 363                                   ) ";
 364             }
 365             push @bind_params, $issuing_rule->{branchcode};
 366             push @bind_params, $issuing_rule->{categorycode};
 367             push @bind_params, $cat_borrower;
 368         } else {
 369             # rule has specific item type, so count loans of that
 370             # specific item type
 371             if (C4::Context->preference('item-level_itypes')) {
 372                 $count_query .= " WHERE items.itype = ? ";
 373             } else {
 374                 $count_query .= " JOIN  biblioitems USING (biblionumber)
 375                                   WHERE biblioitems.itemtype= ? ";
 376             }
 377             push @bind_params, $type;
 378         }
 379
 380         $count_query .= " AND borrowernumber = ? ";
 381         push @bind_params, $borrower->{'borrowernumber'};
 382         my $rule_branch = $issuing_rule->{branchcode};
 383         if ($rule_branch ne "*") {
 384             if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
 385                 $count_query .= " AND issues.branchcode = ? ";
 386                 push @bind_params, $branch;
 387             } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
 388                 ; # if branch is the patron's home branch, then count all loans by patron
 389             } else {
 390                 $count_query .= " AND items.homebranch = ? ";
 391                 push @bind_params, $branch;
 392             }
 393         }
 394
 395         my $count_sth = $dbh->prepare($count_query);
 396         $count_sth->execute(@bind_params);
 397         my ($current_loan_count) = $count_sth->fetchrow_array;
 398
 399         my $max_loans_allowed = $issuing_rule->{'maxissueqty'};
 400         if ($current_loan_count >= $max_loans_allowed) {
 401             return "$current_loan_count / $max_loans_allowed";
 402         }
 403     }
 404
 405     # Now count total loans against the limit for the branch
 406     my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
 407     if (defined($branch_borrower_circ_rule->{maxissueqty})) {
 408         my @bind_params = ();
 409         my $branch_count_query = "SELECT COUNT(*) FROM issues
 410                                   JOIN items USING (itemnumber)
 411                                   WHERE borrowernumber = ? ";
 412         push @bind_params, $borrower->{borrowernumber};
 413
 414         if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
 415             $branch_count_query .= " AND issues.branchcode = ? ";
 416             push @bind_params, $branch;
 417         } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
 418             ; # if branch is the patron's home branch, then count all loans by patron
 419         } else {
 420             $branch_count_query .= " AND items.homebranch = ? ";
 421             push @bind_params, $branch;
 422         }
 423         my $branch_count_sth = $dbh->prepare($branch_count_query);
 424         $branch_count_sth->execute(@bind_params);
 425         my ($current_loan_count) = $branch_count_sth->fetchrow_array;
 426
 427         my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty};
 428         if ($current_loan_count >= $max_loans_allowed) {
 429             return "$current_loan_count / $max_loans_allowed";
 430         }
 431     }
 432
 433     # OK, the patron can issue !!!
 434     return;
 435 }
 436
 437 =head2 itemissues
 438
 439   @issues = &itemissues($biblioitemnumber, $biblio);
 440
 441 Looks up information about who has borrowed the bookZ<>(s) with the
 442 given biblioitemnumber.
 443
 444 C<$biblio> is ignored.
 445
 446 C<&itemissues> returns an array of references-to-hash. The keys
 447 include the fields from the C<items> table in the Koha database.
 448 Additional keys include:
 449
 450 =over 4
 451
 452 =item C<date_due>
 453
 454 If the item is currently on loan, this gives the due date.
 455
 456 If the item is not on loan, then this is either "Available" or
 457 "Cancelled", if the item has been withdrawn.
 458
 459 =item C<card>
 460
 461 If the item is currently on loan, this gives the card number of the
 462 patron who currently has the item.
 463
 464 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
 465
 466 These give the timestamp for the last three times the item was
 467 borrowed.
 468
 469 =item C<card0>, C<card1>, C<card2>
 470
 471 The card number of the last three patrons who borrowed this item.
 472
 473 =item C<borrower0>, C<borrower1>, C<borrower2>
 474
 475 The borrower number of the last three patrons who borrowed this item.
 476
 477 =back
 478
 479 =cut
 480
 481 #'
 482 sub itemissues {
 483     my ( $bibitem, $biblio ) = @_;
 484     my $dbh = C4::Context->dbh;
 485     my $sth =
 486       $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
 487       || die $dbh->errstr;
 488     my $i = 0;
 489     my @results;
 490
 491     $sth->execute($bibitem) || die $sth->errstr;
 492
 493     while ( my $data = $sth->fetchrow_hashref ) {
 494
 495         # Find out who currently has this item.
 496         # FIXME - Wouldn't it be better to do this as a left join of
 497         # some sort? Currently, this code assumes that if
 498         # fetchrow_hashref() fails, then the book is on the shelf.
 499         # fetchrow_hashref() can fail for any number of reasons (e.g.,
 500         # database server crash), not just because no items match the
 501         # search criteria.
 502         my $sth2 = $dbh->prepare(
 503             "SELECT * FROM issues
 504                 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 505                 WHERE itemnumber = ?
 506             "
 507         );
 508
 509         $sth2->execute( $data->{'itemnumber'} );
 510         if ( my $data2 = $sth2->fetchrow_hashref ) {
 511             $data->{'date_due'} = $data2->{'date_due'};
 512             $data->{'card'}     = $data2->{'cardnumber'};
 513             $data->{'borrower'} = $data2->{'borrowernumber'};
 514         }
 515         else {
 516             $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
 517         }
 518
 519         $sth2->finish;
 520
 521         # Find the last 3 people who borrowed this item.
 522         $sth2 = $dbh->prepare(
 523             "SELECT * FROM old_issues
 524                 LEFT JOIN borrowers ON  issues.borrowernumber = borrowers.borrowernumber
 525                 WHERE itemnumber = ?
 526                 ORDER BY returndate DESC,timestamp DESC"
 527         );
 528
 529         $sth2->execute( $data->{'itemnumber'} );
 530         for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
 531         {    # FIXME : error if there is less than 3 pple borrowing this item
 532             if ( my $data2 = $sth2->fetchrow_hashref ) {
 533                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
 534                 $data->{"card$i2"}      = $data2->{'cardnumber'};
 535                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
 536             }    # if
 537         }    # for
 538
 539         $sth2->finish;
 540         $results[$i] = $data;
 541         $i++;
 542     }
 543
 544     $sth->finish;
 545     return (@results);
 546 }
 547
 548 =head2 CanBookBeIssued
 549
 550 Check if a book can be issued.
 551
 552 ( $issuingimpossible, $needsconfirmation ) =  CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess );
 553
 554 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
 555
 556 =over 4
 557
 558 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
 559
 560 =item C<$barcode> is the bar code of the book being issued.
 561
 562 =item C<$duedatespec> is a C4::Dates object.
 563
 564 =item C<$inprocess>
 565
 566 =back
 567
 568 Returns :
 569
 570 =over 4
 571
 572 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
 573 Possible values are :
 574
 575 =back
 576
 577 =head3 INVALID_DATE
 578
 579 sticky due date is invalid
 580
 581 =head3 GNA
 582
 583 borrower gone with no address
 584
 585 =head3 CARD_LOST
 586
 587 borrower declared it's card lost
 588
 589 =head3 DEBARRED
 590
 591 borrower debarred
 592
 593 =head3 UNKNOWN_BARCODE
 594
 595 barcode unknown
 596
 597 =head3 NOT_FOR_LOAN
 598
 599 item is not for loan
 600
 601 =head3 WTHDRAWN
 602
 603 item withdrawn.
 604
 605 =head3 RESTRICTED
 606
 607 item is restricted (set by ??)
 608
 609 C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
 610 Possible values are :
 611
 612 =head3 DEBT
 613
 614 borrower has debts.
 615
 616 =head3 RENEW_ISSUE
 617
 618 renewing, not issuing
 619
 620 =head3 ISSUED_TO_ANOTHER
 621
 622 issued to someone else.
 623
 624 =head3 RESERVED
 625
 626 reserved for someone else.
 627
 628 =head3 INVALID_DATE
 629
 630 sticky due date is invalid
 631
 632 =head3 TOO_MANY
 633
 634 if the borrower borrows to much things
 635
 636 =cut
 637
 638 sub CanBookBeIssued {
 639     my ( $borrower, $barcode, $duedate, $inprocess ) = @_;
 640     my %needsconfirmation;    # filled with problems that needs confirmations
 641     my %issuingimpossible;    # filled with problems that causes the issue to be IMPOSSIBLE
 642     my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
 643     my $issue = GetItemIssue($item->{itemnumber});
 644         my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
 645         $item->{'itemtype'}=$item->{'itype'};
 646     my $dbh             = C4::Context->dbh;
 647
 648     #
 649     # DUE DATE is OK ? -- should already have checked.
 650     #
 651     #$issuingimpossible{INVALID_DATE} = 1 unless ($duedate);
 652
 653     #
 654     # BORROWER STATUS
 655     #
 656     if ( $borrower->{'category_type'} eq 'X' && (  $item->{barcode}  )) {
 657         # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1  .
 658         &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
 659         return( { STATS => 1 }, {});
 660     }
 661     if ( $borrower->{flags}->{GNA} ) {
 662         $issuingimpossible{GNA} = 1;
 663     }
 664     if ( $borrower->{flags}->{'LOST'} ) {
 665         $issuingimpossible{CARD_LOST} = 1;
 666     }
 667     if ( $borrower->{flags}->{'DBARRED'} ) {
 668         $issuingimpossible{DEBARRED} = 1;
 669     }
 670     if ( $borrower->{'dateexpiry'} eq '0000-00-00') {
 671         $issuingimpossible{EXPIRED} = 1;
 672     } else {
 673         my @expirydate=  split /-/,$borrower->{'dateexpiry'};
 674         if($expirydate[0]==0 || $expirydate[1]==0|| $expirydate[2]==0 ||
 675             Date_to_Days(Today) > Date_to_Days( @expirydate )) {
 676             $issuingimpossible{EXPIRED} = 1;
 677         }
 678     }
 679     #
 680     # BORROWER STATUS
 681     #
 682
 683     # DEBTS
 684     my ($amount) =
 685       C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') );
 686     if ( C4::Context->preference("IssuingInProcess") ) {
 687         my $amountlimit = C4::Context->preference("noissuescharge");
 688         if ( $amount > $amountlimit && !$inprocess ) {
 689             $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
 690         }
 691         elsif ( $amount > 0 && $amount <= $amountlimit && !$inprocess ) {
 692             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
 693         }
 694     }
 695     else {
 696         if ( $amount > 0 ) {
 697             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
 698         }
 699     }
 700
 701     #
 702     # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
 703     #
 704         my $toomany = TooMany( $borrower, $item->{biblionumber}, $item );
 705     $needsconfirmation{TOO_MANY} = $toomany if $toomany;
 706
 707     #
 708     # ITEM CHECKING
 709     #
 710     unless ( $item->{barcode} ) {
 711         $issuingimpossible{UNKNOWN_BARCODE} = 1;
 712     }
 713     if (   $item->{'notforloan'}
 714         && $item->{'notforloan'} > 0 )
 715     {
 716         $issuingimpossible{NOT_FOR_LOAN} = 1;
 717     }
 718         elsif ( !$item->{'notforloan'} ){
 719                 # we have to check itemtypes.notforloan also
 720                 if (C4::Context->preference('item-level_itypes')){
 721                         # this should probably be a subroutine
 722                         my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
 723                         $sth->execute($item->{'itemtype'});
 724                         my $notforloan=$sth->fetchrow_hashref();
 725                         $sth->finish();
 726                         if ($notforloan->{'notforloan'} == 1){
 727                                 $issuingimpossible{NOT_FOR_LOAN} = 1;
 728                         }
 729                 }
 730                 elsif ($biblioitem->{'notforloan'} == 1){
 731                         $issuingimpossible{NOT_FOR_LOAN} = 1;
 732                 }
 733         }
 734     if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
 735     {
 736         $issuingimpossible{WTHDRAWN} = 1;
 737     }
 738     if (   $item->{'restricted'}
 739         && $item->{'restricted'} == 1 )
 740     {
 741         $issuingimpossible{RESTRICTED} = 1;
 742     }
 743     if ( C4::Context->preference("IndependantBranches") ) {
 744         my $userenv = C4::Context->userenv;
 745         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 746             $issuingimpossible{NOTSAMEBRANCH} = 1
 747               if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
 748         }
 749     }
 750
 751     #
 752     # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
 753     #
 754     if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
 755     {
 756
 757         # Already issued to current borrower. Ask whether the loan should
 758         # be renewed.
 759         my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
 760             $borrower->{'borrowernumber'},
 761             $item->{'itemnumber'}
 762         );
 763         if ( $CanBookBeRenewed == 0 ) {    # no more renewals allowed
 764             $issuingimpossible{NO_MORE_RENEWALS} = 1;
 765         }
 766         else {
 767             $needsconfirmation{RENEW_ISSUE} = 1;
 768         }
 769     }
 770     elsif ($issue->{borrowernumber}) {
 771
 772         # issued to someone else
 773         my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
 774
 775 #        warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
 776         $needsconfirmation{ISSUED_TO_ANOTHER} =
 777 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
 778     }
 779
 780     # See if the item is on reserve.
 781     my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
 782     if ($restype) {
 783                 my $resbor = $res->{'borrowernumber'};
 784                 my ( $resborrower ) = C4::Members::GetMemberDetails( $resbor, 0 );
 785                 my $branches  = GetBranches();
 786                 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
 787         if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
 788         {
 789             # The item is on reserve and waiting, but has been
 790             # reserved by some other patron.
 791             $needsconfirmation{RESERVE_WAITING} =
 792 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
 793         }
 794         elsif ( $restype eq "Reserved" ) {
 795             # The item is on reserve for someone else.
 796             $needsconfirmation{RESERVED} =
 797 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
 798         }
 799     }
 800     if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) {
 801         if ( $borrower->{'categorycode'} eq 'W' ) {
 802             my %emptyhash;
 803             return ( \%emptyhash, \%needsconfirmation );
 804         }
 805         }
 806         return ( \%issuingimpossible, \%needsconfirmation );
 807 }
 808
 809 =head2 AddIssue
 810
 811 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
 812
 813 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
 814
 815 =over 4
 816
 817 =item C<$borrower> is a hash with borrower informations (from GetMemberDetails).
 818
 819 =item C<$barcode> is the barcode of the item being issued.
 820
 821 =item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional).
 822 Calculated if empty.
 823
 824 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
 825
 826 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
 827 Defaults to today.  Unlike C<$datedue>, NOT a C4::Dates object, unfortunately.
 828
 829 AddIssue does the following things :
 830 - step 01: check that there is a borrowernumber & a barcode provided
 831 - check for RENEWAL (book issued & being issued to the same patron)
 832     - renewal YES = Calculate Charge & renew
 833     - renewal NO  =
 834         * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
 835         * RESERVE PLACED ?
 836             - fill reserve if reserve to this patron
 837             - cancel reserve or not, otherwise
 838         * TRANSFERT PENDING ?
 839             - complete the transfert
 840         * ISSUE THE BOOK
 841
 842 =back
 843
 844 =cut
 845
 846 sub AddIssue {
 847     my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_;
 848     my $dbh = C4::Context->dbh;
 849         my $barcodecheck=CheckValidBarcode($barcode);
 850
 851     # $issuedate defaults to today.
 852     if ( ! defined $issuedate ) {
 853         $issuedate = strftime( "%Y-%m-%d", localtime );
 854         # TODO: for hourly circ, this will need to be a C4::Dates object
 855         # and all calls to AddIssue including issuedate will need to pass a Dates object.
 856     }
 857         if ($borrower and $barcode and $barcodecheck ne '0'){
 858                 # find which item we issue
 859                 my $item = GetItem('', $barcode) or return undef;       # if we don't get an Item, abort.
 860                 my $branch = (C4::Context->preference('CircControl') eq 'PickupLibrary') ? C4::Context->userenv->{'branch'} :
 861                      (C4::Context->preference('CircControl') eq 'PatronLibrary') ? $borrower->{'branchcode'}        :
 862                      $item->{'homebranch'};     # fallback to item's homebranch
 863
 864                 # get actual issuing if there is one
 865                 my $actualissue = GetItemIssue( $item->{itemnumber});
 866
 867                 # get biblioinformation for this item
 868                 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
 869
 870                 #
 871                 # check if we just renew the issue.
 872                 #
 873                 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
 874                         $datedue = AddRenewal(
 875                                 $borrower->{'borrowernumber'},
 876                                 $item->{'itemnumber'},
 877                                 $branch,
 878                                 $datedue,
 879                 $issuedate, # here interpreted as the renewal date
 880                         );
 881                 }
 882                 else {
 883         # it's NOT a renewal
 884                         if ( $actualissue->{borrowernumber}) {
 885                                 # This book is currently on loan, but not to the person
 886                                 # who wants to borrow it now. mark it returned before issuing to the new borrower
 887                                 AddReturn(
 888                                         $item->{'barcode'},
 889                                         C4::Context->userenv->{'branch'}
 890                                 );
 891                         }
 892
 893                         # See if the item is on reserve.
 894                         my ( $restype, $res ) =
 895                           C4::Reserves::CheckReserves( $item->{'itemnumber'} );
 896                         if ($restype) {
 897                                 my $resbor = $res->{'borrowernumber'};
 898                                 if ( $resbor eq $borrower->{'borrowernumber'} ) {
 899                                         # The item is reserved by the current patron
 900                                         ModReserveFill($res);
 901                                 }
 902                                 elsif ( $restype eq "Waiting" ) {
 903                                         # warn "Waiting";
 904                                         # The item is on reserve and waiting, but has been
 905                                         # reserved by some other patron.
 906                                 }
 907                                 elsif ( $restype eq "Reserved" ) {
 908                                         # warn "Reserved";
 909                                         # The item is reserved by someone else.
 910                                         if ($cancelreserve) { # cancel reserves on this item
 911                                                 CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
 912                                         }
 913                                 }
 914                                 if ($cancelreserve) {
 915                                         CancelReserve($res->{'biblionumber'}, 0, $res->{'borrowernumber'});
 916                                 }
 917                                 else {
 918                                         # set waiting reserve to first in reserve queue as book isn't waiting now
 919                                         ModReserve(1,
 920                                                 $res->{'biblionumber'},
 921                                                 $res->{'borrowernumber'},
 922                                                 $res->{'branchcode'}
 923                                         );
 924                                 }
 925                         }
 926
 927                         # Starting process for transfer job (checking transfert and validate it if we have one)
 928             my ($datesent) = GetTransfers($item->{'itemnumber'});
 929             if ($datesent) {
 930         #       updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
 931                 my $sth =
 932                     $dbh->prepare(
 933                     "UPDATE branchtransfers
 934                         SET datearrived = now(),
 935                         tobranch = ?,
 936                         comments = 'Forced branchtransfer'
 937                     WHERE itemnumber= ? AND datearrived IS NULL"
 938                     );
 939                 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
 940             }
 941
 942         # Record in the database the fact that the book was issued.
 943         my $sth =
 944           $dbh->prepare(
 945                 "INSERT INTO issues
 946                     (borrowernumber, itemnumber,issuedate, date_due, branchcode)
 947                 VALUES (?,?,?,?,?)"
 948           );
 949         unless ($datedue) {
 950             my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
 951             my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch );
 952             $datedue = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch );
 953
 954             # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
 955             if ( C4::Context->preference('ReturnBeforeExpiry') && $datedue->output('iso') gt $borrower->{dateexpiry} ) {
 956                 $datedue = C4::Dates->new( $borrower->{dateexpiry}, 'iso' );
 957             }
 958         }
 959         $sth->execute(
 960             $borrower->{'borrowernumber'},      # borrowernumber
 961             $item->{'itemnumber'},              # itemnumber
 962             $issuedate,                         # issuedate
 963             $datedue->output('iso'),            # date_due
 964             C4::Context->userenv->{'branch'}    # branchcode
 965         );
 966         $sth->finish;
 967         $item->{'issues'}++;
 968         ModItem({ issues           => $item->{'issues'},
 969                   holdingbranch    => C4::Context->userenv->{'branch'},
 970                   itemlost         => 0,
 971                   datelastborrowed => C4::Dates->new()->output('iso'),
 972                   onloan           => $datedue->output('iso'),
 973                 }, $item->{'biblionumber'}, $item->{'itemnumber'});
 974         ModDateLastSeen( $item->{'itemnumber'} );
 975
 976         # If it costs to borrow this book, charge it to the patron's account.
 977         my ( $charge, $itemtype ) = GetIssuingCharges(
 978             $item->{'itemnumber'},
 979             $borrower->{'borrowernumber'}
 980         );
 981         if ( $charge > 0 ) {
 982             AddIssuingCharge(
 983                 $item->{'itemnumber'},
 984                 $borrower->{'borrowernumber'}, $charge
 985             );
 986             $item->{'charge'} = $charge;
 987         }
 988
 989         # Record the fact that this book was issued.
 990         &UpdateStats(
 991             C4::Context->userenv->{'branch'},
 992             'issue', $charge,
 993             ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
 994             $item->{'itype'}, $borrower->{'borrowernumber'}
 995         );
 996     }
 997
 998     logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
 999         if C4::Context->preference("IssueLog");
1000   }
1001   return ($datedue);    # not necessarily the same as when it came in!
1002 }
1003
1004 =head2 GetLoanLength
1005
1006 Get loan length for an itemtype, a borrower type and a branch
1007
1008 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1009
1010 =cut
1011
1012 sub GetLoanLength {
1013     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1014     my $dbh = C4::Context->dbh;
1015     my $sth =
1016       $dbh->prepare(
1017 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1018       );
1019 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1020 # try to find issuelength & return the 1st available.
1021 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1022     $sth->execute( $borrowertype, $itemtype, $branchcode );
1023     my $loanlength = $sth->fetchrow_hashref;
1024     return $loanlength->{issuelength}
1025       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1026
1027     $sth->execute( $borrowertype, "*", $branchcode );
1028     $loanlength = $sth->fetchrow_hashref;
1029     return $loanlength->{issuelength}
1030       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1031
1032     $sth->execute( "*", $itemtype, $branchcode );
1033     $loanlength = $sth->fetchrow_hashref;
1034     return $loanlength->{issuelength}
1035       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1036
1037     $sth->execute( "*", "*", $branchcode );
1038     $loanlength = $sth->fetchrow_hashref;
1039     return $loanlength->{issuelength}
1040       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1041
1042     $sth->execute( $borrowertype, $itemtype, "*" );
1043     $loanlength = $sth->fetchrow_hashref;
1044     return $loanlength->{issuelength}
1045       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1046
1047     $sth->execute( $borrowertype, "*", "*" );
1048     $loanlength = $sth->fetchrow_hashref;
1049     return $loanlength->{issuelength}
1050       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1051
1052     $sth->execute( "*", $itemtype, "*" );
1053     $loanlength = $sth->fetchrow_hashref;
1054     return $loanlength->{issuelength}
1055       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1056
1057     $sth->execute( "*", "*", "*" );
1058     $loanlength = $sth->fetchrow_hashref;
1059     return $loanlength->{issuelength}
1060       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1061
1062     # if no rule is set => 21 days (hardcoded)
1063     return 21;
1064 }
1065
1066 =head2 GetIssuingRule
1067
1068 FIXME - This is a copy-paste of GetLoanLength
1069 as a stop-gap.  Do not wish to change API for GetLoanLength
1070 this close to release, however, Overdues::GetIssuingRules is broken.
1071
1072 Get the issuing rule for an itemtype, a borrower type and a branch
1073 Returns a hashref from the issuingrules table.
1074
1075 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1076
1077 =cut
1078
1079 sub GetIssuingRule {
1080     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1081     my $dbh = C4::Context->dbh;
1082     my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"  );
1083     my $irule;
1084
1085         $sth->execute( $borrowertype, $itemtype, $branchcode );
1086     $irule = $sth->fetchrow_hashref;
1087     return $irule if defined($irule) ;
1088
1089     $sth->execute( $borrowertype, "*", $branchcode );
1090     $irule = $sth->fetchrow_hashref;
1091     return $irule if defined($irule) ;
1092
1093     $sth->execute( "*", $itemtype, $branchcode );
1094     $irule = $sth->fetchrow_hashref;
1095     return $irule if defined($irule) ;
1096
1097     $sth->execute( "*", "*", $branchcode );
1098     $irule = $sth->fetchrow_hashref;
1099     return $irule if defined($irule) ;
1100
1101     $sth->execute( $borrowertype, $itemtype, "*" );
1102     $irule = $sth->fetchrow_hashref;
1103     return $irule if defined($irule) ;
1104
1105     $sth->execute( $borrowertype, "*", "*" );
1106     $irule = $sth->fetchrow_hashref;
1107     return $irule if defined($irule) ;
1108
1109     $sth->execute( "*", $itemtype, "*" );
1110     $irule = $sth->fetchrow_hashref;
1111     return $irule if defined($irule) ;
1112
1113     $sth->execute( "*", "*", "*" );
1114     $irule = $sth->fetchrow_hashref;
1115     return $irule if defined($irule) ;
1116
1117     # if no rule matches,
1118     return undef;
1119 }
1120
1121 =head2 GetBranchBorrowerCircRule
1122
1123 =over 4
1124
1125 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1126
1127 =back
1128
1129 Retrieves circulation rule attributes that apply to the given
1130 branch and patron category, regardless of item type.
1131 The return value is a hashref containing the following key:
1132
1133 maxissueqty - maximum number of loans that a
1134 patron of the given category can have at the given
1135 branch.  If the value is undef, no limit.
1136
1137 This will first check for a specific branch and
1138 category match from branch_borrower_circ_rules.
1139
1140 If no rule is found, it will then check default_branch_circ_rules
1141 (same branch, default category).  If no rule is found,
1142 it will then check default_borrower_circ_rules (default
1143 branch, same category), then failing that, default_circ_rules
1144 (default branch, default category).
1145
1146 If no rule has been found in the database, it will default to
1147 the buillt in rule:
1148
1149 maxissueqty - undef
1150
1151 C<$branchcode> and C<$categorycode> should contain the
1152 literal branch code and patron category code, respectively - no
1153 wildcards.
1154
1155 =cut
1156
1157 sub GetBranchBorrowerCircRule {
1158     my $branchcode = shift;
1159     my $categorycode = shift;
1160
1161     my $branch_cat_query = "SELECT maxissueqty
1162                             FROM branch_borrower_circ_rules
1163                             WHERE branchcode = ?
1164                             AND   categorycode = ?";
1165     my $dbh = C4::Context->dbh();
1166     my $sth = $dbh->prepare($branch_cat_query);
1167     $sth->execute($branchcode, $categorycode);
1168     my $result;
1169     if ($result = $sth->fetchrow_hashref()) {
1170         return $result;
1171     }
1172
1173     # try same branch, default borrower category
1174     my $branch_query = "SELECT maxissueqty
1175                         FROM default_branch_circ_rules
1176                         WHERE branchcode = ?";
1177     $sth = $dbh->prepare($branch_query);
1178     $sth->execute($branchcode);
1179     if ($result = $sth->fetchrow_hashref()) {
1180         return $result;
1181     }
1182
1183     # try default branch, same borrower category
1184     my $category_query = "SELECT maxissueqty
1185                           FROM default_borrower_circ_rules
1186                           WHERE categorycode = ?";
1187     $sth = $dbh->prepare($category_query);
1188     $sth->execute($categorycode);
1189     if ($result = $sth->fetchrow_hashref()) {
1190         return $result;
1191     }
1192
1193     # try default branch, default borrower category
1194     my $default_query = "SELECT maxissueqty
1195                           FROM default_circ_rules";
1196     $sth = $dbh->prepare($default_query);
1197     $sth->execute();
1198     if ($result = $sth->fetchrow_hashref()) {
1199         return $result;
1200     }
1201
1202     # built-in default circulation rule
1203     return {
1204         maxissueqty => undef,
1205     };
1206 }
1207
1208 =head2 AddReturn
1209
1210 ($doreturn, $messages, $iteminformation, $borrower) =
1211     &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1212
1213 Returns a book.
1214
1215 =over 4
1216
1217 =item C<$barcode> is the bar code of the book being returned.
1218
1219 =item C<$branch> is the code of the branch where the book is being returned.
1220
1221 =item C<$exemptfine> indicates that overdue charges for the item will be
1222 removed.
1223
1224 =item C<$dropbox> indicates that the check-in date is assumed to be
1225 yesterday, or the last non-holiday as defined in C4::Calendar .  If
1226 overdue charges are applied and C<$dropbox> is true, the last charge
1227 will be removed.  This assumes that the fines accrual script has run
1228 for _today_.
1229
1230 =back
1231
1232 C<&AddReturn> returns a list of four items:
1233
1234 C<$doreturn> is true iff the return succeeded.
1235
1236 C<$messages> is a reference-to-hash giving the reason for failure:
1237
1238 =over 4
1239
1240 =item C<BadBarcode>
1241
1242 No item with this barcode exists. The value is C<$barcode>.
1243
1244 =item C<NotIssued>
1245
1246 The book is not currently on loan. The value is C<$barcode>.
1247
1248 =item C<IsPermanent>
1249
1250 The book's home branch is a permanent collection. If you have borrowed
1251 this book, you are not allowed to return it. The value is the code for
1252 the book's home branch.
1253
1254 =item C<wthdrawn>
1255
1256 This book has been withdrawn/cancelled. The value should be ignored.
1257
1258 =item C<ResFound>
1259
1260 The item was reserved. The value is a reference-to-hash whose keys are
1261 fields from the reserves table of the Koha database, and
1262 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1263 either C<Waiting>, C<Reserved>, or 0.
1264
1265 =back
1266
1267 C<$borrower> is a reference-to-hash, giving information about the
1268 patron who last borrowed the book.
1269
1270 =cut
1271
1272 sub AddReturn {
1273     my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1274     my $dbh      = C4::Context->dbh;
1275     my $messages;
1276     my $doreturn = 1;
1277     my $borrower;
1278     my $validTransfert = 0;
1279     my $reserveDone = 0;
1280
1281     # get information on item
1282     my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1283     my $biblio = GetBiblioItemData($iteminformation->{'biblioitemnumber'});
1284 #     use Data::Dumper;warn Data::Dumper::Dumper($iteminformation);
1285     unless ($iteminformation->{'itemnumber'} ) {
1286         $messages->{'BadBarcode'} = $barcode;
1287         $doreturn = 0;
1288     } else {
1289         # find the borrower
1290         if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1291             $messages->{'NotIssued'} = $barcode;
1292             # even though item is not on loan, it may still
1293             # be transferred; therefore, get current branch information
1294             my $curr_iteminfo = GetItem($iteminformation->{'itemnumber'});
1295             $iteminformation->{'homebranch'} = $curr_iteminfo->{'homebranch'};
1296             $iteminformation->{'holdingbranch'} = $curr_iteminfo->{'holdingbranch'};
1297             $doreturn = 0;
1298         }
1299
1300         # check if the book is in a permanent collection....
1301         my $hbr      = $iteminformation->{C4::Context->preference("HomeOrHoldingBranch")};
1302         my $branches = GetBranches();
1303                 # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
1304         if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1305             $messages->{'IsPermanent'} = $hbr;
1306         }
1307
1308                     # if independent branches are on and returning to different branch, refuse the return
1309         if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){
1310                           $messages->{'Wrongbranch'} = 1;
1311                           $doreturn=0;
1312                     }
1313
1314         # check that the book has been cancelled
1315         if ( $iteminformation->{'wthdrawn'} ) {
1316             $messages->{'wthdrawn'} = 1;
1317             $doreturn = 0;
1318         }
1319
1320     #     new op dev : if the book returned in an other branch update the holding branch
1321
1322     # update issues, thereby returning book (should push this out into another subroutine
1323         $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1324
1325     # case of a return of document (deal with issues and holdingbranch)
1326
1327         if ($doreturn) {
1328                         my $circControlBranch;
1329                         if($dropbox) {
1330                                 # don't allow dropbox mode to create an invalid entry in issues (issuedate > returndate) FIXME: actually checks eq, not gt
1331                                 undef($dropbox) if ( $iteminformation->{'issuedate'} eq C4::Dates->today('iso') );
1332                                 if (C4::Context->preference('CircControl') eq 'ItemHomeBranch' ) {
1333                                         $circControlBranch = $iteminformation->{homebranch};
1334                                 } elsif ( C4::Context->preference('CircControl') eq 'PatronLibrary') {
1335                                         $circControlBranch = $borrower->{branchcode};
1336                                 } else { # CircControl must be PickupLibrary.
1337                                         $circControlBranch = $iteminformation->{holdingbranch};
1338                                         # FIXME - is this right ? are we sure that the holdingbranch is still the pickup branch?
1339                                 }
1340                         }
1341             MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'},$circControlBranch);
1342             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?
1343             # continue to deal with returns cases, but not only if we have an issue
1344
1345             # the holdingbranch is updated if the document is returned in an other location .
1346             if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) {
1347                            UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1348                            #           reload iteminformation holdingbranch with the userenv value
1349                            $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1350             }
1351             ModDateLastSeen( $iteminformation->{'itemnumber'} );
1352             ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'});
1353
1354             if ($iteminformation->{borrowernumber}){
1355               ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1356             }
1357         }
1358         # fix up the accounts.....
1359         if ( $iteminformation->{'itemlost'} ) {
1360             $messages->{'WasLost'} = 1;
1361         }
1362
1363     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1364     #     check if we have a transfer for this document
1365         my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1366
1367     #     if we have a transfer to do, we update the line of transfers with the datearrived
1368         if ($datesent) {
1369             if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1370                     my $sth =
1371                     $dbh->prepare(
1372                             "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1373                     );
1374                     $sth->execute( $iteminformation->{'itemnumber'} );
1375                     $sth->finish;
1376     #         now we check if there is a reservation with the validate of transfer if we have one, we can         set it with the status 'W'
1377             C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1378             }
1379         else {
1380             $messages->{'WrongTransfer'} = $tobranch;
1381             $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1382         }
1383         $validTransfert = 1;
1384         }
1385
1386     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1387         # fix up the accounts.....
1388         if ($iteminformation->{'itemlost'}) {
1389                 FixAccountForLostAndReturned($iteminformation, $borrower);
1390                 $messages->{'WasLost'} = 1;
1391         }
1392         # fix up the overdues in accounts...
1393         FixOverduesOnReturn( $borrower->{'borrowernumber'},
1394             $iteminformation->{'itemnumber'}, $exemptfine, $dropbox );
1395
1396     # find reserves.....
1397     #     if we don't have a reserve with the status W, we launch the Checkreserves routine
1398         my ( $resfound, $resrec ) =
1399         C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1400         if ($resfound) {
1401             $resrec->{'ResFound'}   = $resfound;
1402             $messages->{'ResFound'} = $resrec;
1403             $reserveDone = 1;
1404         }
1405
1406         # update stats?
1407         # Record the fact that this book was returned.
1408         UpdateStats(
1409             $branch, 'return', '0', '',
1410             $iteminformation->{'itemnumber'},
1411             $biblio->{'itemtype'},
1412             $borrower->{'borrowernumber'}
1413         );
1414
1415         logaction("CIRCULATION", "RETURN", $iteminformation->{borrowernumber}, $iteminformation->{'biblionumber'})
1416             if C4::Context->preference("ReturnLog");
1417
1418         #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1419         #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1420
1421         if ($doreturn and ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1422                         if (C4::Context->preference("AutomaticItemReturn") == 1) {
1423                                 ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1424                                 $messages->{'WasTransfered'} = 1;
1425                         }
1426                         else {
1427                                 $messages->{'NeedsTransfer'} = 1;
1428                         }
1429         }
1430     }
1431     return ( $doreturn, $messages, $iteminformation, $borrower );
1432 }
1433
1434 =head2 MarkIssueReturned
1435
1436 =over 4
1437
1438 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate);
1439
1440 =back
1441
1442 Unconditionally marks an issue as being returned by
1443 moving the C<issues> row to C<old_issues> and
1444 setting C<returndate> to the current date, or
1445 the last non-holiday date of the branccode specified in
1446 C<dropbox_branch> .  Assumes you've already checked that
1447 it's safe to do this, i.e. last non-holiday > issuedate.
1448
1449 if C<$returndate> is specified (in iso format), it is used as the date
1450 of the return. It is ignored when a dropbox_branch is passed in.
1451
1452 Ideally, this function would be internal to C<C4::Circulation>,
1453 not exported, but it is currently needed by one
1454 routine in C<C4::Accounts>.
1455
1456 =cut
1457
1458 sub MarkIssueReturned {
1459     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate ) = @_;
1460     my $dbh   = C4::Context->dbh;
1461     my $query = "UPDATE issues SET returndate=";
1462     my @bind;
1463     if ($dropbox_branch) {
1464         my $calendar = C4::Calendar->new( branchcode => $dropbox_branch );
1465         my $dropboxdate = $calendar->addDate( C4::Dates->new(), -1 );
1466         $query .= " ? ";
1467         push @bind, $dropboxdate->output('iso');
1468     } elsif ($returndate) {
1469         $query .= " ? ";
1470         push @bind, $returndate;
1471     } else {
1472         $query .= " now() ";
1473     }
1474     $query .= " WHERE  borrowernumber = ?  AND itemnumber = ?";
1475     push @bind, $borrowernumber, $itemnumber;
1476     # FIXME transaction
1477     my $sth_upd  = $dbh->prepare($query);
1478     $sth_upd->execute(@bind);
1479     my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1480                                   WHERE borrowernumber = ?
1481                                   AND itemnumber = ?");
1482     $sth_copy->execute($borrowernumber, $itemnumber);
1483     my $sth_del  = $dbh->prepare("DELETE FROM issues
1484                                   WHERE borrowernumber = ?
1485                                   AND itemnumber = ?");
1486     $sth_del->execute($borrowernumber, $itemnumber);
1487 }
1488
1489 =head2 FixOverduesOnReturn
1490
1491     &FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1492
1493 C<$brn> borrowernumber
1494
1495 C<$itm> itemnumber
1496
1497 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1498 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1499
1500 internal function, called only by AddReturn
1501
1502 =cut
1503
1504 sub FixOverduesOnReturn {
1505     my ( $borrowernumber, $item, $exemptfine, $dropbox ) = @_;
1506     my $dbh = C4::Context->dbh;
1507
1508     # check for overdue fine
1509     my $sth =
1510       $dbh->prepare(
1511 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1512       );
1513     $sth->execute( $borrowernumber, $item );
1514
1515     # alter fine to show that the book has been returned
1516    my $data;
1517         if ($data = $sth->fetchrow_hashref) {
1518         my $uquery;
1519                 my @bind = ($borrowernumber,$item ,$data->{'accountno'});
1520                 if ($exemptfine) {
1521                         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1522                         if (C4::Context->preference("FinesLog")) {
1523                         &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1524                         }
1525                 } elsif ($dropbox && $data->{lastincrement}) {
1526                         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1527                         my $amt = $data->{amount} - $data->{lastincrement} ;
1528                         if (C4::Context->preference("FinesLog")) {
1529                         &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1530                         }
1531                          $uquery = "update accountlines set accounttype='F' ";
1532                          if($outstanding  >= 0 && $amt >=0) {
1533                                 $uquery .= ", amount = ? , amountoutstanding=? ";
1534                                 unshift @bind, ($amt, $outstanding) ;
1535                         }
1536                 } else {
1537                         $uquery = "update accountlines set accounttype='F' ";
1538                 }
1539                 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1540         my $usth = $dbh->prepare($uquery);
1541         $usth->execute(@bind);
1542         $usth->finish();
1543     }
1544
1545     $sth->finish();
1546     return;
1547 }
1548
1549 =head2 FixAccountForLostAndReturned
1550
1551         &FixAccountForLostAndReturned($iteminfo,$borrower);
1552
1553 Calculates the charge for a book lost and returned (Not exported & used only once)
1554
1555 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1556
1557 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1558
1559 Internal function, called by AddReturn
1560
1561 =cut
1562
1563 sub FixAccountForLostAndReturned {
1564         my ($iteminfo, $borrower) = @_;
1565         my $dbh = C4::Context->dbh;
1566         my $itm = $iteminfo->{'itemnumber'};
1567         # check for charge made for lost book
1568         my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1569         $sth->execute($itm);
1570         if (my $data = $sth->fetchrow_hashref) {
1571         # writeoff this amount
1572                 my $offset;
1573                 my $amount = $data->{'amount'};
1574                 my $acctno = $data->{'accountno'};
1575                 my $amountleft;
1576                 if ($data->{'amountoutstanding'} == $amount) {
1577                 $offset = $data->{'amount'};
1578                 $amountleft = 0;
1579                 } else {
1580                 $offset = $amount - $data->{'amountoutstanding'};
1581                 $amountleft = $data->{'amountoutstanding'} - $amount;
1582                 }
1583                 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1584                         WHERE (borrowernumber = ?)
1585                         AND (itemnumber = ?) AND (accountno = ?) ");
1586                 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1587                 $usth->finish;
1588         #check if any credit is left if so writeoff other accounts
1589                 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1590                 if ($amountleft < 0){
1591                 $amountleft*=-1;
1592                 }
1593                 if ($amountleft > 0){
1594                 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1595                                                         AND (amountoutstanding >0) ORDER BY date");
1596                 $msth->execute($data->{'borrowernumber'});
1597         # offset transactions
1598                 my $newamtos;
1599                 my $accdata;
1600                 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1601                         if ($accdata->{'amountoutstanding'} < $amountleft) {
1602                         $newamtos = 0;
1603                         $amountleft -= $accdata->{'amountoutstanding'};
1604                         }  else {
1605                         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1606                         $amountleft = 0;
1607                         }
1608                         my $thisacct = $accdata->{'accountno'};
1609                         my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1610                                         WHERE (borrowernumber = ?)
1611                                         AND (accountno=?)");
1612                         $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1613                         $usth->finish;
1614                         $usth = $dbh->prepare("INSERT INTO accountoffsets
1615                                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1616                                 VALUES
1617                                 (?,?,?,?)");
1618                         $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1619                         $usth->finish;
1620                 }
1621                 $msth->finish;
1622                 }
1623                 if ($amountleft > 0){
1624                         $amountleft*=-1;
1625                 }
1626                 my $desc="Item Returned ".$iteminfo->{'barcode'};
1627                 $usth = $dbh->prepare("INSERT INTO accountlines
1628                         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1629                         VALUES (?,?,now(),?,?,'CR',?)");
1630                 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1631                 $usth->finish;
1632                 $usth = $dbh->prepare("INSERT INTO accountoffsets
1633                         (borrowernumber, accountno, offsetaccount,  offsetamount)
1634                         VALUES (?,?,?,?)");
1635                 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1636                 $usth->finish;
1637         ModItem({ paidfor => '' }, undef, $itm);
1638         }
1639         $sth->finish;
1640         return;
1641 }
1642
1643 =head2 GetItemIssue
1644
1645 $issues = &GetItemIssue($itemnumber);
1646
1647 Returns patrons currently having a book. nothing if item is not issued atm
1648
1649 C<$itemnumber> is the itemnumber
1650
1651 Returns an array of hashes
1652
1653 FIXME: Though the above says that this function returns nothing if the
1654 item is not issued, this actually returns a hasref that looks like
1655 this:
1656     {
1657       itemnumber => 1,
1658       overdue    => 1
1659     }
1660
1661
1662 =cut
1663
1664 sub GetItemIssue {
1665     my ( $itemnumber) = @_;
1666     return unless $itemnumber;
1667     my $dbh = C4::Context->dbh;
1668     my @GetItemIssues;
1669
1670     # get today date
1671     my $today = POSIX::strftime("%Y%m%d", localtime);
1672
1673     my $sth = $dbh->prepare(
1674         "SELECT * FROM issues
1675         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1676     WHERE
1677     issues.itemnumber=?");
1678     $sth->execute($itemnumber);
1679     my $data = $sth->fetchrow_hashref;
1680     my $datedue = $data->{'date_due'};
1681     $datedue =~ s/-//g;
1682     if ( $datedue < $today ) {
1683         $data->{'overdue'} = 1;
1684     }
1685     $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1686     $sth->finish;
1687     return ($data);
1688 }
1689
1690 =head2 GetItemIssues
1691
1692 $issues = &GetItemIssues($itemnumber, $history);
1693
1694 Returns patrons that have issued a book
1695
1696 C<$itemnumber> is the itemnumber
1697 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1698
1699 Returns an array of hashes
1700
1701 =cut
1702
1703 sub GetItemIssues {
1704     my ( $itemnumber,$history ) = @_;
1705     my $dbh = C4::Context->dbh;
1706     my @GetItemIssues;
1707
1708     # get today date
1709     my $today = POSIX::strftime("%Y%m%d", localtime);
1710
1711     my $sql = "SELECT * FROM issues
1712               JOIN borrowers USING (borrowernumber)
1713               JOIN items USING (itemnumber)
1714               WHERE issues.itemnumber = ? ";
1715     if ($history) {
1716         $sql .= "UNION ALL
1717                  SELECT * FROM old_issues
1718                  LEFT JOIN borrowers USING (borrowernumber)
1719                  JOIN items USING (itemnumber)
1720                  WHERE old_issues.itemnumber = ? ";
1721     }
1722     $sql .= "ORDER BY date_due DESC";
1723     my $sth = $dbh->prepare($sql);
1724     if ($history) {
1725         $sth->execute($itemnumber, $itemnumber);
1726     } else {
1727         $sth->execute($itemnumber);
1728     }
1729     while ( my $data = $sth->fetchrow_hashref ) {
1730         my $datedue = $data->{'date_due'};
1731         $datedue =~ s/-//g;
1732         if ( $datedue < $today ) {
1733             $data->{'overdue'} = 1;
1734         }
1735         my $itemnumber = $data->{'itemnumber'};
1736         push @GetItemIssues, $data;
1737     }
1738     $sth->finish;
1739     return ( \@GetItemIssues );
1740 }
1741
1742 =head2 GetBiblioIssues
1743
1744 $issues = GetBiblioIssues($biblionumber);
1745
1746 this function get all issues from a biblionumber.
1747
1748 Return:
1749 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1750 tables issues and the firstname,surname & cardnumber from borrowers.
1751
1752 =cut
1753
1754 sub GetBiblioIssues {
1755     my $biblionumber = shift;
1756     return undef unless $biblionumber;
1757     my $dbh   = C4::Context->dbh;
1758     my $query = "
1759         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1760         FROM issues
1761             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1762             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1763             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1764             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1765         WHERE biblio.biblionumber = ?
1766         UNION ALL
1767         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1768         FROM old_issues
1769             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1770             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1771             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1772             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1773         WHERE biblio.biblionumber = ?
1774         ORDER BY timestamp
1775     ";
1776     my $sth = $dbh->prepare($query);
1777     $sth->execute($biblionumber, $biblionumber);
1778
1779     my @issues;
1780     while ( my $data = $sth->fetchrow_hashref ) {
1781         push @issues, $data;
1782     }
1783     return \@issues;
1784 }
1785
1786 =head2 GetUpcomingDueIssues
1787
1788 =over 4
1789
1790 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
1791
1792 =back
1793
1794 =cut
1795
1796 sub GetUpcomingDueIssues {
1797     my $params = shift;
1798
1799     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
1800     my $dbh = C4::Context->dbh;
1801
1802     my $statement = <<END_SQL;
1803 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due
1804 FROM issues
1805 LEFT JOIN items USING (itemnumber)
1806 WhERE returndate is NULL
1807 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
1808 END_SQL
1809
1810     my @bind_parameters = ( $params->{'days_in_advance'} );
1811
1812     my $sth = $dbh->prepare( $statement );
1813     $sth->execute( @bind_parameters );
1814     my $upcoming_dues = $sth->fetchall_arrayref({});
1815     $sth->finish;
1816
1817     return $upcoming_dues;
1818 }
1819
1820 =head2 CanBookBeRenewed
1821
1822 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
1823
1824 Find out whether a borrowed item may be renewed.
1825
1826 C<$dbh> is a DBI handle to the Koha database.
1827
1828 C<$borrowernumber> is the borrower number of the patron who currently
1829 has the item on loan.
1830
1831 C<$itemnumber> is the number of the item to renew.
1832
1833 C<$override_limit>, if supplied with a true value, causes
1834 the limit on the number of times that the loan can be renewed
1835 (as controlled by the item type) to be ignored.
1836
1837 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1838 item must currently be on loan to the specified borrower; renewals
1839 must be allowed for the item's type; and the borrower must not have
1840 already renewed the loan. $error will contain the reason the renewal can not proceed
1841
1842 =cut
1843
1844 sub CanBookBeRenewed {
1845
1846     # check renewal status
1847     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
1848     my $dbh       = C4::Context->dbh;
1849     my $renews    = 1;
1850     my $renewokay = 0;
1851         my $error;
1852
1853     # Look in the issues table for this item, lent to this borrower,
1854     # and not yet returned.
1855
1856     # FIXME - I think this function could be redone to use only one SQL call.
1857     my $sth1 = $dbh->prepare(
1858         "SELECT * FROM issues
1859             WHERE borrowernumber = ?
1860             AND itemnumber = ?"
1861     );
1862     $sth1->execute( $borrowernumber, $itemnumber );
1863     if ( my $data1 = $sth1->fetchrow_hashref ) {
1864
1865         # Found a matching item
1866
1867         # See if this item may be renewed. This query is convoluted
1868         # because it's a bit messy: given the item number, we need to find
1869         # the biblioitem, which gives us the itemtype, which tells us
1870         # whether it may be renewed.
1871         my $query = "SELECT renewalsallowed FROM items ";
1872         $query .= (C4::Context->preference('item-level_itypes'))
1873                     ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1874                     : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1875                        LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1876         $query .= "WHERE items.itemnumber = ?";
1877         my $sth2 = $dbh->prepare($query);
1878         $sth2->execute($itemnumber);
1879         if ( my $data2 = $sth2->fetchrow_hashref ) {
1880             $renews = $data2->{'renewalsallowed'};
1881         }
1882         if ( ( $renews && $renews > $data1->{'renewals'} ) || $override_limit ) {
1883             $renewokay = 1;
1884         }
1885         else {
1886                         $error="too_many";
1887                 }
1888         $sth2->finish;
1889         my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1890         if ($resfound) {
1891             $renewokay = 0;
1892                         $error="on_reserve"
1893         }
1894
1895     }
1896     $sth1->finish;
1897     return ($renewokay,$error);
1898 }
1899
1900 =head2 AddRenewal
1901
1902 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
1903
1904 Renews a loan.
1905
1906 C<$borrowernumber> is the borrower number of the patron who currently
1907 has the item.
1908
1909 C<$itemnumber> is the number of the item to renew.
1910
1911 C<$branch> is the library branch.  Defaults to the homebranch of the ITEM.
1912
1913 C<$datedue> can be a C4::Dates object used to set the due date.
1914
1915 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
1916 this parameter is not supplied, lastreneweddate is set to the current date.
1917
1918 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
1919 from the book's item type.
1920
1921 =cut
1922
1923 sub AddRenewal {
1924         my $borrowernumber = shift or return undef;
1925         my     $itemnumber = shift or return undef;
1926     my $item   = GetItem($itemnumber) or return undef;
1927     my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
1928     my $branch  = (@_) ? shift : $item->{homebranch};   # opac-renew doesn't send branch
1929     my $datedue = shift;
1930     my $lastreneweddate = shift;
1931
1932     # If the due date wasn't specified, calculate it by adding the
1933     # book's loan length to today's date.
1934     unless ($datedue && $datedue->output('iso')) {
1935
1936         my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
1937         my $loanlength = GetLoanLength(
1938             $borrower->{'categorycode'},
1939              (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
1940                         $item->{homebranch}                     # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument?
1941         );
1942                 #FIXME -- use circControl?
1943                 $datedue =  CalcDateDue(C4::Dates->new(),$loanlength,$branch);  # this branch is the transactional branch.
1944                                                                 # The question of whether to use item's homebranch calendar is open.
1945     }
1946
1947     # $lastreneweddate defaults to today.
1948     unless (defined $lastreneweddate) {
1949         $lastreneweddate = strftime( "%Y-%m-%d", localtime );
1950     }
1951
1952     my $dbh = C4::Context->dbh;
1953     # Find the issues record for this book
1954     my $sth =
1955       $dbh->prepare("SELECT * FROM issues
1956                         WHERE borrowernumber=?
1957                         AND itemnumber=?"
1958       );
1959     $sth->execute( $borrowernumber, $itemnumber );
1960     my $issuedata = $sth->fetchrow_hashref;
1961     $sth->finish;
1962
1963     # Update the issues record to have the new due date, and a new count
1964     # of how many times it has been renewed.
1965     my $renews = $issuedata->{'renewals'} + 1;
1966     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
1967                             WHERE borrowernumber=?
1968                             AND itemnumber=?"
1969     );
1970     $sth->execute( $datedue->output('iso'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
1971     $sth->finish;
1972
1973     # Update the renewal count on the item, and tell zebra to reindex
1974     $renews = $biblio->{'renewals'} + 1;
1975     ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber);
1976
1977     # Charge a new rental fee, if applicable?
1978     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1979     if ( $charge > 0 ) {
1980         my $accountno = getnextacctno( $borrowernumber );
1981         my $item = GetBiblioFromItemNumber($itemnumber);
1982         $sth = $dbh->prepare(
1983                 "INSERT INTO accountlines
1984                     (date,
1985                                         borrowernumber, accountno, amount,
1986                     description,
1987                                         accounttype, amountoutstanding, itemnumber
1988                                         )
1989                     VALUES (now(),?,?,?,?,?,?,?)"
1990         );
1991         $sth->execute( $borrowernumber, $accountno, $charge,
1992             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1993             'Rent', $charge, $itemnumber );
1994         $sth->finish;
1995     }
1996     # Log the renewal
1997     UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
1998         return $datedue;
1999 }
2000
2001 sub GetRenewCount {
2002     # check renewal status
2003     my ($bornum,$itemno)=@_;
2004     my $dbh = C4::Context->dbh;
2005     my $renewcount = 0;
2006         my $renewsallowed = 0;
2007         my $renewsleft = 0;
2008     # Look in the issues table for this item, lent to this borrower,
2009     # and not yet returned.
2010
2011     # FIXME - I think this function could be redone to use only one SQL call.
2012     my $sth = $dbh->prepare("select * from issues
2013                                 where (borrowernumber = ?)
2014                                 and (itemnumber = ?)");
2015     $sth->execute($bornum,$itemno);
2016     my $data = $sth->fetchrow_hashref;
2017     $renewcount = $data->{'renewals'} if $data->{'renewals'};
2018     $sth->finish;
2019     my $query = "SELECT renewalsallowed FROM items ";
2020     $query .= (C4::Context->preference('item-level_itypes'))
2021                 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2022                 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
2023                    LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2024     $query .= "WHERE items.itemnumber = ?";
2025     my $sth2 = $dbh->prepare($query);
2026     $sth2->execute($itemno);
2027     my $data2 = $sth2->fetchrow_hashref();
2028     $renewsallowed = $data2->{'renewalsallowed'};
2029     $renewsleft = $renewsallowed - $renewcount;
2030     return ($renewcount,$renewsallowed,$renewsleft);
2031 }
2032
2033 =head2 GetIssuingCharges
2034
2035 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2036
2037 Calculate how much it would cost for a given patron to borrow a given
2038 item, including any applicable discounts.
2039
2040 C<$itemnumber> is the item number of item the patron wishes to borrow.
2041
2042 C<$borrowernumber> is the patron's borrower number.
2043
2044 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2045 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2046 if it's a video).
2047
2048 =cut
2049
2050 sub GetIssuingCharges {
2051
2052     # calculate charges due
2053     my ( $itemnumber, $borrowernumber ) = @_;
2054     my $charge = 0;
2055     my $dbh    = C4::Context->dbh;
2056     my $item_type;
2057
2058     # Get the book's item type and rental charge (via its biblioitem).
2059     my $qcharge =     "SELECT itemtypes.itemtype,rentalcharge FROM items
2060             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
2061         $qcharge .= (C4::Context->preference('item-level_itypes'))
2062                 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2063                 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2064
2065     $qcharge .=      "WHERE items.itemnumber =?";
2066
2067     my $sth1 = $dbh->prepare($qcharge);
2068     $sth1->execute($itemnumber);
2069     if ( my $data1 = $sth1->fetchrow_hashref ) {
2070         $item_type = $data1->{'itemtype'};
2071         $charge    = $data1->{'rentalcharge'};
2072         my $q2 = "SELECT rentaldiscount FROM borrowers
2073             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2074             WHERE borrowers.borrowernumber = ?
2075             AND issuingrules.itemtype = ?";
2076         my $sth2 = $dbh->prepare($q2);
2077         $sth2->execute( $borrowernumber, $item_type );
2078         if ( my $data2 = $sth2->fetchrow_hashref ) {
2079             my $discount = $data2->{'rentaldiscount'};
2080             if ( $discount eq 'NULL' ) {
2081                 $discount = 0;
2082             }
2083             $charge = ( $charge * ( 100 - $discount ) ) / 100;
2084         }
2085         $sth2->finish;
2086     }
2087
2088     $sth1->finish;
2089     return ( $charge, $item_type );
2090 }
2091
2092 =head2 AddIssuingCharge
2093
2094 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2095
2096 =cut
2097
2098 sub AddIssuingCharge {
2099     my ( $itemnumber, $borrowernumber, $charge ) = @_;
2100     my $dbh = C4::Context->dbh;
2101     my $nextaccntno = getnextacctno( $borrowernumber );
2102     my $query ="
2103         INSERT INTO accountlines
2104             (borrowernumber, itemnumber, accountno,
2105             date, amount, description, accounttype,
2106             amountoutstanding)
2107         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2108     ";
2109     my $sth = $dbh->prepare($query);
2110     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2111     $sth->finish;
2112 }
2113
2114 =head2 GetTransfers
2115
2116 GetTransfers($itemnumber);
2117
2118 =cut
2119
2120 sub GetTransfers {
2121     my ($itemnumber) = @_;
2122
2123     my $dbh = C4::Context->dbh;
2124
2125     my $query = '
2126         SELECT datesent,
2127                frombranch,
2128                tobranch
2129         FROM branchtransfers
2130         WHERE itemnumber = ?
2131           AND datearrived IS NULL
2132         ';
2133     my $sth = $dbh->prepare($query);
2134     $sth->execute($itemnumber);
2135     my @row = $sth->fetchrow_array();
2136     $sth->finish;
2137     return @row;
2138 }
2139
2140
2141 =head2 GetTransfersFromTo
2142
2143 @results = GetTransfersFromTo($frombranch,$tobranch);
2144
2145 Returns the list of pending transfers between $from and $to branch
2146
2147 =cut
2148
2149 sub GetTransfersFromTo {
2150     my ( $frombranch, $tobranch ) = @_;
2151     return unless ( $frombranch && $tobranch );
2152     my $dbh   = C4::Context->dbh;
2153     my $query = "
2154         SELECT itemnumber,datesent,frombranch
2155         FROM   branchtransfers
2156         WHERE  frombranch=?
2157           AND  tobranch=?
2158           AND datearrived IS NULL
2159     ";
2160     my $sth = $dbh->prepare($query);
2161     $sth->execute( $frombranch, $tobranch );
2162     my @gettransfers;
2163
2164     while ( my $data = $sth->fetchrow_hashref ) {
2165         push @gettransfers, $data;
2166     }
2167     $sth->finish;
2168     return (@gettransfers);
2169 }
2170
2171 =head2 DeleteTransfer
2172
2173 &DeleteTransfer($itemnumber);
2174
2175 =cut
2176
2177 sub DeleteTransfer {
2178     my ($itemnumber) = @_;
2179     my $dbh          = C4::Context->dbh;
2180     my $sth          = $dbh->prepare(
2181         "DELETE FROM branchtransfers
2182          WHERE itemnumber=?
2183          AND datearrived IS NULL "
2184     );
2185     $sth->execute($itemnumber);
2186     $sth->finish;
2187 }
2188
2189 =head2 AnonymiseIssueHistory
2190
2191 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2192
2193 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2194 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2195
2196 return the number of affected rows.
2197
2198 =cut
2199
2200 sub AnonymiseIssueHistory {
2201     my $date           = shift;
2202     my $borrowernumber = shift;
2203     my $dbh            = C4::Context->dbh;
2204     my $query          = "
2205         UPDATE old_issues
2206         SET    borrowernumber = NULL
2207         WHERE  returndate < '".$date."'
2208           AND borrowernumber IS NOT NULL
2209     ";
2210     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2211     my $rows_affected = $dbh->do($query);
2212     return $rows_affected;
2213 }
2214
2215 =head2 updateWrongTransfer
2216
2217 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2218
2219 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
2220
2221 =cut
2222
2223 sub updateWrongTransfer {
2224         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2225         my $dbh = C4::Context->dbh;
2226 # first step validate the actual line of transfert .
2227         my $sth =
2228                 $dbh->prepare(
2229                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2230                 );
2231                 $sth->execute($FromLibrary,$itemNumber);
2232                 $sth->finish;
2233
2234 # second step create a new line of branchtransfer to the right location .
2235         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2236
2237 #third step changing holdingbranch of item
2238         UpdateHoldingbranch($FromLibrary,$itemNumber);
2239 }
2240
2241 =head2 UpdateHoldingbranch
2242
2243 $items = UpdateHoldingbranch($branch,$itmenumber);
2244 Simple methode for updating hodlingbranch in items BDD line
2245
2246 =cut
2247
2248 sub UpdateHoldingbranch {
2249         my ( $branch,$itemnumber ) = @_;
2250     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2251 }
2252
2253 =head2 CalcDateDue
2254
2255 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2256 this function calculates the due date given the loan length ,
2257 checking against the holidays calendar as per the 'useDaysMode' syspref.
2258 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2259 C<$branch>  = location whose calendar to use
2260 C<$loanlength>  = loan length prior to adjustment
2261 =cut
2262
2263 sub CalcDateDue {
2264         my ($startdate,$loanlength,$branch) = @_;
2265         if(C4::Context->preference('useDaysMode') eq 'Days') {  # ignoring calendar
2266                 my $datedue = time + ($loanlength) * 86400;
2267         #FIXME - assumes now even though we take a startdate
2268                 my @datearr  = localtime($datedue);
2269                 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2270         } else {
2271                 my $calendar = C4::Calendar->new(  branchcode => $branch );
2272                 my $datedue = $calendar->addDate($startdate, $loanlength);
2273                 return $datedue;
2274         }
2275 }
2276
2277 =head2 CheckValidDatedue
2278        This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2279        To be replaced by CalcDateDue() once C4::Calendar use is tested.
2280
2281 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2282 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2283 C<$date_due>   = returndate calculate with no day check
2284 C<$itemnumber>  = itemnumber
2285 C<$branchcode>  = location of issue (affected by 'CircControl' syspref)
2286 C<$loanlength>  = loan length prior to adjustment
2287 =cut
2288
2289 sub CheckValidDatedue {
2290 my ($date_due,$itemnumber,$branchcode)=@_;
2291 my @datedue=split('-',$date_due->output('iso'));
2292 my $years=$datedue[0];
2293 my $month=$datedue[1];
2294 my $day=$datedue[2];
2295 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2296 my $dow;
2297 for (my $i=0;$i<2;$i++){
2298     $dow=Day_of_Week($years,$month,$day);
2299     ($dow=0) if ($dow>6);
2300     my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2301     my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2302     my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2303         if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2304         $i=0;
2305         (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2306         }
2307     }
2308     my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2309 return $newdatedue;
2310 }
2311
2312
2313 =head2 CheckRepeatableHolidays
2314
2315 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2316 this function checks if the date due is a repeatable holiday
2317 C<$date_due>   = returndate calculate with no day check
2318 C<$itemnumber>  = itemnumber
2319 C<$branchcode>  = localisation of issue
2320
2321 =cut
2322
2323 sub CheckRepeatableHolidays{
2324 my($itemnumber,$week_day,$branchcode)=@_;
2325 my $dbh = C4::Context->dbh;
2326 my $query = qq|SELECT count(*)
2327         FROM repeatable_holidays
2328         WHERE branchcode=?
2329         AND weekday=?|;
2330 my $sth = $dbh->prepare($query);
2331 $sth->execute($branchcode,$week_day);
2332 my $result=$sth->fetchrow;
2333 $sth->finish;
2334 return $result;
2335 }
2336
2337
2338 =head2 CheckSpecialHolidays
2339
2340 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2341 this function check if the date is a special holiday
2342 C<$years>   = the years of datedue
2343 C<$month>   = the month of datedue
2344 C<$day>     = the day of datedue
2345 C<$itemnumber>  = itemnumber
2346 C<$branchcode>  = localisation of issue
2347
2348 =cut
2349
2350 sub CheckSpecialHolidays{
2351 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2352 my $dbh = C4::Context->dbh;
2353 my $query=qq|SELECT count(*)
2354              FROM `special_holidays`
2355              WHERE year=?
2356              AND month=?
2357              AND day=?
2358              AND branchcode=?
2359             |;
2360 my $sth = $dbh->prepare($query);
2361 $sth->execute($years,$month,$day,$branchcode);
2362 my $countspecial=$sth->fetchrow ;
2363 $sth->finish;
2364 return $countspecial;
2365 }
2366
2367 =head2 CheckRepeatableSpecialHolidays
2368
2369 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2370 this function check if the date is a repeatble special holidays
2371 C<$month>   = the month of datedue
2372 C<$day>     = the day of datedue
2373 C<$itemnumber>  = itemnumber
2374 C<$branchcode>  = localisation of issue
2375
2376 =cut
2377
2378 sub CheckRepeatableSpecialHolidays{
2379 my ($month,$day,$itemnumber,$branchcode) = @_;
2380 my $dbh = C4::Context->dbh;
2381 my $query=qq|SELECT count(*)
2382              FROM `repeatable_holidays`
2383              WHERE month=?
2384              AND day=?
2385              AND branchcode=?
2386             |;
2387 my $sth = $dbh->prepare($query);
2388 $sth->execute($month,$day,$branchcode);
2389 my $countspecial=$sth->fetchrow ;
2390 $sth->finish;
2391 return $countspecial;
2392 }
2393
2394
2395
2396 sub CheckValidBarcode{
2397 my ($barcode) = @_;
2398 my $dbh = C4::Context->dbh;
2399 my $query=qq|SELECT count(*)
2400              FROM items
2401              WHERE barcode=?
2402             |;
2403 my $sth = $dbh->prepare($query);
2404 $sth->execute($barcode);
2405 my $exist=$sth->fetchrow ;
2406 $sth->finish;
2407 return $exist;
2408 }
2409
2410 1;
2411
2412 __END__
2413
2414 =head1 AUTHOR
2415
2416 Koha Developement team <info@koha.org>
2417
2418 =cut
2419