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       GetBorrowerAcctRecord( $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                 FillReserve($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                     UpdateReserve(
 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             SetWaitingStatus( $iteminformation->{'itemnumber'} );
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 = &GetBorrowerIssue($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 = &GetBorrowerIssues($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 GetBorrowerIssues
1505
1506 $issues = &GetBorrowerIssues($borrower);
1507
1508 Returns a list of books currently on loan to a patron.
1509
1510 C<$borrower->{borrowernumber}> is the borrower number of the patron
1511 whose issues we want to list.
1512
1513 C<&GetBorrowerIssues> returns a PHP-style array: C<$issues> is a
1514 reference-to-hash whose keys are integers in the range 1...I<n>, where
1515 I<n> is the number of items on issue (either today or before today).
1516 C<$issues-E<gt>{I<n>}> is a reference-to-hash whose keys are all of
1517 the fields of the biblio, biblioitems, items, and issues fields of the
1518 Koha database for that particular item.
1519
1520 =cut
1521
1522 sub GetBorrowerIssues {
1523     my ( $borrower ) = @_;
1524     my $dbh = C4::Context->dbh;
1525     my @GetBorrowerIssues;
1526     # get today date
1527     my $today = POSIX::strftime("%Y%m%d", localtime);
1528
1529     my $sth = $dbh->prepare(
1530         "SELECT * FROM issues
1531     LEFT JOIN items ON issues.itemnumber=items.itemnumber
1532     LEFT JOIN biblio ON     items.biblionumber=biblio.biblionumber
1533     LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1534     WHERE
1535     borrowernumber=? AND returndate IS NULL
1536     ORDER BY issues.date_due"
1537     );
1538     $sth->execute($borrower->{'borrowernumber'});
1539     while ( my $data = $sth->fetchrow_hashref ) {
1540         my $datedue = $data->{'date_due'};
1541         $datedue =~ s/-//g;
1542         if ( $datedue < $today ) {
1543             $data->{'overdue'} = 1;
1544         }
1545         my $itemnumber = $data->{'itemnumber'};
1546
1547         push @GetBorrowerIssues, $data;
1548     }
1549     $sth->finish;
1550     return ( \@GetBorrowerIssues );
1551 }
1552
1553 =head2 GetBiblioIssues
1554
1555 $issues = GetBiblioIssues($biblionumber);
1556
1557 this function get all issues from a biblionumber.
1558
1559 Return:
1560 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1561 tables issues and the firstname,surname & cardnumber from borrowers.
1562
1563 =cut
1564
1565 sub GetBiblioIssues {
1566     my $biblionumber = shift;
1567     return undef unless $biblionumber;
1568     my $dbh   = C4::Context->dbh;
1569     my $query = "
1570         SELECT issues.*,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1571         FROM issues
1572             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1573             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1574             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1575             LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1576         WHERE biblio.biblionumber = ?
1577         ORDER BY issues.timestamp
1578     ";
1579     my $sth = $dbh->prepare($query);
1580     $sth->execute($biblionumber);
1581
1582     my @issues;
1583     while ( my $data = $sth->fetchrow_hashref ) {
1584         push @issues, $data;
1585     }
1586     return \@issues;
1587 }
1588
1589 =head2 CanBookBeRenewed
1590
1591 $ok = &CanBookBeRenewed($borrowernumber, $itemnumber);
1592
1593 Find out whether a borrowed item may be renewed.
1594
1595 C<$dbh> is a DBI handle to the Koha database.
1596
1597 C<$borrowernumber> is the borrower number of the patron who currently
1598 has the item on loan.
1599
1600 C<$itemnumber> is the number of the item to renew.
1601
1602 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1603 item must currently be on loan to the specified borrower; renewals
1604 must be allowed for the item's type; and the borrower must not have
1605 already renewed the loan.
1606
1607 =cut
1608
1609 sub CanBookBeRenewed {
1610
1611     # check renewal status
1612     my ( $borrowernumber, $itemnumber ) = @_;
1613     my $dbh       = C4::Context->dbh;
1614     my $renews    = 1;
1615     my $renewokay = 0;
1616
1617     # Look in the issues table for this item, lent to this borrower,
1618     # and not yet returned.
1619
1620     # FIXME - I think this function could be redone to use only one SQL call.
1621     my $sth1 = $dbh->prepare(
1622         "SELECT * FROM issues
1623             WHERE borrowernumber = ?
1624             AND itemnumber = ?
1625             AND returndate IS NULL"
1626     );
1627     $sth1->execute( $borrowernumber, $itemnumber );
1628     if ( my $data1 = $sth1->fetchrow_hashref ) {
1629
1630         # Found a matching item
1631
1632         # See if this item may be renewed. This query is convoluted
1633         # because it's a bit messy: given the item number, we need to find
1634         # the biblioitem, which gives us the itemtype, which tells us
1635         # whether it may be renewed.
1636         my $sth2 = $dbh->prepare(
1637             "SELECT renewalsallowed FROM items
1638                 LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1639                 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1640                 WHERE items.itemnumber = ?
1641                 "
1642         );
1643         $sth2->execute($itemnumber);
1644         if ( my $data2 = $sth2->fetchrow_hashref ) {
1645             $renews = $data2->{'renewalsallowed'};
1646         }
1647         if ( $renews && $renews > $data1->{'renewals'} ) {
1648             $renewokay = 1;
1649         }
1650         $sth2->finish;
1651         my ( $resfound, $resrec ) = CheckReserves($itemnumber);
1652         if ($resfound) {
1653             $renewokay = 0;
1654         }
1655         ( $resfound, $resrec ) = CheckReserves($itemnumber);
1656         if ($resfound) {
1657             $renewokay = 0;
1658         }
1659
1660     }
1661     $sth1->finish;
1662     return ($renewokay);
1663 }
1664
1665 =head2 AddRenewal
1666
1667 &AddRenewal($borrowernumber, $itemnumber, $datedue);
1668
1669 Renews a loan.
1670
1671 C<$borrowernumber> is the borrower number of the patron who currently
1672 has the item.
1673
1674 C<$itemnumber> is the number of the item to renew.
1675
1676 C<$datedue> can be used to set the due date. If C<$datedue> is the
1677 empty string, C<&AddRenewal> will calculate the due date automatically
1678 from the book's item type. If you wish to set the due date manually,
1679 C<$datedue> should be in the form YYYY-MM-DD.
1680
1681 =cut
1682
1683 sub AddRenewal {
1684
1685     my ( $borrowernumber, $itemnumber, $datedue ) = @_;
1686     my $dbh = C4::Context->dbh;
1687
1688     # If the due date wasn't specified, calculate it by adding the
1689     # book's loan length to today's date.
1690     if ( $datedue eq "" ) {
1691
1692         my $biblio = GetBiblioFromItemNumber($itemnumber);
1693         my $borrower = GetMemberDetails( $borrowernumber, 0 );
1694         my $loanlength = GetLoanLength(
1695             $borrower->{'categorycode'},
1696             $biblio->{'itemtype'},
1697             $borrower->{'branchcode'}
1698         );
1699         my ( $due_year, $due_month, $due_day ) =
1700           Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
1701         $datedue = "$due_year-$due_month-$due_day";
1702
1703     }
1704
1705     # Find the issues record for this book
1706     my $sth =
1707       $dbh->prepare("SELECT * FROM issues
1708                         WHERE borrowernumber=?
1709                         AND itemnumber=?
1710                         AND returndate IS NULL"
1711       );
1712     $sth->execute( $borrowernumber, $itemnumber );
1713     my $issuedata = $sth->fetchrow_hashref;
1714     $sth->finish;
1715
1716     # Update the issues record to have the new due date, and a new count
1717     # of how many times it has been renewed.
1718     my $renews = $issuedata->{'renewals'} + 1;
1719     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1720                             WHERE borrowernumber=?
1721                             AND itemnumber=?
1722                             AND returndate IS NULL"
1723     );
1724     $sth->execute( $datedue, $renews, $borrowernumber, $itemnumber );
1725     $sth->finish;
1726
1727     # Log the renewal
1728     UpdateStats( C4::Context->userenv->{'branchcode'}, 'renew', '', '', $itemnumber );
1729
1730     # Charge a new rental fee, if applicable?
1731     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1732     if ( $charge > 0 ) {
1733         my $accountno = getnextacctno( $borrowernumber );
1734         my $item = GetBiblioFromItemNumber($itemnumber);
1735         $sth = $dbh->prepare(
1736                 "INSERT INTO accountlines
1737                     (borrowernumber,accountno,date,amount,
1738                         description,accounttype,amountoutstanding,
1739                     itemnumber)
1740                     VALUES (?,?,now(),?,?,?,?,?)"
1741         );
1742         $sth->execute( $borrowernumber, $accountno, $charge,
1743             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1744             'Rent', $charge, $itemnumber );
1745         $sth->finish;
1746     }
1747 }
1748
1749 =head2 GetIssuingCharges
1750
1751 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
1752
1753 Calculate how much it would cost for a given patron to borrow a given
1754 item, including any applicable discounts.
1755
1756 C<$itemnumber> is the item number of item the patron wishes to borrow.
1757
1758 C<$borrowernumber> is the patron's borrower number.
1759
1760 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
1761 and C<$item_type> is the code for the item's item type (e.g., C<VID>
1762 if it's a video).
1763
1764 =cut
1765
1766 sub GetIssuingCharges {
1767
1768     # calculate charges due
1769     my ( $itemnumber, $borrowernumber ) = @_;
1770     my $charge = 0;
1771     my $dbh    = C4::Context->dbh;
1772     my $item_type;
1773
1774     # Get the book's item type and rental charge (via its biblioitem).
1775     my $sth1 = $dbh->prepare(
1776         "SELECT itemtypes.itemtype,rentalcharge FROM items
1777             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1778             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1779             WHERE items.itemnumber =?
1780         "
1781     );
1782     $sth1->execute($itemnumber);
1783     if ( my $data1 = $sth1->fetchrow_hashref ) {
1784         $item_type = $data1->{'itemtype'};
1785         $charge    = $data1->{'rentalcharge'};
1786         my $q2 = "SELECT rentaldiscount FROM borrowers
1787             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
1788             WHERE borrowers.borrowernumber = ?
1789             AND issuingrules.itemtype = ?";
1790         my $sth2 = $dbh->prepare($q2);
1791         $sth2->execute( $borrowernumber, $item_type );
1792         if ( my $data2 = $sth2->fetchrow_hashref ) {
1793             my $discount = $data2->{'rentaldiscount'};
1794             if ( $discount eq 'NULL' ) {
1795                 $discount = 0;
1796             }
1797             $charge = ( $charge * ( 100 - $discount ) ) / 100;
1798         }
1799         $sth2->finish;
1800     }
1801
1802     $sth1->finish;
1803     return ( $charge, $item_type );
1804 }
1805
1806 =head2 AddIssuingCharge
1807
1808 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
1809
1810 =cut
1811
1812 sub AddIssuingCharge {
1813     my ( $itemnumber, $borrowernumber, $charge ) = @_;
1814     my $dbh = C4::Context->dbh;
1815     my $nextaccntno = getnextacctno( $borrowernumber );
1816     my $query ="
1817         INSERT INTO accountlines
1818             (borrowernumber, itemnumber, accountno,
1819             date, amount, description, accounttype,
1820             amountoutstanding)
1821         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
1822     ";
1823     my $sth = $dbh->prepare($query);
1824     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
1825     $sth->finish;
1826 }
1827
1828 =head2 GetTransfers
1829
1830 GetTransfers($itemnumber);
1831
1832 =cut
1833
1834 sub GetTransfers {
1835     my ($itemnumber) = @_;
1836
1837     my $dbh = C4::Context->dbh;
1838
1839     my $query = '
1840         SELECT datesent,
1841                frombranch,
1842                tobranch
1843         FROM branchtransfers
1844         WHERE itemnumber = ?
1845           AND datearrived IS NULL
1846         ';
1847     my $sth = $dbh->prepare($query);
1848     $sth->execute($itemnumber);
1849     my @row = $sth->fetchrow_array();
1850     $sth->finish;
1851     return @row;
1852 }
1853
1854
1855 =head2 GetTransfersFromTo
1856
1857 @results = GetTransfersFromTo($frombranch,$tobranch);
1858
1859 Returns the list of pending transfers between $from and $to branch
1860
1861 =cut
1862
1863 sub GetTransfersFromTo {
1864     my ( $frombranch, $tobranch ) = @_;
1865     return unless ( $frombranch && $tobranch );
1866     my $dbh   = C4::Context->dbh;
1867     my $query = "
1868         SELECT itemnumber,datesent,frombranch
1869         FROM   branchtransfers
1870         WHERE  frombranch=?
1871           AND  tobranch=?
1872           AND datearrived IS NULL
1873     ";
1874     my $sth = $dbh->prepare($query);
1875     $sth->execute( $frombranch, $tobranch );
1876     my @gettransfers;
1877
1878     while ( my $data = $sth->fetchrow_hashref ) {
1879         push @gettransfers, $data;
1880     }
1881     $sth->finish;
1882     return (@gettransfers);
1883 }
1884
1885 =head2 DeleteTransfer
1886
1887 &DeleteTransfer($itemnumber);
1888
1889 =cut
1890
1891 sub DeleteTransfer {
1892     my ($itemnumber) = @_;
1893     my $dbh          = C4::Context->dbh;
1894     my $sth          = $dbh->prepare(
1895         "DELETE FROM branchtransfers
1896          WHERE itemnumber=?
1897          AND datearrived IS NULL "
1898     );
1899     $sth->execute($itemnumber);
1900     $sth->finish;
1901 }
1902
1903 =head2 AnonymiseIssueHistory
1904
1905 $rows = AnonymiseIssueHistory($borrowernumber,$date)
1906
1907 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
1908 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
1909
1910 return the number of affected rows.
1911
1912 =cut
1913
1914 sub AnonymiseIssueHistory {
1915     my $date           = shift;
1916     my $borrowernumber = shift;
1917     my $dbh            = C4::Context->dbh;
1918     my $query          = "
1919         UPDATE issues
1920         SET    borrowernumber = NULL
1921         WHERE  returndate < '".$date."'
1922           AND borrowernumber IS NOT NULL
1923     ";
1924     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
1925     my $rows_affected = $dbh->do($query);
1926     return $rows_affected;
1927 }
1928
1929 =head2 updateWrongTransfer
1930
1931 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
1932
1933 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
1934
1935 =cut
1936
1937 sub updateWrongTransfer {
1938         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
1939         my $dbh = C4::Context->dbh;
1940 # first step validate the actual line of transfert .
1941         my $sth =
1942                 $dbh->prepare(
1943                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
1944                 );
1945                 $sth->execute($FromLibrary,$itemNumber);
1946                 $sth->finish;
1947
1948 # second step create a new line of branchtransfer to the right location .
1949         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
1950
1951 #third step changing holdingbranch of item
1952         UpdateHoldingbranch($FromLibrary,$itemNumber);
1953 }
1954
1955 =head2 UpdateHoldingbranch
1956
1957 $items = UpdateHoldingbranch($branch,$itmenumber);
1958 Simple methode for updating hodlingbranch in items BDD line
1959 =cut
1960
1961 sub UpdateHoldingbranch {
1962         my ( $branch,$itmenumber ) = @_;
1963         my $dbh = C4::Context->dbh;
1964 # first step validate the actual line of transfert .
1965         my $sth =
1966                 $dbh->prepare(
1967                         "update items set holdingbranch = ? where itemnumber= ?"
1968                 );
1969                 $sth->execute($branch,$itmenumber);
1970                 $sth->finish;
1971
1972
1973 }
1974
1975 1;
1976
1977 __END__
1978
1979 =head1 AUTHOR
1980
1981 Koha Developement team <info@koha.org>
1982
1983 =cut
1984