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