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