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 %env;
1507         my $dbh = C4::Context->dbh;
1508         my $itm = $iteminfo->{'itemnumber'};
1509         # check for charge made for lost book
1510         my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1511         $sth->execute($itm);
1512         if (my $data = $sth->fetchrow_hashref) {
1513         # writeoff this amount
1514                 my $offset;
1515                 my $amount = $data->{'amount'};
1516                 my $acctno = $data->{'accountno'};
1517                 my $amountleft;
1518                 if ($data->{'amountoutstanding'} == $amount) {
1519                 $offset = $data->{'amount'};
1520                 $amountleft = 0;
1521                 } else {
1522                 $offset = $amount - $data->{'amountoutstanding'};
1523                 $amountleft = $data->{'amountoutstanding'} - $amount;
1524                 }
1525                 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1526                         WHERE (borrowernumber = ?)
1527                         AND (itemnumber = ?) AND (accountno = ?) ");
1528                 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1529                 $usth->finish;
1530         #check if any credit is left if so writeoff other accounts
1531                 my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
1532                 if ($amountleft < 0){
1533                 $amountleft*=-1;
1534                 }
1535                 if ($amountleft > 0){
1536                 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1537                                                         AND (amountoutstanding >0) ORDER BY date");
1538                 $msth->execute($data->{'borrowernumber'});
1539         # offset transactions
1540                 my $newamtos;
1541                 my $accdata;
1542                 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1543                         if ($accdata->{'amountoutstanding'} < $amountleft) {
1544                         $newamtos = 0;
1545                         $amountleft -= $accdata->{'amountoutstanding'};
1546                         }  else {
1547                         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1548                         $amountleft = 0;
1549                         }
1550                         my $thisacct = $accdata->{'accountno'};
1551                         my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1552                                         WHERE (borrowernumber = ?)
1553                                         AND (accountno=?)");
1554                         $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1555                         $usth->finish;
1556                         $usth = $dbh->prepare("INSERT INTO accountoffsets
1557                                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1558                                 VALUES
1559                                 (?,?,?,?)");
1560                         $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1561                         $usth->finish;
1562                 }
1563                 $msth->finish;
1564                 }
1565                 if ($amountleft > 0){
1566                         $amountleft*=-1;
1567                 }
1568                 my $desc="Item Returned ".$iteminfo->{'barcode'};
1569                 $usth = $dbh->prepare("INSERT INTO accountlines
1570                         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1571                         VALUES (?,?,now(),?,?,'CR',?)");
1572                 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1573                 $usth->finish;
1574                 $usth = $dbh->prepare("INSERT INTO accountoffsets
1575                         (borrowernumber, accountno, offsetaccount,  offsetamount)
1576                         VALUES (?,?,?,?)");
1577                 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1578                 $usth->finish;
1579         ModItem({ paidfor => '' }, undef, $itm);
1580         }
1581         $sth->finish;
1582         return;
1583 }
1584
1585 =head2 GetItemIssue
1586
1587 $issues = &GetItemIssue($itemnumber);
1588
1589 Returns patrons currently having a book. nothing if item is not issued atm
1590
1591 C<$itemnumber> is the itemnumber
1592
1593 Returns an array of hashes
1594
1595 =cut
1596
1597 sub GetItemIssue {
1598     my ( $itemnumber) = @_;
1599     return unless $itemnumber;
1600     my $dbh = C4::Context->dbh;
1601     my @GetItemIssues;
1602
1603     # get today date
1604     my $today = POSIX::strftime("%Y%m%d", localtime);
1605
1606     my $sth = $dbh->prepare(
1607         "SELECT * FROM issues
1608         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1609     WHERE
1610     issues.itemnumber=?");
1611     $sth->execute($itemnumber);
1612     my $data = $sth->fetchrow_hashref;
1613     my $datedue = $data->{'date_due'};
1614     $datedue =~ s/-//g;
1615     if ( $datedue < $today ) {
1616         $data->{'overdue'} = 1;
1617     }
1618     $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1619     $sth->finish;
1620     return ($data);
1621 }
1622
1623 =head2 GetItemIssues
1624
1625 $issues = &GetItemIssues($itemnumber, $history);
1626
1627 Returns patrons that have issued a book
1628
1629 C<$itemnumber> is the itemnumber
1630 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1631
1632 Returns an array of hashes
1633
1634 =cut
1635
1636 sub GetItemIssues {
1637     my ( $itemnumber,$history ) = @_;
1638     my $dbh = C4::Context->dbh;
1639     my @GetItemIssues;
1640
1641     # get today date
1642     my $today = POSIX::strftime("%Y%m%d", localtime);
1643
1644     my $sql = "SELECT * FROM issues
1645               JOIN borrowers USING (borrowernumber)
1646               JOIN items USING (itemnumber)
1647               WHERE issues.itemnumber = ? ";
1648     if ($history) {
1649         $sql .= "UNION ALL
1650                  SELECT * FROM old_issues
1651                  LEFT JOIN borrowers USING (borrowernumber)
1652                  JOIN items USING (itemnumber)
1653                  WHERE old_issues.itemnumber = ? ";
1654     }
1655     $sql .= "ORDER BY date_due DESC";
1656     my $sth = $dbh->prepare($sql);
1657     if ($history) {
1658         $sth->execute($itemnumber, $itemnumber);
1659     } else {
1660         $sth->execute($itemnumber);
1661     }
1662     while ( my $data = $sth->fetchrow_hashref ) {
1663         my $datedue = $data->{'date_due'};
1664         $datedue =~ s/-//g;
1665         if ( $datedue < $today ) {
1666             $data->{'overdue'} = 1;
1667         }
1668         my $itemnumber = $data->{'itemnumber'};
1669         push @GetItemIssues, $data;
1670     }
1671     $sth->finish;
1672     return ( \@GetItemIssues );
1673 }
1674
1675 =head2 GetBiblioIssues
1676
1677 $issues = GetBiblioIssues($biblionumber);
1678
1679 this function get all issues from a biblionumber.
1680
1681 Return:
1682 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1683 tables issues and the firstname,surname & cardnumber from borrowers.
1684
1685 =cut
1686
1687 sub GetBiblioIssues {
1688     my $biblionumber = shift;
1689     return undef unless $biblionumber;
1690     my $dbh   = C4::Context->dbh;
1691     my $query = "
1692         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1693         FROM issues
1694             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1695             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1696             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1697             LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1698         WHERE biblio.biblionumber = ?
1699         UNION ALL
1700         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1701         FROM old_issues
1702             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1703             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1704             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1705             LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1706         WHERE biblio.biblionumber = ?
1707         ORDER BY timestamp
1708     ";
1709     my $sth = $dbh->prepare($query);
1710     $sth->execute($biblionumber, $biblionumber);
1711
1712     my @issues;
1713     while ( my $data = $sth->fetchrow_hashref ) {
1714         push @issues, $data;
1715     }
1716     return \@issues;
1717 }
1718
1719 =head2 CanBookBeRenewed
1720
1721 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber);
1722
1723 Find out whether a borrowed item may be renewed.
1724
1725 C<$dbh> is a DBI handle to the Koha database.
1726
1727 C<$borrowernumber> is the borrower number of the patron who currently
1728 has the item on loan.
1729
1730 C<$itemnumber> is the number of the item to renew.
1731
1732 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1733 item must currently be on loan to the specified borrower; renewals
1734 must be allowed for the item's type; and the borrower must not have
1735 already renewed the loan. $error will contain the reason the renewal can not proceed
1736
1737 =cut
1738
1739 sub CanBookBeRenewed {
1740
1741     # check renewal status
1742     my ( $borrowernumber, $itemnumber ) = @_;
1743     my $dbh       = C4::Context->dbh;
1744     my $renews    = 1;
1745     my $renewokay = 0;
1746         my $error;
1747
1748     # Look in the issues table for this item, lent to this borrower,
1749     # and not yet returned.
1750
1751     # FIXME - I think this function could be redone to use only one SQL call.
1752     my $sth1 = $dbh->prepare(
1753         "SELECT * FROM issues
1754             WHERE borrowernumber = ?
1755             AND itemnumber = ?"
1756     );
1757     $sth1->execute( $borrowernumber, $itemnumber );
1758     if ( my $data1 = $sth1->fetchrow_hashref ) {
1759
1760         # Found a matching item
1761
1762         # See if this item may be renewed. This query is convoluted
1763         # because it's a bit messy: given the item number, we need to find
1764         # the biblioitem, which gives us the itemtype, which tells us
1765         # whether it may be renewed.
1766         my $query = "SELECT renewalsallowed FROM items ";
1767         $query .= (C4::Context->preference('item-level_itypes'))
1768                     ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1769                     : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1770                        LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1771         $query .= "WHERE items.itemnumber = ?";
1772         my $sth2 = $dbh->prepare($query);
1773         $sth2->execute($itemnumber);
1774         if ( my $data2 = $sth2->fetchrow_hashref ) {
1775             $renews = $data2->{'renewalsallowed'};
1776         }
1777         if ( $renews && $renews > $data1->{'renewals'} ) {
1778             $renewokay = 1;
1779         }
1780         else {
1781                         $error="too_many";
1782                 }
1783         $sth2->finish;
1784         my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1785         if ($resfound) {
1786             $renewokay = 0;
1787                         $error="on_reserve"
1788         }
1789
1790     }
1791     $sth1->finish;
1792     return ($renewokay,$error);
1793 }
1794
1795 =head2 AddRenewal
1796
1797 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue]);
1798
1799 Renews a loan.
1800
1801 C<$borrowernumber> is the borrower number of the patron who currently
1802 has the item.
1803
1804 C<$itemnumber> is the number of the item to renew.
1805
1806 C<$branch> is the library branch.  Defaults to the homebranch of the ITEM.
1807
1808 C<$datedue> can be a C4::Dates object used to set the due date.
1809
1810 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
1811 from the book's item type.
1812
1813 =cut
1814
1815 sub AddRenewal {
1816         my $borrowernumber = shift or return undef;
1817         my     $itemnumber = shift or return undef;
1818     my $item   = GetItem($itemnumber) or return undef;
1819     my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
1820     my $branch  = (@_) ? shift : $item->{homebranch};   # opac-renew doesn't send branch
1821     my $datedue;
1822     # If the due date wasn't specified, calculate it by adding the
1823     # book's loan length to today's date.
1824     unless (@_ and $datedue = shift and $datedue->output('iso')) {
1825
1826         my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
1827         my $loanlength = GetLoanLength(
1828             $borrower->{'categorycode'},
1829              (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
1830                         $item->{homebranch}                     # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument?
1831         );
1832                 #FIXME -- use circControl?
1833                 $datedue =  CalcDateDue(C4::Dates->new(),$loanlength,$branch);  # this branch is the transactional branch.
1834                                                                 # The question of whether to use item's homebranch calendar is open.
1835     }
1836
1837     my $dbh = C4::Context->dbh;
1838     # Find the issues record for this book
1839     my $sth =
1840       $dbh->prepare("SELECT * FROM issues
1841                         WHERE borrowernumber=?
1842                         AND itemnumber=?"
1843       );
1844     $sth->execute( $borrowernumber, $itemnumber );
1845     my $issuedata = $sth->fetchrow_hashref;
1846     $sth->finish;
1847
1848     # Update the issues record to have the new due date, and a new count
1849     # of how many times it has been renewed.
1850     my $renews = $issuedata->{'renewals'} + 1;
1851     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1852                             WHERE borrowernumber=?
1853                             AND itemnumber=?"
1854     );
1855     $sth->execute( $datedue->output('iso'), $renews, $borrowernumber, $itemnumber );
1856     $sth->finish;
1857
1858     # Update the renewal count on the item, and tell zebra to reindex
1859     $renews = $biblio->{'renewals'} + 1;
1860     ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber);
1861
1862     # Charge a new rental fee, if applicable?
1863     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1864     if ( $charge > 0 ) {
1865         my $accountno = getnextacctno( $borrowernumber );
1866         my $item = GetBiblioFromItemNumber($itemnumber);
1867         $sth = $dbh->prepare(
1868                 "INSERT INTO accountlines
1869                     (date,
1870                                         borrowernumber, accountno, amount,
1871                     description,
1872                                         accounttype, amountoutstanding, itemnumber
1873                                         )
1874                     VALUES (now(),?,?,?,?,?,?,?)"
1875         );
1876         $sth->execute( $borrowernumber, $accountno, $charge,
1877             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1878             'Rent', $charge, $itemnumber );
1879         $sth->finish;
1880     }
1881     # Log the renewal
1882     UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
1883 }
1884
1885 sub GetRenewCount {
1886     # check renewal status
1887     my ($bornum,$itemno)=@_;
1888     my $dbh = C4::Context->dbh;
1889     my $renewcount = 0;
1890         my $renewsallowed = 0;
1891         my $renewsleft = 0;
1892     # Look in the issues table for this item, lent to this borrower,
1893     # and not yet returned.
1894
1895     # FIXME - I think this function could be redone to use only one SQL call.
1896     my $sth = $dbh->prepare("select * from issues
1897                                 where (borrowernumber = ?)
1898                                 and (itemnumber = ?)");
1899     $sth->execute($bornum,$itemno);
1900     my $data = $sth->fetchrow_hashref;
1901     $renewcount = $data->{'renewals'} if $data->{'renewals'};
1902     $sth->finish;
1903     my $query = "SELECT renewalsallowed FROM items ";
1904     $query .= (C4::Context->preference('item-level_itypes'))
1905                 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1906                 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1907                    LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1908     $query .= "WHERE items.itemnumber = ?";
1909     my $sth2 = $dbh->prepare($query);
1910     $sth2->execute($itemno);
1911     my $data2 = $sth2->fetchrow_hashref();
1912     $renewsallowed = $data2->{'renewalsallowed'};
1913     $renewsleft = $renewsallowed - $renewcount;
1914     return ($renewcount,$renewsallowed,$renewsleft);
1915 }
1916
1917 =head2 GetIssuingCharges
1918
1919 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
1920
1921 Calculate how much it would cost for a given patron to borrow a given
1922 item, including any applicable discounts.
1923
1924 C<$itemnumber> is the item number of item the patron wishes to borrow.
1925
1926 C<$borrowernumber> is the patron's borrower number.
1927
1928 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
1929 and C<$item_type> is the code for the item's item type (e.g., C<VID>
1930 if it's a video).
1931
1932 =cut
1933
1934 sub GetIssuingCharges {
1935
1936     # calculate charges due
1937     my ( $itemnumber, $borrowernumber ) = @_;
1938     my $charge = 0;
1939     my $dbh    = C4::Context->dbh;
1940     my $item_type;
1941
1942     # Get the book's item type and rental charge (via its biblioitem).
1943     my $qcharge =     "SELECT itemtypes.itemtype,rentalcharge FROM items
1944             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
1945         $qcharge .= (C4::Context->preference('item-level_itypes'))
1946                 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1947                 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1948
1949     $qcharge .=      "WHERE items.itemnumber =?";
1950
1951     my $sth1 = $dbh->prepare($qcharge);
1952     $sth1->execute($itemnumber);
1953     if ( my $data1 = $sth1->fetchrow_hashref ) {
1954         $item_type = $data1->{'itemtype'};
1955         $charge    = $data1->{'rentalcharge'};
1956         my $q2 = "SELECT rentaldiscount FROM borrowers
1957             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
1958             WHERE borrowers.borrowernumber = ?
1959             AND issuingrules.itemtype = ?";
1960         my $sth2 = $dbh->prepare($q2);
1961         $sth2->execute( $borrowernumber, $item_type );
1962         if ( my $data2 = $sth2->fetchrow_hashref ) {
1963             my $discount = $data2->{'rentaldiscount'};
1964             if ( $discount eq 'NULL' ) {
1965                 $discount = 0;
1966             }
1967             $charge = ( $charge * ( 100 - $discount ) ) / 100;
1968         }
1969         $sth2->finish;
1970     }
1971
1972     $sth1->finish;
1973     return ( $charge, $item_type );
1974 }
1975
1976 =head2 AddIssuingCharge
1977
1978 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
1979
1980 =cut
1981
1982 sub AddIssuingCharge {
1983     my ( $itemnumber, $borrowernumber, $charge ) = @_;
1984     my $dbh = C4::Context->dbh;
1985     my $nextaccntno = getnextacctno( $borrowernumber );
1986     my $query ="
1987         INSERT INTO accountlines
1988             (borrowernumber, itemnumber, accountno,
1989             date, amount, description, accounttype,
1990             amountoutstanding)
1991         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
1992     ";
1993     my $sth = $dbh->prepare($query);
1994     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
1995     $sth->finish;
1996 }
1997
1998 =head2 GetTransfers
1999
2000 GetTransfers($itemnumber);
2001
2002 =cut
2003
2004 sub GetTransfers {
2005     my ($itemnumber) = @_;
2006
2007     my $dbh = C4::Context->dbh;
2008
2009     my $query = '
2010         SELECT datesent,
2011                frombranch,
2012                tobranch
2013         FROM branchtransfers
2014         WHERE itemnumber = ?
2015           AND datearrived IS NULL
2016         ';
2017     my $sth = $dbh->prepare($query);
2018     $sth->execute($itemnumber);
2019     my @row = $sth->fetchrow_array();
2020     $sth->finish;
2021     return @row;
2022 }
2023
2024
2025 =head2 GetTransfersFromTo
2026
2027 @results = GetTransfersFromTo($frombranch,$tobranch);
2028
2029 Returns the list of pending transfers between $from and $to branch
2030
2031 =cut
2032
2033 sub GetTransfersFromTo {
2034     my ( $frombranch, $tobranch ) = @_;
2035     return unless ( $frombranch && $tobranch );
2036     my $dbh   = C4::Context->dbh;
2037     my $query = "
2038         SELECT itemnumber,datesent,frombranch
2039         FROM   branchtransfers
2040         WHERE  frombranch=?
2041           AND  tobranch=?
2042           AND datearrived IS NULL
2043     ";
2044     my $sth = $dbh->prepare($query);
2045     $sth->execute( $frombranch, $tobranch );
2046     my @gettransfers;
2047
2048     while ( my $data = $sth->fetchrow_hashref ) {
2049         push @gettransfers, $data;
2050     }
2051     $sth->finish;
2052     return (@gettransfers);
2053 }
2054
2055 =head2 DeleteTransfer
2056
2057 &DeleteTransfer($itemnumber);
2058
2059 =cut
2060
2061 sub DeleteTransfer {
2062     my ($itemnumber) = @_;
2063     my $dbh          = C4::Context->dbh;
2064     my $sth          = $dbh->prepare(
2065         "DELETE FROM branchtransfers
2066          WHERE itemnumber=?
2067          AND datearrived IS NULL "
2068     );
2069     $sth->execute($itemnumber);
2070     $sth->finish;
2071 }
2072
2073 =head2 AnonymiseIssueHistory
2074
2075 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2076
2077 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2078 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2079
2080 return the number of affected rows.
2081
2082 =cut
2083
2084 sub AnonymiseIssueHistory {
2085     my $date           = shift;
2086     my $borrowernumber = shift;
2087     my $dbh            = C4::Context->dbh;
2088     my $query          = "
2089         UPDATE old_issues
2090         SET    borrowernumber = NULL
2091         WHERE  returndate < '".$date."'
2092           AND borrowernumber IS NOT NULL
2093     ";
2094     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2095     my $rows_affected = $dbh->do($query);
2096     return $rows_affected;
2097 }
2098
2099 =head2 updateWrongTransfer
2100
2101 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2102
2103 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
2104
2105 =cut
2106
2107 sub updateWrongTransfer {
2108         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2109         my $dbh = C4::Context->dbh;
2110 # first step validate the actual line of transfert .
2111         my $sth =
2112                 $dbh->prepare(
2113                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2114                 );
2115                 $sth->execute($FromLibrary,$itemNumber);
2116                 $sth->finish;
2117
2118 # second step create a new line of branchtransfer to the right location .
2119         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2120
2121 #third step changing holdingbranch of item
2122         UpdateHoldingbranch($FromLibrary,$itemNumber);
2123 }
2124
2125 =head2 UpdateHoldingbranch
2126
2127 $items = UpdateHoldingbranch($branch,$itmenumber);
2128 Simple methode for updating hodlingbranch in items BDD line
2129
2130 =cut
2131
2132 sub UpdateHoldingbranch {
2133         my ( $branch,$itemnumber ) = @_;
2134     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2135 }
2136
2137 =head2 CalcDateDue
2138
2139 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2140 this function calculates the due date given the loan length ,
2141 checking against the holidays calendar as per the 'useDaysMode' syspref.
2142 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2143 C<$branch>  = location whose calendar to use
2144 C<$loanlength>  = loan length prior to adjustment
2145 =cut
2146
2147 sub CalcDateDue {
2148         my ($startdate,$loanlength,$branch) = @_;
2149         if(C4::Context->preference('useDaysMode') eq 'Days') {  # ignoring calendar
2150                 my $datedue = time + ($loanlength) * 86400;
2151         #FIXME - assumes now even though we take a startdate
2152                 my @datearr  = localtime($datedue);
2153                 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2154         } else {
2155                 my $calendar = C4::Calendar->new(  branchcode => $branch );
2156                 my $datedue = $calendar->addDate($startdate, $loanlength);
2157                 return $datedue;
2158         }
2159 }
2160
2161 =head2 CheckValidDatedue
2162        This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2163        To be replaced by CalcDateDue() once C4::Calendar use is tested.
2164
2165 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2166 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2167 C<$date_due>   = returndate calculate with no day check
2168 C<$itemnumber>  = itemnumber
2169 C<$branchcode>  = location of issue (affected by 'CircControl' syspref)
2170 C<$loanlength>  = loan length prior to adjustment
2171 =cut
2172
2173 sub CheckValidDatedue {
2174 my ($date_due,$itemnumber,$branchcode)=@_;
2175 my @datedue=split('-',$date_due->output('iso'));
2176 my $years=$datedue[0];
2177 my $month=$datedue[1];
2178 my $day=$datedue[2];
2179 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2180 my $dow;
2181 for (my $i=0;$i<2;$i++){
2182     $dow=Day_of_Week($years,$month,$day);
2183     ($dow=0) if ($dow>6);
2184     my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2185     my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2186     my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2187         if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2188         $i=0;
2189         (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2190         }
2191     }
2192     my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2193 return $newdatedue;
2194 }
2195
2196
2197 =head2 CheckRepeatableHolidays
2198
2199 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2200 this function checks if the date due is a repeatable holiday
2201 C<$date_due>   = returndate calculate with no day check
2202 C<$itemnumber>  = itemnumber
2203 C<$branchcode>  = localisation of issue
2204
2205 =cut
2206
2207 sub CheckRepeatableHolidays{
2208 my($itemnumber,$week_day,$branchcode)=@_;
2209 my $dbh = C4::Context->dbh;
2210 my $query = qq|SELECT count(*)
2211         FROM repeatable_holidays
2212         WHERE branchcode=?
2213         AND weekday=?|;
2214 my $sth = $dbh->prepare($query);
2215 $sth->execute($branchcode,$week_day);
2216 my $result=$sth->fetchrow;
2217 $sth->finish;
2218 return $result;
2219 }
2220
2221
2222 =head2 CheckSpecialHolidays
2223
2224 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2225 this function check if the date is a special holiday
2226 C<$years>   = the years of datedue
2227 C<$month>   = the month of datedue
2228 C<$day>     = the day of datedue
2229 C<$itemnumber>  = itemnumber
2230 C<$branchcode>  = localisation of issue
2231
2232 =cut
2233
2234 sub CheckSpecialHolidays{
2235 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2236 my $dbh = C4::Context->dbh;
2237 my $query=qq|SELECT count(*)
2238              FROM `special_holidays`
2239              WHERE year=?
2240              AND month=?
2241              AND day=?
2242              AND branchcode=?
2243             |;
2244 my $sth = $dbh->prepare($query);
2245 $sth->execute($years,$month,$day,$branchcode);
2246 my $countspecial=$sth->fetchrow ;
2247 $sth->finish;
2248 return $countspecial;
2249 }
2250
2251 =head2 CheckRepeatableSpecialHolidays
2252
2253 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2254 this function check if the date is a repeatble special holidays
2255 C<$month>   = the month of datedue
2256 C<$day>     = the day of datedue
2257 C<$itemnumber>  = itemnumber
2258 C<$branchcode>  = localisation of issue
2259
2260 =cut
2261
2262 sub CheckRepeatableSpecialHolidays{
2263 my ($month,$day,$itemnumber,$branchcode) = @_;
2264 my $dbh = C4::Context->dbh;
2265 my $query=qq|SELECT count(*)
2266              FROM `repeatable_holidays`
2267              WHERE month=?
2268              AND day=?
2269              AND branchcode=?
2270             |;
2271 my $sth = $dbh->prepare($query);
2272 $sth->execute($month,$day,$branchcode);
2273 my $countspecial=$sth->fetchrow ;
2274 $sth->finish;
2275 return $countspecial;
2276 }
2277
2278
2279
2280 sub CheckValidBarcode{
2281 my ($barcode) = @_;
2282 my $dbh = C4::Context->dbh;
2283 my $query=qq|SELECT count(*)
2284              FROM items
2285              WHERE barcode=?
2286             |;
2287 my $sth = $dbh->prepare($query);
2288 $sth->execute($barcode);
2289 my $exist=$sth->fetchrow ;
2290 $sth->finish;
2291 return $exist;
2292 }
2293
2294 1;
2295
2296 __END__
2297
2298 =head1 AUTHOR
2299
2300 Koha Developement team <info@koha.org>
2301
2302 =cut
2303