C4/Circulation.pm

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