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