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