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