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