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.  If overdue
1175 charges are applied and C<$dropbox> is true, the last charge will be removed.
1176
1177 C<&AddReturn> returns a list of four items:
1178
1179 C<$doreturn> is true iff the return succeeded.
1180
1181 C<$messages> is a reference-to-hash giving the reason for failure:
1182
1183 =over 4
1184
1185 =item C<BadBarcode>
1186
1187 No item with this barcode exists. The value is C<$barcode>.
1188
1189 =item C<NotIssued>
1190
1191 The book is not currently on loan. The value is C<$barcode>.
1192
1193 =item C<IsPermanent>
1194
1195 The book's home branch is a permanent collection. If you have borrowed
1196 this book, you are not allowed to return it. The value is the code for
1197 the book's home branch.
1198
1199 =item C<wthdrawn>
1200
1201 This book has been withdrawn/cancelled. The value should be ignored.
1202
1203 =item C<ResFound>
1204
1205 The item was reserved. The value is a reference-to-hash whose keys are
1206 fields from the reserves table of the Koha database, and
1207 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1208 either C<Waiting>, C<Reserved>, or 0.
1209
1210 =back
1211
1212 C<$borrower> is a reference-to-hash, giving information about the
1213 patron who last borrowed the book.
1214
1215 =cut
1216
1217 sub AddReturn {
1218     my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1219     my $dbh      = C4::Context->dbh;
1220     my $messages;
1221     my $doreturn = 1;
1222     my $borrower;
1223     my $validTransfert = 0;
1224     my $reserveDone = 0;
1225
1226     # get information on item
1227     my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1228     my $biblio = GetBiblioItemData($iteminformation->{'biblioitemnumber'});
1229 #     use Data::Dumper;warn Data::Dumper::Dumper($iteminformation);
1230     unless ($iteminformation->{'itemnumber'} ) {
1231         $messages->{'BadBarcode'} = $barcode;
1232         $doreturn = 0;
1233     } else {
1234         # find the borrower
1235         if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1236             $messages->{'NotIssued'} = $barcode;
1237             # even though item is not on loan, it may still
1238             # be transferred; therefore, get current branch information
1239             my $curr_iteminfo = GetItem($iteminformation->{'itemnumber'});
1240             $iteminformation->{'homebranch'} = $curr_iteminfo->{'homebranch'};
1241             $iteminformation->{'holdingbranch'} = $curr_iteminfo->{'holdingbranch'};
1242             $doreturn = 0;
1243         }
1244
1245         # check if the book is in a permanent collection....
1246         my $hbr      = $iteminformation->{C4::Context->preference("HomeOrHoldingBranch")};
1247         my $branches = GetBranches();
1248         if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1249             $messages->{'IsPermanent'} = $hbr;
1250         }
1251
1252                     # if independent branches are on and returning to different branch, refuse the return
1253         if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){
1254                           $messages->{'Wrongbranch'} = 1;
1255                           $doreturn=0;
1256                     }
1257
1258         # check that the book has been cancelled
1259         if ( $iteminformation->{'wthdrawn'} ) {
1260             $messages->{'wthdrawn'} = 1;
1261             $doreturn = 0;
1262         }
1263
1264     #     new op dev : if the book returned in an other branch update the holding branch
1265
1266     # update issues, thereby returning book (should push this out into another subroutine
1267         $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1268
1269     # case of a return of document (deal with issues and holdingbranch)
1270
1271         if ($doreturn) {
1272                         if($dropbox) {
1273                                 # don't allow dropbox mode to create an invalid entry in issues ( issuedate > returndate)
1274                                 undef($dropbox) if ( $iteminformation->{'issuedate'} eq C4::Dates->today('iso') );
1275                         }
1276             MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'},$dropbox);
1277             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?
1278         }
1279
1280     # continue to deal with returns cases, but not only if we have an issue
1281
1282         # the holdingbranch is updated if the document is returned in an other location .
1283         if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) {
1284                         UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1285                         #               reload iteminformation holdingbranch with the userenv value
1286                         $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1287         }
1288         ModDateLastSeen( $iteminformation->{'itemnumber'} );
1289         ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'});
1290
1291                     if ($iteminformation->{borrowernumber}){
1292                           ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1293         }
1294         # fix up the accounts.....
1295         if ( $iteminformation->{'itemlost'} ) {
1296             $messages->{'WasLost'} = 1;
1297         }
1298
1299     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1300     #     check if we have a transfer for this document
1301         my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1302
1303     #     if we have a transfer to do, we update the line of transfers with the datearrived
1304         if ($datesent) {
1305             if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1306                     my $sth =
1307                     $dbh->prepare(
1308                             "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1309                     );
1310                     $sth->execute( $iteminformation->{'itemnumber'} );
1311                     $sth->finish;
1312     #         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'
1313             C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1314             }
1315         else {
1316             $messages->{'WrongTransfer'} = $tobranch;
1317             $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1318         }
1319         $validTransfert = 1;
1320         }
1321
1322     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1323         # fix up the accounts.....
1324         if ($iteminformation->{'itemlost'}) {
1325                 FixAccountForLostAndReturned($iteminformation, $borrower);
1326                 $messages->{'WasLost'} = 1;
1327         }
1328         # fix up the overdues in accounts...
1329         FixOverduesOnReturn( $borrower->{'borrowernumber'},
1330             $iteminformation->{'itemnumber'}, $exemptfine, $dropbox );
1331
1332     # find reserves.....
1333     #     if we don't have a reserve with the status W, we launch the Checkreserves routine
1334         my ( $resfound, $resrec ) =
1335         C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1336         if ($resfound) {
1337             $resrec->{'ResFound'}   = $resfound;
1338             $messages->{'ResFound'} = $resrec;
1339             $reserveDone = 1;
1340         }
1341
1342         # update stats?
1343         # Record the fact that this book was returned.
1344         UpdateStats(
1345             $branch, 'return', '0', '',
1346             $iteminformation->{'itemnumber'},
1347             $biblio->{'itemtype'},
1348             $borrower->{'borrowernumber'}
1349         );
1350
1351         logaction("CIRCULATION", "RETURN", $iteminformation->{borrowernumber}, $iteminformation->{'biblionumber'})
1352             if C4::Context->preference("ReturnLog");
1353
1354         #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1355         #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1356
1357         if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1358                         if (C4::Context->preference("AutomaticItemReturn") == 1) {
1359                                 ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1360                                 $messages->{'WasTransfered'} = 1;
1361                         }
1362                         else {
1363                                 $messages->{'NeedsTransfer'} = 1;
1364                         }
1365         }
1366     }
1367     return ( $doreturn, $messages, $iteminformation, $borrower );
1368 }
1369
1370 =head2 MarkIssueReturned
1371
1372 =over 4
1373
1374 MarkIssueReturned($borrowernumber, $itemnumber);
1375
1376 =back
1377
1378 Unconditionally marks an issue as being returned by
1379 moving the C<issues> row to C<old_issues> and
1380 setting C<returndate> to the current date, or
1381 yesterday if C<dropbox> is true.  Assumes you've
1382 already checked that yesterday > issuedate.
1383
1384 Ideally, this function would be internal to C<C4::Circulation>,
1385 not exported, but it is currently needed by one
1386 routine in C<C4::Accounts>.
1387
1388 =cut
1389
1390 sub MarkIssueReturned {
1391     my ($borrowernumber, $itemnumber, $dropbox) = @_;
1392         my $dbh = C4::Context->dbh;
1393         my $query = "UPDATE issues SET returndate=";
1394         my @bind = ($borrowernumber,$itemnumber);
1395         if($dropbox) {
1396                 my @datearr = localtime( time() );
1397                 my @yesterdayarr =  Add_Delta_Days( $datearr[5] + 1900 , $datearr[4] + 1, $datearr[3] , -1 );
1398                 unshift @bind, sprintf("%0.4d-%0.2d-%0.2d",@yesterdayarr) ;
1399                 $query .= " ? "
1400         } else {
1401                 $query .= " now() ";
1402         }
1403         $query .=  " WHERE  borrowernumber = ?  AND itemnumber = ?";
1404     # FIXME transaction
1405     my $sth_upd  = $dbh->prepare($query);
1406     $sth_upd->execute(@bind);
1407     my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1408                                   WHERE borrowernumber = ?
1409                                   AND itemnumber = ?");
1410     $sth_copy->execute($borrowernumber, $itemnumber);
1411     my $sth_del  = $dbh->prepare("DELETE FROM issues
1412                                   WHERE borrowernumber = ?
1413                                   AND itemnumber = ?");
1414     $sth_del->execute($borrowernumber, $itemnumber);
1415 }
1416
1417 =head2 FixOverduesOnReturn
1418
1419     &FixOverduesOnReturn($brn,$itm, $exemptfine);
1420
1421 C<$brn> borrowernumber
1422
1423 C<$itm> itemnumber
1424
1425 internal function, called only by AddReturn
1426
1427 =cut
1428
1429 sub FixOverduesOnReturn {
1430     my ( $borrowernumber, $item, $exemptfine ) = @_;
1431     my $dbh = C4::Context->dbh;
1432
1433     # check for overdue fine
1434     my $sth =
1435       $dbh->prepare(
1436 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1437       );
1438     $sth->execute( $borrowernumber, $item );
1439
1440     # alter fine to show that the book has been returned
1441    my $data;
1442         if ($data = $sth->fetchrow_hashref) {
1443         my $uquery =($exemptfine)? "update accountlines set accounttype='FFOR', amountoutstanding=0":"update accountlines set accounttype='F' ";
1444                 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1445         my $usth = $dbh->prepare($uquery);
1446         $usth->execute($borrowernumber,$item ,$data->{'accountno'});
1447         $usth->finish();
1448     }
1449
1450     $sth->finish();
1451     return;
1452 }
1453
1454 =head2 FixAccountForLostAndReturned
1455
1456         &FixAccountForLostAndReturned($iteminfo,$borrower);
1457
1458 Calculates the charge for a book lost and returned (Not exported & used only once)
1459
1460 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1461
1462 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1463
1464 Internal function, called by AddReturn
1465
1466 =cut
1467
1468 sub FixAccountForLostAndReturned {
1469         my ($iteminfo, $borrower) = @_;
1470         my %env;
1471         my $dbh = C4::Context->dbh;
1472         my $itm = $iteminfo->{'itemnumber'};
1473         # check for charge made for lost book
1474         my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1475         $sth->execute($itm);
1476         if (my $data = $sth->fetchrow_hashref) {
1477         # writeoff this amount
1478                 my $offset;
1479                 my $amount = $data->{'amount'};
1480                 my $acctno = $data->{'accountno'};
1481                 my $amountleft;
1482                 if ($data->{'amountoutstanding'} == $amount) {
1483                 $offset = $data->{'amount'};
1484                 $amountleft = 0;
1485                 } else {
1486                 $offset = $amount - $data->{'amountoutstanding'};
1487                 $amountleft = $data->{'amountoutstanding'} - $amount;
1488                 }
1489                 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1490                         WHERE (borrowernumber = ?)
1491                         AND (itemnumber = ?) AND (accountno = ?) ");
1492                 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1493                 $usth->finish;
1494         #check if any credit is left if so writeoff other accounts
1495                 my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
1496                 if ($amountleft < 0){
1497                 $amountleft*=-1;
1498                 }
1499                 if ($amountleft > 0){
1500                 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1501                                                         AND (amountoutstanding >0) ORDER BY date");
1502                 $msth->execute($data->{'borrowernumber'});
1503         # offset transactions
1504                 my $newamtos;
1505                 my $accdata;
1506                 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1507                         if ($accdata->{'amountoutstanding'} < $amountleft) {
1508                         $newamtos = 0;
1509                         $amountleft -= $accdata->{'amountoutstanding'};
1510                         }  else {
1511                         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1512                         $amountleft = 0;
1513                         }
1514                         my $thisacct = $accdata->{'accountno'};
1515                         my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1516                                         WHERE (borrowernumber = ?)
1517                                         AND (accountno=?)");
1518                         $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1519                         $usth->finish;
1520                         $usth = $dbh->prepare("INSERT INTO accountoffsets
1521                                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1522                                 VALUES
1523                                 (?,?,?,?)");
1524                         $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1525                         $usth->finish;
1526                 }
1527                 $msth->finish;
1528                 }
1529                 if ($amountleft > 0){
1530                         $amountleft*=-1;
1531                 }
1532                 my $desc="Item Returned ".$iteminfo->{'barcode'};
1533                 $usth = $dbh->prepare("INSERT INTO accountlines
1534                         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1535                         VALUES (?,?,now(),?,?,'CR',?)");
1536                 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1537                 $usth->finish;
1538                 $usth = $dbh->prepare("INSERT INTO accountoffsets
1539                         (borrowernumber, accountno, offsetaccount,  offsetamount)
1540                         VALUES (?,?,?,?)");
1541                 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1542                 $usth->finish;
1543         ModItem({ paidfor => '' }, undef, $itm);
1544         }
1545         $sth->finish;
1546         return;
1547 }
1548
1549 =head2 GetItemIssue
1550
1551 $issues = &GetItemIssue($itemnumber);
1552
1553 Returns patrons currently having a book. nothing if item is not issued atm
1554
1555 C<$itemnumber> is the itemnumber
1556
1557 Returns an array of hashes
1558
1559 =cut
1560
1561 sub GetItemIssue {
1562     my ( $itemnumber) = @_;
1563     return unless $itemnumber;
1564     my $dbh = C4::Context->dbh;
1565     my @GetItemIssues;
1566
1567     # get today date
1568     my $today = POSIX::strftime("%Y%m%d", localtime);
1569
1570     my $sth = $dbh->prepare(
1571         "SELECT * FROM issues
1572         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1573     WHERE
1574     issues.itemnumber=?");
1575     $sth->execute($itemnumber);
1576     my $data = $sth->fetchrow_hashref;
1577     my $datedue = $data->{'date_due'};
1578     $datedue =~ s/-//g;
1579     if ( $datedue < $today ) {
1580         $data->{'overdue'} = 1;
1581     }
1582     $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1583     $sth->finish;
1584     return ($data);
1585 }
1586
1587 =head2 GetItemIssues
1588
1589 $issues = &GetItemIssues($itemnumber, $history);
1590
1591 Returns patrons that have issued a book
1592
1593 C<$itemnumber> is the itemnumber
1594 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1595
1596 Returns an array of hashes
1597
1598 =cut
1599
1600 sub GetItemIssues {
1601     my ( $itemnumber,$history ) = @_;
1602     my $dbh = C4::Context->dbh;
1603     my @GetItemIssues;
1604
1605     # get today date
1606     my $today = POSIX::strftime("%Y%m%d", localtime);
1607
1608     my $sql = "SELECT * FROM issues
1609               JOIN borrowers USING (borrowernumber)
1610               JOIN items USING (itemnumber)
1611               WHERE issues.itemnumber = ? ";
1612     if ($history) {
1613         $sql .= "UNION ALL
1614                  SELECT * FROM old_issues
1615                  LEFT JOIN borrowers USING (borrowernumber)
1616                  JOIN items USING (itemnumber)
1617                  WHERE old_issues.itemnumber = ? ";
1618     }
1619     $sql .= "ORDER BY date_due DESC";
1620     my $sth = $dbh->prepare($sql);
1621     if ($history) {
1622         $sth->execute($itemnumber, $itemnumber);
1623     } else {
1624         $sth->execute($itemnumber);
1625     }
1626     while ( my $data = $sth->fetchrow_hashref ) {
1627         my $datedue = $data->{'date_due'};
1628         $datedue =~ s/-//g;
1629         if ( $datedue < $today ) {
1630             $data->{'overdue'} = 1;
1631         }
1632         my $itemnumber = $data->{'itemnumber'};
1633         push @GetItemIssues, $data;
1634     }
1635     $sth->finish;
1636     return ( \@GetItemIssues );
1637 }
1638
1639 =head2 GetBiblioIssues
1640
1641 $issues = GetBiblioIssues($biblionumber);
1642
1643 this function get all issues from a biblionumber.
1644
1645 Return:
1646 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1647 tables issues and the firstname,surname & cardnumber from borrowers.
1648
1649 =cut
1650
1651 sub GetBiblioIssues {
1652     my $biblionumber = shift;
1653     return undef unless $biblionumber;
1654     my $dbh   = C4::Context->dbh;
1655     my $query = "
1656         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1657         FROM issues
1658             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1659             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1660             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1661             LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1662         WHERE biblio.biblionumber = ?
1663         UNION ALL
1664         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1665         FROM old_issues
1666             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1667             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1668             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1669             LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1670         WHERE biblio.biblionumber = ?
1671         ORDER BY timestamp
1672     ";
1673     my $sth = $dbh->prepare($query);
1674     $sth->execute($biblionumber, $biblionumber);
1675
1676     my @issues;
1677     while ( my $data = $sth->fetchrow_hashref ) {
1678         push @issues, $data;
1679     }
1680     return \@issues;
1681 }
1682
1683 =head2 CanBookBeRenewed
1684
1685 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber);
1686
1687 Find out whether a borrowed item may be renewed.
1688
1689 C<$dbh> is a DBI handle to the Koha database.
1690
1691 C<$borrowernumber> is the borrower number of the patron who currently
1692 has the item on loan.
1693
1694 C<$itemnumber> is the number of the item to renew.
1695
1696 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1697 item must currently be on loan to the specified borrower; renewals
1698 must be allowed for the item's type; and the borrower must not have
1699 already renewed the loan. $error will contain the reason the renewal can not proceed
1700
1701 =cut
1702
1703 sub CanBookBeRenewed {
1704
1705     # check renewal status
1706     my ( $borrowernumber, $itemnumber ) = @_;
1707     my $dbh       = C4::Context->dbh;
1708     my $renews    = 1;
1709     my $renewokay = 0;
1710         my $error;
1711
1712     # Look in the issues table for this item, lent to this borrower,
1713     # and not yet returned.
1714
1715     # FIXME - I think this function could be redone to use only one SQL call.
1716     my $sth1 = $dbh->prepare(
1717         "SELECT * FROM issues
1718             WHERE borrowernumber = ?
1719             AND itemnumber = ?"
1720     );
1721     $sth1->execute( $borrowernumber, $itemnumber );
1722     if ( my $data1 = $sth1->fetchrow_hashref ) {
1723
1724         # Found a matching item
1725
1726         # See if this item may be renewed. This query is convoluted
1727         # because it's a bit messy: given the item number, we need to find
1728         # the biblioitem, which gives us the itemtype, which tells us
1729         # whether it may be renewed.
1730         my $query = "SELECT renewalsallowed FROM items ";
1731         $query .= (C4::Context->preference('item-level_itypes'))
1732                     ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1733                     : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1734                        LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1735         $query .= "WHERE items.itemnumber = ?";
1736         my $sth2 = $dbh->prepare($query);
1737         $sth2->execute($itemnumber);
1738         if ( my $data2 = $sth2->fetchrow_hashref ) {
1739             $renews = $data2->{'renewalsallowed'};
1740         }
1741         if ( $renews && $renews > $data1->{'renewals'} ) {
1742             $renewokay = 1;
1743         }
1744         else {
1745                         $error="too_many";
1746                 }
1747         $sth2->finish;
1748         my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1749         if ($resfound) {
1750             $renewokay = 0;
1751                         $error="on_reserve"
1752         }
1753
1754     }
1755     $sth1->finish;
1756     return ($renewokay,$error);
1757 }
1758
1759 =head2 AddRenewal
1760
1761 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue]);
1762
1763 Renews a loan.
1764
1765 C<$borrowernumber> is the borrower number of the patron who currently
1766 has the item.
1767
1768 C<$itemnumber> is the number of the item to renew.
1769
1770 C<$branch> is the library branch.  Defaults to the homebranch of the ITEM.
1771
1772 C<$datedue> can be a C4::Dates object used to set the due date.
1773
1774 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
1775 from the book's item type.
1776
1777 =cut
1778
1779 sub AddRenewal {
1780         my $borrowernumber = shift or return undef;
1781         my     $itemnumber = shift or return undef;
1782     my $item   = GetItem($itemnumber) or return undef;
1783     my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
1784     my $branch  = (@_) ? shift : $item->{homebranch};   # opac-renew doesn't send branch
1785     my $datedue;
1786     # If the due date wasn't specified, calculate it by adding the
1787     # book's loan length to today's date.
1788     unless (@_ and $datedue = shift and $datedue->output('iso')) {
1789
1790         my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
1791         my $loanlength = GetLoanLength(
1792             $borrower->{'categorycode'},
1793              (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
1794                         $item->{homebranch}                     # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument?
1795         );
1796                 #FIXME -- use circControl?
1797                 $datedue =  CalcDateDue(C4::Dates->new(),$loanlength,$branch);  # this branch is the transactional branch.
1798                                                                 # The question of whether to use item's homebranch calendar is open.
1799     }
1800
1801     my $dbh = C4::Context->dbh;
1802     # Find the issues record for this book
1803     my $sth =
1804       $dbh->prepare("SELECT * FROM issues
1805                         WHERE borrowernumber=?
1806                         AND itemnumber=?"
1807       );
1808     $sth->execute( $borrowernumber, $itemnumber );
1809     my $issuedata = $sth->fetchrow_hashref;
1810     $sth->finish;
1811
1812     # Update the issues record to have the new due date, and a new count
1813     # of how many times it has been renewed.
1814     my $renews = $issuedata->{'renewals'} + 1;
1815     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1816                             WHERE borrowernumber=?
1817                             AND itemnumber=?"
1818     );
1819     $sth->execute( $datedue->output('iso'), $renews, $borrowernumber, $itemnumber );
1820     $sth->finish;
1821
1822     # Update the renewal count on the item, and tell zebra to reindex
1823     $renews = $biblio->{'renewals'} + 1;
1824     ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber);
1825
1826     # Charge a new rental fee, if applicable?
1827     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1828     if ( $charge > 0 ) {
1829         my $accountno = getnextacctno( $borrowernumber );
1830         my $item = GetBiblioFromItemNumber($itemnumber);
1831         $sth = $dbh->prepare(
1832                 "INSERT INTO accountlines
1833                     (date,
1834                                         borrowernumber, accountno, amount,
1835                     description,
1836                                         accounttype, amountoutstanding, itemnumber
1837                                         )
1838                     VALUES (now(),?,?,?,?,?,?,?)"
1839         );
1840         $sth->execute( $borrowernumber, $accountno, $charge,
1841             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1842             'Rent', $charge, $itemnumber );
1843         $sth->finish;
1844     }
1845     # Log the renewal
1846     UpdateStats( $branch, 'renew', $charge, '', $itemnumber );
1847 }
1848
1849 sub GetRenewCount {
1850     # check renewal status
1851     my ($bornum,$itemno)=@_;
1852     my $dbh = C4::Context->dbh;
1853     my $renewcount = 0;
1854         my $renewsallowed = 0;
1855         my $renewsleft = 0;
1856     # Look in the issues table for this item, lent to this borrower,
1857     # and not yet returned.
1858
1859     # FIXME - I think this function could be redone to use only one SQL call.
1860     my $sth = $dbh->prepare("select * from issues
1861                                 where (borrowernumber = ?)
1862                                 and (itemnumber = ?)");
1863     $sth->execute($bornum,$itemno);
1864     my $data = $sth->fetchrow_hashref;
1865     $renewcount = $data->{'renewals'} if $data->{'renewals'};
1866     $sth->finish;
1867     my $query = "SELECT renewalsallowed FROM items ";
1868     $query .= (C4::Context->preference('item-level_itypes'))
1869                 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1870                 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1871                    LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1872     $query .= "WHERE items.itemnumber = ?";
1873     my $sth2 = $dbh->prepare($query);
1874     $sth2->execute($itemno);
1875     my $data2 = $sth2->fetchrow_hashref();
1876     $renewsallowed = $data2->{'renewalsallowed'};
1877     $renewsleft = $renewsallowed - $renewcount;
1878     return ($renewcount,$renewsallowed,$renewsleft);
1879 }
1880
1881 =head2 GetIssuingCharges
1882
1883 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
1884
1885 Calculate how much it would cost for a given patron to borrow a given
1886 item, including any applicable discounts.
1887
1888 C<$itemnumber> is the item number of item the patron wishes to borrow.
1889
1890 C<$borrowernumber> is the patron's borrower number.
1891
1892 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
1893 and C<$item_type> is the code for the item's item type (e.g., C<VID>
1894 if it's a video).
1895
1896 =cut
1897
1898 sub GetIssuingCharges {
1899
1900     # calculate charges due
1901     my ( $itemnumber, $borrowernumber ) = @_;
1902     my $charge = 0;
1903     my $dbh    = C4::Context->dbh;
1904     my $item_type;
1905
1906     # Get the book's item type and rental charge (via its biblioitem).
1907     my $qcharge =     "SELECT itemtypes.itemtype,rentalcharge FROM items
1908             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
1909         $qcharge .= (C4::Context->preference('item-level_itypes'))
1910                 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1911                 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1912
1913     $qcharge .=      "WHERE items.itemnumber =?";
1914
1915     my $sth1 = $dbh->prepare($qcharge);
1916     $sth1->execute($itemnumber);
1917     if ( my $data1 = $sth1->fetchrow_hashref ) {
1918         $item_type = $data1->{'itemtype'};
1919         $charge    = $data1->{'rentalcharge'};
1920         my $q2 = "SELECT rentaldiscount FROM borrowers
1921             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
1922             WHERE borrowers.borrowernumber = ?
1923             AND issuingrules.itemtype = ?";
1924         my $sth2 = $dbh->prepare($q2);
1925         $sth2->execute( $borrowernumber, $item_type );
1926         if ( my $data2 = $sth2->fetchrow_hashref ) {
1927             my $discount = $data2->{'rentaldiscount'};
1928             if ( $discount eq 'NULL' ) {
1929                 $discount = 0;
1930             }
1931             $charge = ( $charge * ( 100 - $discount ) ) / 100;
1932         }
1933         $sth2->finish;
1934     }
1935
1936     $sth1->finish;
1937     return ( $charge, $item_type );
1938 }
1939
1940 =head2 AddIssuingCharge
1941
1942 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
1943
1944 =cut
1945
1946 sub AddIssuingCharge {
1947     my ( $itemnumber, $borrowernumber, $charge ) = @_;
1948     my $dbh = C4::Context->dbh;
1949     my $nextaccntno = getnextacctno( $borrowernumber );
1950     my $query ="
1951         INSERT INTO accountlines
1952             (borrowernumber, itemnumber, accountno,
1953             date, amount, description, accounttype,
1954             amountoutstanding)
1955         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
1956     ";
1957     my $sth = $dbh->prepare($query);
1958     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
1959     $sth->finish;
1960 }
1961
1962 =head2 GetTransfers
1963
1964 GetTransfers($itemnumber);
1965
1966 =cut
1967
1968 sub GetTransfers {
1969     my ($itemnumber) = @_;
1970
1971     my $dbh = C4::Context->dbh;
1972
1973     my $query = '
1974         SELECT datesent,
1975                frombranch,
1976                tobranch
1977         FROM branchtransfers
1978         WHERE itemnumber = ?
1979           AND datearrived IS NULL
1980         ';
1981     my $sth = $dbh->prepare($query);
1982     $sth->execute($itemnumber);
1983     my @row = $sth->fetchrow_array();
1984     $sth->finish;
1985     return @row;
1986 }
1987
1988
1989 =head2 GetTransfersFromTo
1990
1991 @results = GetTransfersFromTo($frombranch,$tobranch);
1992
1993 Returns the list of pending transfers between $from and $to branch
1994
1995 =cut
1996
1997 sub GetTransfersFromTo {
1998     my ( $frombranch, $tobranch ) = @_;
1999     return unless ( $frombranch && $tobranch );
2000     my $dbh   = C4::Context->dbh;
2001     my $query = "
2002         SELECT itemnumber,datesent,frombranch
2003         FROM   branchtransfers
2004         WHERE  frombranch=?
2005           AND  tobranch=?
2006           AND datearrived IS NULL
2007     ";
2008     my $sth = $dbh->prepare($query);
2009     $sth->execute( $frombranch, $tobranch );
2010     my @gettransfers;
2011
2012     while ( my $data = $sth->fetchrow_hashref ) {
2013         push @gettransfers, $data;
2014     }
2015     $sth->finish;
2016     return (@gettransfers);
2017 }
2018
2019 =head2 DeleteTransfer
2020
2021 &DeleteTransfer($itemnumber);
2022
2023 =cut
2024
2025 sub DeleteTransfer {
2026     my ($itemnumber) = @_;
2027     my $dbh          = C4::Context->dbh;
2028     my $sth          = $dbh->prepare(
2029         "DELETE FROM branchtransfers
2030          WHERE itemnumber=?
2031          AND datearrived IS NULL "
2032     );
2033     $sth->execute($itemnumber);
2034     $sth->finish;
2035 }
2036
2037 =head2 AnonymiseIssueHistory
2038
2039 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2040
2041 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2042 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2043
2044 return the number of affected rows.
2045
2046 =cut
2047
2048 sub AnonymiseIssueHistory {
2049     my $date           = shift;
2050     my $borrowernumber = shift;
2051     my $dbh            = C4::Context->dbh;
2052     my $query          = "
2053         UPDATE old_issues
2054         SET    borrowernumber = NULL
2055         WHERE  returndate < '".$date."'
2056           AND borrowernumber IS NOT NULL
2057     ";
2058     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2059     my $rows_affected = $dbh->do($query);
2060     return $rows_affected;
2061 }
2062
2063 =head2 updateWrongTransfer
2064
2065 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2066
2067 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
2068
2069 =cut
2070
2071 sub updateWrongTransfer {
2072         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2073         my $dbh = C4::Context->dbh;
2074 # first step validate the actual line of transfert .
2075         my $sth =
2076                 $dbh->prepare(
2077                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2078                 );
2079                 $sth->execute($FromLibrary,$itemNumber);
2080                 $sth->finish;
2081
2082 # second step create a new line of branchtransfer to the right location .
2083         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2084
2085 #third step changing holdingbranch of item
2086         UpdateHoldingbranch($FromLibrary,$itemNumber);
2087 }
2088
2089 =head2 UpdateHoldingbranch
2090
2091 $items = UpdateHoldingbranch($branch,$itmenumber);
2092 Simple methode for updating hodlingbranch in items BDD line
2093
2094 =cut
2095
2096 sub UpdateHoldingbranch {
2097         my ( $branch,$itemnumber ) = @_;
2098     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2099 }
2100
2101 =head2 CalcDateDue
2102
2103 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2104 this function calculates the due date given the loan length ,
2105 checking against the holidays calendar as per the 'useDaysMode' syspref.
2106 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2107 C<$branch>  = location whose calendar to use
2108 C<$loanlength>  = loan length prior to adjustment
2109 =cut
2110
2111 sub CalcDateDue {
2112         my ($startdate,$loanlength,$branch) = @_;
2113         if(C4::Context->preference('useDaysMode') eq 'Days') {  # ignoring calendar
2114                 my $datedue = time + ($loanlength) * 86400;
2115         #FIXME - assumes now even though we take a startdate
2116                 my @datearr  = localtime($datedue);
2117                 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2118         } else {
2119                 my $calendar = C4::Calendar->new(  branchcode => $branch );
2120                 my $datedue = $calendar->addDate($startdate, $loanlength);
2121                 return $datedue;
2122         }
2123 }
2124
2125 =head2 CheckValidDatedue
2126        This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2127        To be replaced by CalcDateDue() once C4::Calendar use is tested.
2128
2129 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2130 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2131 C<$date_due>   = returndate calculate with no day check
2132 C<$itemnumber>  = itemnumber
2133 C<$branchcode>  = location of issue (affected by 'CircControl' syspref)
2134 C<$loanlength>  = loan length prior to adjustment
2135 =cut
2136
2137 sub CheckValidDatedue {
2138 my ($date_due,$itemnumber,$branchcode)=@_;
2139 my @datedue=split('-',$date_due->output('iso'));
2140 my $years=$datedue[0];
2141 my $month=$datedue[1];
2142 my $day=$datedue[2];
2143 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2144 my $dow;
2145 for (my $i=0;$i<2;$i++){
2146     $dow=Day_of_Week($years,$month,$day);
2147     ($dow=0) if ($dow>6);
2148     my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2149     my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2150     my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2151         if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2152         $i=0;
2153         (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2154         }
2155     }
2156     my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2157 return $newdatedue;
2158 }
2159
2160
2161 =head2 CheckRepeatableHolidays
2162
2163 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2164 this function checks if the date due is a repeatable holiday
2165 C<$date_due>   = returndate calculate with no day check
2166 C<$itemnumber>  = itemnumber
2167 C<$branchcode>  = localisation of issue
2168
2169 =cut
2170
2171 sub CheckRepeatableHolidays{
2172 my($itemnumber,$week_day,$branchcode)=@_;
2173 my $dbh = C4::Context->dbh;
2174 my $query = qq|SELECT count(*)
2175         FROM repeatable_holidays
2176         WHERE branchcode=?
2177         AND weekday=?|;
2178 my $sth = $dbh->prepare($query);
2179 $sth->execute($branchcode,$week_day);
2180 my $result=$sth->fetchrow;
2181 $sth->finish;
2182 return $result;
2183 }
2184
2185
2186 =head2 CheckSpecialHolidays
2187
2188 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2189 this function check if the date is a special holiday
2190 C<$years>   = the years of datedue
2191 C<$month>   = the month of datedue
2192 C<$day>     = the day of datedue
2193 C<$itemnumber>  = itemnumber
2194 C<$branchcode>  = localisation of issue
2195
2196 =cut
2197
2198 sub CheckSpecialHolidays{
2199 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2200 my $dbh = C4::Context->dbh;
2201 my $query=qq|SELECT count(*)
2202              FROM `special_holidays`
2203              WHERE year=?
2204              AND month=?
2205              AND day=?
2206              AND branchcode=?
2207             |;
2208 my $sth = $dbh->prepare($query);
2209 $sth->execute($years,$month,$day,$branchcode);
2210 my $countspecial=$sth->fetchrow ;
2211 $sth->finish;
2212 return $countspecial;
2213 }
2214
2215 =head2 CheckRepeatableSpecialHolidays
2216
2217 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2218 this function check if the date is a repeatble special holidays
2219 C<$month>   = the month of datedue
2220 C<$day>     = the day of datedue
2221 C<$itemnumber>  = itemnumber
2222 C<$branchcode>  = localisation of issue
2223
2224 =cut
2225
2226 sub CheckRepeatableSpecialHolidays{
2227 my ($month,$day,$itemnumber,$branchcode) = @_;
2228 my $dbh = C4::Context->dbh;
2229 my $query=qq|SELECT count(*)
2230              FROM `repeatable_holidays`
2231              WHERE month=?
2232              AND day=?
2233              AND branchcode=?
2234             |;
2235 my $sth = $dbh->prepare($query);
2236 $sth->execute($month,$day,$branchcode);
2237 my $countspecial=$sth->fetchrow ;
2238 $sth->finish;
2239 return $countspecial;
2240 }
2241
2242
2243
2244 sub CheckValidBarcode{
2245 my ($barcode) = @_;
2246 my $dbh = C4::Context->dbh;
2247 my $query=qq|SELECT count(*)
2248              FROM items
2249              WHERE barcode=?
2250             |;
2251 my $sth = $dbh->prepare($query);
2252 $sth->execute($barcode);
2253 my $exist=$sth->fetchrow ;
2254 $sth->finish;
2255 return $exist;
2256 }
2257
2258 1;
2259
2260 __END__
2261
2262 =head1 AUTHOR
2263
2264 Koha Developement team <info@koha.org>
2265
2266 =cut
2267