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