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