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