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