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