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