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