C4/Circulation.pm

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