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     my $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     my $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     my $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     my $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         $sth =
1017           $dbh->prepare(
1018             "UPDATE items SET issues=?, holdingbranch=?, itemlost=0, datelastborrowed  = now(), onloan = ? WHERE itemnumber=?");
1019         $sth->execute(
1020             $item->{'issues'},
1021             C4::Context->userenv->{'branch'},
1022                         $dateduef->output('iso'),
1023             $item->{'itemnumber'}
1024         );
1025         $sth->finish;
1026         &ModDateLastSeen( $item->{'itemnumber'} );
1027         my $record = GetMarcItem( $item->{'biblionumber'}, $item->{'itemnumber'} );
1028         my $frameworkcode = GetFrameworkCode( $item->{'biblionumber'} );
1029         ModItemInMarc( $record, $item->{'biblionumber'}, $item->{'itemnumber'}, $frameworkcode );
1030         # If it costs to borrow this book, charge it to the patron's account.
1031         my ( $charge, $itemtype ) = GetIssuingCharges(
1032             $item->{'itemnumber'},
1033             $borrower->{'borrowernumber'}
1034         );
1035         if ( $charge > 0 ) {
1036             AddIssuingCharge(
1037                 $item->{'itemnumber'},
1038                 $borrower->{'borrowernumber'}, $charge
1039             );
1040             $item->{'charge'} = $charge;
1041         }
1042
1043         # Record the fact that this book was issued.
1044         &UpdateStats(
1045             C4::Context->userenv->{'branch'},
1046             'issue',                        $charge,
1047             '',                             $item->{'itemnumber'},
1048             $item->{'itemtype'}, $borrower->{'borrowernumber'}
1049         );
1050     }
1051
1052     &logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$biblio->{'biblionumber'})
1053         if C4::Context->preference("IssueLog");
1054     return ($datedue);
1055   }
1056 }
1057
1058 =head2 GetLoanLength
1059
1060 Get loan length for an itemtype, a borrower type and a branch
1061
1062 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1063
1064 =cut
1065
1066 sub GetLoanLength {
1067     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1068     my $dbh = C4::Context->dbh;
1069     my $sth =
1070       $dbh->prepare(
1071 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1072       );
1073 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1074 # try to find issuelength & return the 1st available.
1075 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1076     $sth->execute( $borrowertype, $itemtype, $branchcode );
1077     my $loanlength = $sth->fetchrow_hashref;
1078     return $loanlength->{issuelength}
1079       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1080
1081     $sth->execute( $borrowertype, $itemtype, "*" );
1082     $loanlength = $sth->fetchrow_hashref;
1083     return $loanlength->{issuelength}
1084       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1085
1086     $sth->execute( $borrowertype, "*", $branchcode );
1087     $loanlength = $sth->fetchrow_hashref;
1088     return $loanlength->{issuelength}
1089       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1090
1091     $sth->execute( "*", $itemtype, $branchcode );
1092     $loanlength = $sth->fetchrow_hashref;
1093     return $loanlength->{issuelength}
1094       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1095
1096     $sth->execute( $borrowertype, "*", "*" );
1097     $loanlength = $sth->fetchrow_hashref;
1098     return $loanlength->{issuelength}
1099       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1100
1101     $sth->execute( "*", "*", $branchcode );
1102     $loanlength = $sth->fetchrow_hashref;
1103     return $loanlength->{issuelength}
1104       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1105
1106     $sth->execute( "*", $itemtype, "*" );
1107     $loanlength = $sth->fetchrow_hashref;
1108     return $loanlength->{issuelength}
1109       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1110
1111     $sth->execute( "*", "*", "*" );
1112     $loanlength = $sth->fetchrow_hashref;
1113     return $loanlength->{issuelength}
1114       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1115
1116     # if no rule is set => 21 days (hardcoded)
1117     return 21;
1118 }
1119
1120 =head2 AddReturn
1121
1122 ($doreturn, $messages, $iteminformation, $borrower) =
1123     &AddReturn($barcode, $branch, $exemptfine);
1124
1125 Returns a book.
1126
1127 C<$barcode> is the bar code of the book being returned. C<$branch> is
1128 the code of the branch where the book is being returned.  C<$exemptfine>
1129 indicates that overdue charges for the item will not be applied.
1130
1131 C<&AddReturn> returns a list of four items:
1132
1133 C<$doreturn> is true iff the return succeeded.
1134
1135 C<$messages> is a reference-to-hash giving the reason for failure:
1136
1137 =over 4
1138
1139 =item C<BadBarcode>
1140
1141 No item with this barcode exists. The value is C<$barcode>.
1142
1143 =item C<NotIssued>
1144
1145 The book is not currently on loan. The value is C<$barcode>.
1146
1147 =item C<IsPermanent>
1148
1149 The book's home branch is a permanent collection. If you have borrowed
1150 this book, you are not allowed to return it. The value is the code for
1151 the book's home branch.
1152
1153 =item C<wthdrawn>
1154
1155 This book has been withdrawn/cancelled. The value should be ignored.
1156
1157 =item C<ResFound>
1158
1159 The item was reserved. The value is a reference-to-hash whose keys are
1160 fields from the reserves table of the Koha database, and
1161 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1162 either C<Waiting>, C<Reserved>, or 0.
1163
1164 =back
1165
1166 C<$borrower> is a reference-to-hash, giving information about the
1167 patron who last borrowed the book.
1168
1169 =cut
1170
1171 sub AddReturn {
1172     my ( $barcode, $branch, $exemptfine ) = @_;
1173     my $dbh      = C4::Context->dbh;
1174     my $messages;
1175     my $doreturn = 1;
1176     my $borrower;
1177     my $validTransfert = 0;
1178     my $reserveDone = 0;
1179
1180     # get information on item
1181     my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1182     my $biblio = GetBiblioFromItemNumber($iteminformation->{'itemnumber'});
1183     unless ($iteminformation->{'itemnumber'} ) {
1184         $messages->{'BadBarcode'} = $barcode;
1185         $doreturn = 0;
1186     } else {
1187         # find the borrower
1188         if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1189             $messages->{'NotIssued'} = $barcode;
1190             $doreturn = 0;
1191         }
1192
1193         # check if the book is in a permanent collection....
1194         my $hbr      = $iteminformation->{'homebranch'};
1195         my $branches = GetBranches();
1196         if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1197             $messages->{'IsPermanent'} = $hbr;
1198         }
1199
1200                 # if independent branches are on and returning to different branch, refuse the return
1201         if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){
1202                         $messages->{'Wrongbranch'} = 1;
1203                         $doreturn=0;
1204                 }
1205
1206         # check that the book has been cancelled
1207         if ( $iteminformation->{'wthdrawn'} ) {
1208             $messages->{'wthdrawn'} = 1;
1209             $doreturn = 0;
1210         }
1211
1212     #     new op dev : if the book returned in an other branch update the holding branch
1213
1214     # update issues, thereby returning book (should push this out into another subroutine
1215         $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1216
1217     # case of a return of document (deal with issues and holdingbranch)
1218
1219         if ($doreturn) {
1220             my $sth =
1221             $dbh->prepare(
1222     "UPDATE issues SET returndate = now() WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (returndate IS NULL)"
1223             );
1224             $sth->execute( $borrower->{'borrowernumber'},
1225                 $iteminformation->{'itemnumber'} );
1226             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?
1227         }
1228
1229     # continue to deal with returns cases, but not only if we have an issue
1230
1231     # the holdingbranch is updated if the document is returned in an other location .
1232     if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) {
1233                 UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1234                 #               reload iteminformation holdingbranch with the userenv value
1235                 $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1236         }
1237         ModDateLastSeen( $iteminformation->{'itemnumber'} );
1238                 my $sth = $dbh->prepare("UPDATE items SET onloan = NULL where itemnumber = ?");
1239                 $sth->execute($iteminformation->{'itemnumber'});
1240                 $sth->finish();
1241                 my $record = GetMarcItem( $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'} );
1242                 my $frameworkcode = GetFrameworkCode( $biblio->{'biblionumber'} );
1243                 ModItemInMarc( $record, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'}, $frameworkcode );
1244
1245                 if ($iteminformation->{borrowernumber}){
1246                         ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1247                 }
1248         # fix up the accounts.....
1249         if ( $iteminformation->{'itemlost'} ) {
1250             $messages->{'WasLost'} = 1;
1251         }
1252
1253     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1254     #     check if we have a transfer for this document
1255         my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1256
1257     #     if we have a transfer to do, we update the line of transfers with the datearrived
1258         if ($datesent) {
1259             if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1260                     my $sth =
1261                     $dbh->prepare(
1262                             "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1263                     );
1264                     $sth->execute( $iteminformation->{'itemnumber'} );
1265                     $sth->finish;
1266     #         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'
1267             C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1268             }
1269         else {
1270             $messages->{'WrongTransfer'} = $tobranch;
1271             $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1272         }
1273         $validTransfert = 1;
1274         }
1275
1276     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1277         # fix up the accounts.....
1278         if ($iteminformation->{'itemlost'}) {
1279                 FixAccountForLostAndReturned($iteminformation, $borrower);
1280                 $messages->{'WasLost'} = 1;
1281         }
1282         # fix up the overdues in accounts...
1283         FixOverduesOnReturn( $borrower->{'borrowernumber'},
1284             $iteminformation->{'itemnumber'}, $exemptfine );
1285
1286     # find reserves.....
1287     #     if we don't have a reserve with the status W, we launch the Checkreserves routine
1288         my ( $resfound, $resrec ) =
1289         C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1290         if ($resfound) {
1291             $resrec->{'ResFound'}   = $resfound;
1292             $messages->{'ResFound'} = $resrec;
1293             $reserveDone = 1;
1294         }
1295
1296         # update stats?
1297         # Record the fact that this book was returned.
1298         UpdateStats(
1299             $branch, 'return', '0', '',
1300             $iteminformation->{'itemnumber'},
1301             $iteminformation->{'itemtype'},
1302             $borrower->{'borrowernumber'}
1303         );
1304
1305         &logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$iteminformation->{borrowernumber},$iteminformation->{'biblionumber'})
1306             if C4::Context->preference("ReturnLog");
1307
1308         #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1309         #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1310
1311         if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1312                         if (C4::Context->preference("AutomaticItemReturn") == 1) {
1313                                 ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1314                                 $messages->{'WasTransfered'} = 1;
1315                         }
1316                         else {
1317                                 $messages->{'NeedsTransfer'} = 1;
1318                         }
1319         }
1320     }
1321     return ( $doreturn, $messages, $iteminformation, $borrower );
1322 }
1323
1324 =head2 FixOverduesOnReturn
1325
1326     &FixOverduesOnReturn($brn,$itm, $exemptfine);
1327
1328 C<$brn> borrowernumber
1329
1330 C<$itm> itemnumber
1331
1332 internal function, called only by AddReturn
1333
1334 =cut
1335
1336 sub FixOverduesOnReturn {
1337     my ( $borrowernumber, $item, $exemptfine ) = @_;
1338     my $dbh = C4::Context->dbh;
1339
1340     # check for overdue fine
1341     my $sth =
1342       $dbh->prepare(
1343 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1344       );
1345     $sth->execute( $borrowernumber, $item );
1346
1347     # alter fine to show that the book has been returned
1348    my $data;
1349         if ($data = $sth->fetchrow_hashref) {
1350         my $uquery =($exemptfine)? "update accountlines set accounttype='FFOR', amountoutstanding=0":"update accountlines set accounttype='F' ";
1351                 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1352         my $usth = $dbh->prepare($uquery);
1353         $usth->execute($borrowernumber,$item ,$data->{'accountno'});
1354         $usth->finish();
1355     }
1356
1357     $sth->finish();
1358     return;
1359 }
1360
1361 =head2 FixAccountForLostAndReturned
1362
1363         &FixAccountForLostAndReturned($iteminfo,$borrower);
1364
1365 Calculates the charge for a book lost and returned (Not exported & used only once)
1366
1367 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1368
1369 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1370
1371 Internal function, called by AddReturn
1372
1373 =cut
1374
1375 sub FixAccountForLostAndReturned {
1376         my ($iteminfo, $borrower) = @_;
1377         my %env;
1378         my $dbh = C4::Context->dbh;
1379         my $itm = $iteminfo->{'itemnumber'};
1380         # check for charge made for lost book
1381         my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1382         $sth->execute($itm);
1383         if (my $data = $sth->fetchrow_hashref) {
1384         # writeoff this amount
1385                 my $offset;
1386                 my $amount = $data->{'amount'};
1387                 my $acctno = $data->{'accountno'};
1388                 my $amountleft;
1389                 if ($data->{'amountoutstanding'} == $amount) {
1390                 $offset = $data->{'amount'};
1391                 $amountleft = 0;
1392                 } else {
1393                 $offset = $amount - $data->{'amountoutstanding'};
1394                 $amountleft = $data->{'amountoutstanding'} - $amount;
1395                 }
1396                 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1397                         WHERE (borrowernumber = ?)
1398                         AND (itemnumber = ?) AND (accountno = ?) ");
1399                 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1400                 $usth->finish;
1401         #check if any credit is left if so writeoff other accounts
1402                 my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
1403                 if ($amountleft < 0){
1404                 $amountleft*=-1;
1405                 }
1406                 if ($amountleft > 0){
1407                 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1408                                                         AND (amountoutstanding >0) ORDER BY date");
1409                 $msth->execute($data->{'borrowernumber'});
1410         # offset transactions
1411                 my $newamtos;
1412                 my $accdata;
1413                 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1414                         if ($accdata->{'amountoutstanding'} < $amountleft) {
1415                         $newamtos = 0;
1416                         $amountleft -= $accdata->{'amountoutstanding'};
1417                         }  else {
1418                         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1419                         $amountleft = 0;
1420                         }
1421                         my $thisacct = $accdata->{'accountno'};
1422                         my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1423                                         WHERE (borrowernumber = ?)
1424                                         AND (accountno=?)");
1425                         $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1426                         $usth->finish;
1427                         $usth = $dbh->prepare("INSERT INTO accountoffsets
1428                                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1429                                 VALUES
1430                                 (?,?,?,?)");
1431                         $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1432                         $usth->finish;
1433                 }
1434                 $msth->finish;
1435                 }
1436                 if ($amountleft > 0){
1437                         $amountleft*=-1;
1438                 }
1439                 my $desc="Item Returned ".$iteminfo->{'barcode'};
1440                 $usth = $dbh->prepare("INSERT INTO accountlines
1441                         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1442                         VALUES (?,?,now(),?,?,'CR',?)");
1443                 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1444                 $usth->finish;
1445                 $usth = $dbh->prepare("INSERT INTO accountoffsets
1446                         (borrowernumber, accountno, offsetaccount,  offsetamount)
1447                         VALUES (?,?,?,?)");
1448                 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1449                 $usth->finish;
1450                 $usth = $dbh->prepare("UPDATE items SET paidfor='' WHERE itemnumber=?");
1451                 $usth->execute($itm);
1452                 $usth->finish;
1453         }
1454         $sth->finish;
1455         return;
1456 }
1457
1458 =head2 GetItemIssue
1459
1460 $issues = &GetItemIssue($itemnumber);
1461
1462 Returns patrons currently having a book. nothing if item is not issued atm
1463
1464 C<$itemnumber> is the itemnumber
1465
1466 Returns an array of hashes
1467 =cut
1468
1469 sub GetItemIssue {
1470     my ( $itemnumber) = @_;
1471     return unless $itemnumber;
1472     my $dbh = C4::Context->dbh;
1473     my @GetItemIssues;
1474
1475     # get today date
1476     my $today = POSIX::strftime("%Y%m%d", localtime);
1477
1478     my $sth = $dbh->prepare(
1479         "SELECT * FROM issues
1480         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1481     WHERE
1482     issues.itemnumber=?  AND returndate IS NULL ");
1483     $sth->execute($itemnumber);
1484     my $data = $sth->fetchrow_hashref;
1485     my $datedue = $data->{'date_due'};
1486     $datedue =~ s/-//g;
1487     if ( $datedue < $today ) {
1488         $data->{'overdue'} = 1;
1489     }
1490     $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1491     $sth->finish;
1492     return ($data);
1493 }
1494
1495 =head2 GetItemIssues
1496
1497 $issues = &GetItemIssues($itemnumber, $history);
1498
1499 Returns patrons that have issued a book
1500
1501 C<$itemnumber> is the itemnumber
1502 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1503
1504 Returns an array of hashes
1505 =cut
1506
1507 sub GetItemIssues {
1508     my ( $itemnumber,$history ) = @_;
1509     my $dbh = C4::Context->dbh;
1510     my @GetItemIssues;
1511
1512     # get today date
1513     my $today = POSIX::strftime("%Y%m%d", localtime);
1514
1515     my $sth = $dbh->prepare(
1516         "SELECT * FROM issues
1517         LEFT JOIN borrowers ON borrowers.borrowernumber
1518         LEFT JOIN items ON items.itemnumber=issues.itemnumber
1519     WHERE
1520     issues.itemnumber=?".($history?"":" AND returndate IS NULL ").
1521     "ORDER BY issues.date_due DESC"
1522     );
1523     $sth->execute($itemnumber);
1524     while ( my $data = $sth->fetchrow_hashref ) {
1525         my $datedue = $data->{'date_due'};
1526         $datedue =~ s/-//g;
1527         if ( $datedue < $today ) {
1528             $data->{'overdue'} = 1;
1529         }
1530         my $itemnumber = $data->{'itemnumber'};
1531         push @GetItemIssues, $data;
1532     }
1533     $sth->finish;
1534     return ( \@GetItemIssues );
1535 }
1536
1537 =head2 GetBiblioIssues
1538
1539 $issues = GetBiblioIssues($biblionumber);
1540
1541 this function get all issues from a biblionumber.
1542
1543 Return:
1544 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1545 tables issues and the firstname,surname & cardnumber from borrowers.
1546
1547 =cut
1548
1549 sub GetBiblioIssues {
1550     my $biblionumber = shift;
1551     return undef unless $biblionumber;
1552     my $dbh   = C4::Context->dbh;
1553     my $query = "
1554         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1555         FROM issues
1556             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1557             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1558             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1559             LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1560         WHERE biblio.biblionumber = ?
1561         ORDER BY issues.timestamp
1562     ";
1563     my $sth = $dbh->prepare($query);
1564     $sth->execute($biblionumber);
1565
1566     my @issues;
1567     while ( my $data = $sth->fetchrow_hashref ) {
1568         push @issues, $data;
1569     }
1570     return \@issues;
1571 }
1572
1573 =head2 CanBookBeRenewed
1574
1575 $ok = &CanBookBeRenewed($borrowernumber, $itemnumber);
1576
1577 Find out whether a borrowed item may be renewed.
1578
1579 C<$dbh> is a DBI handle to the Koha database.
1580
1581 C<$borrowernumber> is the borrower number of the patron who currently
1582 has the item on loan.
1583
1584 C<$itemnumber> is the number of the item to renew.
1585
1586 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1587 item must currently be on loan to the specified borrower; renewals
1588 must be allowed for the item's type; and the borrower must not have
1589 already renewed the loan.
1590
1591 =cut
1592
1593 sub CanBookBeRenewed {
1594
1595     # check renewal status
1596     my ( $borrowernumber, $itemnumber ) = @_;
1597     my $dbh       = C4::Context->dbh;
1598     my $renews    = 1;
1599     my $renewokay = 0;
1600
1601     # Look in the issues table for this item, lent to this borrower,
1602     # and not yet returned.
1603
1604     # FIXME - I think this function could be redone to use only one SQL call.
1605     my $sth1 = $dbh->prepare(
1606         "SELECT * FROM issues
1607             WHERE borrowernumber = ?
1608             AND itemnumber = ?
1609             AND returndate IS NULL"
1610     );
1611     $sth1->execute( $borrowernumber, $itemnumber );
1612     if ( my $data1 = $sth1->fetchrow_hashref ) {
1613
1614         # Found a matching item
1615
1616         # See if this item may be renewed. This query is convoluted
1617         # because it's a bit messy: given the item number, we need to find
1618         # the biblioitem, which gives us the itemtype, which tells us
1619         # whether it may be renewed.
1620         my $sth2 = $dbh->prepare(
1621             "SELECT renewalsallowed FROM items
1622                 LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1623                 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1624                 WHERE items.itemnumber = ?
1625                 "
1626         );
1627         $sth2->execute($itemnumber);
1628         if ( my $data2 = $sth2->fetchrow_hashref ) {
1629             $renews = $data2->{'renewalsallowed'};
1630         }
1631         if ( $renews && $renews >= $data1->{'renewals'} ) {
1632             $renewokay = 1;
1633         }
1634         $sth2->finish;
1635         my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1636         if ($resfound) {
1637             $renewokay = 0;
1638         }
1639
1640     }
1641     $sth1->finish;
1642     return ($renewokay);
1643 }
1644
1645 =head2 AddRenewal
1646
1647 &AddRenewal($borrowernumber, $itemnumber, $datedue);
1648
1649 Renews a loan.
1650
1651 C<$borrowernumber> is the borrower number of the patron who currently
1652 has the item.
1653
1654 C<$itemnumber> is the number of the item to renew.
1655
1656 C<$datedue> can be used to set the due date. If C<$datedue> is the
1657 empty string, C<&AddRenewal> will calculate the due date automatically
1658 from the book's item type. If you wish to set the due date manually,
1659 C<$datedue> should be in the form YYYY-MM-DD.
1660
1661 =cut
1662
1663 sub AddRenewal {
1664
1665     my ( $borrowernumber, $itemnumber, $branch ,$datedue ) = @_;
1666     my $dbh = C4::Context->dbh;
1667
1668         my $biblio = GetBiblioFromItemNumber($itemnumber);
1669     # If the due date wasn't specified, calculate it by adding the
1670     # book's loan length to today's date.
1671     unless ( $datedue ) {
1672
1673
1674         my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
1675         my $loanlength = GetLoanLength(
1676             $borrower->{'categorycode'},
1677              (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
1678                         $borrower->{'branchcode'}
1679         );
1680                 #FIXME --  choose issuer or borrower branch.
1681                 #FIXME -- where's the calendar ?
1682                 #FIXME -- $debug-ify the (0)
1683         my @darray = Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
1684         $datedue = C4::Dates->new( sprintf("%04d-%02d-%02d",@darray[0..2]), 'iso');
1685                 (0) and print STDERR  "C4::Dates->new->output = " . C4::Dates->new()->output()
1686                                 . "\ndatedue->output = " . $datedue->output()
1687                                 . "\n(Y,M,D) = " . join ',', @darray;
1688                 $datedue=CheckValidDatedue($datedue,$itemnumber,$branch);
1689     }
1690
1691     # Find the issues record for this book
1692     my $sth =
1693       $dbh->prepare("SELECT * FROM issues
1694                         WHERE borrowernumber=?
1695                         AND itemnumber=?
1696                         AND returndate IS NULL"
1697       );
1698     $sth->execute( $borrowernumber, $itemnumber );
1699     my $issuedata = $sth->fetchrow_hashref;
1700     $sth->finish;
1701
1702     # Update the issues record to have the new due date, and a new count
1703     # of how many times it has been renewed.
1704     my $renews = $issuedata->{'renewals'} + 1;
1705     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1706                             WHERE borrowernumber=?
1707                             AND itemnumber=?
1708                             AND returndate IS NULL"
1709     );
1710     $sth->execute( $datedue->output('iso'), $renews, $borrowernumber, $itemnumber );
1711     $sth->finish;
1712
1713     # Update the renewal count on the item, and tell zebra to reindex
1714     $renews = $biblio->{'renewals'} + 1;
1715     $sth = $dbh->prepare("UPDATE items SET renewals = ? WHERE itemnumber = ?");
1716     $sth->execute($renews,$itemnumber);
1717     $sth->finish();
1718     my $record = GetMarcItem( $biblio->{'biblionumber'}, $itemnumber );
1719     my $frameworkcode = GetFrameworkCode( $biblio->{'biblionumber'} );
1720     ModItemInMarc( $record, $biblio->{'biblionumber'}, $itemnumber, $frameworkcode );
1721
1722     # Charge a new rental fee, if applicable?
1723     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1724     if ( $charge > 0 ) {
1725         my $accountno = getnextacctno( $borrowernumber );
1726         my $item = GetBiblioFromItemNumber($itemnumber);
1727         $sth = $dbh->prepare(
1728                 "INSERT INTO accountlines
1729                     (borrowernumber,accountno,date,amount,
1730                         description,accounttype,amountoutstanding,
1731                     itemnumber)
1732                     VALUES (?,?,now(),?,?,?,?,?)"
1733         );
1734         $sth->execute( $borrowernumber, $accountno, $charge,
1735             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1736             'Rent', $charge, $itemnumber );
1737         $sth->finish;
1738     }
1739     # Log the renewal
1740     UpdateStats( $branch, 'renew', $charge, '', $itemnumber );
1741 }
1742
1743 sub GetRenewCount {
1744     # check renewal status
1745     my ($bornum,$itemno)=@_;
1746     my $dbh = C4::Context->dbh;
1747     my $renewcount = 0;
1748         my $renewsallowed = 0;
1749         my $renewsleft = 0;
1750     # Look in the issues table for this item, lent to this borrower,
1751     # and not yet returned.
1752
1753     # FIXME - I think this function could be redone to use only one SQL call.
1754     my $sth = $dbh->prepare("select * from issues
1755                                 where (borrowernumber = ?)
1756                                 and (itemnumber = ?)
1757                                 and returndate is null");
1758     $sth->execute($bornum,$itemno);
1759         my $data = $sth->fetchrow_hashref;
1760         $renewcount = $data->{'renewals'} if $data->{'renewals'};
1761     my $sth2 = $dbh->prepare("select renewalsallowed from items,biblioitems,itemtypes
1762         where (items.itemnumber = ?)
1763                 and (items.biblioitemnumber = biblioitems.biblioitemnumber)
1764         and (biblioitems.itemtype = itemtypes.itemtype)");
1765     $sth2->execute($itemno);
1766         my $data2 = $sth2->fetchrow_hashref();
1767         $renewsallowed = $data2->{'renewalsallowed'};
1768         $renewsleft = $renewsallowed - $renewcount;
1769         warn "Renewcount:$renewcount RenewsAll:$renewsallowed RenewLeft:$renewsleft";
1770         return ($renewcount,$renewsallowed,$renewsleft);
1771 }
1772 =head2 GetIssuingCharges
1773
1774 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
1775
1776 Calculate how much it would cost for a given patron to borrow a given
1777 item, including any applicable discounts.
1778
1779 C<$itemnumber> is the item number of item the patron wishes to borrow.
1780
1781 C<$borrowernumber> is the patron's borrower number.
1782
1783 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
1784 and C<$item_type> is the code for the item's item type (e.g., C<VID>
1785 if it's a video).
1786
1787 =cut
1788
1789 sub GetIssuingCharges {
1790
1791     # calculate charges due
1792     my ( $itemnumber, $borrowernumber ) = @_;
1793     my $charge = 0;
1794     my $dbh    = C4::Context->dbh;
1795     my $item_type;
1796
1797     # Get the book's item type and rental charge (via its biblioitem).
1798     my $qcharge =     "SELECT itemtypes.itemtype,rentalcharge FROM items
1799             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
1800         $qcharge .= (C4::Context->preference('item-level_itypes'))
1801                 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1802                 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1803
1804     $qcharge .=      "WHERE items.itemnumber =?";
1805
1806     my $sth1 = $dbh->prepare($qcharge);
1807     $sth1->execute($itemnumber);
1808     if ( my $data1 = $sth1->fetchrow_hashref ) {
1809         $item_type = $data1->{'itemtype'};
1810         $charge    = $data1->{'rentalcharge'};
1811         my $q2 = "SELECT rentaldiscount FROM borrowers
1812             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
1813             WHERE borrowers.borrowernumber = ?
1814             AND issuingrules.itemtype = ?";
1815         my $sth2 = $dbh->prepare($q2);
1816         $sth2->execute( $borrowernumber, $item_type );
1817         if ( my $data2 = $sth2->fetchrow_hashref ) {
1818             my $discount = $data2->{'rentaldiscount'};
1819             if ( $discount eq 'NULL' ) {
1820                 $discount = 0;
1821             }
1822             $charge = ( $charge * ( 100 - $discount ) ) / 100;
1823         }
1824         $sth2->finish;
1825     }
1826
1827     $sth1->finish;
1828     return ( $charge, $item_type );
1829 }
1830
1831 =head2 AddIssuingCharge
1832
1833 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
1834
1835 =cut
1836
1837 sub AddIssuingCharge {
1838     my ( $itemnumber, $borrowernumber, $charge ) = @_;
1839     my $dbh = C4::Context->dbh;
1840     my $nextaccntno = getnextacctno( $borrowernumber );
1841     my $query ="
1842         INSERT INTO accountlines
1843             (borrowernumber, itemnumber, accountno,
1844             date, amount, description, accounttype,
1845             amountoutstanding)
1846         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
1847     ";
1848     my $sth = $dbh->prepare($query);
1849     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
1850     $sth->finish;
1851 }
1852
1853 =head2 GetTransfers
1854
1855 GetTransfers($itemnumber);
1856
1857 =cut
1858
1859 sub GetTransfers {
1860     my ($itemnumber) = @_;
1861
1862     my $dbh = C4::Context->dbh;
1863
1864     my $query = '
1865         SELECT datesent,
1866                frombranch,
1867                tobranch
1868         FROM branchtransfers
1869         WHERE itemnumber = ?
1870           AND datearrived IS NULL
1871         ';
1872     my $sth = $dbh->prepare($query);
1873     $sth->execute($itemnumber);
1874     my @row = $sth->fetchrow_array();
1875     $sth->finish;
1876     return @row;
1877 }
1878
1879
1880 =head2 GetTransfersFromTo
1881
1882 @results = GetTransfersFromTo($frombranch,$tobranch);
1883
1884 Returns the list of pending transfers between $from and $to branch
1885
1886 =cut
1887
1888 sub GetTransfersFromTo {
1889     my ( $frombranch, $tobranch ) = @_;
1890     return unless ( $frombranch && $tobranch );
1891     my $dbh   = C4::Context->dbh;
1892     my $query = "
1893         SELECT itemnumber,datesent,frombranch
1894         FROM   branchtransfers
1895         WHERE  frombranch=?
1896           AND  tobranch=?
1897           AND datearrived IS NULL
1898     ";
1899     my $sth = $dbh->prepare($query);
1900     $sth->execute( $frombranch, $tobranch );
1901     my @gettransfers;
1902
1903     while ( my $data = $sth->fetchrow_hashref ) {
1904         push @gettransfers, $data;
1905     }
1906     $sth->finish;
1907     return (@gettransfers);
1908 }
1909
1910 =head2 DeleteTransfer
1911
1912 &DeleteTransfer($itemnumber);
1913
1914 =cut
1915
1916 sub DeleteTransfer {
1917     my ($itemnumber) = @_;
1918     my $dbh          = C4::Context->dbh;
1919     my $sth          = $dbh->prepare(
1920         "DELETE FROM branchtransfers
1921          WHERE itemnumber=?
1922          AND datearrived IS NULL "
1923     );
1924     $sth->execute($itemnumber);
1925     $sth->finish;
1926 }
1927
1928 =head2 AnonymiseIssueHistory
1929
1930 $rows = AnonymiseIssueHistory($borrowernumber,$date)
1931
1932 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
1933 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
1934
1935 return the number of affected rows.
1936
1937 =cut
1938
1939 sub AnonymiseIssueHistory {
1940     my $date           = shift;
1941     my $borrowernumber = shift;
1942     my $dbh            = C4::Context->dbh;
1943     my $query          = "
1944         UPDATE issues
1945         SET    borrowernumber = NULL
1946         WHERE  returndate < '".$date."'
1947           AND borrowernumber IS NOT NULL
1948     ";
1949     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
1950     my $rows_affected = $dbh->do($query);
1951     return $rows_affected;
1952 }
1953
1954 =head2 updateWrongTransfer
1955
1956 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
1957
1958 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
1959
1960 =cut
1961
1962 sub updateWrongTransfer {
1963         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
1964         my $dbh = C4::Context->dbh;
1965 # first step validate the actual line of transfert .
1966         my $sth =
1967                 $dbh->prepare(
1968                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
1969                 );
1970                 $sth->execute($FromLibrary,$itemNumber);
1971                 $sth->finish;
1972
1973 # second step create a new line of branchtransfer to the right location .
1974         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
1975
1976 #third step changing holdingbranch of item
1977         UpdateHoldingbranch($FromLibrary,$itemNumber);
1978 }
1979
1980 =head2 UpdateHoldingbranch
1981
1982 $items = UpdateHoldingbranch($branch,$itmenumber);
1983 Simple methode for updating hodlingbranch in items BDD line
1984 =cut
1985
1986 sub UpdateHoldingbranch {
1987         my ( $branch,$itmenumber ) = @_;
1988         my $dbh = C4::Context->dbh;
1989 # first step validate the actual line of transfert .
1990         my $sth =
1991                 $dbh->prepare(
1992                         "update items set holdingbranch = ? where itemnumber= ?"
1993                 );
1994                 $sth->execute($branch,$itmenumber);
1995                 $sth->finish;
1996
1997
1998 }
1999 =head2 CheckValidDatedue
2000
2001 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2002 this function return a new date due after checked if it's a repeatable or special holiday
2003 C<$date_due>   = returndate calculate with no day check
2004 C<$itemnumber>  = itemnumber
2005 C<$branchcode>  = localisation of issue
2006 =cut
2007 # Why not create calendar object?  -
2008 # TODO add 'duedate' option to useDaysMode .
2009 sub CheckValidDatedue {
2010 my ($date_due,$itemnumber,$branchcode)=@_;
2011 my @datedue=split('-',$date_due->output('iso'));
2012 my $years=$datedue[0];
2013 my $month=$datedue[1];
2014 my $day=$datedue[2];
2015 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2016 my $dow;
2017 for (my $i=0;$i<2;$i++){
2018         $dow=Day_of_Week($years,$month,$day);
2019         ($dow=0) if ($dow>6);
2020         my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2021         my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2022         my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2023                 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2024                 $i=0;
2025                 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2026                 }
2027         }
2028         my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2029 return $newdatedue;
2030 }
2031 =head2 CheckRepeatableHolidays
2032
2033 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2034 this function check if the date due is a repeatable holiday
2035 C<$date_due>   = returndate calculate with no day check
2036 C<$itemnumber>  = itemnumber
2037 C<$branchcode>  = localisation of issue
2038
2039 =cut
2040
2041 sub CheckRepeatableHolidays{
2042 my($itemnumber,$week_day,$branchcode)=@_;
2043 my $dbh = C4::Context->dbh;
2044 my $query = qq|SELECT count(*)
2045         FROM repeatable_holidays
2046         WHERE branchcode=?
2047         AND weekday=?|;
2048 my $sth = $dbh->prepare($query);
2049 $sth->execute($branchcode,$week_day);
2050 my $result=$sth->fetchrow;
2051 $sth->finish;
2052 return $result;
2053 }
2054
2055
2056 =head2 CheckSpecialHolidays
2057
2058 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2059 this function check if the date is a special holiday
2060 C<$years>   = the years of datedue
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 CheckSpecialHolidays{
2067 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2068 my $dbh = C4::Context->dbh;
2069 my $query=qq|SELECT count(*)
2070              FROM `special_holidays`
2071              WHERE year=?
2072              AND month=?
2073              AND day=?
2074              AND branchcode=?
2075             |;
2076 my $sth = $dbh->prepare($query);
2077 $sth->execute($years,$month,$day,$branchcode);
2078 my $countspecial=$sth->fetchrow ;
2079 $sth->finish;
2080 return $countspecial;
2081 }
2082
2083 =head2 CheckRepeatableSpecialHolidays
2084
2085 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2086 this function check if the date is a repeatble special holidays
2087 C<$month>   = the month of datedue
2088 C<$day>     = the day of datedue
2089 C<$itemnumber>  = itemnumber
2090 C<$branchcode>  = localisation of issue
2091 =cut
2092 sub CheckRepeatableSpecialHolidays{
2093 my ($month,$day,$itemnumber,$branchcode) = @_;
2094 my $dbh = C4::Context->dbh;
2095 my $query=qq|SELECT count(*)
2096              FROM `repeatable_holidays`
2097              WHERE month=?
2098              AND day=?
2099              AND branchcode=?
2100             |;
2101 my $sth = $dbh->prepare($query);
2102 $sth->execute($month,$day,$branchcode);
2103 my $countspecial=$sth->fetchrow ;
2104 $sth->finish;
2105 return $countspecial;
2106 }
2107
2108
2109
2110 sub CheckValidBarcode{
2111 my ($barcode) = @_;
2112 my $dbh = C4::Context->dbh;
2113 my $query=qq|SELECT count(*)
2114              FROM items
2115              WHERE barcode=?
2116             |;
2117 my $sth = $dbh->prepare($query);
2118 $sth->execute($barcode);
2119 my $exist=$sth->fetchrow ;
2120 $sth->finish;
2121 return $exist;
2122 }
2123
2124 1;
2125
2126 __END__
2127
2128 =head1 AUTHOR
2129
2130 Koha Developement team <info@koha.org>
2131
2132 =cut
2133