C4/Circulation.pm

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