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