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