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