koha-dev.rot13.org Git - srvgit/blob - C4/Circulation.pm

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