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