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