C4/Circulation.pm

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