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