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