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