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 documents
 737         $issuingimpossible{USERBLOCKEDREMAINING} = $count;
 738     }elsif($blocktype == 1){
 739         ## blocked because of overdue return
 740         $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
 741     }
 742
 743 #
 744     # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
 745     #
 746         my $toomany = TooMany( $borrower, $item->{biblionumber}, $item );
 747     # if TooMany return / 0, then the user has no permission to check out this book
 748     if ($toomany =~ /\/ 0/) {
 749         $needsconfirmation{PATRON_CANT} = 1;
 750     } else {
 751         $needsconfirmation{TOO_MANY} = $toomany if $toomany;
 752     }
 753
 754     #
 755     # ITEM CHECKING
 756     #
 757     if (   $item->{'notforloan'}
 758         && $item->{'notforloan'} > 0 )
 759     {
 760         if(!C4::Context->preference("AllowNotForLoanOverride")){
 761             $issuingimpossible{NOT_FOR_LOAN} = 1;
 762         }else{
 763             $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 764         }
 765     }
 766     elsif ( !$item->{'notforloan'} ){
 767         # we have to check itemtypes.notforloan also
 768         if (C4::Context->preference('item-level_itypes')){
 769             # this should probably be a subroutine
 770             my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
 771             $sth->execute($item->{'itemtype'});
 772             my $notforloan=$sth->fetchrow_hashref();
 773             $sth->finish();
 774             if ($notforloan->{'notforloan'}) {
 775                 if (!C4::Context->preference("AllowNotForLoanOverride")) {
 776                     $issuingimpossible{NOT_FOR_LOAN} = 1;
 777                 } else {
 778                     $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 779                 }
 780             }
 781         }
 782         elsif ($biblioitem->{'notforloan'} == 1){
 783             if (!C4::Context->preference("AllowNotForLoanOverride")) {
 784                 $issuingimpossible{NOT_FOR_LOAN} = 1;
 785             } else {
 786                 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 787             }
 788         }
 789     }
 790     if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
 791     {
 792         $issuingimpossible{WTHDRAWN} = 1;
 793     }
 794     if (   $item->{'restricted'}
 795         && $item->{'restricted'} == 1 )
 796     {
 797         $issuingimpossible{RESTRICTED} = 1;
 798     }
 799     if ( C4::Context->preference("IndependantBranches") ) {
 800         my $userenv = C4::Context->userenv;
 801         if ( ($userenv) && ( $userenv->{flags} % 2 != 1 ) ) {
 802             $issuingimpossible{NOTSAMEBRANCH} = 1
 803               if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
 804         }
 805     }
 806
 807     #
 808     # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
 809     #
 810     if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
 811     {
 812
 813         # Already issued to current borrower. Ask whether the loan should
 814         # be renewed.
 815         my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
 816             $borrower->{'borrowernumber'},
 817             $item->{'itemnumber'}
 818         );
 819         if ( $CanBookBeRenewed == 0 ) {    # no more renewals allowed
 820             $issuingimpossible{NO_MORE_RENEWALS} = 1;
 821         }
 822         else {
 823             $needsconfirmation{RENEW_ISSUE} = 1;
 824         }
 825     }
 826     elsif ($issue->{borrowernumber}) {
 827
 828         # issued to someone else
 829         my $currborinfo =    C4::Members::GetMemberDetails( $issue->{borrowernumber} );
 830
 831 #        warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
 832         $needsconfirmation{ISSUED_TO_ANOTHER} =
 833 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
 834     }
 835
 836     # See if the item is on reserve.
 837     my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
 838     if ($restype) {
 839                 my $resbor = $res->{'borrowernumber'};
 840                 my ( $resborrower ) = C4::Members::GetMemberDetails( $resbor, 0 );
 841                 my $branches  = GetBranches();
 842                 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
 843         if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
 844         {
 845             # The item is on reserve and waiting, but has been
 846             # reserved by some other patron.
 847             $needsconfirmation{RESERVE_WAITING} =
 848 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
 849         }
 850         elsif ( $restype eq "Reserved" ) {
 851             # The item is on reserve for someone else.
 852             $needsconfirmation{RESERVED} =
 853 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
 854         }
 855     }
 856         return ( \%issuingimpossible, \%needsconfirmation );
 857 }
 858
 859 =head2 AddIssue
 860
 861 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
 862
 863 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
 864
 865 =over 4
 866
 867 =item C<$borrower> is a hash with borrower informations (from GetMemberDetails).
 868
 869 =item C<$barcode> is the barcode of the item being issued.
 870
 871 =item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional).
 872 Calculated if empty.
 873
 874 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
 875
 876 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
 877 Defaults to today.  Unlike C<$datedue>, NOT a C4::Dates object, unfortunately.
 878
 879 AddIssue does the following things :
 880
 881   - step 01: check that there is a borrowernumber & a barcode provided
 882   - check for RENEWAL (book issued & being issued to the same patron)
 883       - renewal YES = Calculate Charge & renew
 884       - renewal NO  =
 885           * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
 886           * RESERVE PLACED ?
 887               - fill reserve if reserve to this patron
 888               - cancel reserve or not, otherwise
 889           * TRANSFERT PENDING ?
 890               - complete the transfert
 891           * ISSUE THE BOOK
 892
 893 =back
 894
 895 =cut
 896
 897 sub AddIssue {
 898     my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_;
 899     my $dbh = C4::Context->dbh;
 900         my $barcodecheck=CheckValidBarcode($barcode);
 901
 902     # $issuedate defaults to today.
 903     if ( ! defined $issuedate ) {
 904         $issuedate = strftime( "%Y-%m-%d", localtime );
 905         # TODO: for hourly circ, this will need to be a C4::Dates object
 906         # and all calls to AddIssue including issuedate will need to pass a Dates object.
 907     }
 908         if ($borrower and $barcode and $barcodecheck ne '0'){
 909                 # find which item we issue
 910                 my $item = GetItem('', $barcode) or return undef;       # if we don't get an Item, abort.
 911                 my $branch = _GetCircControlBranch($item,$borrower);
 912
 913                 # get actual issuing if there is one
 914                 my $actualissue = GetItemIssue( $item->{itemnumber});
 915
 916                 # get biblioinformation for this item
 917                 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
 918
 919                 #
 920                 # check if we just renew the issue.
 921                 #
 922                 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
 923                         $datedue = AddRenewal(
 924                                 $borrower->{'borrowernumber'},
 925                                 $item->{'itemnumber'},
 926                                 $branch,
 927                                 $datedue,
 928                 $issuedate, # here interpreted as the renewal date
 929                         );
 930                 }
 931                 else {
 932         # it's NOT a renewal
 933                         if ( $actualissue->{borrowernumber}) {
 934                                 # This book is currently on loan, but not to the person
 935                                 # who wants to borrow it now. mark it returned before issuing to the new borrower
 936                                 AddReturn(
 937                                         $item->{'barcode'},
 938                                         C4::Context->userenv->{'branch'}
 939                                 );
 940                         }
 941
 942                         # See if the item is on reserve.
 943                         my ( $restype, $res ) =
 944                           C4::Reserves::CheckReserves( $item->{'itemnumber'} );
 945                         if ($restype) {
 946                                 my $resbor = $res->{'borrowernumber'};
 947                                 if ( $resbor eq $borrower->{'borrowernumber'} ) {
 948                                         # The item is reserved by the current patron
 949                                         ModReserveFill($res);
 950                                 }
 951                                 elsif ( $restype eq "Waiting" ) {
 952                                         # warn "Waiting";
 953                                         # The item is on reserve and waiting, but has been
 954                                         # reserved by some other patron.
 955                                 }
 956                                 elsif ( $restype eq "Reserved" ) {
 957                                         # warn "Reserved";
 958                                         # The item is reserved by someone else.
 959                                         if ($cancelreserve) { # cancel reserves on this item
 960                                                 CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
 961                                         }
 962                                 }
 963                                 if ($cancelreserve) {
 964                                         CancelReserve($res->{'biblionumber'}, 0, $res->{'borrowernumber'});
 965                                 }
 966                                 else {
 967                                         # set waiting reserve to first in reserve queue as book isn't waiting now
 968                                         ModReserve(1,
 969                                                 $res->{'biblionumber'},
 970                                                 $res->{'borrowernumber'},
 971                                                 $res->{'branchcode'}
 972                                         );
 973                                 }
 974                         }
 975
 976                         # Starting process for transfer job (checking transfert and validate it if we have one)
 977             my ($datesent) = GetTransfers($item->{'itemnumber'});
 978             if ($datesent) {
 979         #       updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
 980                 my $sth =
 981                     $dbh->prepare(
 982                     "UPDATE branchtransfers
 983                         SET datearrived = now(),
 984                         tobranch = ?,
 985                         comments = 'Forced branchtransfer'
 986                     WHERE itemnumber= ? AND datearrived IS NULL"
 987                     );
 988                 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
 989             }
 990
 991         # Record in the database the fact that the book was issued.
 992         my $sth =
 993           $dbh->prepare(
 994                 "INSERT INTO issues
 995                     (borrowernumber, itemnumber,issuedate, date_due, branchcode)
 996                 VALUES (?,?,?,?,?)"
 997           );
 998         unless ($datedue) {
 999             my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1000             my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch );
1001             $datedue = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch, $borrower );
1002
1003         }
1004         $sth->execute(
1005             $borrower->{'borrowernumber'},      # borrowernumber
1006             $item->{'itemnumber'},              # itemnumber
1007             $issuedate,                         # issuedate
1008             $datedue->output('iso'),            # date_due
1009             C4::Context->userenv->{'branch'}    # branchcode
1010         );
1011         $sth->finish;
1012         if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1013           CartToShelf( $item->{'itemnumber'} );
1014         }
1015         $item->{'issues'}++;
1016         ModItem({ issues           => $item->{'issues'},
1017                   holdingbranch    => C4::Context->userenv->{'branch'},
1018                   itemlost         => 0,
1019                   datelastborrowed => C4::Dates->new()->output('iso'),
1020                   onloan           => $datedue->output('iso'),
1021                 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1022         ModDateLastSeen( $item->{'itemnumber'} );
1023
1024         # If it costs to borrow this book, charge it to the patron's account.
1025         my ( $charge, $itemtype ) = GetIssuingCharges(
1026             $item->{'itemnumber'},
1027             $borrower->{'borrowernumber'}
1028         );
1029         if ( $charge > 0 ) {
1030             AddIssuingCharge(
1031                 $item->{'itemnumber'},
1032                 $borrower->{'borrowernumber'}, $charge
1033             );
1034             $item->{'charge'} = $charge;
1035         }
1036
1037         # Record the fact that this book was issued.
1038         &UpdateStats(
1039             C4::Context->userenv->{'branch'},
1040             'issue', $charge,
1041             ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
1042             $item->{'itype'}, $borrower->{'borrowernumber'}
1043         );
1044
1045         # Send a checkout slip.
1046         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1047         my %conditions = (
1048             branchcode   => $branch,
1049             categorycode => $borrower->{categorycode},
1050             item_type    => $item->{itype},
1051             notification => 'CHECKOUT',
1052         );
1053         if ($circulation_alert->is_enabled_for(\%conditions)) {
1054             SendCirculationAlert({
1055                 type     => 'CHECKOUT',
1056                 item     => $item,
1057                 borrower => $borrower,
1058                 branch   => $branch,
1059             });
1060         }
1061     }
1062
1063     logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1064         if C4::Context->preference("IssueLog");
1065   }
1066   return ($datedue);    # not necessarily the same as when it came in!
1067 }
1068
1069 =head2 GetLoanLength
1070
1071 Get loan length for an itemtype, a borrower type and a branch
1072
1073 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1074
1075 =cut
1076
1077 sub GetLoanLength {
1078     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1079     my $dbh = C4::Context->dbh;
1080     my $sth =
1081       $dbh->prepare(
1082 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1083       );
1084 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1085 # try to find issuelength & return the 1st available.
1086 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1087     $sth->execute( $borrowertype, $itemtype, $branchcode );
1088     my $loanlength = $sth->fetchrow_hashref;
1089     return $loanlength->{issuelength}
1090       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1091
1092     $sth->execute( $borrowertype, "*", $branchcode );
1093     $loanlength = $sth->fetchrow_hashref;
1094     return $loanlength->{issuelength}
1095       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1096
1097     $sth->execute( "*", $itemtype, $branchcode );
1098     $loanlength = $sth->fetchrow_hashref;
1099     return $loanlength->{issuelength}
1100       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1101
1102     $sth->execute( "*", "*", $branchcode );
1103     $loanlength = $sth->fetchrow_hashref;
1104     return $loanlength->{issuelength}
1105       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1106
1107     $sth->execute( $borrowertype, $itemtype, "*" );
1108     $loanlength = $sth->fetchrow_hashref;
1109     return $loanlength->{issuelength}
1110       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1111
1112     $sth->execute( $borrowertype, "*", "*" );
1113     $loanlength = $sth->fetchrow_hashref;
1114     return $loanlength->{issuelength}
1115       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1116
1117     $sth->execute( "*", $itemtype, "*" );
1118     $loanlength = $sth->fetchrow_hashref;
1119     return $loanlength->{issuelength}
1120       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1121
1122     $sth->execute( "*", "*", "*" );
1123     $loanlength = $sth->fetchrow_hashref;
1124     return $loanlength->{issuelength}
1125       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1126
1127     # if no rule is set => 21 days (hardcoded)
1128     return 21;
1129 }
1130
1131 =head2 GetIssuingRule
1132
1133 FIXME - This is a copy-paste of GetLoanLength
1134 as a stop-gap.  Do not wish to change API for GetLoanLength
1135 this close to release, however, Overdues::GetIssuingRules is broken.
1136
1137 Get the issuing rule for an itemtype, a borrower type and a branch
1138 Returns a hashref from the issuingrules table.
1139
1140 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1141
1142 =cut
1143
1144 sub GetIssuingRule {
1145     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1146     my $dbh = C4::Context->dbh;
1147     my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"  );
1148     my $irule;
1149
1150         $sth->execute( $borrowertype, $itemtype, $branchcode );
1151     $irule = $sth->fetchrow_hashref;
1152     return $irule if defined($irule) ;
1153
1154     $sth->execute( $borrowertype, "*", $branchcode );
1155     $irule = $sth->fetchrow_hashref;
1156     return $irule if defined($irule) ;
1157
1158     $sth->execute( "*", $itemtype, $branchcode );
1159     $irule = $sth->fetchrow_hashref;
1160     return $irule if defined($irule) ;
1161
1162     $sth->execute( "*", "*", $branchcode );
1163     $irule = $sth->fetchrow_hashref;
1164     return $irule if defined($irule) ;
1165
1166     $sth->execute( $borrowertype, $itemtype, "*" );
1167     $irule = $sth->fetchrow_hashref;
1168     return $irule if defined($irule) ;
1169
1170     $sth->execute( $borrowertype, "*", "*" );
1171     $irule = $sth->fetchrow_hashref;
1172     return $irule if defined($irule) ;
1173
1174     $sth->execute( "*", $itemtype, "*" );
1175     $irule = $sth->fetchrow_hashref;
1176     return $irule if defined($irule) ;
1177
1178     $sth->execute( "*", "*", "*" );
1179     $irule = $sth->fetchrow_hashref;
1180     return $irule if defined($irule) ;
1181
1182     # if no rule matches,
1183     return undef;
1184 }
1185
1186 =head2 GetBranchBorrowerCircRule
1187
1188 =over 4
1189
1190 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1191
1192 =back
1193
1194 Retrieves circulation rule attributes that apply to the given
1195 branch and patron category, regardless of item type.
1196 The return value is a hashref containing the following key:
1197
1198 maxissueqty - maximum number of loans that a
1199 patron of the given category can have at the given
1200 branch.  If the value is undef, no limit.
1201
1202 This will first check for a specific branch and
1203 category match from branch_borrower_circ_rules.
1204
1205 If no rule is found, it will then check default_branch_circ_rules
1206 (same branch, default category).  If no rule is found,
1207 it will then check default_borrower_circ_rules (default
1208 branch, same category), then failing that, default_circ_rules
1209 (default branch, default category).
1210
1211 If no rule has been found in the database, it will default to
1212 the buillt in rule:
1213
1214 maxissueqty - undef
1215
1216 C<$branchcode> and C<$categorycode> should contain the
1217 literal branch code and patron category code, respectively - no
1218 wildcards.
1219
1220 =cut
1221
1222 sub GetBranchBorrowerCircRule {
1223     my $branchcode = shift;
1224     my $categorycode = shift;
1225
1226     my $branch_cat_query = "SELECT maxissueqty
1227                             FROM branch_borrower_circ_rules
1228                             WHERE branchcode = ?
1229                             AND   categorycode = ?";
1230     my $dbh = C4::Context->dbh();
1231     my $sth = $dbh->prepare($branch_cat_query);
1232     $sth->execute($branchcode, $categorycode);
1233     my $result;
1234     if ($result = $sth->fetchrow_hashref()) {
1235         return $result;
1236     }
1237
1238     # try same branch, default borrower category
1239     my $branch_query = "SELECT maxissueqty
1240                         FROM default_branch_circ_rules
1241                         WHERE branchcode = ?";
1242     $sth = $dbh->prepare($branch_query);
1243     $sth->execute($branchcode);
1244     if ($result = $sth->fetchrow_hashref()) {
1245         return $result;
1246     }
1247
1248     # try default branch, same borrower category
1249     my $category_query = "SELECT maxissueqty
1250                           FROM default_borrower_circ_rules
1251                           WHERE categorycode = ?";
1252     $sth = $dbh->prepare($category_query);
1253     $sth->execute($categorycode);
1254     if ($result = $sth->fetchrow_hashref()) {
1255         return $result;
1256     }
1257
1258     # try default branch, default borrower category
1259     my $default_query = "SELECT maxissueqty
1260                           FROM default_circ_rules";
1261     $sth = $dbh->prepare($default_query);
1262     $sth->execute();
1263     if ($result = $sth->fetchrow_hashref()) {
1264         return $result;
1265     }
1266
1267     # built-in default circulation rule
1268     return {
1269         maxissueqty => undef,
1270     };
1271 }
1272
1273 =head2 GetBranchItemRule
1274
1275 =over 4
1276
1277 my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1278
1279 =back
1280
1281 Retrieves circulation rule attributes that apply to the given
1282 branch and item type, regardless of patron category.
1283
1284 The return value is a hashref containing the following key:
1285
1286 holdallowed => Hold policy for this branch and itemtype. Possible values:
1287   0: No holds allowed.
1288   1: Holds allowed only by patrons that have the same homebranch as the item.
1289   2: Holds allowed from any patron.
1290
1291 This searches branchitemrules in the following order:
1292
1293   * Same branchcode and itemtype
1294   * Same branchcode, itemtype '*'
1295   * branchcode '*', same itemtype
1296   * branchcode and itemtype '*'
1297
1298 Neither C<$branchcode> nor C<$categorycode> should be '*'.
1299
1300 =cut
1301
1302 sub GetBranchItemRule {
1303     my ( $branchcode, $itemtype ) = @_;
1304     my $dbh = C4::Context->dbh();
1305     my $result = {};
1306
1307     my @attempts = (
1308         ['SELECT holdallowed
1309             FROM branch_item_rules
1310             WHERE branchcode = ?
1311               AND itemtype = ?', $branchcode, $itemtype],
1312         ['SELECT holdallowed
1313             FROM default_branch_circ_rules
1314             WHERE branchcode = ?', $branchcode],
1315         ['SELECT holdallowed
1316             FROM default_branch_item_rules
1317             WHERE itemtype = ?', $itemtype],
1318         ['SELECT holdallowed
1319             FROM default_circ_rules'],
1320     );
1321
1322     foreach my $attempt (@attempts) {
1323         my ($query, @bind_params) = @{$attempt};
1324
1325         # Since branch/category and branch/itemtype use the same per-branch
1326         # defaults tables, we have to check that the key we want is set, not
1327         # just that a row was returned
1328         return $result if ( defined( $result->{'holdallowed'} = $dbh->selectrow_array( $query, {}, @bind_params ) ) );
1329     }
1330
1331     # built-in default circulation rule
1332     return {
1333         holdallowed => 2,
1334     };
1335 }
1336
1337 =head2 AddReturn
1338
1339 ($doreturn, $messages, $iteminformation, $borrower) =
1340     &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1341
1342 Returns a book.
1343
1344 =over 4
1345
1346 =item C<$barcode> is the bar code of the book being returned.
1347
1348 =item C<$branch> is the code of the branch where the book is being returned.
1349
1350 =item C<$exemptfine> indicates that overdue charges for the item will be
1351 removed.
1352
1353 =item C<$dropbox> indicates that the check-in date is assumed to be
1354 yesterday, or the last non-holiday as defined in C4::Calendar .  If
1355 overdue charges are applied and C<$dropbox> is true, the last charge
1356 will be removed.  This assumes that the fines accrual script has run
1357 for _today_.
1358
1359 =back
1360
1361 C<&AddReturn> returns a list of four items:
1362
1363 C<$doreturn> is true iff the return succeeded.
1364
1365 C<$messages> is a reference-to-hash giving feedback on the operation.
1366 The keys of the hash are:
1367
1368 =over 4
1369
1370 =item C<BadBarcode>
1371
1372 No item with this barcode exists. The value is C<$barcode>.
1373
1374 =item C<NotIssued>
1375
1376 The book is not currently on loan. The value is C<$barcode>.
1377
1378 =item C<IsPermanent>
1379
1380 The book's home branch is a permanent collection. If you have borrowed
1381 this book, you are not allowed to return it. The value is the code for
1382 the book's home branch.
1383
1384 =item C<wthdrawn>
1385
1386 This book has been withdrawn/cancelled. The value should be ignored.
1387
1388 =item C<Wrongbranch>
1389
1390 This book has was returned to the wrong branch.  The value is a hashref
1391 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1392 contain the branchcode of the incorrect and correct return library, respectively.
1393
1394 =item C<ResFound>
1395
1396 The item was reserved. The value is a reference-to-hash whose keys are
1397 fields from the reserves table of the Koha database, and
1398 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1399 either C<Waiting>, C<Reserved>, or 0.
1400
1401 =back
1402
1403 C<$iteminformation> is a reference-to-hash, giving information about the
1404 returned item from the issues table.
1405
1406 C<$borrower> is a reference-to-hash, giving information about the
1407 patron who last borrowed the book.
1408
1409 =cut
1410
1411 sub AddReturn {
1412     my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1413     if ($branch and not GetBranchDetail($branch)) {
1414         warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
1415         undef $branch;
1416     }
1417     $branch = C4::Context->userenv->{'branch'} unless $branch;  # we trust userenv to be a safe fallback/default
1418     my $messages;
1419     my $borrower;
1420     my $biblio;
1421     my $doreturn       = 1;
1422     my $validTransfert = 0;
1423
1424     # get information on item
1425     my $itemnumber = GetItemnumberFromBarcode( $barcode );
1426     unless ($itemnumber) {
1427         return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower.  bail out.
1428     }
1429     my $issue  = GetItemIssue($itemnumber);
1430 #   warn Dumper($iteminformation);
1431     if ($issue and $issue->{borrowernumber}) {
1432         $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1433             or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existant borrowernumber '$issue->{borrowernumber}'\n"
1434                 . Dumper($issue) . "\n";
1435     } else {
1436         $messages->{'NotIssued'} = $barcode;
1437         # even though item is not on loan, it may still be transferred;  therefore, get current branch info
1438         $doreturn = 0;
1439         # No issue, no borrowernumber.  ONLY if $doreturn, *might* you have a $borrower later.
1440     }
1441
1442     my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1443         # full item data, but no borrowernumber or checkout info (no issue)
1444         # we know GetItem should work because GetItemnumberFromBarcode worked
1445     my $hbr = $item->{C4::Context->preference("HomeOrHoldingBranch")} || '';
1446         # item must be from items table -- issues table has branchcode and issuingbranch, not homebranch nor holdingbranch
1447
1448     my $borrowernumber = $borrower->{'borrowernumber'} || undef;    # we don't know if we had a borrower or not
1449
1450     # check if the book is in a permanent collection....
1451     # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
1452     if ( $hbr ) {
1453         my $branches = GetBranches();    # a potentially expensive call for a non-feature.
1454         $branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr;
1455     }
1456
1457     # if indy branches and returning to different branch, refuse the return
1458     if ($hbr ne $branch && C4::Context->preference("IndependantBranches")){
1459         $messages->{'Wrongbranch'} = {
1460             Wrongbranch => $branch,
1461             Rightbranch => $hbr,
1462         };
1463         $doreturn = 0;
1464         # bailing out here - in this case, current desired behavior
1465         # is to act as if no return ever happened at all.
1466         # FIXME - even in an indy branches situation, there should
1467         # still be an option for the library to accept the item
1468         # and transfer it to its owning library.
1469         return ( $doreturn, $messages, $issue, $borrower );
1470     }
1471
1472     if ( $item->{'wthdrawn'} ) { # book has been cancelled
1473         $messages->{'wthdrawn'} = 1;
1474         $doreturn = 0;
1475     }
1476
1477     # case of a return of document (deal with issues and holdingbranch)
1478     if ($doreturn) {
1479         $borrower or warn "AddReturn without current borrower";
1480                 my $circControlBranch = _GetCircControlBranch($item,$borrower);
1481         if ($dropbox) {
1482             # don't allow dropbox mode to create an invalid entry in issues (issuedate > returndate) FIXME: actually checks eq, not gt
1483             undef($dropbox) if ( $item->{'issuedate'} eq C4::Dates->today('iso') );
1484         }
1485
1486         if ($borrowernumber) {
1487             MarkIssueReturned($borrowernumber, $item->{'itemnumber'}, $circControlBranch);
1488             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?  This could be the borrower hash.
1489         }
1490
1491         ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1492     }
1493
1494     # the holdingbranch is updated if the document is returned to another location.
1495     # this is always done regardless of whether the item was on loan or not
1496     if ($item->{'holdingbranch'} ne $branch) {
1497         UpdateHoldingbranch($branch, $item->{'itemnumber'});
1498         $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1499     }
1500     ModDateLastSeen( $item->{'itemnumber'} );
1501
1502     # check if we have a transfer for this document
1503     my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1504
1505     # if we have a transfer to do, we update the line of transfers with the datearrived
1506     if ($datesent) {
1507         if ( $tobranch eq $branch ) {
1508             my $sth = C4::Context->dbh->prepare(
1509                 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1510             );
1511             $sth->execute( $item->{'itemnumber'} );
1512             # if we have a reservation with valid transfer, we can set it's status to 'W'
1513             C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1514         } else {
1515             $messages->{'WrongTransfer'}     = $tobranch;
1516             $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1517         }
1518         $validTransfert = 1;
1519     }
1520
1521     # fix up the accounts.....
1522     if ($item->{'itemlost'}) {
1523         _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode);    # can tolerate undef $borrowernumber
1524         $messages->{'WasLost'} = 1;
1525     }
1526
1527     # fix up the overdues in accounts...
1528     if ($borrowernumber) {
1529         my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1530         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!";  # zero is OK, check defined
1531     }
1532
1533     # find reserves.....
1534     # if we don't have a reserve with the status W, we launch the Checkreserves routine
1535     my ($resfound, $resrec) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1536     if ($resfound) {
1537           $resrec->{'ResFound'} = $resfound;
1538         $messages->{'ResFound'} = $resrec;
1539     }
1540
1541     # update stats?
1542     # Record the fact that this book was returned.
1543     UpdateStats(
1544         $branch, 'return', '0', '',
1545         $item->{'itemnumber'},
1546         $biblio->{'itemtype'},
1547         $borrowernumber
1548     );
1549
1550     # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
1551     my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1552     my %conditions = (
1553         branchcode   => $branch,
1554         categorycode => $borrower->{categorycode},
1555         item_type    => $item->{itype},
1556         notification => 'CHECKIN',
1557     );
1558     if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
1559         SendCirculationAlert({
1560             type     => 'CHECKIN',
1561             item     => $item,
1562             borrower => $borrower,
1563             branch   => $branch,
1564         });
1565     }
1566
1567     logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'})
1568         if C4::Context->preference("ReturnLog");
1569
1570     # FIXME: make this comment intelligible.
1571     #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1572     #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1573
1574     if ($doreturn and ($branch ne $hbr) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) ){
1575         if ( C4::Context->preference("AutomaticItemReturn"    ) or
1576             (C4::Context->preference("UseBranchTransferLimits") and
1577              ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} )
1578            )) {
1579             $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
1580             $debug and warn "item: " . Dumper($item);
1581             ModItemTransfer($item->{'itemnumber'}, $branch, $hbr);
1582             $messages->{'WasTransfered'} = 1;
1583         } else {
1584             $messages->{'NeedsTransfer'} = 1;   # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
1585         }
1586     }
1587     return ( $doreturn, $messages, $issue, $borrower );
1588 }
1589
1590 =head2 MarkIssueReturned
1591
1592 =over 4
1593
1594 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate);
1595
1596 =back
1597
1598 Unconditionally marks an issue as being returned by
1599 moving the C<issues> row to C<old_issues> and
1600 setting C<returndate> to the current date, or
1601 the last non-holiday date of the branccode specified in
1602 C<dropbox_branch> .  Assumes you've already checked that
1603 it's safe to do this, i.e. last non-holiday > issuedate.
1604
1605 if C<$returndate> is specified (in iso format), it is used as the date
1606 of the return. It is ignored when a dropbox_branch is passed in.
1607
1608 Ideally, this function would be internal to C<C4::Circulation>,
1609 not exported, but it is currently needed by one
1610 routine in C<C4::Accounts>.
1611
1612 =cut
1613
1614 sub MarkIssueReturned {
1615     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate ) = @_;
1616     my $dbh   = C4::Context->dbh;
1617     my $query = "UPDATE issues SET returndate=";
1618     my @bind;
1619     if ($dropbox_branch) {
1620         my $calendar = C4::Calendar->new( branchcode => $dropbox_branch );
1621         my $dropboxdate = $calendar->addDate( C4::Dates->new(), -1 );
1622         $query .= " ? ";
1623         push @bind, $dropboxdate->output('iso');
1624     } elsif ($returndate) {
1625         $query .= " ? ";
1626         push @bind, $returndate;
1627     } else {
1628         $query .= " now() ";
1629     }
1630     $query .= " WHERE  borrowernumber = ?  AND itemnumber = ?";
1631     push @bind, $borrowernumber, $itemnumber;
1632     # FIXME transaction
1633     my $sth_upd  = $dbh->prepare($query);
1634     $sth_upd->execute(@bind);
1635     my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1636                                   WHERE borrowernumber = ?
1637                                   AND itemnumber = ?");
1638     $sth_copy->execute($borrowernumber, $itemnumber);
1639     my $sth_del  = $dbh->prepare("DELETE FROM issues
1640                                   WHERE borrowernumber = ?
1641                                   AND itemnumber = ?");
1642     $sth_del->execute($borrowernumber, $itemnumber);
1643 }
1644
1645 =head2 _FixOverduesOnReturn
1646
1647     &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1648
1649 C<$brn> borrowernumber
1650
1651 C<$itm> itemnumber
1652
1653 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1654 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1655
1656 Internal function, called only by AddReturn
1657
1658 =cut
1659
1660 sub _FixOverduesOnReturn {
1661     my ($borrowernumber, $item);
1662     unless ($borrowernumber = shift) {
1663         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
1664         return;
1665     }
1666     unless ($item = shift) {
1667         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
1668         return;
1669     }
1670     my ($exemptfine, $dropbox) = @_;
1671     my $dbh = C4::Context->dbh;
1672
1673     # check for overdue fine
1674     my $sth = $dbh->prepare(
1675 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1676     );
1677     $sth->execute( $borrowernumber, $item );
1678
1679     # alter fine to show that the book has been returned
1680     my $data = $sth->fetchrow_hashref;
1681     return 0 unless $data;    # no warning, there's just nothing to fix
1682
1683     my $uquery;
1684     my @bind = ($borrowernumber, $item, $data->{'accountno'});
1685     if ($exemptfine) {
1686         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1687         if (C4::Context->preference("FinesLog")) {
1688             &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1689         }
1690     } elsif ($dropbox && $data->{lastincrement}) {
1691         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1692         my $amt = $data->{amount} - $data->{lastincrement} ;
1693         if (C4::Context->preference("FinesLog")) {
1694             &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1695         }
1696          $uquery = "update accountlines set accounttype='F' ";
1697          if($outstanding  >= 0 && $amt >=0) {
1698             $uquery .= ", amount = ? , amountoutstanding=? ";
1699             unshift @bind, ($amt, $outstanding) ;
1700         }
1701     } else {
1702         $uquery = "update accountlines set accounttype='F' ";
1703     }
1704     $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1705     my $usth = $dbh->prepare($uquery);
1706     return $usth->execute(@bind);
1707 }
1708
1709 =head2 _FixAccountForLostAndReturned
1710
1711         &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
1712
1713 Calculates the charge for a book lost and returned.
1714
1715 Internal function, not exported, called only by AddReturn.
1716
1717 FIXME: This function reflects how inscrutable fines logic is.  Fix both.
1718 FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.
1719
1720 =cut
1721
1722 sub _FixAccountForLostAndReturned {
1723     my $itemnumber     = shift or return;
1724     my $borrowernumber = @_ ? shift : undef;
1725     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
1726     my $dbh = C4::Context->dbh;
1727     # check for charge made for lost book
1728     my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1729     $sth->execute($itemnumber);
1730     my $data = $sth->fetchrow_hashref;
1731     $data or return;    # bail if there is nothing to do
1732
1733     # writeoff this amount
1734     my $offset;
1735     my $amount = $data->{'amount'};
1736     my $acctno = $data->{'accountno'};
1737     my $amountleft;                                             # Starts off undef/zero.
1738     if ($data->{'amountoutstanding'} == $amount) {
1739         $offset     = $data->{'amount'};
1740         $amountleft = 0;                                        # Hey, it's zero here, too.
1741     } else {
1742         $offset     = $amount - $data->{'amountoutstanding'};   # Um, isn't this the same as ZERO?  We just tested those two things are ==
1743         $amountleft = $data->{'amountoutstanding'} - $amount;   # Um, isn't this the same as ZERO?  We just tested those two things are ==
1744     }
1745     my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1746         WHERE (borrowernumber = ?)
1747         AND (itemnumber = ?) AND (accountno = ?) ");
1748     $usth->execute($data->{'borrowernumber'},$itemnumber,$acctno);      # We might be adjusting an account for some OTHER borrowernumber now.  Not the one we passed in.
1749     #check if any credit is left if so writeoff other accounts
1750     my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1751     $amountleft *= -1 if ($amountleft < 0);
1752     if ($amountleft > 0) {
1753         my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1754                             AND (amountoutstanding >0) ORDER BY date");     # might want to order by amountoustanding ASC (pay smallest first)
1755         $msth->execute($data->{'borrowernumber'});
1756         # offset transactions
1757         my $newamtos;
1758         my $accdata;
1759         while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1760             if ($accdata->{'amountoutstanding'} < $amountleft) {
1761                 $newamtos = 0;
1762                 $amountleft -= $accdata->{'amountoutstanding'};
1763             }  else {
1764                 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1765                 $amountleft = 0;
1766             }
1767             my $thisacct = $accdata->{'accountno'};
1768             # FIXME: move prepares outside while loop!
1769             my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1770                     WHERE (borrowernumber = ?)
1771                     AND (accountno=?)");
1772             $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');    # FIXME: '$thisacct' is a string literal!
1773             $usth = $dbh->prepare("INSERT INTO accountoffsets
1774                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1775                 VALUES
1776                 (?,?,?,?)");
1777             $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1778         }
1779         $msth->finish;  # $msth might actually have data left
1780     }
1781     $amountleft *= -1 if ($amountleft > 0);
1782     my $desc = "Item Returned " . $item_id;
1783     $usth = $dbh->prepare("INSERT INTO accountlines
1784         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1785         VALUES (?,?,now(),?,?,'CR',?)");
1786     $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1787     if ($borrowernumber) {
1788         # FIXME: same as query above.  use 1 sth for both
1789         $usth = $dbh->prepare("INSERT INTO accountoffsets
1790             (borrowernumber, accountno, offsetaccount,  offsetamount)
1791             VALUES (?,?,?,?)");
1792         $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
1793     }
1794     ModItem({ paidfor => '' }, undef, $itemnumber);
1795     return;
1796 }
1797
1798 =head2 _GetCircControlBranch
1799
1800    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
1801
1802 Internal function :
1803
1804 Return the library code to be used to determine which circulation
1805 policy applies to a transaction.  Looks up the CircControl and
1806 HomeOrHoldingBranch system preferences.
1807
1808 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
1809
1810 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
1811
1812 =cut
1813
1814 sub _GetCircControlBranch {
1815     my ($item, $borrower) = @_;
1816     my $circcontrol = C4::Context->preference('CircControl');
1817     my $branch;
1818
1819     if ($circcontrol eq 'PickupLibrary') {
1820         $branch= C4::Context->userenv->{'branch'};
1821     } elsif ($circcontrol eq 'PatronLibrary') {
1822         $branch=$borrower->{branchcode};
1823     } else {
1824         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
1825         $branch = $item->{$branchfield};
1826         # default to item home branch if holdingbranch is used
1827         # and is not defined
1828         if (!defined($branch) && $branchfield eq 'holdingbranch') {
1829             $branch = $item->{homebranch};
1830         }
1831     }
1832     return $branch;
1833 }
1834
1835
1836
1837
1838
1839
1840 =head2 GetItemIssue
1841
1842 $issue = &GetItemIssue($itemnumber);
1843
1844 Returns patron currently having a book, or undef if not checked out.
1845
1846 C<$itemnumber> is the itemnumber.
1847
1848 C<$issue> is a hashref of the row from the issues table.
1849
1850 =cut
1851
1852 sub GetItemIssue {
1853     my ($itemnumber) = @_;
1854     return unless $itemnumber;
1855     my $sth = C4::Context->dbh->prepare(
1856         "SELECT *
1857         FROM issues
1858         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1859         WHERE issues.itemnumber=?");
1860     $sth->execute($itemnumber);
1861     my $data = $sth->fetchrow_hashref;
1862     return unless $data;
1863     $data->{'overdue'} = ($data->{'date_due'} lt C4::Dates->today('iso')) ? 1 : 0;
1864     return ($data);
1865 }
1866
1867 =head2 GetOpenIssue
1868
1869 $issue = GetOpenIssue( $itemnumber );
1870
1871 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
1872
1873 C<$itemnumber> is the item's itemnumber
1874
1875 Returns a hashref
1876
1877 =cut
1878
1879 sub GetOpenIssue {
1880   my ( $itemnumber ) = @_;
1881
1882   my $dbh = C4::Context->dbh;
1883   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
1884   $sth->execute( $itemnumber );
1885   my $issue = $sth->fetchrow_hashref();
1886   return $issue;
1887 }
1888
1889 =head2 GetItemIssues
1890
1891 $issues = &GetItemIssues($itemnumber, $history);
1892
1893 Returns patrons that have issued a book
1894
1895 C<$itemnumber> is the itemnumber
1896 C<$history> is false if you just want the current "issuer" (if any)
1897 and true if you want issues history from old_issues also.
1898
1899 Returns reference to an array of hashes
1900
1901 =cut
1902
1903 sub GetItemIssues {
1904     my ( $itemnumber, $history ) = @_;
1905
1906     my $today = C4::Dates->today('iso');  # get today date
1907     my $sql = "SELECT * FROM issues
1908               JOIN borrowers USING (borrowernumber)
1909               JOIN items     USING (itemnumber)
1910               WHERE issues.itemnumber = ? ";
1911     if ($history) {
1912         $sql .= "UNION ALL
1913                  SELECT * FROM old_issues
1914                  LEFT JOIN borrowers USING (borrowernumber)
1915                  JOIN items USING (itemnumber)
1916                  WHERE old_issues.itemnumber = ? ";
1917     }
1918     $sql .= "ORDER BY date_due DESC";
1919     my $sth = C4::Context->dbh->prepare($sql);
1920     if ($history) {
1921         $sth->execute($itemnumber, $itemnumber);
1922     } else {
1923         $sth->execute($itemnumber);
1924     }
1925     my $results = $sth->fetchall_arrayref({});
1926     foreach (@$results) {
1927         $_->{'overdue'} = ($_->{'date_due'} lt $today) ? 1 : 0;
1928     }
1929     return $results;
1930 }
1931
1932 =head2 GetBiblioIssues
1933
1934 $issues = GetBiblioIssues($biblionumber);
1935
1936 this function get all issues from a biblionumber.
1937
1938 Return:
1939 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1940 tables issues and the firstname,surname & cardnumber from borrowers.
1941
1942 =cut
1943
1944 sub GetBiblioIssues {
1945     my $biblionumber = shift;
1946     return undef unless $biblionumber;
1947     my $dbh   = C4::Context->dbh;
1948     my $query = "
1949         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1950         FROM issues
1951             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1952             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1953             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1954             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1955         WHERE biblio.biblionumber = ?
1956         UNION ALL
1957         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1958         FROM old_issues
1959             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1960             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1961             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1962             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1963         WHERE biblio.biblionumber = ?
1964         ORDER BY timestamp
1965     ";
1966     my $sth = $dbh->prepare($query);
1967     $sth->execute($biblionumber, $biblionumber);
1968
1969     my @issues;
1970     while ( my $data = $sth->fetchrow_hashref ) {
1971         push @issues, $data;
1972     }
1973     return \@issues;
1974 }
1975
1976 =head2 GetUpcomingDueIssues
1977
1978 =over 4
1979
1980 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
1981
1982 =back
1983
1984 =cut
1985
1986 sub GetUpcomingDueIssues {
1987     my $params = shift;
1988
1989     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
1990     my $dbh = C4::Context->dbh;
1991
1992     my $statement = <<END_SQL;
1993 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due
1994 FROM issues
1995 LEFT JOIN items USING (itemnumber)
1996 WhERE returndate is NULL
1997 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
1998 END_SQL
1999
2000     my @bind_parameters = ( $params->{'days_in_advance'} );
2001
2002     my $sth = $dbh->prepare( $statement );
2003     $sth->execute( @bind_parameters );
2004     my $upcoming_dues = $sth->fetchall_arrayref({});
2005     $sth->finish;
2006
2007     return $upcoming_dues;
2008 }
2009
2010 =head2 CanBookBeRenewed
2011
2012 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2013
2014 Find out whether a borrowed item may be renewed.
2015
2016 C<$dbh> is a DBI handle to the Koha database.
2017
2018 C<$borrowernumber> is the borrower number of the patron who currently
2019 has the item on loan.
2020
2021 C<$itemnumber> is the number of the item to renew.
2022
2023 C<$override_limit>, if supplied with a true value, causes
2024 the limit on the number of times that the loan can be renewed
2025 (as controlled by the item type) to be ignored.
2026
2027 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
2028 item must currently be on loan to the specified borrower; renewals
2029 must be allowed for the item's type; and the borrower must not have
2030 already renewed the loan. $error will contain the reason the renewal can not proceed
2031
2032 =cut
2033
2034 sub CanBookBeRenewed {
2035
2036     # check renewal status
2037     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2038     my $dbh       = C4::Context->dbh;
2039     my $renews    = 1;
2040     my $renewokay = 0;
2041         my $error;
2042
2043     # Look in the issues table for this item, lent to this borrower,
2044     # and not yet returned.
2045
2046     # Look in the issues table for this item, lent to this borrower,
2047     # and not yet returned.
2048     my %branch = (
2049             'ItemHomeLibrary' => 'items.homebranch',
2050             'PickupLibrary'   => 'items.holdingbranch',
2051             'PatronLibrary'   => 'borrowers.branchcode'
2052             );
2053     my $controlbranch = $branch{C4::Context->preference('CircControl')};
2054     my $itype         = C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype';
2055
2056     my $sthcount = $dbh->prepare("
2057                    SELECT
2058                     borrowers.categorycode, biblioitems.itemtype, issues.renewals, renewalsallowed, $controlbranch
2059                    FROM  issuingrules,
2060                    issues
2061                    LEFT JOIN items USING (itemnumber)
2062                    LEFT JOIN borrowers USING (borrowernumber)
2063                    LEFT JOIN biblioitems USING (biblioitemnumber)
2064
2065                    WHERE
2066                     issuingrules.categorycode = borrowers.categorycode
2067                    AND
2068                     issuingrules.itemtype = $itype
2069                    AND
2070                     (issuingrules.branchcode = $controlbranch OR issuingrules.branchcode = '*')
2071                    AND
2072                     borrowernumber = ?
2073                    AND
2074                     itemnumber = ?
2075                    ORDER BY
2076                     issuingrules.categorycode desc,
2077                     issuingrules.itemtype desc,
2078                     issuingrules.branchcode desc
2079                    LIMIT 1;
2080                   ");
2081
2082     $sthcount->execute( $borrowernumber, $itemnumber );
2083     if ( my $data1 = $sthcount->fetchrow_hashref ) {
2084
2085         if ( ( $data1->{renewalsallowed} && $data1->{renewalsallowed} > $data1->{renewals} ) || $override_limit ) {
2086             $renewokay = 1;
2087         }
2088         else {
2089                         $error="too_many";
2090                 }
2091
2092         my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
2093         if ($resfound) {
2094             $renewokay = 0;
2095                         $error="on_reserve"
2096         }
2097
2098     }
2099     return ($renewokay,$error);
2100 }
2101
2102 =head2 AddRenewal
2103
2104 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2105
2106 Renews a loan.
2107
2108 C<$borrowernumber> is the borrower number of the patron who currently
2109 has the item.
2110
2111 C<$itemnumber> is the number of the item to renew.
2112
2113 C<$branch> is the library where the renewal took place (if any).
2114            The library that controls the circ policies for the renewal is retrieved from the issues record.
2115
2116 C<$datedue> can be a C4::Dates object used to set the due date.
2117
2118 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2119 this parameter is not supplied, lastreneweddate is set to the current date.
2120
2121 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2122 from the book's item type.
2123
2124 =cut
2125
2126 sub AddRenewal {
2127     my $borrowernumber  = shift or return undef;
2128     my $itemnumber      = shift or return undef;
2129     my $branch          = shift;
2130     my $datedue         = shift;
2131     my $lastreneweddate = shift || C4::Dates->new()->output('iso');
2132     my $item   = GetItem($itemnumber) or return undef;
2133     my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
2134
2135     my $dbh = C4::Context->dbh;
2136     # Find the issues record for this book
2137     my $sth =
2138       $dbh->prepare("SELECT * FROM issues
2139                         WHERE borrowernumber=?
2140                         AND itemnumber=?"
2141       );
2142     $sth->execute( $borrowernumber, $itemnumber );
2143     my $issuedata = $sth->fetchrow_hashref;
2144     $sth->finish;
2145     if($datedue && ! $datedue->output('iso')){
2146         warn "Invalid date passed to AddRenewal.";
2147         return undef;
2148     }
2149     # If the due date wasn't specified, calculate it by adding the
2150     # book's loan length to today's date or the current due date
2151     # based on the value of the RenewalPeriodBase syspref.
2152     unless ($datedue) {
2153
2154         my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
2155         my $loanlength = GetLoanLength(
2156                     $borrower->{'categorycode'},
2157                     (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
2158                                 $issuedata->{'branchcode'}  );   # that's the circ control branch.
2159
2160         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2161                                         C4::Dates->new($issuedata->{date_due}, 'iso') :
2162                                         C4::Dates->new();
2163         $datedue =  CalcDateDue($datedue,$loanlength,$issuedata->{'branchcode'},$borrower);
2164     }
2165
2166     # Update the issues record to have the new due date, and a new count
2167     # of how many times it has been renewed.
2168     my $renews = $issuedata->{'renewals'} + 1;
2169     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2170                             WHERE borrowernumber=?
2171                             AND itemnumber=?"
2172     );
2173     $sth->execute( $datedue->output('iso'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2174     $sth->finish;
2175
2176     # Update the renewal count on the item, and tell zebra to reindex
2177     $renews = $biblio->{'renewals'} + 1;
2178     ModItem({ renewals => $renews, onloan => $datedue->output('iso') }, $biblio->{'biblionumber'}, $itemnumber);
2179
2180     # Charge a new rental fee, if applicable?
2181     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2182     if ( $charge > 0 ) {
2183         my $accountno = getnextacctno( $borrowernumber );
2184         my $item = GetBiblioFromItemNumber($itemnumber);
2185         $sth = $dbh->prepare(
2186                 "INSERT INTO accountlines
2187                     (date,
2188                                         borrowernumber, accountno, amount,
2189                     description,
2190                                         accounttype, amountoutstanding, itemnumber
2191                                         )
2192                     VALUES (now(),?,?,?,?,?,?,?)"
2193         );
2194         $sth->execute( $borrowernumber, $accountno, $charge,
2195             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2196             'Rent', $charge, $itemnumber );
2197         $sth->finish;
2198     }
2199     # Log the renewal
2200     UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2201         return $datedue;
2202 }
2203
2204 sub GetRenewCount {
2205     # check renewal status
2206     my ($bornum,$itemno)=@_;
2207     my $dbh = C4::Context->dbh;
2208     my $renewcount = 0;
2209         my $renewsallowed = 0;
2210         my $renewsleft = 0;
2211     # Look in the issues table for this item, lent to this borrower,
2212     # and not yet returned.
2213
2214     # FIXME - I think this function could be redone to use only one SQL call.
2215     my $sth = $dbh->prepare("select * from issues
2216                                 where (borrowernumber = ?)
2217                                 and (itemnumber = ?)");
2218     $sth->execute($bornum,$itemno);
2219     my $data = $sth->fetchrow_hashref;
2220     $renewcount = $data->{'renewals'} if $data->{'renewals'};
2221     $sth->finish;
2222     my $query = "SELECT renewalsallowed FROM items ";
2223     $query .= (C4::Context->preference('item-level_itypes'))
2224                 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2225                 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
2226                    LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2227     $query .= "WHERE items.itemnumber = ?";
2228     my $sth2 = $dbh->prepare($query);
2229     $sth2->execute($itemno);
2230     my $data2 = $sth2->fetchrow_hashref();
2231     $renewsallowed = $data2->{'renewalsallowed'};
2232     $renewsleft = $renewsallowed - $renewcount;
2233     return ($renewcount,$renewsallowed,$renewsleft);
2234 }
2235
2236 =head2 GetIssuingCharges
2237
2238 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2239
2240 Calculate how much it would cost for a given patron to borrow a given
2241 item, including any applicable discounts.
2242
2243 C<$itemnumber> is the item number of item the patron wishes to borrow.
2244
2245 C<$borrowernumber> is the patron's borrower number.
2246
2247 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2248 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2249 if it's a video).
2250
2251 =cut
2252
2253 sub GetIssuingCharges {
2254
2255     # calculate charges due
2256     my ( $itemnumber, $borrowernumber ) = @_;
2257     my $charge = 0;
2258     my $dbh    = C4::Context->dbh;
2259     my $item_type;
2260
2261     # Get the book's item type and rental charge (via its biblioitem).
2262     my $qcharge =     "SELECT itemtypes.itemtype,rentalcharge FROM items
2263             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
2264         $qcharge .= (C4::Context->preference('item-level_itypes'))
2265                 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2266                 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2267
2268     $qcharge .=      "WHERE items.itemnumber =?";
2269
2270     my $sth1 = $dbh->prepare($qcharge);
2271     $sth1->execute($itemnumber);
2272     if ( my $data1 = $sth1->fetchrow_hashref ) {
2273         $item_type = $data1->{'itemtype'};
2274         $charge    = $data1->{'rentalcharge'};
2275         my $q2 = "SELECT rentaldiscount FROM borrowers
2276             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2277             WHERE borrowers.borrowernumber = ?
2278             AND issuingrules.itemtype = ?";
2279         my $sth2 = $dbh->prepare($q2);
2280         $sth2->execute( $borrowernumber, $item_type );
2281         if ( my $data2 = $sth2->fetchrow_hashref ) {
2282             my $discount = $data2->{'rentaldiscount'};
2283             if ( $discount eq 'NULL' ) {
2284                 $discount = 0;
2285             }
2286             $charge = ( $charge * ( 100 - $discount ) ) / 100;
2287         }
2288         $sth2->finish;
2289     }
2290
2291     $sth1->finish;
2292     return ( $charge, $item_type );
2293 }
2294
2295 =head2 AddIssuingCharge
2296
2297 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2298
2299 =cut
2300
2301 sub AddIssuingCharge {
2302     my ( $itemnumber, $borrowernumber, $charge ) = @_;
2303     my $dbh = C4::Context->dbh;
2304     my $nextaccntno = getnextacctno( $borrowernumber );
2305     my $query ="
2306         INSERT INTO accountlines
2307             (borrowernumber, itemnumber, accountno,
2308             date, amount, description, accounttype,
2309             amountoutstanding)
2310         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2311     ";
2312     my $sth = $dbh->prepare($query);
2313     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2314     $sth->finish;
2315 }
2316
2317 =head2 GetTransfers
2318
2319 GetTransfers($itemnumber);
2320
2321 =cut
2322
2323 sub GetTransfers {
2324     my ($itemnumber) = @_;
2325
2326     my $dbh = C4::Context->dbh;
2327
2328     my $query = '
2329         SELECT datesent,
2330                frombranch,
2331                tobranch
2332         FROM branchtransfers
2333         WHERE itemnumber = ?
2334           AND datearrived IS NULL
2335         ';
2336     my $sth = $dbh->prepare($query);
2337     $sth->execute($itemnumber);
2338     my @row = $sth->fetchrow_array();
2339     $sth->finish;
2340     return @row;
2341 }
2342
2343 =head2 GetTransfersFromTo
2344
2345 @results = GetTransfersFromTo($frombranch,$tobranch);
2346
2347 Returns the list of pending transfers between $from and $to branch
2348
2349 =cut
2350
2351 sub GetTransfersFromTo {
2352     my ( $frombranch, $tobranch ) = @_;
2353     return unless ( $frombranch && $tobranch );
2354     my $dbh   = C4::Context->dbh;
2355     my $query = "
2356         SELECT itemnumber,datesent,frombranch
2357         FROM   branchtransfers
2358         WHERE  frombranch=?
2359           AND  tobranch=?
2360           AND datearrived IS NULL
2361     ";
2362     my $sth = $dbh->prepare($query);
2363     $sth->execute( $frombranch, $tobranch );
2364     my @gettransfers;
2365
2366     while ( my $data = $sth->fetchrow_hashref ) {
2367         push @gettransfers, $data;
2368     }
2369     $sth->finish;
2370     return (@gettransfers);
2371 }
2372
2373 =head2 DeleteTransfer
2374
2375 &DeleteTransfer($itemnumber);
2376
2377 =cut
2378
2379 sub DeleteTransfer {
2380     my ($itemnumber) = @_;
2381     my $dbh          = C4::Context->dbh;
2382     my $sth          = $dbh->prepare(
2383         "DELETE FROM branchtransfers
2384          WHERE itemnumber=?
2385          AND datearrived IS NULL "
2386     );
2387     $sth->execute($itemnumber);
2388     $sth->finish;
2389 }
2390
2391 =head2 AnonymiseIssueHistory
2392
2393 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2394
2395 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2396 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2397
2398 return the number of affected rows.
2399
2400 =cut
2401
2402 sub AnonymiseIssueHistory {
2403     my $date           = shift;
2404     my $borrowernumber = shift;
2405     my $dbh            = C4::Context->dbh;
2406     my $query          = "
2407         UPDATE old_issues
2408         SET    borrowernumber = NULL
2409         WHERE  returndate < '".$date."'
2410           AND borrowernumber IS NOT NULL
2411     ";
2412     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2413     my $rows_affected = $dbh->do($query);
2414     return $rows_affected;
2415 }
2416
2417 =head2 SendCirculationAlert
2418
2419 Send out a C<check-in> or C<checkout> alert using the messaging system.
2420
2421 B<Parameters>:
2422
2423 =over 4
2424
2425 =item type
2426
2427 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
2428
2429 =item item
2430
2431 Hashref of information about the item being checked in or out.
2432
2433 =item borrower
2434
2435 Hashref of information about the borrower of the item.
2436
2437 =item branch
2438
2439 The branchcode from where the checkout or check-in took place.
2440
2441 =back
2442
2443 B<Example>:
2444
2445     SendCirculationAlert({
2446         type     => 'CHECKOUT',
2447         item     => $item,
2448         borrower => $borrower,
2449         branch   => $branch,
2450     });
2451
2452 =cut
2453
2454 sub SendCirculationAlert {
2455     my ($opts) = @_;
2456     my ($type, $item, $borrower, $branch) =
2457         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
2458     my %message_name = (
2459         CHECKIN  => 'Item Check-in',
2460         CHECKOUT => 'Item Checkout',
2461     );
2462     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
2463         borrowernumber => $borrower->{borrowernumber},
2464         message_name   => $message_name{$type},
2465     });
2466     my $letter = C4::Letters::getletter('circulation', $type);
2467     C4::Letters::parseletter($letter, 'biblio',      $item->{biblionumber});
2468     C4::Letters::parseletter($letter, 'biblioitems', $item->{biblionumber});
2469     C4::Letters::parseletter($letter, 'borrowers',   $borrower->{borrowernumber});
2470     C4::Letters::parseletter($letter, 'branches',    $branch);
2471     my @transports = @{ $borrower_preferences->{transports} };
2472     # warn "no transports" unless @transports;
2473     for (@transports) {
2474         # warn "transport: $_";
2475         my $message = C4::Message->find_last_message($borrower, $type, $_);
2476         if (!$message) {
2477             #warn "create new message";
2478             C4::Message->enqueue($letter, $borrower, $_);
2479         } else {
2480             #warn "append to old message";
2481             $message->append($letter);
2482             $message->update;
2483         }
2484     }
2485     $letter;
2486 }
2487
2488 =head2 updateWrongTransfer
2489
2490 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2491
2492 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
2493
2494 =cut
2495
2496 sub updateWrongTransfer {
2497         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2498         my $dbh = C4::Context->dbh;
2499 # first step validate the actual line of transfert .
2500         my $sth =
2501                 $dbh->prepare(
2502                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2503                 );
2504                 $sth->execute($FromLibrary,$itemNumber);
2505                 $sth->finish;
2506
2507 # second step create a new line of branchtransfer to the right location .
2508         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2509
2510 #third step changing holdingbranch of item
2511         UpdateHoldingbranch($FromLibrary,$itemNumber);
2512 }
2513
2514 =head2 UpdateHoldingbranch
2515
2516 $items = UpdateHoldingbranch($branch,$itmenumber);
2517 Simple methode for updating hodlingbranch in items BDD line
2518
2519 =cut
2520
2521 sub UpdateHoldingbranch {
2522         my ( $branch,$itemnumber ) = @_;
2523     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2524 }
2525
2526 =head2 CalcDateDue
2527
2528 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2529 this function calculates the due date given the loan length ,
2530 checking against the holidays calendar as per the 'useDaysMode' syspref.
2531 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2532 C<$branch>  = location whose calendar to use
2533 C<$loanlength>  = loan length prior to adjustment
2534 =cut
2535
2536 sub CalcDateDue {
2537         my ($startdate,$loanlength,$branch,$borrower) = @_;
2538         my $datedue;
2539
2540         if(C4::Context->preference('useDaysMode') eq 'Days') {  # ignoring calendar
2541                 my $timedue = time + ($loanlength) * 86400;
2542         #FIXME - assumes now even though we take a startdate
2543                 my @datearr  = localtime($timedue);
2544                 $datedue = C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2545         } else {
2546                 my $calendar = C4::Calendar->new(  branchcode => $branch );
2547                 $datedue = $calendar->addDate($startdate, $loanlength);
2548         }
2549
2550         # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
2551         if ( C4::Context->preference('ReturnBeforeExpiry') && $datedue->output('iso') gt $borrower->{dateexpiry} ) {
2552             $datedue = C4::Dates->new( $borrower->{dateexpiry}, 'iso' );
2553         }
2554
2555         # if ceilingDueDate ON the datedue can't be after the ceiling date
2556         if ( C4::Context->preference('ceilingDueDate')
2557              && ( C4::Context->preference('ceilingDueDate') =~ C4::Dates->regexp('syspref') ) ) {
2558             my $ceilingDate = C4::Dates->new( C4::Context->preference('ceilingDueDate') );
2559             if ( $datedue->output( 'iso' ) gt $ceilingDate->output( 'iso' ) ) {
2560                 $datedue = $ceilingDate;
2561             }
2562         }
2563
2564         return $datedue;
2565 }
2566
2567 =head2 CheckValidDatedue
2568        This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2569        To be replaced by CalcDateDue() once C4::Calendar use is tested.
2570
2571 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2572 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2573 C<$date_due>   = returndate calculate with no day check
2574 C<$itemnumber>  = itemnumber
2575 C<$branchcode>  = location of issue (affected by 'CircControl' syspref)
2576 C<$loanlength>  = loan length prior to adjustment
2577 =cut
2578
2579 sub CheckValidDatedue {
2580 my ($date_due,$itemnumber,$branchcode)=@_;
2581 my @datedue=split('-',$date_due->output('iso'));
2582 my $years=$datedue[0];
2583 my $month=$datedue[1];
2584 my $day=$datedue[2];
2585 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2586 my $dow;
2587 for (my $i=0;$i<2;$i++){
2588     $dow=Day_of_Week($years,$month,$day);
2589     ($dow=0) if ($dow>6);
2590     my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2591     my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2592     my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2593         if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2594         $i=0;
2595         (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2596         }
2597     }
2598     my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2599 return $newdatedue;
2600 }
2601
2602
2603 =head2 CheckRepeatableHolidays
2604
2605 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2606 this function checks if the date due is a repeatable holiday
2607 C<$date_due>   = returndate calculate with no day check
2608 C<$itemnumber>  = itemnumber
2609 C<$branchcode>  = localisation of issue
2610
2611 =cut
2612
2613 sub CheckRepeatableHolidays{
2614 my($itemnumber,$week_day,$branchcode)=@_;
2615 my $dbh = C4::Context->dbh;
2616 my $query = qq|SELECT count(*)
2617         FROM repeatable_holidays
2618         WHERE branchcode=?
2619         AND weekday=?|;
2620 my $sth = $dbh->prepare($query);
2621 $sth->execute($branchcode,$week_day);
2622 my $result=$sth->fetchrow;
2623 $sth->finish;
2624 return $result;
2625 }
2626
2627
2628 =head2 CheckSpecialHolidays
2629
2630 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2631 this function check if the date is a special holiday
2632 C<$years>   = the years of datedue
2633 C<$month>   = the month of datedue
2634 C<$day>     = the day of datedue
2635 C<$itemnumber>  = itemnumber
2636 C<$branchcode>  = localisation of issue
2637
2638 =cut
2639
2640 sub CheckSpecialHolidays{
2641 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2642 my $dbh = C4::Context->dbh;
2643 my $query=qq|SELECT count(*)
2644              FROM `special_holidays`
2645              WHERE year=?
2646              AND month=?
2647              AND day=?
2648              AND branchcode=?
2649             |;
2650 my $sth = $dbh->prepare($query);
2651 $sth->execute($years,$month,$day,$branchcode);
2652 my $countspecial=$sth->fetchrow ;
2653 $sth->finish;
2654 return $countspecial;
2655 }
2656
2657 =head2 CheckRepeatableSpecialHolidays
2658
2659 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2660 this function check if the date is a repeatble special holidays
2661 C<$month>   = the month of datedue
2662 C<$day>     = the day of datedue
2663 C<$itemnumber>  = itemnumber
2664 C<$branchcode>  = localisation of issue
2665
2666 =cut
2667
2668 sub CheckRepeatableSpecialHolidays{
2669 my ($month,$day,$itemnumber,$branchcode) = @_;
2670 my $dbh = C4::Context->dbh;
2671 my $query=qq|SELECT count(*)
2672              FROM `repeatable_holidays`
2673              WHERE month=?
2674              AND day=?
2675              AND branchcode=?
2676             |;
2677 my $sth = $dbh->prepare($query);
2678 $sth->execute($month,$day,$branchcode);
2679 my $countspecial=$sth->fetchrow ;
2680 $sth->finish;
2681 return $countspecial;
2682 }
2683
2684
2685
2686 sub CheckValidBarcode{
2687 my ($barcode) = @_;
2688 my $dbh = C4::Context->dbh;
2689 my $query=qq|SELECT count(*)
2690              FROM items
2691              WHERE barcode=?
2692             |;
2693 my $sth = $dbh->prepare($query);
2694 $sth->execute($barcode);
2695 my $exist=$sth->fetchrow ;
2696 $sth->finish;
2697 return $exist;
2698 }
2699
2700 =head2 IsBranchTransferAllowed
2701
2702 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
2703
2704 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
2705
2706 =cut
2707
2708 sub IsBranchTransferAllowed {
2709         my ( $toBranch, $fromBranch, $code ) = @_;
2710
2711         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
2712
2713         my $limitType = C4::Context->preference("BranchTransferLimitsType");
2714         my $dbh = C4::Context->dbh;
2715
2716         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
2717         $sth->execute( $toBranch, $fromBranch, $code );
2718         my $limit = $sth->fetchrow_hashref();
2719
2720         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
2721         if ( $limit->{'limitId'} ) {
2722                 return 0;
2723         } else {
2724                 return 1;
2725         }
2726 }
2727
2728 =head2 CreateBranchTransferLimit
2729
2730 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
2731
2732 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
2733
2734 =cut
2735
2736 sub CreateBranchTransferLimit {
2737    my ( $toBranch, $fromBranch, $code ) = @_;
2738
2739    my $limitType = C4::Context->preference("BranchTransferLimitsType");
2740
2741    my $dbh = C4::Context->dbh;
2742
2743    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
2744    $sth->execute( $code, $toBranch, $fromBranch );
2745 }
2746
2747 =head2 DeleteBranchTransferLimits
2748
2749 DeleteBranchTransferLimits();
2750
2751 =cut
2752
2753 sub DeleteBranchTransferLimits {
2754    my $dbh = C4::Context->dbh;
2755    my $sth = $dbh->prepare("TRUNCATE TABLE branch_transfer_limits");
2756    $sth->execute();
2757 }
2758
2759
2760   1;
2761
2762 __END__
2763
2764 =head1 AUTHOR
2765
2766 Koha Developement team <info@koha.org>
2767
2768 =cut
2769