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