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