C4/Circulation.pm

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