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