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