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);
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);
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 Ideally, this function would be internal to C<C4::Circulation>,
1637 not exported, but it is currently needed by one
1638 routine in C<C4::Accounts>.
1639
1640 =cut
1641
1642 sub MarkIssueReturned {
1643     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate ) = @_;
1644     my $dbh   = C4::Context->dbh;
1645     my $query = "UPDATE issues SET returndate=";
1646     my @bind;
1647     if ($dropbox_branch) {
1648         my $calendar = C4::Calendar->new( branchcode => $dropbox_branch );
1649         my $dropboxdate = $calendar->addDate( C4::Dates->new(), -1 );
1650         $query .= " ? ";
1651         push @bind, $dropboxdate->output('iso');
1652     } elsif ($returndate) {
1653         $query .= " ? ";
1654         push @bind, $returndate;
1655     } else {
1656         $query .= " now() ";
1657     }
1658     $query .= " WHERE  borrowernumber = ?  AND itemnumber = ?";
1659     push @bind, $borrowernumber, $itemnumber;
1660     # FIXME transaction
1661     my $sth_upd  = $dbh->prepare($query);
1662     $sth_upd->execute(@bind);
1663     my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1664                                   WHERE borrowernumber = ?
1665                                   AND itemnumber = ?");
1666     $sth_copy->execute($borrowernumber, $itemnumber);
1667     my $sth_del  = $dbh->prepare("DELETE FROM issues
1668                                   WHERE borrowernumber = ?
1669                                   AND itemnumber = ?");
1670     $sth_del->execute($borrowernumber, $itemnumber);
1671 }
1672
1673 =head2 _FixOverduesOnReturn
1674
1675    &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1676
1677 C<$brn> borrowernumber
1678
1679 C<$itm> itemnumber
1680
1681 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1682 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1683
1684 Internal function, called only by AddReturn
1685
1686 =cut
1687
1688 sub _FixOverduesOnReturn {
1689     my ($borrowernumber, $item);
1690     unless ($borrowernumber = shift) {
1691         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
1692         return;
1693     }
1694     unless ($item = shift) {
1695         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
1696         return;
1697     }
1698     my ($exemptfine, $dropbox) = @_;
1699     my $dbh = C4::Context->dbh;
1700
1701     # check for overdue fine
1702     my $sth = $dbh->prepare(
1703 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1704     );
1705     $sth->execute( $borrowernumber, $item );
1706
1707     # alter fine to show that the book has been returned
1708     my $data = $sth->fetchrow_hashref;
1709     return 0 unless $data;    # no warning, there's just nothing to fix
1710
1711     my $uquery;
1712     my @bind = ($borrowernumber, $item, $data->{'accountno'});
1713     if ($exemptfine) {
1714         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1715         if (C4::Context->preference("FinesLog")) {
1716             &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1717         }
1718     } elsif ($dropbox && $data->{lastincrement}) {
1719         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1720         my $amt = $data->{amount} - $data->{lastincrement} ;
1721         if (C4::Context->preference("FinesLog")) {
1722             &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1723         }
1724          $uquery = "update accountlines set accounttype='F' ";
1725          if($outstanding  >= 0 && $amt >=0) {
1726             $uquery .= ", amount = ? , amountoutstanding=? ";
1727             unshift @bind, ($amt, $outstanding) ;
1728         }
1729     } else {
1730         $uquery = "update accountlines set accounttype='F' ";
1731     }
1732     $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1733     my $usth = $dbh->prepare($uquery);
1734     return $usth->execute(@bind);
1735 }
1736
1737 =head2 _FixAccountForLostAndReturned
1738
1739   &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
1740
1741 Calculates the charge for a book lost and returned.
1742
1743 Internal function, not exported, called only by AddReturn.
1744
1745 FIXME: This function reflects how inscrutable fines logic is.  Fix both.
1746 FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.
1747
1748 =cut
1749
1750 sub _FixAccountForLostAndReturned {
1751     my $itemnumber     = shift or return;
1752     my $borrowernumber = @_ ? shift : undef;
1753     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
1754     my $dbh = C4::Context->dbh;
1755     # check for charge made for lost book
1756     my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1757     $sth->execute($itemnumber);
1758     my $data = $sth->fetchrow_hashref;
1759     $data or return;    # bail if there is nothing to do
1760
1761     # writeoff this amount
1762     my $offset;
1763     my $amount = $data->{'amount'};
1764     my $acctno = $data->{'accountno'};
1765     my $amountleft;                                             # Starts off undef/zero.
1766     if ($data->{'amountoutstanding'} == $amount) {
1767         $offset     = $data->{'amount'};
1768         $amountleft = 0;                                        # Hey, it's zero here, too.
1769     } else {
1770         $offset     = $amount - $data->{'amountoutstanding'};   # Um, isn't this the same as ZERO?  We just tested those two things are ==
1771         $amountleft = $data->{'amountoutstanding'} - $amount;   # Um, isn't this the same as ZERO?  We just tested those two things are ==
1772     }
1773     my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1774         WHERE (borrowernumber = ?)
1775         AND (itemnumber = ?) AND (accountno = ?) ");
1776     $usth->execute($data->{'borrowernumber'},$itemnumber,$acctno);      # We might be adjusting an account for some OTHER borrowernumber now.  Not the one we passed in.
1777     #check if any credit is left if so writeoff other accounts
1778     my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1779     $amountleft *= -1 if ($amountleft < 0);
1780     if ($amountleft > 0) {
1781         my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1782                             AND (amountoutstanding >0) ORDER BY date");     # might want to order by amountoustanding ASC (pay smallest first)
1783         $msth->execute($data->{'borrowernumber'});
1784         # offset transactions
1785         my $newamtos;
1786         my $accdata;
1787         while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1788             if ($accdata->{'amountoutstanding'} < $amountleft) {
1789                 $newamtos = 0;
1790                 $amountleft -= $accdata->{'amountoutstanding'};
1791             }  else {
1792                 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1793                 $amountleft = 0;
1794             }
1795             my $thisacct = $accdata->{'accountno'};
1796             # FIXME: move prepares outside while loop!
1797             my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1798                     WHERE (borrowernumber = ?)
1799                     AND (accountno=?)");
1800             $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');    # FIXME: '$thisacct' is a string literal!
1801             $usth = $dbh->prepare("INSERT INTO accountoffsets
1802                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1803                 VALUES
1804                 (?,?,?,?)");
1805             $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1806         }
1807         $msth->finish;  # $msth might actually have data left
1808     }
1809     $amountleft *= -1 if ($amountleft > 0);
1810     my $desc = "Item Returned " . $item_id;
1811     $usth = $dbh->prepare("INSERT INTO accountlines
1812         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1813         VALUES (?,?,now(),?,?,'CR',?)");
1814     $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1815     if ($borrowernumber) {
1816         # FIXME: same as query above.  use 1 sth for both
1817         $usth = $dbh->prepare("INSERT INTO accountoffsets
1818             (borrowernumber, accountno, offsetaccount,  offsetamount)
1819             VALUES (?,?,?,?)");
1820         $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
1821     }
1822     ModItem({ paidfor => '' }, undef, $itemnumber);
1823     return;
1824 }
1825
1826 =head2 _GetCircControlBranch
1827
1828    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
1829
1830 Internal function :
1831
1832 Return the library code to be used to determine which circulation
1833 policy applies to a transaction.  Looks up the CircControl and
1834 HomeOrHoldingBranch system preferences.
1835
1836 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
1837
1838 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
1839
1840 =cut
1841
1842 sub _GetCircControlBranch {
1843     my ($item, $borrower) = @_;
1844     my $circcontrol = C4::Context->preference('CircControl');
1845     my $branch;
1846
1847     if ($circcontrol eq 'PickupLibrary') {
1848         $branch= C4::Context->userenv->{'branch'};
1849     } elsif ($circcontrol eq 'PatronLibrary') {
1850         $branch=$borrower->{branchcode};
1851     } else {
1852         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
1853         $branch = $item->{$branchfield};
1854         # default to item home branch if holdingbranch is used
1855         # and is not defined
1856         if (!defined($branch) && $branchfield eq 'holdingbranch') {
1857             $branch = $item->{homebranch};
1858         }
1859     }
1860     return $branch;
1861 }
1862
1863
1864
1865
1866
1867
1868 =head2 GetItemIssue
1869
1870   $issue = &GetItemIssue($itemnumber);
1871
1872 Returns patron currently having a book, or undef if not checked out.
1873
1874 C<$itemnumber> is the itemnumber.
1875
1876 C<$issue> is a hashref of the row from the issues table.
1877
1878 =cut
1879
1880 sub GetItemIssue {
1881     my ($itemnumber) = @_;
1882     return unless $itemnumber;
1883     my $sth = C4::Context->dbh->prepare(
1884         "SELECT *
1885         FROM issues
1886         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1887         WHERE issues.itemnumber=?");
1888     $sth->execute($itemnumber);
1889     my $data = $sth->fetchrow_hashref;
1890     return unless $data;
1891     $data->{'overdue'} = ($data->{'date_due'} lt C4::Dates->today('iso')) ? 1 : 0;
1892     return ($data);
1893 }
1894
1895 =head2 GetOpenIssue
1896
1897   $issue = GetOpenIssue( $itemnumber );
1898
1899 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
1900
1901 C<$itemnumber> is the item's itemnumber
1902
1903 Returns a hashref
1904
1905 =cut
1906
1907 sub GetOpenIssue {
1908   my ( $itemnumber ) = @_;
1909
1910   my $dbh = C4::Context->dbh;
1911   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
1912   $sth->execute( $itemnumber );
1913   my $issue = $sth->fetchrow_hashref();
1914   return $issue;
1915 }
1916
1917 =head2 GetItemIssues
1918
1919   $issues = &GetItemIssues($itemnumber, $history);
1920
1921 Returns patrons that have issued a book
1922
1923 C<$itemnumber> is the itemnumber
1924 C<$history> is false if you just want the current "issuer" (if any)
1925 and true if you want issues history from old_issues also.
1926
1927 Returns reference to an array of hashes
1928
1929 =cut
1930
1931 sub GetItemIssues {
1932     my ( $itemnumber, $history ) = @_;
1933
1934     my $today = C4::Dates->today('iso');  # get today date
1935     my $sql = "SELECT * FROM issues
1936               JOIN borrowers USING (borrowernumber)
1937               JOIN items     USING (itemnumber)
1938               WHERE issues.itemnumber = ? ";
1939     if ($history) {
1940         $sql .= "UNION ALL
1941                  SELECT * FROM old_issues
1942                  LEFT JOIN borrowers USING (borrowernumber)
1943                  JOIN items USING (itemnumber)
1944                  WHERE old_issues.itemnumber = ? ";
1945     }
1946     $sql .= "ORDER BY date_due DESC";
1947     my $sth = C4::Context->dbh->prepare($sql);
1948     if ($history) {
1949         $sth->execute($itemnumber, $itemnumber);
1950     } else {
1951         $sth->execute($itemnumber);
1952     }
1953     my $results = $sth->fetchall_arrayref({});
1954     foreach (@$results) {
1955         $_->{'overdue'} = ($_->{'date_due'} lt $today) ? 1 : 0;
1956     }
1957     return $results;
1958 }
1959
1960 =head2 GetBiblioIssues
1961
1962   $issues = GetBiblioIssues($biblionumber);
1963
1964 this function get all issues from a biblionumber.
1965
1966 Return:
1967 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1968 tables issues and the firstname,surname & cardnumber from borrowers.
1969
1970 =cut
1971
1972 sub GetBiblioIssues {
1973     my $biblionumber = shift;
1974     return undef unless $biblionumber;
1975     my $dbh   = C4::Context->dbh;
1976     my $query = "
1977         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1978         FROM issues
1979             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1980             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1981             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1982             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1983         WHERE biblio.biblionumber = ?
1984         UNION ALL
1985         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1986         FROM old_issues
1987             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1988             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1989             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1990             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1991         WHERE biblio.biblionumber = ?
1992         ORDER BY timestamp
1993     ";
1994     my $sth = $dbh->prepare($query);
1995     $sth->execute($biblionumber, $biblionumber);
1996
1997     my @issues;
1998     while ( my $data = $sth->fetchrow_hashref ) {
1999         push @issues, $data;
2000     }
2001     return \@issues;
2002 }
2003
2004 =head2 GetUpcomingDueIssues
2005
2006   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2007
2008 =cut
2009
2010 sub GetUpcomingDueIssues {
2011     my $params = shift;
2012
2013     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2014     my $dbh = C4::Context->dbh;
2015
2016     my $statement = <<END_SQL;
2017 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due
2018 FROM issues
2019 LEFT JOIN items USING (itemnumber)
2020 WhERE returndate is NULL
2021 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
2022 END_SQL
2023
2024     my @bind_parameters = ( $params->{'days_in_advance'} );
2025
2026     my $sth = $dbh->prepare( $statement );
2027     $sth->execute( @bind_parameters );
2028     my $upcoming_dues = $sth->fetchall_arrayref({});
2029     $sth->finish;
2030
2031     return $upcoming_dues;
2032 }
2033
2034 =head2 CanBookBeRenewed
2035
2036   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2037
2038 Find out whether a borrowed item may be renewed.
2039
2040 C<$dbh> is a DBI handle to the Koha database.
2041
2042 C<$borrowernumber> is the borrower number of the patron who currently
2043 has the item on loan.
2044
2045 C<$itemnumber> is the number of the item to renew.
2046
2047 C<$override_limit>, if supplied with a true value, causes
2048 the limit on the number of times that the loan can be renewed
2049 (as controlled by the item type) to be ignored.
2050
2051 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
2052 item must currently be on loan to the specified borrower; renewals
2053 must be allowed for the item's type; and the borrower must not have
2054 already renewed the loan. $error will contain the reason the renewal can not proceed
2055
2056 =cut
2057
2058 sub CanBookBeRenewed {
2059
2060     # check renewal status
2061     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2062     my $dbh       = C4::Context->dbh;
2063     my $renews    = 1;
2064     my $renewokay = 0;
2065         my $error;
2066
2067     # Look in the issues table for this item, lent to this borrower,
2068     # and not yet returned.
2069
2070     # Look in the issues table for this item, lent to this borrower,
2071     # and not yet returned.
2072     my %branch = (
2073             'ItemHomeLibrary' => 'items.homebranch',
2074             'PickupLibrary'   => 'items.holdingbranch',
2075             'PatronLibrary'   => 'borrowers.branchcode'
2076             );
2077     my $controlbranch = $branch{C4::Context->preference('CircControl')};
2078     my $itype         = C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype';
2079
2080     my $sthcount = $dbh->prepare("
2081                    SELECT
2082                     borrowers.categorycode, biblioitems.itemtype, issues.renewals, renewalsallowed, $controlbranch
2083                    FROM  issuingrules,
2084                    issues
2085                    LEFT JOIN items USING (itemnumber)
2086                    LEFT JOIN borrowers USING (borrowernumber)
2087                    LEFT JOIN biblioitems USING (biblioitemnumber)
2088
2089                    WHERE
2090                     (issuingrules.categorycode = borrowers.categorycode OR issuingrules.categorycode = '*')
2091                    AND
2092                     (issuingrules.itemtype = $itype OR issuingrules.itemtype = '*')
2093                    AND
2094                     (issuingrules.branchcode = $controlbranch OR issuingrules.branchcode = '*')
2095                    AND
2096                     borrowernumber = ?
2097                    AND
2098                     itemnumber = ?
2099                    ORDER BY
2100                     issuingrules.categorycode desc,
2101                     issuingrules.itemtype desc,
2102                     issuingrules.branchcode desc
2103                    LIMIT 1;
2104                   ");
2105
2106     $sthcount->execute( $borrowernumber, $itemnumber );
2107     if ( my $data1 = $sthcount->fetchrow_hashref ) {
2108
2109         if ( ( $data1->{renewalsallowed} && $data1->{renewalsallowed} > $data1->{renewals} ) || $override_limit ) {
2110             $renewokay = 1;
2111         }
2112         else {
2113                         $error="too_many";
2114                 }
2115
2116         my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
2117         if ($resfound) {
2118             $renewokay = 0;
2119                         $error="on_reserve"
2120         }
2121
2122     }
2123     return ($renewokay,$error);
2124 }
2125
2126 =head2 AddRenewal
2127
2128   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2129
2130 Renews a loan.
2131
2132 C<$borrowernumber> is the borrower number of the patron who currently
2133 has the item.
2134
2135 C<$itemnumber> is the number of the item to renew.
2136
2137 C<$branch> is the library where the renewal took place (if any).
2138            The library that controls the circ policies for the renewal is retrieved from the issues record.
2139
2140 C<$datedue> can be a C4::Dates object used to set the due date.
2141
2142 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2143 this parameter is not supplied, lastreneweddate is set to the current date.
2144
2145 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2146 from the book's item type.
2147
2148 =cut
2149
2150 sub AddRenewal {
2151     my $borrowernumber  = shift or return undef;
2152     my $itemnumber      = shift or return undef;
2153     my $branch          = shift;
2154     my $datedue         = shift;
2155     my $lastreneweddate = shift || C4::Dates->new()->output('iso');
2156     my $item   = GetItem($itemnumber) or return undef;
2157     my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
2158
2159     my $dbh = C4::Context->dbh;
2160     # Find the issues record for this book
2161     my $sth =
2162       $dbh->prepare("SELECT * FROM issues
2163                         WHERE borrowernumber=?
2164                         AND itemnumber=?"
2165       );
2166     $sth->execute( $borrowernumber, $itemnumber );
2167     my $issuedata = $sth->fetchrow_hashref;
2168     $sth->finish;
2169     if($datedue && ! $datedue->output('iso')){
2170         warn "Invalid date passed to AddRenewal.";
2171         return undef;
2172     }
2173     # If the due date wasn't specified, calculate it by adding the
2174     # book's loan length to today's date or the current due date
2175     # based on the value of the RenewalPeriodBase syspref.
2176     unless ($datedue) {
2177
2178         my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
2179         my $loanlength = GetLoanLength(
2180                     $borrower->{'categorycode'},
2181                     (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
2182                                 $issuedata->{'branchcode'}  );   # that's the circ control branch.
2183
2184         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2185                                         C4::Dates->new($issuedata->{date_due}, 'iso') :
2186                                         C4::Dates->new();
2187         $datedue =  CalcDateDue($datedue,$loanlength,$issuedata->{'branchcode'},$borrower);
2188     }
2189
2190     # Update the issues record to have the new due date, and a new count
2191     # of how many times it has been renewed.
2192     my $renews = $issuedata->{'renewals'} + 1;
2193     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2194                             WHERE borrowernumber=?
2195                             AND itemnumber=?"
2196     );
2197     $sth->execute( $datedue->output('iso'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2198     $sth->finish;
2199
2200     # Update the renewal count on the item, and tell zebra to reindex
2201     $renews = $biblio->{'renewals'} + 1;
2202     ModItem({ renewals => $renews, onloan => $datedue->output('iso') }, $biblio->{'biblionumber'}, $itemnumber);
2203
2204     # Charge a new rental fee, if applicable?
2205     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2206     if ( $charge > 0 ) {
2207         my $accountno = getnextacctno( $borrowernumber );
2208         my $item = GetBiblioFromItemNumber($itemnumber);
2209         $sth = $dbh->prepare(
2210                 "INSERT INTO accountlines
2211                     (date,
2212                                         borrowernumber, accountno, amount,
2213                     description,
2214                                         accounttype, amountoutstanding, itemnumber
2215                                         )
2216                     VALUES (now(),?,?,?,?,?,?,?)"
2217         );
2218         $sth->execute( $borrowernumber, $accountno, $charge,
2219             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2220             'Rent', $charge, $itemnumber );
2221         $sth->finish;
2222     }
2223     # Log the renewal
2224     UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2225         return $datedue;
2226 }
2227
2228 sub GetRenewCount {
2229     # check renewal status
2230     my ( $bornum, $itemno ) = @_;
2231     my $dbh           = C4::Context->dbh;
2232     my $renewcount    = 0;
2233     my $renewsallowed = 0;
2234     my $renewsleft    = 0;
2235
2236     my $borrower = C4::Members::GetMemberDetails($bornum);
2237     my $item     = GetItem($itemno);
2238
2239     # Look in the issues table for this item, lent to this borrower,
2240     # and not yet returned.
2241
2242     # FIXME - I think this function could be redone to use only one SQL call.
2243     my $sth = $dbh->prepare(
2244         "select * from issues
2245                                 where (borrowernumber = ?)
2246                                 and (itemnumber = ?)"
2247     );
2248     $sth->execute( $bornum, $itemno );
2249     my $data = $sth->fetchrow_hashref;
2250     $renewcount = $data->{'renewals'} if $data->{'renewals'};
2251     $sth->finish;
2252     # $item and $borrower should be calculated
2253     my $branchcode = _GetCircControlBranch($item, $borrower);
2254
2255     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2256
2257     $renewsallowed = $issuingrule->{'renewalsallowed'};
2258     $renewsleft    = $renewsallowed - $renewcount;
2259     if($renewsleft < 0){ $renewsleft = 0; }
2260     return ( $renewcount, $renewsallowed, $renewsleft );
2261 }
2262
2263 =head2 GetIssuingCharges
2264
2265   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2266
2267 Calculate how much it would cost for a given patron to borrow a given
2268 item, including any applicable discounts.
2269
2270 C<$itemnumber> is the item number of item the patron wishes to borrow.
2271
2272 C<$borrowernumber> is the patron's borrower number.
2273
2274 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2275 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2276 if it's a video).
2277
2278 =cut
2279
2280 sub GetIssuingCharges {
2281
2282     # calculate charges due
2283     my ( $itemnumber, $borrowernumber ) = @_;
2284     my $charge = 0;
2285     my $dbh    = C4::Context->dbh;
2286     my $item_type;
2287
2288     # Get the book's item type and rental charge (via its biblioitem).
2289     my $qcharge =     "SELECT itemtypes.itemtype,rentalcharge FROM items
2290             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
2291         $qcharge .= (C4::Context->preference('item-level_itypes'))
2292                 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2293                 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2294
2295     $qcharge .=      "WHERE items.itemnumber =?";
2296
2297     my $sth1 = $dbh->prepare($qcharge);
2298     $sth1->execute($itemnumber);
2299     if ( my $data1 = $sth1->fetchrow_hashref ) {
2300         $item_type = $data1->{'itemtype'};
2301         $charge    = $data1->{'rentalcharge'};
2302         my $q2 = "SELECT rentaldiscount FROM borrowers
2303             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2304             WHERE borrowers.borrowernumber = ?
2305             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')";
2306         my $sth2 = $dbh->prepare($q2);
2307         $sth2->execute( $borrowernumber, $item_type );
2308         if ( my $data2 = $sth2->fetchrow_hashref ) {
2309             my $discount = $data2->{'rentaldiscount'};
2310             if ( $discount eq 'NULL' ) {
2311                 $discount = 0;
2312             }
2313             $charge = ( $charge * ( 100 - $discount ) ) / 100;
2314         }
2315         $sth2->finish;
2316     }
2317
2318     $sth1->finish;
2319     return ( $charge, $item_type );
2320 }
2321
2322 =head2 AddIssuingCharge
2323
2324   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2325
2326 =cut
2327
2328 sub AddIssuingCharge {
2329     my ( $itemnumber, $borrowernumber, $charge ) = @_;
2330     my $dbh = C4::Context->dbh;
2331     my $nextaccntno = getnextacctno( $borrowernumber );
2332     my $query ="
2333         INSERT INTO accountlines
2334             (borrowernumber, itemnumber, accountno,
2335             date, amount, description, accounttype,
2336             amountoutstanding)
2337         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2338     ";
2339     my $sth = $dbh->prepare($query);
2340     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2341     $sth->finish;
2342 }
2343
2344 =head2 GetTransfers
2345
2346   GetTransfers($itemnumber);
2347
2348 =cut
2349
2350 sub GetTransfers {
2351     my ($itemnumber) = @_;
2352
2353     my $dbh = C4::Context->dbh;
2354
2355     my $query = '
2356         SELECT datesent,
2357                frombranch,
2358                tobranch
2359         FROM branchtransfers
2360         WHERE itemnumber = ?
2361           AND datearrived IS NULL
2362         ';
2363     my $sth = $dbh->prepare($query);
2364     $sth->execute($itemnumber);
2365     my @row = $sth->fetchrow_array();
2366     $sth->finish;
2367     return @row;
2368 }
2369
2370 =head2 GetTransfersFromTo
2371
2372   @results = GetTransfersFromTo($frombranch,$tobranch);
2373
2374 Returns the list of pending transfers between $from and $to branch
2375
2376 =cut
2377
2378 sub GetTransfersFromTo {
2379     my ( $frombranch, $tobranch ) = @_;
2380     return unless ( $frombranch && $tobranch );
2381     my $dbh   = C4::Context->dbh;
2382     my $query = "
2383         SELECT itemnumber,datesent,frombranch
2384         FROM   branchtransfers
2385         WHERE  frombranch=?
2386           AND  tobranch=?
2387           AND datearrived IS NULL
2388     ";
2389     my $sth = $dbh->prepare($query);
2390     $sth->execute( $frombranch, $tobranch );
2391     my @gettransfers;
2392
2393     while ( my $data = $sth->fetchrow_hashref ) {
2394         push @gettransfers, $data;
2395     }
2396     $sth->finish;
2397     return (@gettransfers);
2398 }
2399
2400 =head2 DeleteTransfer
2401
2402   &DeleteTransfer($itemnumber);
2403
2404 =cut
2405
2406 sub DeleteTransfer {
2407     my ($itemnumber) = @_;
2408     my $dbh          = C4::Context->dbh;
2409     my $sth          = $dbh->prepare(
2410         "DELETE FROM branchtransfers
2411          WHERE itemnumber=?
2412          AND datearrived IS NULL "
2413     );
2414     $sth->execute($itemnumber);
2415     $sth->finish;
2416 }
2417
2418 =head2 AnonymiseIssueHistory
2419
2420   $rows = AnonymiseIssueHistory($borrowernumber,$date)
2421
2422 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2423 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2424
2425 return the number of affected rows.
2426
2427 =cut
2428
2429 sub AnonymiseIssueHistory {
2430     my $date           = shift;
2431     my $borrowernumber = shift;
2432     my $dbh            = C4::Context->dbh;
2433     my $query          = "
2434         UPDATE old_issues
2435         SET    borrowernumber = NULL
2436         WHERE  returndate < '".$date."'
2437           AND borrowernumber IS NOT NULL
2438     ";
2439     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2440     my $rows_affected = $dbh->do($query);
2441     return $rows_affected;
2442 }
2443
2444 =head2 SendCirculationAlert
2445
2446 Send out a C<check-in> or C<checkout> alert using the messaging system.
2447
2448 B<Parameters>:
2449
2450 =over 4
2451
2452 =item type
2453
2454 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
2455
2456 =item item
2457
2458 Hashref of information about the item being checked in or out.
2459
2460 =item borrower
2461
2462 Hashref of information about the borrower of the item.
2463
2464 =item branch
2465
2466 The branchcode from where the checkout or check-in took place.
2467
2468 =back
2469
2470 B<Example>:
2471
2472     SendCirculationAlert({
2473         type     => 'CHECKOUT',
2474         item     => $item,
2475         borrower => $borrower,
2476         branch   => $branch,
2477     });
2478
2479 =cut
2480
2481 sub SendCirculationAlert {
2482     my ($opts) = @_;
2483     my ($type, $item, $borrower, $branch) =
2484         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
2485     my %message_name = (
2486         CHECKIN  => 'Item Check-in',
2487         CHECKOUT => 'Item Checkout',
2488     );
2489     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
2490         borrowernumber => $borrower->{borrowernumber},
2491         message_name   => $message_name{$type},
2492     });
2493     my $letter = C4::Letters::getletter('circulation', $type);
2494     C4::Letters::parseletter($letter, 'biblio',      $item->{biblionumber});
2495     C4::Letters::parseletter($letter, 'biblioitems', $item->{biblionumber});
2496     C4::Letters::parseletter($letter, 'borrowers',   $borrower->{borrowernumber});
2497     C4::Letters::parseletter($letter, 'branches',    $branch);
2498     my @transports = @{ $borrower_preferences->{transports} };
2499     # warn "no transports" unless @transports;
2500     for (@transports) {
2501         # warn "transport: $_";
2502         my $message = C4::Message->find_last_message($borrower, $type, $_);
2503         if (!$message) {
2504             #warn "create new message";
2505             C4::Message->enqueue($letter, $borrower, $_);
2506         } else {
2507             #warn "append to old message";
2508             $message->append($letter);
2509             $message->update;
2510         }
2511     }
2512     $letter;
2513 }
2514
2515 =head2 updateWrongTransfer
2516
2517   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2518
2519 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
2520
2521 =cut
2522
2523 sub updateWrongTransfer {
2524         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2525         my $dbh = C4::Context->dbh;
2526 # first step validate the actual line of transfert .
2527         my $sth =
2528                 $dbh->prepare(
2529                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2530                 );
2531                 $sth->execute($FromLibrary,$itemNumber);
2532                 $sth->finish;
2533
2534 # second step create a new line of branchtransfer to the right location .
2535         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2536
2537 #third step changing holdingbranch of item
2538         UpdateHoldingbranch($FromLibrary,$itemNumber);
2539 }
2540
2541 =head2 UpdateHoldingbranch
2542
2543   $items = UpdateHoldingbranch($branch,$itmenumber);
2544
2545 Simple methode for updating hodlingbranch in items BDD line
2546
2547 =cut
2548
2549 sub UpdateHoldingbranch {
2550         my ( $branch,$itemnumber ) = @_;
2551     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2552 }
2553
2554 =head2 CalcDateDue
2555
2556 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2557 this function calculates the due date given the loan length ,
2558 checking against the holidays calendar as per the 'useDaysMode' syspref.
2559 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2560 C<$branch>  = location whose calendar to use
2561 C<$loanlength>  = loan length prior to adjustment
2562 =cut
2563
2564 sub CalcDateDue {
2565         my ($startdate,$loanlength,$branch,$borrower) = @_;
2566         my $datedue;
2567
2568         if(C4::Context->preference('useDaysMode') eq 'Days') {  # ignoring calendar
2569                 my $timedue = time + ($loanlength) * 86400;
2570         #FIXME - assumes now even though we take a startdate
2571                 my @datearr  = localtime($timedue);
2572                 $datedue = C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2573         } else {
2574                 my $calendar = C4::Calendar->new(  branchcode => $branch );
2575                 $datedue = $calendar->addDate($startdate, $loanlength);
2576         }
2577
2578         # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
2579         if ( C4::Context->preference('ReturnBeforeExpiry') && $datedue->output('iso') gt $borrower->{dateexpiry} ) {
2580             $datedue = C4::Dates->new( $borrower->{dateexpiry}, 'iso' );
2581         }
2582
2583         # if ceilingDueDate ON the datedue can't be after the ceiling date
2584         if ( C4::Context->preference('ceilingDueDate')
2585              && ( C4::Context->preference('ceilingDueDate') =~ C4::Dates->regexp('syspref') ) ) {
2586             my $ceilingDate = C4::Dates->new( C4::Context->preference('ceilingDueDate') );
2587             if ( $datedue->output( 'iso' ) gt $ceilingDate->output( 'iso' ) ) {
2588                 $datedue = $ceilingDate;
2589             }
2590         }
2591
2592         return $datedue;
2593 }
2594
2595 =head2 CheckValidDatedue
2596
2597   $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2598
2599 This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2600 To be replaced by CalcDateDue() once C4::Calendar use is tested.
2601
2602 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2603 C<$date_due>   = returndate calculate with no day check
2604 C<$itemnumber>  = itemnumber
2605 C<$branchcode>  = location of issue (affected by 'CircControl' syspref)
2606 C<$loanlength>  = loan length prior to adjustment
2607
2608 =cut
2609
2610 sub CheckValidDatedue {
2611 my ($date_due,$itemnumber,$branchcode)=@_;
2612 my @datedue=split('-',$date_due->output('iso'));
2613 my $years=$datedue[0];
2614 my $month=$datedue[1];
2615 my $day=$datedue[2];
2616 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2617 my $dow;
2618 for (my $i=0;$i<2;$i++){
2619     $dow=Day_of_Week($years,$month,$day);
2620     ($dow=0) if ($dow>6);
2621     my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2622     my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2623     my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2624         if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2625         $i=0;
2626         (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2627         }
2628     }
2629     my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2630 return $newdatedue;
2631 }
2632
2633
2634 =head2 CheckRepeatableHolidays
2635
2636   $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2637
2638 This function checks if the date due is a repeatable holiday
2639
2640 C<$date_due>   = returndate calculate with no day check
2641 C<$itemnumber>  = itemnumber
2642 C<$branchcode>  = localisation of issue
2643
2644 =cut
2645
2646 sub CheckRepeatableHolidays{
2647 my($itemnumber,$week_day,$branchcode)=@_;
2648 my $dbh = C4::Context->dbh;
2649 my $query = qq|SELECT count(*)
2650         FROM repeatable_holidays
2651         WHERE branchcode=?
2652         AND weekday=?|;
2653 my $sth = $dbh->prepare($query);
2654 $sth->execute($branchcode,$week_day);
2655 my $result=$sth->fetchrow;
2656 $sth->finish;
2657 return $result;
2658 }
2659
2660
2661 =head2 CheckSpecialHolidays
2662
2663   $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2664
2665 This function check if the date is a special holiday
2666
2667 C<$years>   = the years of datedue
2668 C<$month>   = the month of datedue
2669 C<$day>     = the day of datedue
2670 C<$itemnumber>  = itemnumber
2671 C<$branchcode>  = localisation of issue
2672
2673 =cut
2674
2675 sub CheckSpecialHolidays{
2676 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2677 my $dbh = C4::Context->dbh;
2678 my $query=qq|SELECT count(*)
2679              FROM `special_holidays`
2680              WHERE year=?
2681              AND month=?
2682              AND day=?
2683              AND branchcode=?
2684             |;
2685 my $sth = $dbh->prepare($query);
2686 $sth->execute($years,$month,$day,$branchcode);
2687 my $countspecial=$sth->fetchrow ;
2688 $sth->finish;
2689 return $countspecial;
2690 }
2691
2692 =head2 CheckRepeatableSpecialHolidays
2693
2694   $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2695
2696 This function check if the date is a repeatble special holidays
2697
2698 C<$month>   = the month of datedue
2699 C<$day>     = the day of datedue
2700 C<$itemnumber>  = itemnumber
2701 C<$branchcode>  = localisation of issue
2702
2703 =cut
2704
2705 sub CheckRepeatableSpecialHolidays{
2706 my ($month,$day,$itemnumber,$branchcode) = @_;
2707 my $dbh = C4::Context->dbh;
2708 my $query=qq|SELECT count(*)
2709              FROM `repeatable_holidays`
2710              WHERE month=?
2711              AND day=?
2712              AND branchcode=?
2713             |;
2714 my $sth = $dbh->prepare($query);
2715 $sth->execute($month,$day,$branchcode);
2716 my $countspecial=$sth->fetchrow ;
2717 $sth->finish;
2718 return $countspecial;
2719 }
2720
2721
2722
2723 sub CheckValidBarcode{
2724 my ($barcode) = @_;
2725 my $dbh = C4::Context->dbh;
2726 my $query=qq|SELECT count(*)
2727              FROM items
2728              WHERE barcode=?
2729             |;
2730 my $sth = $dbh->prepare($query);
2731 $sth->execute($barcode);
2732 my $exist=$sth->fetchrow ;
2733 $sth->finish;
2734 return $exist;
2735 }
2736
2737 =head2 IsBranchTransferAllowed
2738
2739   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
2740
2741 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
2742
2743 =cut
2744
2745 sub IsBranchTransferAllowed {
2746         my ( $toBranch, $fromBranch, $code ) = @_;
2747
2748         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
2749
2750         my $limitType = C4::Context->preference("BranchTransferLimitsType");
2751         my $dbh = C4::Context->dbh;
2752
2753         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
2754         $sth->execute( $toBranch, $fromBranch, $code );
2755         my $limit = $sth->fetchrow_hashref();
2756
2757         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
2758         if ( $limit->{'limitId'} ) {
2759                 return 0;
2760         } else {
2761                 return 1;
2762         }
2763 }
2764
2765 =head2 CreateBranchTransferLimit
2766
2767   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
2768
2769 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
2770
2771 =cut
2772
2773 sub CreateBranchTransferLimit {
2774    my ( $toBranch, $fromBranch, $code ) = @_;
2775
2776    my $limitType = C4::Context->preference("BranchTransferLimitsType");
2777
2778    my $dbh = C4::Context->dbh;
2779
2780    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
2781    $sth->execute( $code, $toBranch, $fromBranch );
2782 }
2783
2784 =head2 DeleteBranchTransferLimits
2785
2786   DeleteBranchTransferLimits();
2787
2788 =cut
2789
2790 sub DeleteBranchTransferLimits {
2791    my $dbh = C4::Context->dbh;
2792    my $sth = $dbh->prepare("TRUNCATE TABLE branch_transfer_limits");
2793    $sth->execute();
2794 }
2795
2796
2797   1;
2798
2799 __END__
2800
2801 =head1 AUTHOR
2802
2803 Koha Development Team <http://koha-community.org/>
2804
2805 =cut
2806