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