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