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