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 $query = "SELECT renewalsallowed FROM items ";
1642         $query .= (C4::Context->preference('item-level_itypes'))
1643                     ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1644                     : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1645                        LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1646         $query .= "WHERE items.itemnumber = ?";
1647         my $sth2 = $dbh->prepare($query);
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     $sth->finish;
1779     my $query = "SELECT renewalsallowed FROM items ";
1780     $query .= (C4::Context->preference('item-level_itypes'))
1781                 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1782                 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1783                    LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1784     $query .= "WHERE items.itemnumber = ?";
1785     my $sth2 = $dbh->prepare($query);
1786     $sth2->execute($itemno);
1787     my $data2 = $sth2->fetchrow_hashref();
1788     $renewsallowed = $data2->{'renewalsallowed'};
1789     $renewsleft = $renewsallowed - $renewcount;
1790     return ($renewcount,$renewsallowed,$renewsleft);
1791 }
1792
1793 =head2 GetIssuingCharges
1794
1795 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
1796
1797 Calculate how much it would cost for a given patron to borrow a given
1798 item, including any applicable discounts.
1799
1800 C<$itemnumber> is the item number of item the patron wishes to borrow.
1801
1802 C<$borrowernumber> is the patron's borrower number.
1803
1804 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
1805 and C<$item_type> is the code for the item's item type (e.g., C<VID>
1806 if it's a video).
1807
1808 =cut
1809
1810 sub GetIssuingCharges {
1811
1812     # calculate charges due
1813     my ( $itemnumber, $borrowernumber ) = @_;
1814     my $charge = 0;
1815     my $dbh    = C4::Context->dbh;
1816     my $item_type;
1817
1818     # Get the book's item type and rental charge (via its biblioitem).
1819     my $qcharge =     "SELECT itemtypes.itemtype,rentalcharge FROM items
1820             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
1821         $qcharge .= (C4::Context->preference('item-level_itypes'))
1822                 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1823                 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1824
1825     $qcharge .=      "WHERE items.itemnumber =?";
1826
1827     my $sth1 = $dbh->prepare($qcharge);
1828     $sth1->execute($itemnumber);
1829     if ( my $data1 = $sth1->fetchrow_hashref ) {
1830         $item_type = $data1->{'itemtype'};
1831         $charge    = $data1->{'rentalcharge'};
1832         my $q2 = "SELECT rentaldiscount FROM borrowers
1833             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
1834             WHERE borrowers.borrowernumber = ?
1835             AND issuingrules.itemtype = ?";
1836         my $sth2 = $dbh->prepare($q2);
1837         $sth2->execute( $borrowernumber, $item_type );
1838         if ( my $data2 = $sth2->fetchrow_hashref ) {
1839             my $discount = $data2->{'rentaldiscount'};
1840             if ( $discount eq 'NULL' ) {
1841                 $discount = 0;
1842             }
1843             $charge = ( $charge * ( 100 - $discount ) ) / 100;
1844         }
1845         $sth2->finish;
1846     }
1847
1848     $sth1->finish;
1849     return ( $charge, $item_type );
1850 }
1851
1852 =head2 AddIssuingCharge
1853
1854 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
1855
1856 =cut
1857
1858 sub AddIssuingCharge {
1859     my ( $itemnumber, $borrowernumber, $charge ) = @_;
1860     my $dbh = C4::Context->dbh;
1861     my $nextaccntno = getnextacctno( $borrowernumber );
1862     my $query ="
1863         INSERT INTO accountlines
1864             (borrowernumber, itemnumber, accountno,
1865             date, amount, description, accounttype,
1866             amountoutstanding)
1867         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
1868     ";
1869     my $sth = $dbh->prepare($query);
1870     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
1871     $sth->finish;
1872 }
1873
1874 =head2 GetTransfers
1875
1876 GetTransfers($itemnumber);
1877
1878 =cut
1879
1880 sub GetTransfers {
1881     my ($itemnumber) = @_;
1882
1883     my $dbh = C4::Context->dbh;
1884
1885     my $query = '
1886         SELECT datesent,
1887                frombranch,
1888                tobranch
1889         FROM branchtransfers
1890         WHERE itemnumber = ?
1891           AND datearrived IS NULL
1892         ';
1893     my $sth = $dbh->prepare($query);
1894     $sth->execute($itemnumber);
1895     my @row = $sth->fetchrow_array();
1896     $sth->finish;
1897     return @row;
1898 }
1899
1900
1901 =head2 GetTransfersFromTo
1902
1903 @results = GetTransfersFromTo($frombranch,$tobranch);
1904
1905 Returns the list of pending transfers between $from and $to branch
1906
1907 =cut
1908
1909 sub GetTransfersFromTo {
1910     my ( $frombranch, $tobranch ) = @_;
1911     return unless ( $frombranch && $tobranch );
1912     my $dbh   = C4::Context->dbh;
1913     my $query = "
1914         SELECT itemnumber,datesent,frombranch
1915         FROM   branchtransfers
1916         WHERE  frombranch=?
1917           AND  tobranch=?
1918           AND datearrived IS NULL
1919     ";
1920     my $sth = $dbh->prepare($query);
1921     $sth->execute( $frombranch, $tobranch );
1922     my @gettransfers;
1923
1924     while ( my $data = $sth->fetchrow_hashref ) {
1925         push @gettransfers, $data;
1926     }
1927     $sth->finish;
1928     return (@gettransfers);
1929 }
1930
1931 =head2 DeleteTransfer
1932
1933 &DeleteTransfer($itemnumber);
1934
1935 =cut
1936
1937 sub DeleteTransfer {
1938     my ($itemnumber) = @_;
1939     my $dbh          = C4::Context->dbh;
1940     my $sth          = $dbh->prepare(
1941         "DELETE FROM branchtransfers
1942          WHERE itemnumber=?
1943          AND datearrived IS NULL "
1944     );
1945     $sth->execute($itemnumber);
1946     $sth->finish;
1947 }
1948
1949 =head2 AnonymiseIssueHistory
1950
1951 $rows = AnonymiseIssueHistory($borrowernumber,$date)
1952
1953 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
1954 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
1955
1956 return the number of affected rows.
1957
1958 =cut
1959
1960 sub AnonymiseIssueHistory {
1961     my $date           = shift;
1962     my $borrowernumber = shift;
1963     my $dbh            = C4::Context->dbh;
1964     my $query          = "
1965         UPDATE old_issues
1966         SET    borrowernumber = NULL
1967         WHERE  returndate < '".$date."'
1968           AND borrowernumber IS NOT NULL
1969     ";
1970     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
1971     my $rows_affected = $dbh->do($query);
1972     return $rows_affected;
1973 }
1974
1975 =head2 updateWrongTransfer
1976
1977 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
1978
1979 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
1980
1981 =cut
1982
1983 sub updateWrongTransfer {
1984         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
1985         my $dbh = C4::Context->dbh;
1986 # first step validate the actual line of transfert .
1987         my $sth =
1988                 $dbh->prepare(
1989                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
1990                 );
1991                 $sth->execute($FromLibrary,$itemNumber);
1992                 $sth->finish;
1993
1994 # second step create a new line of branchtransfer to the right location .
1995         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
1996
1997 #third step changing holdingbranch of item
1998         UpdateHoldingbranch($FromLibrary,$itemNumber);
1999 }
2000
2001 =head2 UpdateHoldingbranch
2002
2003 $items = UpdateHoldingbranch($branch,$itmenumber);
2004 Simple methode for updating hodlingbranch in items BDD line
2005
2006 =cut
2007
2008 sub UpdateHoldingbranch {
2009         my ( $branch,$itemnumber ) = @_;
2010     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2011 }
2012
2013 =head2 CalcDateDue
2014
2015 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2016 this function calculates the due date given the loan length ,
2017 checking against the holidays calendar as per the 'useDaysMode' syspref.
2018 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2019 C<$branch>  = location whose calendar to use
2020 C<$loanlength>  = loan length prior to adjustment
2021 =cut
2022
2023 sub CalcDateDue {
2024         my ($startdate,$loanlength,$branch) = @_;
2025         if(C4::Context->preference('useDaysMode') eq 'Days') {  # ignoring calendar
2026                 my $datedue = time + ($loanlength) * 86400;
2027         #FIXME - assumes now even though we take a startdate
2028                 my @datearr  = localtime($datedue);
2029                 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2030         } else {
2031                 my $calendar = C4::Calendar->new(  branchcode => $branch );
2032                 my $datedue = $calendar->addDate($startdate, $loanlength);
2033                 return $datedue;
2034         }
2035 }
2036
2037 =head2 CheckValidDatedue
2038        This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2039        To be replaced by CalcDateDue() once C4::Calendar use is tested.
2040
2041 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2042 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2043 C<$date_due>   = returndate calculate with no day check
2044 C<$itemnumber>  = itemnumber
2045 C<$branchcode>  = location of issue (affected by 'CircControl' syspref)
2046 C<$loanlength>  = loan length prior to adjustment
2047 =cut
2048
2049 sub CheckValidDatedue {
2050 my ($date_due,$itemnumber,$branchcode)=@_;
2051 my @datedue=split('-',$date_due->output('iso'));
2052 my $years=$datedue[0];
2053 my $month=$datedue[1];
2054 my $day=$datedue[2];
2055 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2056 my $dow;
2057 for (my $i=0;$i<2;$i++){
2058     $dow=Day_of_Week($years,$month,$day);
2059     ($dow=0) if ($dow>6);
2060     my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2061     my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2062     my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2063         if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2064         $i=0;
2065         (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2066         }
2067     }
2068     my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2069 return $newdatedue;
2070 }
2071
2072
2073 =head2 CheckRepeatableHolidays
2074
2075 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2076 this function checks if the date due is a repeatable holiday
2077 C<$date_due>   = returndate calculate with no day check
2078 C<$itemnumber>  = itemnumber
2079 C<$branchcode>  = localisation of issue
2080
2081 =cut
2082
2083 sub CheckRepeatableHolidays{
2084 my($itemnumber,$week_day,$branchcode)=@_;
2085 my $dbh = C4::Context->dbh;
2086 my $query = qq|SELECT count(*)
2087         FROM repeatable_holidays
2088         WHERE branchcode=?
2089         AND weekday=?|;
2090 my $sth = $dbh->prepare($query);
2091 $sth->execute($branchcode,$week_day);
2092 my $result=$sth->fetchrow;
2093 $sth->finish;
2094 return $result;
2095 }
2096
2097
2098 =head2 CheckSpecialHolidays
2099
2100 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2101 this function check if the date is a special holiday
2102 C<$years>   = the years of datedue
2103 C<$month>   = the month of datedue
2104 C<$day>     = the day of datedue
2105 C<$itemnumber>  = itemnumber
2106 C<$branchcode>  = localisation of issue
2107
2108 =cut
2109
2110 sub CheckSpecialHolidays{
2111 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2112 my $dbh = C4::Context->dbh;
2113 my $query=qq|SELECT count(*)
2114              FROM `special_holidays`
2115              WHERE year=?
2116              AND month=?
2117              AND day=?
2118              AND branchcode=?
2119             |;
2120 my $sth = $dbh->prepare($query);
2121 $sth->execute($years,$month,$day,$branchcode);
2122 my $countspecial=$sth->fetchrow ;
2123 $sth->finish;
2124 return $countspecial;
2125 }
2126
2127 =head2 CheckRepeatableSpecialHolidays
2128
2129 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2130 this function check if the date is a repeatble special holidays
2131 C<$month>   = the month of datedue
2132 C<$day>     = the day of datedue
2133 C<$itemnumber>  = itemnumber
2134 C<$branchcode>  = localisation of issue
2135
2136 =cut
2137
2138 sub CheckRepeatableSpecialHolidays{
2139 my ($month,$day,$itemnumber,$branchcode) = @_;
2140 my $dbh = C4::Context->dbh;
2141 my $query=qq|SELECT count(*)
2142              FROM `repeatable_holidays`
2143              WHERE month=?
2144              AND day=?
2145              AND branchcode=?
2146             |;
2147 my $sth = $dbh->prepare($query);
2148 $sth->execute($month,$day,$branchcode);
2149 my $countspecial=$sth->fetchrow ;
2150 $sth->finish;
2151 return $countspecial;
2152 }
2153
2154
2155
2156 sub CheckValidBarcode{
2157 my ($barcode) = @_;
2158 my $dbh = C4::Context->dbh;
2159 my $query=qq|SELECT count(*)
2160              FROM items
2161              WHERE barcode=?
2162             |;
2163 my $sth = $dbh->prepare($query);
2164 $sth->execute($barcode);
2165 my $exist=$sth->fetchrow ;
2166 $sth->finish;
2167 return $exist;
2168 }
2169
2170 1;
2171
2172 __END__
2173
2174 =head1 AUTHOR
2175
2176 Koha Developement team <info@koha.org>
2177
2178 =cut
2179