C4/Circulation.pm

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