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