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