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 <= $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         }
1357
1358     # continue to deal with returns cases, but not only if we have an issue
1359
1360         # the holdingbranch is updated if the document is returned in an other location .
1361         if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) {
1362                         UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1363                         #               reload iteminformation holdingbranch with the userenv value
1364                         $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1365         }
1366         ModDateLastSeen( $iteminformation->{'itemnumber'} );
1367         ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'});
1368
1369                     if ($iteminformation->{borrowernumber}){
1370                           ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1371         }
1372         # fix up the accounts.....
1373         if ( $iteminformation->{'itemlost'} ) {
1374             $messages->{'WasLost'} = 1;
1375         }
1376
1377     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1378     #     check if we have a transfer for this document
1379         my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1380
1381     #     if we have a transfer to do, we update the line of transfers with the datearrived
1382         if ($datesent) {
1383             if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1384                     my $sth =
1385                     $dbh->prepare(
1386                             "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1387                     );
1388                     $sth->execute( $iteminformation->{'itemnumber'} );
1389                     $sth->finish;
1390     #         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'
1391             C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1392             }
1393         else {
1394             $messages->{'WrongTransfer'} = $tobranch;
1395             $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1396         }
1397         $validTransfert = 1;
1398         }
1399
1400     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1401         # fix up the accounts.....
1402         if ($iteminformation->{'itemlost'}) {
1403                 FixAccountForLostAndReturned($iteminformation, $borrower);
1404                 $messages->{'WasLost'} = 1;
1405         }
1406         # fix up the overdues in accounts...
1407         FixOverduesOnReturn( $borrower->{'borrowernumber'},
1408             $iteminformation->{'itemnumber'}, $exemptfine, $dropbox );
1409
1410     # find reserves.....
1411     #     if we don't have a reserve with the status W, we launch the Checkreserves routine
1412         my ( $resfound, $resrec ) =
1413         C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1414         if ($resfound) {
1415             $resrec->{'ResFound'}   = $resfound;
1416             $messages->{'ResFound'} = $resrec;
1417             $reserveDone = 1;
1418         }
1419
1420         # update stats?
1421         # Record the fact that this book was returned.
1422         UpdateStats(
1423             $branch, 'return', '0', '',
1424             $iteminformation->{'itemnumber'},
1425             $biblio->{'itemtype'},
1426             $borrower->{'borrowernumber'}
1427         );
1428
1429         logaction("CIRCULATION", "RETURN", $iteminformation->{borrowernumber}, $iteminformation->{'biblionumber'})
1430             if C4::Context->preference("ReturnLog");
1431
1432         #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1433         #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1434
1435         if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1436                         if (C4::Context->preference("AutomaticItemReturn") == 1) {
1437                                 ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1438                                 $messages->{'WasTransfered'} = 1;
1439                         }
1440                         else {
1441                                 $messages->{'NeedsTransfer'} = 1;
1442                         }
1443         }
1444     }
1445     return ( $doreturn, $messages, $iteminformation, $borrower );
1446 }
1447
1448 =head2 MarkIssueReturned
1449
1450 =over 4
1451
1452 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate);
1453
1454 =back
1455
1456 Unconditionally marks an issue as being returned by
1457 moving the C<issues> row to C<old_issues> and
1458 setting C<returndate> to the current date, or
1459 the last non-holiday date of the branccode specified in
1460 C<dropbox_branch> .  Assumes you've already checked that
1461 it's safe to do this, i.e. last non-holiday > issuedate.
1462
1463 if C<$returndate> is specified (in iso format), it is used as the date
1464 of the return. It is ignored when a dropbox_branch is passed in.
1465
1466 Ideally, this function would be internal to C<C4::Circulation>,
1467 not exported, but it is currently needed by one
1468 routine in C<C4::Accounts>.
1469
1470 =cut
1471
1472 sub MarkIssueReturned {
1473     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate ) = @_;
1474     my $dbh   = C4::Context->dbh;
1475     my $query = "UPDATE issues SET returndate=";
1476     my @bind;
1477     if ($dropbox_branch) {
1478         my $calendar = C4::Calendar->new( branchcode => $dropbox_branch );
1479         my $dropboxdate = $calendar->addDate( C4::Dates->new(), -1 );
1480         $query .= " ? ";
1481         push @bind, $dropboxdate->output('iso');
1482     } elsif ($returndate) {
1483         $query .= " ? ";
1484         push @bind, $returndate;
1485     } else {
1486         $query .= " now() ";
1487     }
1488     $query .= " WHERE  borrowernumber = ?  AND itemnumber = ?";
1489     push @bind, $borrowernumber, $itemnumber;
1490     # FIXME transaction
1491     my $sth_upd  = $dbh->prepare($query);
1492     $sth_upd->execute(@bind);
1493     my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1494                                   WHERE borrowernumber = ?
1495                                   AND itemnumber = ?");
1496     $sth_copy->execute($borrowernumber, $itemnumber);
1497     my $sth_del  = $dbh->prepare("DELETE FROM issues
1498                                   WHERE borrowernumber = ?
1499                                   AND itemnumber = ?");
1500     $sth_del->execute($borrowernumber, $itemnumber);
1501 }
1502
1503 =head2 FixOverduesOnReturn
1504
1505     &FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1506
1507 C<$brn> borrowernumber
1508
1509 C<$itm> itemnumber
1510
1511 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1512 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1513
1514 internal function, called only by AddReturn
1515
1516 =cut
1517
1518 sub FixOverduesOnReturn {
1519     my ( $borrowernumber, $item, $exemptfine, $dropbox ) = @_;
1520     my $dbh = C4::Context->dbh;
1521
1522     # check for overdue fine
1523     my $sth =
1524       $dbh->prepare(
1525 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1526       );
1527     $sth->execute( $borrowernumber, $item );
1528
1529     # alter fine to show that the book has been returned
1530    my $data;
1531         if ($data = $sth->fetchrow_hashref) {
1532         my $uquery;
1533                 my @bind = ($borrowernumber,$item ,$data->{'accountno'});
1534                 if ($exemptfine) {
1535                         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1536                         if (C4::Context->preference("FinesLog")) {
1537                         &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1538                         }
1539                 } elsif ($dropbox && $data->{lastincrement}) {
1540                         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1541                         my $amt = $data->{amount} - $data->{lastincrement} ;
1542                         if (C4::Context->preference("FinesLog")) {
1543                         &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1544                         }
1545                          $uquery = "update accountlines set accounttype='F' ";
1546                          if($outstanding  >= 0 && $amt >=0) {
1547                                 $uquery .= ", amount = ? , amountoutstanding=? ";
1548                                 unshift @bind, ($amt, $outstanding) ;
1549                         }
1550                 } else {
1551                         $uquery = "update accountlines set accounttype='F' ";
1552                 }
1553                 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1554         my $usth = $dbh->prepare($uquery);
1555         $usth->execute(@bind);
1556         $usth->finish();
1557     }
1558
1559     $sth->finish();
1560     return;
1561 }
1562
1563 =head2 FixAccountForLostAndReturned
1564
1565         &FixAccountForLostAndReturned($iteminfo,$borrower);
1566
1567 Calculates the charge for a book lost and returned (Not exported & used only once)
1568
1569 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1570
1571 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1572
1573 Internal function, called by AddReturn
1574
1575 =cut
1576
1577 sub FixAccountForLostAndReturned {
1578         my ($iteminfo, $borrower) = @_;
1579         my $dbh = C4::Context->dbh;
1580         my $itm = $iteminfo->{'itemnumber'};
1581         # check for charge made for lost book
1582         my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1583         $sth->execute($itm);
1584         if (my $data = $sth->fetchrow_hashref) {
1585         # writeoff this amount
1586                 my $offset;
1587                 my $amount = $data->{'amount'};
1588                 my $acctno = $data->{'accountno'};
1589                 my $amountleft;
1590                 if ($data->{'amountoutstanding'} == $amount) {
1591                 $offset = $data->{'amount'};
1592                 $amountleft = 0;
1593                 } else {
1594                 $offset = $amount - $data->{'amountoutstanding'};
1595                 $amountleft = $data->{'amountoutstanding'} - $amount;
1596                 }
1597                 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1598                         WHERE (borrowernumber = ?)
1599                         AND (itemnumber = ?) AND (accountno = ?) ");
1600                 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1601                 $usth->finish;
1602         #check if any credit is left if so writeoff other accounts
1603                 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1604                 if ($amountleft < 0){
1605                 $amountleft*=-1;
1606                 }
1607                 if ($amountleft > 0){
1608                 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1609                                                         AND (amountoutstanding >0) ORDER BY date");
1610                 $msth->execute($data->{'borrowernumber'});
1611         # offset transactions
1612                 my $newamtos;
1613                 my $accdata;
1614                 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1615                         if ($accdata->{'amountoutstanding'} < $amountleft) {
1616                         $newamtos = 0;
1617                         $amountleft -= $accdata->{'amountoutstanding'};
1618                         }  else {
1619                         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1620                         $amountleft = 0;
1621                         }
1622                         my $thisacct = $accdata->{'accountno'};
1623                         my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1624                                         WHERE (borrowernumber = ?)
1625                                         AND (accountno=?)");
1626                         $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1627                         $usth->finish;
1628                         $usth = $dbh->prepare("INSERT INTO accountoffsets
1629                                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1630                                 VALUES
1631                                 (?,?,?,?)");
1632                         $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1633                         $usth->finish;
1634                 }
1635                 $msth->finish;
1636                 }
1637                 if ($amountleft > 0){
1638                         $amountleft*=-1;
1639                 }
1640                 my $desc="Item Returned ".$iteminfo->{'barcode'};
1641                 $usth = $dbh->prepare("INSERT INTO accountlines
1642                         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1643                         VALUES (?,?,now(),?,?,'CR',?)");
1644                 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1645                 $usth->finish;
1646                 $usth = $dbh->prepare("INSERT INTO accountoffsets
1647                         (borrowernumber, accountno, offsetaccount,  offsetamount)
1648                         VALUES (?,?,?,?)");
1649                 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1650                 $usth->finish;
1651         ModItem({ paidfor => '' }, undef, $itm);
1652         }
1653         $sth->finish;
1654         return;
1655 }
1656
1657 =head2 GetItemIssue
1658
1659 $issues = &GetItemIssue($itemnumber);
1660
1661 Returns patrons currently having a book. nothing if item is not issued atm
1662
1663 C<$itemnumber> is the itemnumber
1664
1665 Returns an array of hashes
1666
1667 FIXME: Though the above says that this function returns nothing if the
1668 item is not issued, this actually returns a hasref that looks like
1669 this:
1670     {
1671       itemnumber => 1,
1672       overdue    => 1
1673     }
1674
1675
1676 =cut
1677
1678 sub GetItemIssue {
1679     my ( $itemnumber) = @_;
1680     return unless $itemnumber;
1681     my $dbh = C4::Context->dbh;
1682     my @GetItemIssues;
1683
1684     # get today date
1685     my $today = POSIX::strftime("%Y%m%d", localtime);
1686
1687     my $sth = $dbh->prepare(
1688         "SELECT * FROM issues
1689         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1690     WHERE
1691     issues.itemnumber=?");
1692     $sth->execute($itemnumber);
1693     my $data = $sth->fetchrow_hashref;
1694     my $datedue = $data->{'date_due'};
1695     $datedue =~ s/-//g;
1696     if ( $datedue < $today ) {
1697         $data->{'overdue'} = 1;
1698     }
1699     $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1700     $sth->finish;
1701     return ($data);
1702 }
1703
1704 =head2 GetItemIssues
1705
1706 $issues = &GetItemIssues($itemnumber, $history);
1707
1708 Returns patrons that have issued a book
1709
1710 C<$itemnumber> is the itemnumber
1711 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1712
1713 Returns an array of hashes
1714
1715 =cut
1716
1717 sub GetItemIssues {
1718     my ( $itemnumber,$history ) = @_;
1719     my $dbh = C4::Context->dbh;
1720     my @GetItemIssues;
1721
1722     # get today date
1723     my $today = POSIX::strftime("%Y%m%d", localtime);
1724
1725     my $sql = "SELECT * FROM issues
1726               JOIN borrowers USING (borrowernumber)
1727               JOIN items USING (itemnumber)
1728               WHERE issues.itemnumber = ? ";
1729     if ($history) {
1730         $sql .= "UNION ALL
1731                  SELECT * FROM old_issues
1732                  LEFT JOIN borrowers USING (borrowernumber)
1733                  JOIN items USING (itemnumber)
1734                  WHERE old_issues.itemnumber = ? ";
1735     }
1736     $sql .= "ORDER BY date_due DESC";
1737     my $sth = $dbh->prepare($sql);
1738     if ($history) {
1739         $sth->execute($itemnumber, $itemnumber);
1740     } else {
1741         $sth->execute($itemnumber);
1742     }
1743     while ( my $data = $sth->fetchrow_hashref ) {
1744         my $datedue = $data->{'date_due'};
1745         $datedue =~ s/-//g;
1746         if ( $datedue < $today ) {
1747             $data->{'overdue'} = 1;
1748         }
1749         my $itemnumber = $data->{'itemnumber'};
1750         push @GetItemIssues, $data;
1751     }
1752     $sth->finish;
1753     return ( \@GetItemIssues );
1754 }
1755
1756 =head2 GetBiblioIssues
1757
1758 $issues = GetBiblioIssues($biblionumber);
1759
1760 this function get all issues from a biblionumber.
1761
1762 Return:
1763 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1764 tables issues and the firstname,surname & cardnumber from borrowers.
1765
1766 =cut
1767
1768 sub GetBiblioIssues {
1769     my $biblionumber = shift;
1770     return undef unless $biblionumber;
1771     my $dbh   = C4::Context->dbh;
1772     my $query = "
1773         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1774         FROM issues
1775             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1776             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1777             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1778             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1779         WHERE biblio.biblionumber = ?
1780         UNION ALL
1781         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1782         FROM old_issues
1783             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1784             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1785             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1786             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1787         WHERE biblio.biblionumber = ?
1788         ORDER BY timestamp
1789     ";
1790     my $sth = $dbh->prepare($query);
1791     $sth->execute($biblionumber, $biblionumber);
1792
1793     my @issues;
1794     while ( my $data = $sth->fetchrow_hashref ) {
1795         push @issues, $data;
1796     }
1797     return \@issues;
1798 }
1799
1800 =head2 GetUpcomingDueIssues
1801
1802 =over 4
1803
1804 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
1805
1806 =back
1807
1808 =cut
1809
1810 sub GetUpcomingDueIssues {
1811     my $params = shift;
1812
1813     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
1814     my $dbh = C4::Context->dbh;
1815
1816     my $statement = <<END_SQL;
1817 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due
1818 FROM issues
1819 LEFT JOIN items USING (itemnumber)
1820 WhERE returndate is NULL
1821 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
1822 END_SQL
1823
1824     my @bind_parameters = ( $params->{'days_in_advance'} );
1825
1826     my $sth = $dbh->prepare( $statement );
1827     $sth->execute( @bind_parameters );
1828     my $upcoming_dues = $sth->fetchall_arrayref({});
1829     $sth->finish;
1830
1831     return $upcoming_dues;
1832 }
1833
1834 =head2 CanBookBeRenewed
1835
1836 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber);
1837
1838 Find out whether a borrowed item may be renewed.
1839
1840 C<$dbh> is a DBI handle to the Koha database.
1841
1842 C<$borrowernumber> is the borrower number of the patron who currently
1843 has the item on loan.
1844
1845 C<$itemnumber> is the number of the item to renew.
1846
1847 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1848 item must currently be on loan to the specified borrower; renewals
1849 must be allowed for the item's type; and the borrower must not have
1850 already renewed the loan. $error will contain the reason the renewal can not proceed
1851
1852 =cut
1853
1854 sub CanBookBeRenewed {
1855
1856     # check renewal status
1857     my ( $borrowernumber, $itemnumber ) = @_;
1858     my $dbh       = C4::Context->dbh;
1859     my $renews    = 1;
1860     my $renewokay = 0;
1861         my $error;
1862
1863     # Look in the issues table for this item, lent to this borrower,
1864     # and not yet returned.
1865
1866     # FIXME - I think this function could be redone to use only one SQL call.
1867     my $sth1 = $dbh->prepare(
1868         "SELECT * FROM issues
1869             WHERE borrowernumber = ?
1870             AND itemnumber = ?"
1871     );
1872     $sth1->execute( $borrowernumber, $itemnumber );
1873     if ( my $data1 = $sth1->fetchrow_hashref ) {
1874
1875         # Found a matching item
1876
1877         # See if this item may be renewed. This query is convoluted
1878         # because it's a bit messy: given the item number, we need to find
1879         # the biblioitem, which gives us the itemtype, which tells us
1880         # whether it may be renewed.
1881         my $query = "SELECT renewalsallowed FROM items ";
1882         $query .= (C4::Context->preference('item-level_itypes'))
1883                     ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1884                     : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1885                        LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1886         $query .= "WHERE items.itemnumber = ?";
1887         my $sth2 = $dbh->prepare($query);
1888         $sth2->execute($itemnumber);
1889         if ( my $data2 = $sth2->fetchrow_hashref ) {
1890             $renews = $data2->{'renewalsallowed'};
1891         }
1892         if ( $renews && $renews > $data1->{'renewals'} ) {
1893             $renewokay = 1;
1894         }
1895         else {
1896                         $error="too_many";
1897                 }
1898         $sth2->finish;
1899         my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1900         if ($resfound) {
1901             $renewokay = 0;
1902                         $error="on_reserve"
1903         }
1904
1905     }
1906     $sth1->finish;
1907     return ($renewokay,$error);
1908 }
1909
1910 =head2 AddRenewal
1911
1912 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
1913
1914 Renews a loan.
1915
1916 C<$borrowernumber> is the borrower number of the patron who currently
1917 has the item.
1918
1919 C<$itemnumber> is the number of the item to renew.
1920
1921 C<$branch> is the library branch.  Defaults to the homebranch of the ITEM.
1922
1923 C<$datedue> can be a C4::Dates object used to set the due date.
1924
1925 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
1926 this parameter is not supplied, lastreneweddate is set to the current date.
1927
1928 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
1929 from the book's item type.
1930
1931 =cut
1932
1933 sub AddRenewal {
1934         my $borrowernumber = shift or return undef;
1935         my     $itemnumber = shift or return undef;
1936     my $item   = GetItem($itemnumber) or return undef;
1937     my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
1938     my $branch  = (@_) ? shift : $item->{homebranch};   # opac-renew doesn't send branch
1939     my $datedue = shift;
1940     my $lastreneweddate = shift;
1941
1942     # If the due date wasn't specified, calculate it by adding the
1943     # book's loan length to today's date.
1944     unless ($datedue && $datedue->output('iso')) {
1945
1946         my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
1947         my $loanlength = GetLoanLength(
1948             $borrower->{'categorycode'},
1949              (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
1950                         $item->{homebranch}                     # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument?
1951         );
1952                 #FIXME -- use circControl?
1953                 $datedue =  CalcDateDue(C4::Dates->new(),$loanlength,$branch);  # this branch is the transactional branch.
1954                                                                 # The question of whether to use item's homebranch calendar is open.
1955     }
1956
1957     # $lastreneweddate defaults to today.
1958     unless (defined $lastreneweddate) {
1959         $lastreneweddate = strftime( "%Y-%m-%d", localtime );
1960     }
1961
1962     my $dbh = C4::Context->dbh;
1963     # Find the issues record for this book
1964     my $sth =
1965       $dbh->prepare("SELECT * FROM issues
1966                         WHERE borrowernumber=?
1967                         AND itemnumber=?"
1968       );
1969     $sth->execute( $borrowernumber, $itemnumber );
1970     my $issuedata = $sth->fetchrow_hashref;
1971     $sth->finish;
1972
1973     # Update the issues record to have the new due date, and a new count
1974     # of how many times it has been renewed.
1975     my $renews = $issuedata->{'renewals'} + 1;
1976     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
1977                             WHERE borrowernumber=?
1978                             AND itemnumber=?"
1979     );
1980     $sth->execute( $datedue->output('iso'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
1981     $sth->finish;
1982
1983     # Update the renewal count on the item, and tell zebra to reindex
1984     $renews = $biblio->{'renewals'} + 1;
1985     ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber);
1986
1987     # Charge a new rental fee, if applicable?
1988     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1989     if ( $charge > 0 ) {
1990         my $accountno = getnextacctno( $borrowernumber );
1991         my $item = GetBiblioFromItemNumber($itemnumber);
1992         $sth = $dbh->prepare(
1993                 "INSERT INTO accountlines
1994                     (date,
1995                                         borrowernumber, accountno, amount,
1996                     description,
1997                                         accounttype, amountoutstanding, itemnumber
1998                                         )
1999                     VALUES (now(),?,?,?,?,?,?,?)"
2000         );
2001         $sth->execute( $borrowernumber, $accountno, $charge,
2002             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2003             'Rent', $charge, $itemnumber );
2004         $sth->finish;
2005     }
2006     # Log the renewal
2007     UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2008         return $datedue;
2009 }
2010
2011 sub GetRenewCount {
2012     # check renewal status
2013     my ($bornum,$itemno)=@_;
2014     my $dbh = C4::Context->dbh;
2015     my $renewcount = 0;
2016         my $renewsallowed = 0;
2017         my $renewsleft = 0;
2018     # Look in the issues table for this item, lent to this borrower,
2019     # and not yet returned.
2020
2021     # FIXME - I think this function could be redone to use only one SQL call.
2022     my $sth = $dbh->prepare("select * from issues
2023                                 where (borrowernumber = ?)
2024                                 and (itemnumber = ?)");
2025     $sth->execute($bornum,$itemno);
2026     my $data = $sth->fetchrow_hashref;
2027     $renewcount = $data->{'renewals'} if $data->{'renewals'};
2028     $sth->finish;
2029     my $query = "SELECT renewalsallowed FROM items ";
2030     $query .= (C4::Context->preference('item-level_itypes'))
2031                 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2032                 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
2033                    LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2034     $query .= "WHERE items.itemnumber = ?";
2035     my $sth2 = $dbh->prepare($query);
2036     $sth2->execute($itemno);
2037     my $data2 = $sth2->fetchrow_hashref();
2038     $renewsallowed = $data2->{'renewalsallowed'};
2039     $renewsleft = $renewsallowed - $renewcount;
2040     return ($renewcount,$renewsallowed,$renewsleft);
2041 }
2042
2043 =head2 GetIssuingCharges
2044
2045 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2046
2047 Calculate how much it would cost for a given patron to borrow a given
2048 item, including any applicable discounts.
2049
2050 C<$itemnumber> is the item number of item the patron wishes to borrow.
2051
2052 C<$borrowernumber> is the patron's borrower number.
2053
2054 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2055 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2056 if it's a video).
2057
2058 =cut
2059
2060 sub GetIssuingCharges {
2061
2062     # calculate charges due
2063     my ( $itemnumber, $borrowernumber ) = @_;
2064     my $charge = 0;
2065     my $dbh    = C4::Context->dbh;
2066     my $item_type;
2067
2068     # Get the book's item type and rental charge (via its biblioitem).
2069     my $qcharge =     "SELECT itemtypes.itemtype,rentalcharge FROM items
2070             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
2071         $qcharge .= (C4::Context->preference('item-level_itypes'))
2072                 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2073                 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2074
2075     $qcharge .=      "WHERE items.itemnumber =?";
2076
2077     my $sth1 = $dbh->prepare($qcharge);
2078     $sth1->execute($itemnumber);
2079     if ( my $data1 = $sth1->fetchrow_hashref ) {
2080         $item_type = $data1->{'itemtype'};
2081         $charge    = $data1->{'rentalcharge'};
2082         my $q2 = "SELECT rentaldiscount FROM borrowers
2083             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2084             WHERE borrowers.borrowernumber = ?
2085             AND issuingrules.itemtype = ?";
2086         my $sth2 = $dbh->prepare($q2);
2087         $sth2->execute( $borrowernumber, $item_type );
2088         if ( my $data2 = $sth2->fetchrow_hashref ) {
2089             my $discount = $data2->{'rentaldiscount'};
2090             if ( $discount eq 'NULL' ) {
2091                 $discount = 0;
2092             }
2093             $charge = ( $charge * ( 100 - $discount ) ) / 100;
2094         }
2095         $sth2->finish;
2096     }
2097
2098     $sth1->finish;
2099     return ( $charge, $item_type );
2100 }
2101
2102 =head2 AddIssuingCharge
2103
2104 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2105
2106 =cut
2107
2108 sub AddIssuingCharge {
2109     my ( $itemnumber, $borrowernumber, $charge ) = @_;
2110     my $dbh = C4::Context->dbh;
2111     my $nextaccntno = getnextacctno( $borrowernumber );
2112     my $query ="
2113         INSERT INTO accountlines
2114             (borrowernumber, itemnumber, accountno,
2115             date, amount, description, accounttype,
2116             amountoutstanding)
2117         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2118     ";
2119     my $sth = $dbh->prepare($query);
2120     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2121     $sth->finish;
2122 }
2123
2124 =head2 GetTransfers
2125
2126 GetTransfers($itemnumber);
2127
2128 =cut
2129
2130 sub GetTransfers {
2131     my ($itemnumber) = @_;
2132
2133     my $dbh = C4::Context->dbh;
2134
2135     my $query = '
2136         SELECT datesent,
2137                frombranch,
2138                tobranch
2139         FROM branchtransfers
2140         WHERE itemnumber = ?
2141           AND datearrived IS NULL
2142         ';
2143     my $sth = $dbh->prepare($query);
2144     $sth->execute($itemnumber);
2145     my @row = $sth->fetchrow_array();
2146     $sth->finish;
2147     return @row;
2148 }
2149
2150
2151 =head2 GetTransfersFromTo
2152
2153 @results = GetTransfersFromTo($frombranch,$tobranch);
2154
2155 Returns the list of pending transfers between $from and $to branch
2156
2157 =cut
2158
2159 sub GetTransfersFromTo {
2160     my ( $frombranch, $tobranch ) = @_;
2161     return unless ( $frombranch && $tobranch );
2162     my $dbh   = C4::Context->dbh;
2163     my $query = "
2164         SELECT itemnumber,datesent,frombranch
2165         FROM   branchtransfers
2166         WHERE  frombranch=?
2167           AND  tobranch=?
2168           AND datearrived IS NULL
2169     ";
2170     my $sth = $dbh->prepare($query);
2171     $sth->execute( $frombranch, $tobranch );
2172     my @gettransfers;
2173
2174     while ( my $data = $sth->fetchrow_hashref ) {
2175         push @gettransfers, $data;
2176     }
2177     $sth->finish;
2178     return (@gettransfers);
2179 }
2180
2181 =head2 DeleteTransfer
2182
2183 &DeleteTransfer($itemnumber);
2184
2185 =cut
2186
2187 sub DeleteTransfer {
2188     my ($itemnumber) = @_;
2189     my $dbh          = C4::Context->dbh;
2190     my $sth          = $dbh->prepare(
2191         "DELETE FROM branchtransfers
2192          WHERE itemnumber=?
2193          AND datearrived IS NULL "
2194     );
2195     $sth->execute($itemnumber);
2196     $sth->finish;
2197 }
2198
2199 =head2 AnonymiseIssueHistory
2200
2201 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2202
2203 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2204 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2205
2206 return the number of affected rows.
2207
2208 =cut
2209
2210 sub AnonymiseIssueHistory {
2211     my $date           = shift;
2212     my $borrowernumber = shift;
2213     my $dbh            = C4::Context->dbh;
2214     my $query          = "
2215         UPDATE old_issues
2216         SET    borrowernumber = NULL
2217         WHERE  returndate < '".$date."'
2218           AND borrowernumber IS NOT NULL
2219     ";
2220     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2221     my $rows_affected = $dbh->do($query);
2222     return $rows_affected;
2223 }
2224
2225 =head2 updateWrongTransfer
2226
2227 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2228
2229 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
2230
2231 =cut
2232
2233 sub updateWrongTransfer {
2234         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2235         my $dbh = C4::Context->dbh;
2236 # first step validate the actual line of transfert .
2237         my $sth =
2238                 $dbh->prepare(
2239                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2240                 );
2241                 $sth->execute($FromLibrary,$itemNumber);
2242                 $sth->finish;
2243
2244 # second step create a new line of branchtransfer to the right location .
2245         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2246
2247 #third step changing holdingbranch of item
2248         UpdateHoldingbranch($FromLibrary,$itemNumber);
2249 }
2250
2251 =head2 UpdateHoldingbranch
2252
2253 $items = UpdateHoldingbranch($branch,$itmenumber);
2254 Simple methode for updating hodlingbranch in items BDD line
2255
2256 =cut
2257
2258 sub UpdateHoldingbranch {
2259         my ( $branch,$itemnumber ) = @_;
2260     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2261 }
2262
2263 =head2 CalcDateDue
2264
2265 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2266 this function calculates the due date given the loan length ,
2267 checking against the holidays calendar as per the 'useDaysMode' syspref.
2268 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2269 C<$branch>  = location whose calendar to use
2270 C<$loanlength>  = loan length prior to adjustment
2271 =cut
2272
2273 sub CalcDateDue {
2274         my ($startdate,$loanlength,$branch) = @_;
2275         if(C4::Context->preference('useDaysMode') eq 'Days') {  # ignoring calendar
2276                 my $datedue = time + ($loanlength) * 86400;
2277         #FIXME - assumes now even though we take a startdate
2278                 my @datearr  = localtime($datedue);
2279                 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2280         } else {
2281                 my $calendar = C4::Calendar->new(  branchcode => $branch );
2282                 my $datedue = $calendar->addDate($startdate, $loanlength);
2283                 return $datedue;
2284         }
2285 }
2286
2287 =head2 CheckValidDatedue
2288        This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2289        To be replaced by CalcDateDue() once C4::Calendar use is tested.
2290
2291 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2292 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2293 C<$date_due>   = returndate calculate with no day check
2294 C<$itemnumber>  = itemnumber
2295 C<$branchcode>  = location of issue (affected by 'CircControl' syspref)
2296 C<$loanlength>  = loan length prior to adjustment
2297 =cut
2298
2299 sub CheckValidDatedue {
2300 my ($date_due,$itemnumber,$branchcode)=@_;
2301 my @datedue=split('-',$date_due->output('iso'));
2302 my $years=$datedue[0];
2303 my $month=$datedue[1];
2304 my $day=$datedue[2];
2305 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2306 my $dow;
2307 for (my $i=0;$i<2;$i++){
2308     $dow=Day_of_Week($years,$month,$day);
2309     ($dow=0) if ($dow>6);
2310     my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2311     my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2312     my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2313         if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2314         $i=0;
2315         (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2316         }
2317     }
2318     my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2319 return $newdatedue;
2320 }
2321
2322
2323 =head2 CheckRepeatableHolidays
2324
2325 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2326 this function checks if the date due is a repeatable holiday
2327 C<$date_due>   = returndate calculate with no day check
2328 C<$itemnumber>  = itemnumber
2329 C<$branchcode>  = localisation of issue
2330
2331 =cut
2332
2333 sub CheckRepeatableHolidays{
2334 my($itemnumber,$week_day,$branchcode)=@_;
2335 my $dbh = C4::Context->dbh;
2336 my $query = qq|SELECT count(*)
2337         FROM repeatable_holidays
2338         WHERE branchcode=?
2339         AND weekday=?|;
2340 my $sth = $dbh->prepare($query);
2341 $sth->execute($branchcode,$week_day);
2342 my $result=$sth->fetchrow;
2343 $sth->finish;
2344 return $result;
2345 }
2346
2347
2348 =head2 CheckSpecialHolidays
2349
2350 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2351 this function check if the date is a special holiday
2352 C<$years>   = the years of datedue
2353 C<$month>   = the month of datedue
2354 C<$day>     = the day of datedue
2355 C<$itemnumber>  = itemnumber
2356 C<$branchcode>  = localisation of issue
2357
2358 =cut
2359
2360 sub CheckSpecialHolidays{
2361 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2362 my $dbh = C4::Context->dbh;
2363 my $query=qq|SELECT count(*)
2364              FROM `special_holidays`
2365              WHERE year=?
2366              AND month=?
2367              AND day=?
2368              AND branchcode=?
2369             |;
2370 my $sth = $dbh->prepare($query);
2371 $sth->execute($years,$month,$day,$branchcode);
2372 my $countspecial=$sth->fetchrow ;
2373 $sth->finish;
2374 return $countspecial;
2375 }
2376
2377 =head2 CheckRepeatableSpecialHolidays
2378
2379 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2380 this function check if the date is a repeatble special holidays
2381 C<$month>   = the month of datedue
2382 C<$day>     = the day of datedue
2383 C<$itemnumber>  = itemnumber
2384 C<$branchcode>  = localisation of issue
2385
2386 =cut
2387
2388 sub CheckRepeatableSpecialHolidays{
2389 my ($month,$day,$itemnumber,$branchcode) = @_;
2390 my $dbh = C4::Context->dbh;
2391 my $query=qq|SELECT count(*)
2392              FROM `repeatable_holidays`
2393              WHERE month=?
2394              AND day=?
2395              AND branchcode=?
2396             |;
2397 my $sth = $dbh->prepare($query);
2398 $sth->execute($month,$day,$branchcode);
2399 my $countspecial=$sth->fetchrow ;
2400 $sth->finish;
2401 return $countspecial;
2402 }
2403
2404
2405
2406 sub CheckValidBarcode{
2407 my ($barcode) = @_;
2408 my $dbh = C4::Context->dbh;
2409 my $query=qq|SELECT count(*)
2410              FROM items
2411              WHERE barcode=?
2412             |;
2413 my $sth = $dbh->prepare($query);
2414 $sth->execute($barcode);
2415 my $exist=$sth->fetchrow ;
2416 $sth->finish;
2417 return $exist;
2418 }
2419
2420 1;
2421
2422 __END__
2423
2424 =head1 AUTHOR
2425
2426 Koha Developement team <info@koha.org>
2427
2428 =cut
2429