C4/Circulation.pm

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