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 ) = @_;
 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     }
 855         if ($borrower and $barcode and $barcodecheck ne '0'){
 856                 # find which item we issue
 857                 my $item = GetItem('', $barcode) or return undef;       # if we don't get an Item, abort.
 858                 my $branch;
 859                 # Get which branchcode we need
 860                 if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
 861                         $branch = C4::Context->userenv->{'branch'};
 862                 }
 863                 elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
 864                         $branch = $borrower->{'branchcode'};
 865                 }
 866                 else {
 867                         # items home library
 868                         $branch = $item->{'homebranch'};
 869                 }
 870
 871                 # get actual issuing if there is one
 872                 my $actualissue = GetItemIssue( $item->{itemnumber});
 873
 874                 # get biblioinformation for this item
 875                 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
 876
 877                 #
 878                 # check if we just renew the issue.
 879                 #
 880                 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
 881                         $datedue = AddRenewal(
 882                                 $borrower->{'borrowernumber'},
 883                                 $item->{'itemnumber'},
 884                                 $branch,
 885                                 $datedue,
 886                 $issuedate, # here interpreted as the renewal date
 887                         );
 888                 }
 889                 else {
 890         # it's NOT a renewal
 891                         if ( $actualissue->{borrowernumber}) {
 892                                 # This book is currently on loan, but not to the person
 893                                 # who wants to borrow it now. mark it returned before issuing to the new borrower
 894                                 AddReturn(
 895                                         $item->{'barcode'},
 896                                         C4::Context->userenv->{'branch'}
 897                                 );
 898                         }
 899
 900                         # See if the item is on reserve.
 901                         my ( $restype, $res ) =
 902                           C4::Reserves::CheckReserves( $item->{'itemnumber'} );
 903                         if ($restype) {
 904                                 my $resbor = $res->{'borrowernumber'};
 905                                 if ( $resbor eq $borrower->{'borrowernumber'} ) {
 906
 907                                         # The item is reserved by the current patron
 908                                         ModReserveFill($res);
 909                                 }
 910                                 elsif ( $restype eq "Waiting" ) {
 911
 912                                         # warn "Waiting";
 913                                         # The item is on reserve and waiting, but has been
 914                                         # reserved by some other patron.
 915                                 }
 916                                 elsif ( $restype eq "Reserved" ) {
 917
 918                                         # warn "Reserved";
 919                                         # The item is reserved by someone else.
 920                                         if ($cancelreserve) { # cancel reserves on this item
 921                                                 CancelReserve( 0, $res->{'itemnumber'},
 922                                                         $res->{'borrowernumber'} );
 923                                         }
 924                                 }
 925                                 if ($cancelreserve) {
 926                                         CancelReserve( $res->{'biblionumber'}, 0,
 927                     $res->{'borrowernumber'} );
 928                                 }
 929                                 else {
 930                                         # set waiting reserve to first in reserve queue as book isn't waiting now
 931                                         ModReserve(1,
 932                                                 $res->{'biblionumber'},
 933                                                 $res->{'borrowernumber'},
 934                                                 $res->{'branchcode'}
 935                                         );
 936                                 }
 937                         }
 938
 939                         # Starting process for transfer job (checking transfert and validate it if we have one)
 940             my ($datesent) = GetTransfers($item->{'itemnumber'});
 941             if ($datesent) {
 942         #       updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
 943             my $sth =
 944                     $dbh->prepare(
 945                     "UPDATE branchtransfers
 946                         SET datearrived = now(),
 947                         tobranch = ?,
 948                         comments = 'Forced branchtransfer'
 949                     WHERE itemnumber= ? AND datearrived IS NULL"
 950                     );
 951                     $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
 952                     $sth->finish;
 953             }
 954
 955         # Record in the database the fact that the book was issued.
 956         my $sth =
 957           $dbh->prepare(
 958                 "INSERT INTO issues
 959                     (borrowernumber, itemnumber,issuedate, date_due, branchcode)
 960                 VALUES (?,?,?,?,?)"
 961           );
 962         unless ($datedue) {
 963             my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
 964             my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch );
 965             $datedue = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch );
 966
 967             # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
 968             if ( C4::Context->preference('ReturnBeforeExpiry') && $datedue->output('iso') gt $borrower->{dateexpiry} ) {
 969                 $datedue = C4::Dates->new( $borrower->{dateexpiry}, 'iso' );
 970             }
 971         }
 972         $sth->execute(
 973             $borrower->{'borrowernumber'},      # borrowernumber
 974             $item->{'itemnumber'},              # itemnumber
 975             $issuedate,                         # issuedate
 976             $datedue->output('iso'),            # date_due
 977             C4::Context->userenv->{'branch'}    # branchcode
 978         );
 979         $sth->finish;
 980         $item->{'issues'}++;
 981         ModItem({ issues           => $item->{'issues'},
 982                   holdingbranch    => C4::Context->userenv->{'branch'},
 983                   itemlost         => 0,
 984                   datelastborrowed => C4::Dates->new()->output('iso'),
 985                   onloan           => $datedue->output('iso'),
 986                 }, $item->{'biblionumber'}, $item->{'itemnumber'});
 987         ModDateLastSeen( $item->{'itemnumber'} );
 988
 989         # If it costs to borrow this book, charge it to the patron's account.
 990         my ( $charge, $itemtype ) = GetIssuingCharges(
 991             $item->{'itemnumber'},
 992             $borrower->{'borrowernumber'}
 993         );
 994         if ( $charge > 0 ) {
 995             AddIssuingCharge(
 996                 $item->{'itemnumber'},
 997                 $borrower->{'borrowernumber'}, $charge
 998             );
 999             $item->{'charge'} = $charge;
1000         }
1001
1002         # Record the fact that this book was issued.
1003         &UpdateStats(
1004             C4::Context->userenv->{'branch'},
1005             'issue',                        $charge,
1006             '',                             $item->{'itemnumber'},
1007             $item->{'itype'}, $borrower->{'borrowernumber'}
1008         );
1009     }
1010
1011     logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1012         if C4::Context->preference("IssueLog");
1013   }
1014   return ($datedue);    # not necessarily the same as when it came in!
1015 }
1016
1017 =head2 GetLoanLength
1018
1019 Get loan length for an itemtype, a borrower type and a branch
1020
1021 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1022
1023 =cut
1024
1025 sub GetLoanLength {
1026     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1027     my $dbh = C4::Context->dbh;
1028     my $sth =
1029       $dbh->prepare(
1030 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1031       );
1032 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1033 # try to find issuelength & return the 1st available.
1034 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1035     $sth->execute( $borrowertype, $itemtype, $branchcode );
1036     my $loanlength = $sth->fetchrow_hashref;
1037     return $loanlength->{issuelength}
1038       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1039
1040     $sth->execute( $borrowertype, "*", $branchcode );
1041     $loanlength = $sth->fetchrow_hashref;
1042     return $loanlength->{issuelength}
1043       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1044
1045     $sth->execute( "*", $itemtype, $branchcode );
1046     $loanlength = $sth->fetchrow_hashref;
1047     return $loanlength->{issuelength}
1048       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1049
1050     $sth->execute( "*", "*", $branchcode );
1051     $loanlength = $sth->fetchrow_hashref;
1052     return $loanlength->{issuelength}
1053       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1054
1055     $sth->execute( $borrowertype, $itemtype, "*" );
1056     $loanlength = $sth->fetchrow_hashref;
1057     return $loanlength->{issuelength}
1058       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1059
1060     $sth->execute( $borrowertype, "*", "*" );
1061     $loanlength = $sth->fetchrow_hashref;
1062     return $loanlength->{issuelength}
1063       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1064
1065     $sth->execute( "*", $itemtype, "*" );
1066     $loanlength = $sth->fetchrow_hashref;
1067     return $loanlength->{issuelength}
1068       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1069
1070     $sth->execute( "*", "*", "*" );
1071     $loanlength = $sth->fetchrow_hashref;
1072     return $loanlength->{issuelength}
1073       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1074
1075     # if no rule is set => 21 days (hardcoded)
1076     return 21;
1077 }
1078
1079 =head2 GetIssuingRule
1080
1081 FIXME - This is a copy-paste of GetLoanLength
1082 as a stop-gap.  Do not wish to change API for GetLoanLength
1083 this close to release, however, Overdues::GetIssuingRules is broken.
1084
1085 Get the issuing rule for an itemtype, a borrower type and a branch
1086 Returns a hashref from the issuingrules table.
1087
1088 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1089
1090 =cut
1091
1092 sub GetIssuingRule {
1093     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1094     my $dbh = C4::Context->dbh;
1095     my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"  );
1096     my $irule;
1097
1098         $sth->execute( $borrowertype, $itemtype, $branchcode );
1099     $irule = $sth->fetchrow_hashref;
1100     return $irule if defined($irule) ;
1101
1102     $sth->execute( $borrowertype, "*", $branchcode );
1103     $irule = $sth->fetchrow_hashref;
1104     return $irule if defined($irule) ;
1105
1106     $sth->execute( "*", $itemtype, $branchcode );
1107     $irule = $sth->fetchrow_hashref;
1108     return $irule if defined($irule) ;
1109
1110     $sth->execute( "*", "*", $branchcode );
1111     $irule = $sth->fetchrow_hashref;
1112     return $irule if defined($irule) ;
1113
1114     $sth->execute( $borrowertype, $itemtype, "*" );
1115     $irule = $sth->fetchrow_hashref;
1116     return $irule if defined($irule) ;
1117
1118     $sth->execute( $borrowertype, "*", "*" );
1119     $irule = $sth->fetchrow_hashref;
1120     return $irule if defined($irule) ;
1121
1122     $sth->execute( "*", $itemtype, "*" );
1123     $irule = $sth->fetchrow_hashref;
1124     return $irule if defined($irule) ;
1125
1126     $sth->execute( "*", "*", "*" );
1127     $irule = $sth->fetchrow_hashref;
1128     return $irule if defined($irule) ;
1129
1130     # if no rule matches,
1131     return undef;
1132 }
1133
1134 =head2 GetBranchBorrowerCircRule
1135
1136 =over 4
1137
1138 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1139
1140 =back
1141
1142 Retrieves circulation rule attributes that apply to the given
1143 branch and patron category, regardless of item type.
1144 The return value is a hashref containing the following key:
1145
1146 maxissueqty - maximum number of loans that a
1147 patron of the given category can have at the given
1148 branch.  If the value is undef, no limit.
1149
1150 This will first check for a specific branch and
1151 category match from branch_borrower_circ_rules.
1152
1153 If no rule is found, it will then check default_branch_circ_rules
1154 (same branch, default category).  If no rule is found,
1155 it will then check default_borrower_circ_rules (default
1156 branch, same category), then failing that, default_circ_rules
1157 (default branch, default category).
1158
1159 If no rule has been found in the database, it will default to
1160 the buillt in rule:
1161
1162 maxissueqty - undef
1163
1164 C<$branchcode> and C<$categorycode> should contain the
1165 literal branch code and patron category code, respectively - no
1166 wildcards.
1167
1168 =cut
1169
1170 sub GetBranchBorrowerCircRule {
1171     my $branchcode = shift;
1172     my $categorycode = shift;
1173
1174     my $branch_cat_query = "SELECT maxissueqty
1175                             FROM branch_borrower_circ_rules
1176                             WHERE branchcode = ?
1177                             AND   categorycode = ?";
1178     my $dbh = C4::Context->dbh();
1179     my $sth = $dbh->prepare($branch_cat_query);
1180     $sth->execute($branchcode, $categorycode);
1181     my $result;
1182     if ($result = $sth->fetchrow_hashref()) {
1183         return $result;
1184     }
1185
1186     # try same branch, default borrower category
1187     my $branch_query = "SELECT maxissueqty
1188                         FROM default_branch_circ_rules
1189                         WHERE branchcode = ?";
1190     $sth = $dbh->prepare($branch_query);
1191     $sth->execute($branchcode);
1192     if ($result = $sth->fetchrow_hashref()) {
1193         return $result;
1194     }
1195
1196     # try default branch, same borrower category
1197     my $category_query = "SELECT maxissueqty
1198                           FROM default_borrower_circ_rules
1199                           WHERE categorycode = ?";
1200     $sth = $dbh->prepare($category_query);
1201     $sth->execute($categorycode);
1202     if ($result = $sth->fetchrow_hashref()) {
1203         return $result;
1204     }
1205
1206     # try default branch, default borrower category
1207     my $default_query = "SELECT maxissueqty
1208                           FROM default_circ_rules";
1209     $sth = $dbh->prepare($default_query);
1210     $sth->execute();
1211     if ($result = $sth->fetchrow_hashref()) {
1212         return $result;
1213     }
1214
1215     # built-in default circulation rule
1216     return {
1217         maxissueqty => undef,
1218     };
1219 }
1220
1221 =head2 AddReturn
1222
1223 ($doreturn, $messages, $iteminformation, $borrower) =
1224     &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1225
1226 Returns a book.
1227
1228 =over 4
1229
1230 =item C<$barcode> is the bar code of the book being returned.
1231
1232 =item C<$branch> is the code of the branch where the book is being returned.
1233
1234 =item C<$exemptfine> indicates that overdue charges for the item will be
1235 removed.
1236
1237 =item C<$dropbox> indicates that the check-in date is assumed to be
1238 yesterday, or the last non-holiday as defined in C4::Calendar .  If
1239 overdue charges are applied and C<$dropbox> is true, the last charge
1240 will be removed.  This assumes that the fines accrual script has run
1241 for _today_.
1242
1243 =back
1244
1245 C<&AddReturn> returns a list of four items:
1246
1247 C<$doreturn> is true iff the return succeeded.
1248
1249 C<$messages> is a reference-to-hash giving the reason for failure:
1250
1251 =over 4
1252
1253 =item C<BadBarcode>
1254
1255 No item with this barcode exists. The value is C<$barcode>.
1256
1257 =item C<NotIssued>
1258
1259 The book is not currently on loan. The value is C<$barcode>.
1260
1261 =item C<IsPermanent>
1262
1263 The book's home branch is a permanent collection. If you have borrowed
1264 this book, you are not allowed to return it. The value is the code for
1265 the book's home branch.
1266
1267 =item C<wthdrawn>
1268
1269 This book has been withdrawn/cancelled. The value should be ignored.
1270
1271 =item C<ResFound>
1272
1273 The item was reserved. The value is a reference-to-hash whose keys are
1274 fields from the reserves table of the Koha database, and
1275 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1276 either C<Waiting>, C<Reserved>, or 0.
1277
1278 =back
1279
1280 C<$borrower> is a reference-to-hash, giving information about the
1281 patron who last borrowed the book.
1282
1283 =cut
1284
1285 sub AddReturn {
1286     my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1287     my $dbh      = C4::Context->dbh;
1288     my $messages;
1289     my $doreturn = 1;
1290     my $borrower;
1291     my $validTransfert = 0;
1292     my $reserveDone = 0;
1293
1294     # get information on item
1295     my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1296     my $biblio = GetBiblioItemData($iteminformation->{'biblioitemnumber'});
1297 #     use Data::Dumper;warn Data::Dumper::Dumper($iteminformation);
1298     unless ($iteminformation->{'itemnumber'} ) {
1299         $messages->{'BadBarcode'} = $barcode;
1300         $doreturn = 0;
1301     } else {
1302         # find the borrower
1303         if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1304             $messages->{'NotIssued'} = $barcode;
1305             # even though item is not on loan, it may still
1306             # be transferred; therefore, get current branch information
1307             my $curr_iteminfo = GetItem($iteminformation->{'itemnumber'});
1308             $iteminformation->{'homebranch'} = $curr_iteminfo->{'homebranch'};
1309             $iteminformation->{'holdingbranch'} = $curr_iteminfo->{'holdingbranch'};
1310             $doreturn = 0;
1311         }
1312
1313         # check if the book is in a permanent collection....
1314         my $hbr      = $iteminformation->{C4::Context->preference("HomeOrHoldingBranch")};
1315         my $branches = GetBranches();
1316                 # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
1317         if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1318             $messages->{'IsPermanent'} = $hbr;
1319         }
1320
1321                     # if independent branches are on and returning to different branch, refuse the return
1322         if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){
1323                           $messages->{'Wrongbranch'} = 1;
1324                           $doreturn=0;
1325                     }
1326
1327         # check that the book has been cancelled
1328         if ( $iteminformation->{'wthdrawn'} ) {
1329             $messages->{'wthdrawn'} = 1;
1330             $doreturn = 0;
1331         }
1332
1333     #     new op dev : if the book returned in an other branch update the holding branch
1334
1335     # update issues, thereby returning book (should push this out into another subroutine
1336         $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1337
1338     # case of a return of document (deal with issues and holdingbranch)
1339
1340         if ($doreturn) {
1341                         my $circControlBranch;
1342                         if($dropbox) {
1343                                 # don't allow dropbox mode to create an invalid entry in issues (issuedate > returndate) FIXME: actually checks eq, not gt
1344                                 undef($dropbox) if ( $iteminformation->{'issuedate'} eq C4::Dates->today('iso') );
1345                                 if (C4::Context->preference('CircControl') eq 'ItemHomeBranch' ) {
1346                                         $circControlBranch = $iteminformation->{homebranch};
1347                                 } elsif ( C4::Context->preference('CircControl') eq 'PatronLibrary') {
1348                                         $circControlBranch = $borrower->{branchcode};
1349                                 } else { # CircControl must be PickupLibrary.
1350                                         $circControlBranch = $iteminformation->{holdingbranch};
1351                                         # FIXME - is this right ? are we sure that the holdingbranch is still the pickup branch?
1352                                 }
1353                         }
1354             MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'},$circControlBranch);
1355             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?
1356             # continue to deal with returns cases, but not only if we have an issue
1357
1358             # the holdingbranch is updated if the document is returned in an other location .
1359             if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) {
1360                            UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1361                            #           reload iteminformation holdingbranch with the userenv value
1362                            $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1363             }
1364             ModDateLastSeen( $iteminformation->{'itemnumber'} );
1365             ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'});
1366
1367             if ($iteminformation->{borrowernumber}){
1368               ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1369             }
1370         }
1371         # fix up the accounts.....
1372         if ( $iteminformation->{'itemlost'} ) {
1373             $messages->{'WasLost'} = 1;
1374         }
1375
1376     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1377     #     check if we have a transfer for this document
1378         my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1379
1380     #     if we have a transfer to do, we update the line of transfers with the datearrived
1381         if ($datesent) {
1382             if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1383                     my $sth =
1384                     $dbh->prepare(
1385                             "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1386                     );
1387                     $sth->execute( $iteminformation->{'itemnumber'} );
1388                     $sth->finish;
1389     #         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'
1390             C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1391             }
1392         else {
1393             $messages->{'WrongTransfer'} = $tobranch;
1394             $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1395         }
1396         $validTransfert = 1;
1397         }
1398
1399     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1400         # fix up the accounts.....
1401         if ($iteminformation->{'itemlost'}) {
1402                 FixAccountForLostAndReturned($iteminformation, $borrower);
1403                 $messages->{'WasLost'} = 1;
1404         }
1405         # fix up the overdues in accounts...
1406         FixOverduesOnReturn( $borrower->{'borrowernumber'},
1407             $iteminformation->{'itemnumber'}, $exemptfine, $dropbox );
1408
1409     # find reserves.....
1410     #     if we don't have a reserve with the status W, we launch the Checkreserves routine
1411         my ( $resfound, $resrec ) =
1412         C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1413         if ($resfound) {
1414             $resrec->{'ResFound'}   = $resfound;
1415             $messages->{'ResFound'} = $resrec;
1416             $reserveDone = 1;
1417         }
1418
1419         # update stats?
1420         # Record the fact that this book was returned.
1421         UpdateStats(
1422             $branch, 'return', '0', '',
1423             $iteminformation->{'itemnumber'},
1424             $biblio->{'itemtype'},
1425             $borrower->{'borrowernumber'}
1426         );
1427
1428         logaction("CIRCULATION", "RETURN", $iteminformation->{borrowernumber}, $iteminformation->{'biblionumber'})
1429             if C4::Context->preference("ReturnLog");
1430
1431         #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1432         #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1433
1434         if ($doreturn and ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1435                         if (C4::Context->preference("AutomaticItemReturn") == 1) {
1436                                 ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1437                                 $messages->{'WasTransfered'} = 1;
1438                         }
1439                         else {
1440                                 $messages->{'NeedsTransfer'} = 1;
1441                         }
1442         }
1443     }
1444     return ( $doreturn, $messages, $iteminformation, $borrower );
1445 }
1446
1447 =head2 MarkIssueReturned
1448
1449 =over 4
1450
1451 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate);
1452
1453 =back
1454
1455 Unconditionally marks an issue as being returned by
1456 moving the C<issues> row to C<old_issues> and
1457 setting C<returndate> to the current date, or
1458 the last non-holiday date of the branccode specified in
1459 C<dropbox_branch> .  Assumes you've already checked that
1460 it's safe to do this, i.e. last non-holiday > issuedate.
1461
1462 if C<$returndate> is specified (in iso format), it is used as the date
1463 of the return. It is ignored when a dropbox_branch is passed in.
1464
1465 Ideally, this function would be internal to C<C4::Circulation>,
1466 not exported, but it is currently needed by one
1467 routine in C<C4::Accounts>.
1468
1469 =cut
1470
1471 sub MarkIssueReturned {
1472     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate ) = @_;
1473     my $dbh   = C4::Context->dbh;
1474     my $query = "UPDATE issues SET returndate=";
1475     my @bind;
1476     if ($dropbox_branch) {
1477         my $calendar = C4::Calendar->new( branchcode => $dropbox_branch );
1478         my $dropboxdate = $calendar->addDate( C4::Dates->new(), -1 );
1479         $query .= " ? ";
1480         push @bind, $dropboxdate->output('iso');
1481     } elsif ($returndate) {
1482         $query .= " ? ";
1483         push @bind, $returndate;
1484     } else {
1485         $query .= " now() ";
1486     }
1487     $query .= " WHERE  borrowernumber = ?  AND itemnumber = ?";
1488     push @bind, $borrowernumber, $itemnumber;
1489     # FIXME transaction
1490     my $sth_upd  = $dbh->prepare($query);
1491     $sth_upd->execute(@bind);
1492     my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1493                                   WHERE borrowernumber = ?
1494                                   AND itemnumber = ?");
1495     $sth_copy->execute($borrowernumber, $itemnumber);
1496     my $sth_del  = $dbh->prepare("DELETE FROM issues
1497                                   WHERE borrowernumber = ?
1498                                   AND itemnumber = ?");
1499     $sth_del->execute($borrowernumber, $itemnumber);
1500 }
1501
1502 =head2 FixOverduesOnReturn
1503
1504     &FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1505
1506 C<$brn> borrowernumber
1507
1508 C<$itm> itemnumber
1509
1510 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1511 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1512
1513 internal function, called only by AddReturn
1514
1515 =cut
1516
1517 sub FixOverduesOnReturn {
1518     my ( $borrowernumber, $item, $exemptfine, $dropbox ) = @_;
1519     my $dbh = C4::Context->dbh;
1520
1521     # check for overdue fine
1522     my $sth =
1523       $dbh->prepare(
1524 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1525       );
1526     $sth->execute( $borrowernumber, $item );
1527
1528     # alter fine to show that the book has been returned
1529    my $data;
1530         if ($data = $sth->fetchrow_hashref) {
1531         my $uquery;
1532                 my @bind = ($borrowernumber,$item ,$data->{'accountno'});
1533                 if ($exemptfine) {
1534                         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1535                         if (C4::Context->preference("FinesLog")) {
1536                         &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1537                         }
1538                 } elsif ($dropbox && $data->{lastincrement}) {
1539                         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1540                         my $amt = $data->{amount} - $data->{lastincrement} ;
1541                         if (C4::Context->preference("FinesLog")) {
1542                         &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1543                         }
1544                          $uquery = "update accountlines set accounttype='F' ";
1545                          if($outstanding  >= 0 && $amt >=0) {
1546                                 $uquery .= ", amount = ? , amountoutstanding=? ";
1547                                 unshift @bind, ($amt, $outstanding) ;
1548                         }
1549                 } else {
1550                         $uquery = "update accountlines set accounttype='F' ";
1551                 }
1552                 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1553         my $usth = $dbh->prepare($uquery);
1554         $usth->execute(@bind);
1555         $usth->finish();
1556     }
1557
1558     $sth->finish();
1559     return;
1560 }
1561
1562 =head2 FixAccountForLostAndReturned
1563
1564         &FixAccountForLostAndReturned($iteminfo,$borrower);
1565
1566 Calculates the charge for a book lost and returned (Not exported & used only once)
1567
1568 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1569
1570 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1571
1572 Internal function, called by AddReturn
1573
1574 =cut
1575
1576 sub FixAccountForLostAndReturned {
1577         my ($iteminfo, $borrower) = @_;
1578         my $dbh = C4::Context->dbh;
1579         my $itm = $iteminfo->{'itemnumber'};
1580         # check for charge made for lost book
1581         my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1582         $sth->execute($itm);
1583         if (my $data = $sth->fetchrow_hashref) {
1584         # writeoff this amount
1585                 my $offset;
1586                 my $amount = $data->{'amount'};
1587                 my $acctno = $data->{'accountno'};
1588                 my $amountleft;
1589                 if ($data->{'amountoutstanding'} == $amount) {
1590                 $offset = $data->{'amount'};
1591                 $amountleft = 0;
1592                 } else {
1593                 $offset = $amount - $data->{'amountoutstanding'};
1594                 $amountleft = $data->{'amountoutstanding'} - $amount;
1595                 }
1596                 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1597                         WHERE (borrowernumber = ?)
1598                         AND (itemnumber = ?) AND (accountno = ?) ");
1599                 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1600                 $usth->finish;
1601         #check if any credit is left if so writeoff other accounts
1602                 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1603                 if ($amountleft < 0){
1604                 $amountleft*=-1;
1605                 }
1606                 if ($amountleft > 0){
1607                 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1608                                                         AND (amountoutstanding >0) ORDER BY date");
1609                 $msth->execute($data->{'borrowernumber'});
1610         # offset transactions
1611                 my $newamtos;
1612                 my $accdata;
1613                 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1614                         if ($accdata->{'amountoutstanding'} < $amountleft) {
1615                         $newamtos = 0;
1616                         $amountleft -= $accdata->{'amountoutstanding'};
1617                         }  else {
1618                         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1619                         $amountleft = 0;
1620                         }
1621                         my $thisacct = $accdata->{'accountno'};
1622                         my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1623                                         WHERE (borrowernumber = ?)
1624                                         AND (accountno=?)");
1625                         $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1626                         $usth->finish;
1627                         $usth = $dbh->prepare("INSERT INTO accountoffsets
1628                                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1629                                 VALUES
1630                                 (?,?,?,?)");
1631                         $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1632                         $usth->finish;
1633                 }
1634                 $msth->finish;
1635                 }
1636                 if ($amountleft > 0){
1637                         $amountleft*=-1;
1638                 }
1639                 my $desc="Item Returned ".$iteminfo->{'barcode'};
1640                 $usth = $dbh->prepare("INSERT INTO accountlines
1641                         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1642                         VALUES (?,?,now(),?,?,'CR',?)");
1643                 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1644                 $usth->finish;
1645                 $usth = $dbh->prepare("INSERT INTO accountoffsets
1646                         (borrowernumber, accountno, offsetaccount,  offsetamount)
1647                         VALUES (?,?,?,?)");
1648                 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1649                 $usth->finish;
1650         ModItem({ paidfor => '' }, undef, $itm);
1651         }
1652         $sth->finish;
1653         return;
1654 }
1655
1656 =head2 GetItemIssue
1657
1658 $issues = &GetItemIssue($itemnumber);
1659
1660 Returns patrons currently having a book. nothing if item is not issued atm
1661
1662 C<$itemnumber> is the itemnumber
1663
1664 Returns an array of hashes
1665
1666 FIXME: Though the above says that this function returns nothing if the
1667 item is not issued, this actually returns a hasref that looks like
1668 this:
1669     {
1670       itemnumber => 1,
1671       overdue    => 1
1672     }
1673
1674
1675 =cut
1676
1677 sub GetItemIssue {
1678     my ( $itemnumber) = @_;
1679     return unless $itemnumber;
1680     my $dbh = C4::Context->dbh;
1681     my @GetItemIssues;
1682
1683     # get today date
1684     my $today = POSIX::strftime("%Y%m%d", localtime);
1685
1686     my $sth = $dbh->prepare(
1687         "SELECT * FROM issues
1688         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1689     WHERE
1690     issues.itemnumber=?");
1691     $sth->execute($itemnumber);
1692     my $data = $sth->fetchrow_hashref;
1693     my $datedue = $data->{'date_due'};
1694     $datedue =~ s/-//g;
1695     if ( $datedue < $today ) {
1696         $data->{'overdue'} = 1;
1697     }
1698     $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1699     $sth->finish;
1700     return ($data);
1701 }
1702
1703 =head2 GetItemIssues
1704
1705 $issues = &GetItemIssues($itemnumber, $history);
1706
1707 Returns patrons that have issued a book
1708
1709 C<$itemnumber> is the itemnumber
1710 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1711
1712 Returns an array of hashes
1713
1714 =cut
1715
1716 sub GetItemIssues {
1717     my ( $itemnumber,$history ) = @_;
1718     my $dbh = C4::Context->dbh;
1719     my @GetItemIssues;
1720
1721     # get today date
1722     my $today = POSIX::strftime("%Y%m%d", localtime);
1723
1724     my $sql = "SELECT * FROM issues
1725               JOIN borrowers USING (borrowernumber)
1726               JOIN items USING (itemnumber)
1727               WHERE issues.itemnumber = ? ";
1728     if ($history) {
1729         $sql .= "UNION ALL
1730                  SELECT * FROM old_issues
1731                  LEFT JOIN borrowers USING (borrowernumber)
1732                  JOIN items USING (itemnumber)
1733                  WHERE old_issues.itemnumber = ? ";
1734     }
1735     $sql .= "ORDER BY date_due DESC";
1736     my $sth = $dbh->prepare($sql);
1737     if ($history) {
1738         $sth->execute($itemnumber, $itemnumber);
1739     } else {
1740         $sth->execute($itemnumber);
1741     }
1742     while ( my $data = $sth->fetchrow_hashref ) {
1743         my $datedue = $data->{'date_due'};
1744         $datedue =~ s/-//g;
1745         if ( $datedue < $today ) {
1746             $data->{'overdue'} = 1;
1747         }
1748         my $itemnumber = $data->{'itemnumber'};
1749         push @GetItemIssues, $data;
1750     }
1751     $sth->finish;
1752     return ( \@GetItemIssues );
1753 }
1754
1755 =head2 GetBiblioIssues
1756
1757 $issues = GetBiblioIssues($biblionumber);
1758
1759 this function get all issues from a biblionumber.
1760
1761 Return:
1762 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1763 tables issues and the firstname,surname & cardnumber from borrowers.
1764
1765 =cut
1766
1767 sub GetBiblioIssues {
1768     my $biblionumber = shift;
1769     return undef unless $biblionumber;
1770     my $dbh   = C4::Context->dbh;
1771     my $query = "
1772         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1773         FROM issues
1774             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1775             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1776             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1777             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1778         WHERE biblio.biblionumber = ?
1779         UNION ALL
1780         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1781         FROM old_issues
1782             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1783             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1784             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1785             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1786         WHERE biblio.biblionumber = ?
1787         ORDER BY timestamp
1788     ";
1789     my $sth = $dbh->prepare($query);
1790     $sth->execute($biblionumber, $biblionumber);
1791
1792     my @issues;
1793     while ( my $data = $sth->fetchrow_hashref ) {
1794         push @issues, $data;
1795     }
1796     return \@issues;
1797 }
1798
1799 =head2 GetUpcomingDueIssues
1800
1801 =over 4
1802
1803 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
1804
1805 =back
1806
1807 =cut
1808
1809 sub GetUpcomingDueIssues {
1810     my $params = shift;
1811
1812     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
1813     my $dbh = C4::Context->dbh;
1814
1815     my $statement = <<END_SQL;
1816 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due
1817 FROM issues
1818 LEFT JOIN items USING (itemnumber)
1819 WhERE returndate is NULL
1820 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
1821 END_SQL
1822
1823     my @bind_parameters = ( $params->{'days_in_advance'} );
1824
1825     my $sth = $dbh->prepare( $statement );
1826     $sth->execute( @bind_parameters );
1827     my $upcoming_dues = $sth->fetchall_arrayref({});
1828     $sth->finish;
1829
1830     return $upcoming_dues;
1831 }
1832
1833 =head2 CanBookBeRenewed
1834
1835 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
1836
1837 Find out whether a borrowed item may be renewed.
1838
1839 C<$dbh> is a DBI handle to the Koha database.
1840
1841 C<$borrowernumber> is the borrower number of the patron who currently
1842 has the item on loan.
1843
1844 C<$itemnumber> is the number of the item to renew.
1845
1846 C<$override_limit>, if supplied with a true value, causes
1847 the limit on the number of times that the loan can be renewed
1848 (as controlled by the item type) to be ignored.
1849
1850 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1851 item must currently be on loan to the specified borrower; renewals
1852 must be allowed for the item's type; and the borrower must not have
1853 already renewed the loan. $error will contain the reason the renewal can not proceed
1854
1855 =cut
1856
1857 sub CanBookBeRenewed {
1858
1859     # check renewal status
1860     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
1861     my $dbh       = C4::Context->dbh;
1862     my $renews    = 1;
1863     my $renewokay = 0;
1864         my $error;
1865
1866     # Look in the issues table for this item, lent to this borrower,
1867     # and not yet returned.
1868
1869     # FIXME - I think this function could be redone to use only one SQL call.
1870     my $sth1 = $dbh->prepare(
1871         "SELECT * FROM issues
1872             WHERE borrowernumber = ?
1873             AND itemnumber = ?"
1874     );
1875     $sth1->execute( $borrowernumber, $itemnumber );
1876     if ( my $data1 = $sth1->fetchrow_hashref ) {
1877
1878         # Found a matching item
1879
1880         # See if this item may be renewed. This query is convoluted
1881         # because it's a bit messy: given the item number, we need to find
1882         # the biblioitem, which gives us the itemtype, which tells us
1883         # whether it may be renewed.
1884         my $query = "SELECT renewalsallowed FROM items ";
1885         $query .= (C4::Context->preference('item-level_itypes'))
1886                     ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1887                     : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1888                        LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1889         $query .= "WHERE items.itemnumber = ?";
1890         my $sth2 = $dbh->prepare($query);
1891         $sth2->execute($itemnumber);
1892         if ( my $data2 = $sth2->fetchrow_hashref ) {
1893             $renews = $data2->{'renewalsallowed'};
1894         }
1895         if ( ( $renews && $renews > $data1->{'renewals'} ) || $override_limit ) {
1896             $renewokay = 1;
1897         }
1898         else {
1899                         $error="too_many";
1900                 }
1901         $sth2->finish;
1902         my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1903         if ($resfound) {
1904             $renewokay = 0;
1905                         $error="on_reserve"
1906         }
1907
1908     }
1909     $sth1->finish;
1910     return ($renewokay,$error);
1911 }
1912
1913 =head2 AddRenewal
1914
1915 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
1916
1917 Renews a loan.
1918
1919 C<$borrowernumber> is the borrower number of the patron who currently
1920 has the item.
1921
1922 C<$itemnumber> is the number of the item to renew.
1923
1924 C<$branch> is the library branch.  Defaults to the homebranch of the ITEM.
1925
1926 C<$datedue> can be a C4::Dates object used to set the due date.
1927
1928 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
1929 this parameter is not supplied, lastreneweddate is set to the current date.
1930
1931 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
1932 from the book's item type.
1933
1934 =cut
1935
1936 sub AddRenewal {
1937         my $borrowernumber = shift or return undef;
1938         my     $itemnumber = shift or return undef;
1939     my $item   = GetItem($itemnumber) or return undef;
1940     my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
1941     my $branch  = (@_) ? shift : $item->{homebranch};   # opac-renew doesn't send branch
1942     my $datedue = shift;
1943     my $lastreneweddate = shift;
1944
1945     # If the due date wasn't specified, calculate it by adding the
1946     # book's loan length to today's date.
1947     unless ($datedue && $datedue->output('iso')) {
1948
1949         my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
1950         my $loanlength = GetLoanLength(
1951             $borrower->{'categorycode'},
1952              (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
1953                         $item->{homebranch}                     # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument?
1954         );
1955                 #FIXME -- use circControl?
1956                 $datedue =  CalcDateDue(C4::Dates->new(),$loanlength,$branch);  # this branch is the transactional branch.
1957                                                                 # The question of whether to use item's homebranch calendar is open.
1958     }
1959
1960     # $lastreneweddate defaults to today.
1961     unless (defined $lastreneweddate) {
1962         $lastreneweddate = strftime( "%Y-%m-%d", localtime );
1963     }
1964
1965     my $dbh = C4::Context->dbh;
1966     # Find the issues record for this book
1967     my $sth =
1968       $dbh->prepare("SELECT * FROM issues
1969                         WHERE borrowernumber=?
1970                         AND itemnumber=?"
1971       );
1972     $sth->execute( $borrowernumber, $itemnumber );
1973     my $issuedata = $sth->fetchrow_hashref;
1974     $sth->finish;
1975
1976     # Update the issues record to have the new due date, and a new count
1977     # of how many times it has been renewed.
1978     my $renews = $issuedata->{'renewals'} + 1;
1979     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
1980                             WHERE borrowernumber=?
1981                             AND itemnumber=?"
1982     );
1983     $sth->execute( $datedue->output('iso'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
1984     $sth->finish;
1985
1986     # Update the renewal count on the item, and tell zebra to reindex
1987     $renews = $biblio->{'renewals'} + 1;
1988     ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber);
1989
1990     # Charge a new rental fee, if applicable?
1991     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1992     if ( $charge > 0 ) {
1993         my $accountno = getnextacctno( $borrowernumber );
1994         my $item = GetBiblioFromItemNumber($itemnumber);
1995         $sth = $dbh->prepare(
1996                 "INSERT INTO accountlines
1997                     (date,
1998                                         borrowernumber, accountno, amount,
1999                     description,
2000                                         accounttype, amountoutstanding, itemnumber
2001                                         )
2002                     VALUES (now(),?,?,?,?,?,?,?)"
2003         );
2004         $sth->execute( $borrowernumber, $accountno, $charge,
2005             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2006             'Rent', $charge, $itemnumber );
2007         $sth->finish;
2008     }
2009     # Log the renewal
2010     UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2011         return $datedue;
2012 }
2013
2014 sub GetRenewCount {
2015     # check renewal status
2016     my ($bornum,$itemno)=@_;
2017     my $dbh = C4::Context->dbh;
2018     my $renewcount = 0;
2019         my $renewsallowed = 0;
2020         my $renewsleft = 0;
2021     # Look in the issues table for this item, lent to this borrower,
2022     # and not yet returned.
2023
2024     # FIXME - I think this function could be redone to use only one SQL call.
2025     my $sth = $dbh->prepare("select * from issues
2026                                 where (borrowernumber = ?)
2027                                 and (itemnumber = ?)");
2028     $sth->execute($bornum,$itemno);
2029     my $data = $sth->fetchrow_hashref;
2030     $renewcount = $data->{'renewals'} if $data->{'renewals'};
2031     $sth->finish;
2032     my $query = "SELECT renewalsallowed FROM items ";
2033     $query .= (C4::Context->preference('item-level_itypes'))
2034                 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2035                 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
2036                    LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2037     $query .= "WHERE items.itemnumber = ?";
2038     my $sth2 = $dbh->prepare($query);
2039     $sth2->execute($itemno);
2040     my $data2 = $sth2->fetchrow_hashref();
2041     $renewsallowed = $data2->{'renewalsallowed'};
2042     $renewsleft = $renewsallowed - $renewcount;
2043     return ($renewcount,$renewsallowed,$renewsleft);
2044 }
2045
2046 =head2 GetIssuingCharges
2047
2048 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2049
2050 Calculate how much it would cost for a given patron to borrow a given
2051 item, including any applicable discounts.
2052
2053 C<$itemnumber> is the item number of item the patron wishes to borrow.
2054
2055 C<$borrowernumber> is the patron's borrower number.
2056
2057 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2058 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2059 if it's a video).
2060
2061 =cut
2062
2063 sub GetIssuingCharges {
2064
2065     # calculate charges due
2066     my ( $itemnumber, $borrowernumber ) = @_;
2067     my $charge = 0;
2068     my $dbh    = C4::Context->dbh;
2069     my $item_type;
2070
2071     # Get the book's item type and rental charge (via its biblioitem).
2072     my $qcharge =     "SELECT itemtypes.itemtype,rentalcharge FROM items
2073             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
2074         $qcharge .= (C4::Context->preference('item-level_itypes'))
2075                 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2076                 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2077
2078     $qcharge .=      "WHERE items.itemnumber =?";
2079
2080     my $sth1 = $dbh->prepare($qcharge);
2081     $sth1->execute($itemnumber);
2082     if ( my $data1 = $sth1->fetchrow_hashref ) {
2083         $item_type = $data1->{'itemtype'};
2084         $charge    = $data1->{'rentalcharge'};
2085         my $q2 = "SELECT rentaldiscount FROM borrowers
2086             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2087             WHERE borrowers.borrowernumber = ?
2088             AND issuingrules.itemtype = ?";
2089         my $sth2 = $dbh->prepare($q2);
2090         $sth2->execute( $borrowernumber, $item_type );
2091         if ( my $data2 = $sth2->fetchrow_hashref ) {
2092             my $discount = $data2->{'rentaldiscount'};
2093             if ( $discount eq 'NULL' ) {
2094                 $discount = 0;
2095             }
2096             $charge = ( $charge * ( 100 - $discount ) ) / 100;
2097         }
2098         $sth2->finish;
2099     }
2100
2101     $sth1->finish;
2102     return ( $charge, $item_type );
2103 }
2104
2105 =head2 AddIssuingCharge
2106
2107 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2108
2109 =cut
2110
2111 sub AddIssuingCharge {
2112     my ( $itemnumber, $borrowernumber, $charge ) = @_;
2113     my $dbh = C4::Context->dbh;
2114     my $nextaccntno = getnextacctno( $borrowernumber );
2115     my $query ="
2116         INSERT INTO accountlines
2117             (borrowernumber, itemnumber, accountno,
2118             date, amount, description, accounttype,
2119             amountoutstanding)
2120         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2121     ";
2122     my $sth = $dbh->prepare($query);
2123     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2124     $sth->finish;
2125 }
2126
2127 =head2 GetTransfers
2128
2129 GetTransfers($itemnumber);
2130
2131 =cut
2132
2133 sub GetTransfers {
2134     my ($itemnumber) = @_;
2135
2136     my $dbh = C4::Context->dbh;
2137
2138     my $query = '
2139         SELECT datesent,
2140                frombranch,
2141                tobranch
2142         FROM branchtransfers
2143         WHERE itemnumber = ?
2144           AND datearrived IS NULL
2145         ';
2146     my $sth = $dbh->prepare($query);
2147     $sth->execute($itemnumber);
2148     my @row = $sth->fetchrow_array();
2149     $sth->finish;
2150     return @row;
2151 }
2152
2153
2154 =head2 GetTransfersFromTo
2155
2156 @results = GetTransfersFromTo($frombranch,$tobranch);
2157
2158 Returns the list of pending transfers between $from and $to branch
2159
2160 =cut
2161
2162 sub GetTransfersFromTo {
2163     my ( $frombranch, $tobranch ) = @_;
2164     return unless ( $frombranch && $tobranch );
2165     my $dbh   = C4::Context->dbh;
2166     my $query = "
2167         SELECT itemnumber,datesent,frombranch
2168         FROM   branchtransfers
2169         WHERE  frombranch=?
2170           AND  tobranch=?
2171           AND datearrived IS NULL
2172     ";
2173     my $sth = $dbh->prepare($query);
2174     $sth->execute( $frombranch, $tobranch );
2175     my @gettransfers;
2176
2177     while ( my $data = $sth->fetchrow_hashref ) {
2178         push @gettransfers, $data;
2179     }
2180     $sth->finish;
2181     return (@gettransfers);
2182 }
2183
2184 =head2 DeleteTransfer
2185
2186 &DeleteTransfer($itemnumber);
2187
2188 =cut
2189
2190 sub DeleteTransfer {
2191     my ($itemnumber) = @_;
2192     my $dbh          = C4::Context->dbh;
2193     my $sth          = $dbh->prepare(
2194         "DELETE FROM branchtransfers
2195          WHERE itemnumber=?
2196          AND datearrived IS NULL "
2197     );
2198     $sth->execute($itemnumber);
2199     $sth->finish;
2200 }
2201
2202 =head2 AnonymiseIssueHistory
2203
2204 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2205
2206 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2207 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2208
2209 return the number of affected rows.
2210
2211 =cut
2212
2213 sub AnonymiseIssueHistory {
2214     my $date           = shift;
2215     my $borrowernumber = shift;
2216     my $dbh            = C4::Context->dbh;
2217     my $query          = "
2218         UPDATE old_issues
2219         SET    borrowernumber = NULL
2220         WHERE  returndate < '".$date."'
2221           AND borrowernumber IS NOT NULL
2222     ";
2223     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2224     my $rows_affected = $dbh->do($query);
2225     return $rows_affected;
2226 }
2227
2228 =head2 updateWrongTransfer
2229
2230 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2231
2232 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
2233
2234 =cut
2235
2236 sub updateWrongTransfer {
2237         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2238         my $dbh = C4::Context->dbh;
2239 # first step validate the actual line of transfert .
2240         my $sth =
2241                 $dbh->prepare(
2242                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2243                 );
2244                 $sth->execute($FromLibrary,$itemNumber);
2245                 $sth->finish;
2246
2247 # second step create a new line of branchtransfer to the right location .
2248         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2249
2250 #third step changing holdingbranch of item
2251         UpdateHoldingbranch($FromLibrary,$itemNumber);
2252 }
2253
2254 =head2 UpdateHoldingbranch
2255
2256 $items = UpdateHoldingbranch($branch,$itmenumber);
2257 Simple methode for updating hodlingbranch in items BDD line
2258
2259 =cut
2260
2261 sub UpdateHoldingbranch {
2262         my ( $branch,$itemnumber ) = @_;
2263     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2264 }
2265
2266 =head2 CalcDateDue
2267
2268 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2269 this function calculates the due date given the loan length ,
2270 checking against the holidays calendar as per the 'useDaysMode' syspref.
2271 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2272 C<$branch>  = location whose calendar to use
2273 C<$loanlength>  = loan length prior to adjustment
2274 =cut
2275
2276 sub CalcDateDue {
2277         my ($startdate,$loanlength,$branch) = @_;
2278         if(C4::Context->preference('useDaysMode') eq 'Days') {  # ignoring calendar
2279                 my $datedue = time + ($loanlength) * 86400;
2280         #FIXME - assumes now even though we take a startdate
2281                 my @datearr  = localtime($datedue);
2282                 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2283         } else {
2284                 my $calendar = C4::Calendar->new(  branchcode => $branch );
2285                 my $datedue = $calendar->addDate($startdate, $loanlength);
2286                 return $datedue;
2287         }
2288 }
2289
2290 =head2 CheckValidDatedue
2291        This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2292        To be replaced by CalcDateDue() once C4::Calendar use is tested.
2293
2294 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2295 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2296 C<$date_due>   = returndate calculate with no day check
2297 C<$itemnumber>  = itemnumber
2298 C<$branchcode>  = location of issue (affected by 'CircControl' syspref)
2299 C<$loanlength>  = loan length prior to adjustment
2300 =cut
2301
2302 sub CheckValidDatedue {
2303 my ($date_due,$itemnumber,$branchcode)=@_;
2304 my @datedue=split('-',$date_due->output('iso'));
2305 my $years=$datedue[0];
2306 my $month=$datedue[1];
2307 my $day=$datedue[2];
2308 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2309 my $dow;
2310 for (my $i=0;$i<2;$i++){
2311     $dow=Day_of_Week($years,$month,$day);
2312     ($dow=0) if ($dow>6);
2313     my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2314     my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2315     my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2316         if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2317         $i=0;
2318         (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2319         }
2320     }
2321     my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2322 return $newdatedue;
2323 }
2324
2325
2326 =head2 CheckRepeatableHolidays
2327
2328 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2329 this function checks if the date due is a repeatable holiday
2330 C<$date_due>   = returndate calculate with no day check
2331 C<$itemnumber>  = itemnumber
2332 C<$branchcode>  = localisation of issue
2333
2334 =cut
2335
2336 sub CheckRepeatableHolidays{
2337 my($itemnumber,$week_day,$branchcode)=@_;
2338 my $dbh = C4::Context->dbh;
2339 my $query = qq|SELECT count(*)
2340         FROM repeatable_holidays
2341         WHERE branchcode=?
2342         AND weekday=?|;
2343 my $sth = $dbh->prepare($query);
2344 $sth->execute($branchcode,$week_day);
2345 my $result=$sth->fetchrow;
2346 $sth->finish;
2347 return $result;
2348 }
2349
2350
2351 =head2 CheckSpecialHolidays
2352
2353 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2354 this function check if the date is a special holiday
2355 C<$years>   = the years of datedue
2356 C<$month>   = the month of datedue
2357 C<$day>     = the day of datedue
2358 C<$itemnumber>  = itemnumber
2359 C<$branchcode>  = localisation of issue
2360
2361 =cut
2362
2363 sub CheckSpecialHolidays{
2364 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2365 my $dbh = C4::Context->dbh;
2366 my $query=qq|SELECT count(*)
2367              FROM `special_holidays`
2368              WHERE year=?
2369              AND month=?
2370              AND day=?
2371              AND branchcode=?
2372             |;
2373 my $sth = $dbh->prepare($query);
2374 $sth->execute($years,$month,$day,$branchcode);
2375 my $countspecial=$sth->fetchrow ;
2376 $sth->finish;
2377 return $countspecial;
2378 }
2379
2380 =head2 CheckRepeatableSpecialHolidays
2381
2382 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2383 this function check if the date is a repeatble special holidays
2384 C<$month>   = the month of datedue
2385 C<$day>     = the day of datedue
2386 C<$itemnumber>  = itemnumber
2387 C<$branchcode>  = localisation of issue
2388
2389 =cut
2390
2391 sub CheckRepeatableSpecialHolidays{
2392 my ($month,$day,$itemnumber,$branchcode) = @_;
2393 my $dbh = C4::Context->dbh;
2394 my $query=qq|SELECT count(*)
2395              FROM `repeatable_holidays`
2396              WHERE month=?
2397              AND day=?
2398              AND branchcode=?
2399             |;
2400 my $sth = $dbh->prepare($query);
2401 $sth->execute($month,$day,$branchcode);
2402 my $countspecial=$sth->fetchrow ;
2403 $sth->finish;
2404 return $countspecial;
2405 }
2406
2407
2408
2409 sub CheckValidBarcode{
2410 my ($barcode) = @_;
2411 my $dbh = C4::Context->dbh;
2412 my $query=qq|SELECT count(*)
2413              FROM items
2414              WHERE barcode=?
2415             |;
2416 my $sth = $dbh->prepare($query);
2417 $sth->execute($barcode);
2418 my $exist=$sth->fetchrow ;
2419 $sth->finish;
2420 return $exist;
2421 }
2422
2423 1;
2424
2425 __END__
2426
2427 =head1 AUTHOR
2428
2429 Koha Developement team <info@koha.org>
2430
2431 =cut
2432