C4/Circulation.pm

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