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 = C4::Members::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) = C4::Members::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         C4::Reserves::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 ) = C4::Reserves::CheckReserves($itemnumber);
1606         if ($resfound) {
1607             $renewokay = 0;
1608         }
1609
1610     }
1611     $sth1->finish;
1612     return ($renewokay);
1613 }
1614
1615 =head2 AddRenewal
1616
1617 &AddRenewal($borrowernumber, $itemnumber, $datedue);
1618
1619 Renews a loan.
1620
1621 C<$borrowernumber> is the borrower number of the patron who currently
1622 has the item.
1623
1624 C<$itemnumber> is the number of the item to renew.
1625
1626 C<$datedue> can be used to set the due date. If C<$datedue> is the
1627 empty string, C<&AddRenewal> will calculate the due date automatically
1628 from the book's item type. If you wish to set the due date manually,
1629 C<$datedue> should be in the form YYYY-MM-DD.
1630
1631 =cut
1632
1633 sub AddRenewal {
1634
1635     my ( $borrowernumber, $itemnumber, $datedue ) = @_;
1636     my $dbh = C4::Context->dbh;
1637
1638     # If the due date wasn't specified, calculate it by adding the
1639     # book's loan length to today's date.
1640     if ( $datedue eq "" ) {
1641
1642         my $biblio = GetBiblioFromItemNumber($itemnumber);
1643         my $borrower = GetMemberDetails( $borrowernumber, 0 );
1644         my $loanlength = GetLoanLength(
1645             $borrower->{'categorycode'},
1646             $biblio->{'itemtype'},
1647             $borrower->{'branchcode'}
1648         );
1649         my ( $due_year, $due_month, $due_day ) =
1650           Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
1651         $datedue = "$due_year-$due_month-$due_day";
1652
1653     }
1654
1655     # Find the issues record for this book
1656     my $sth =
1657       $dbh->prepare("SELECT * FROM issues
1658                         WHERE borrowernumber=?
1659                         AND itemnumber=?
1660                         AND returndate IS NULL"
1661       );
1662     $sth->execute( $borrowernumber, $itemnumber );
1663     my $issuedata = $sth->fetchrow_hashref;
1664     $sth->finish;
1665
1666     # Update the issues record to have the new due date, and a new count
1667     # of how many times it has been renewed.
1668     my $renews = $issuedata->{'renewals'} + 1;
1669     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1670                             WHERE borrowernumber=?
1671                             AND itemnumber=?
1672                             AND returndate IS NULL"
1673     );
1674     $sth->execute( $datedue, $renews, $borrowernumber, $itemnumber );
1675     $sth->finish;
1676
1677     # Log the renewal
1678     UpdateStats( C4::Context->userenv->{'branchcode'}, 'renew', '', '', $itemnumber );
1679
1680     # Charge a new rental fee, if applicable?
1681     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1682     if ( $charge > 0 ) {
1683         my $accountno = getnextacctno( $borrowernumber );
1684         my $item = GetBiblioFromItemNumber($itemnumber);
1685         $sth = $dbh->prepare(
1686                 "INSERT INTO accountlines
1687                     (borrowernumber,accountno,date,amount,
1688                         description,accounttype,amountoutstanding,
1689                     itemnumber)
1690                     VALUES (?,?,now(),?,?,?,?,?)"
1691         );
1692         $sth->execute( $borrowernumber, $accountno, $charge,
1693             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1694             'Rent', $charge, $itemnumber );
1695         $sth->finish;
1696     }
1697 }
1698
1699 =head2 GetIssuingCharges
1700
1701 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
1702
1703 Calculate how much it would cost for a given patron to borrow a given
1704 item, including any applicable discounts.
1705
1706 C<$itemnumber> is the item number of item the patron wishes to borrow.
1707
1708 C<$borrowernumber> is the patron's borrower number.
1709
1710 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
1711 and C<$item_type> is the code for the item's item type (e.g., C<VID>
1712 if it's a video).
1713
1714 =cut
1715
1716 sub GetIssuingCharges {
1717
1718     # calculate charges due
1719     my ( $itemnumber, $borrowernumber ) = @_;
1720     my $charge = 0;
1721     my $dbh    = C4::Context->dbh;
1722     my $item_type;
1723
1724     # Get the book's item type and rental charge (via its biblioitem).
1725     my $sth1 = $dbh->prepare(
1726         "SELECT itemtypes.itemtype,rentalcharge FROM items
1727             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1728             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1729             WHERE items.itemnumber =?
1730         "
1731     );
1732     $sth1->execute($itemnumber);
1733     if ( my $data1 = $sth1->fetchrow_hashref ) {
1734         $item_type = $data1->{'itemtype'};
1735         $charge    = $data1->{'rentalcharge'};
1736         my $q2 = "SELECT rentaldiscount FROM borrowers
1737             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
1738             WHERE borrowers.borrowernumber = ?
1739             AND issuingrules.itemtype = ?";
1740         my $sth2 = $dbh->prepare($q2);
1741         $sth2->execute( $borrowernumber, $item_type );
1742         if ( my $data2 = $sth2->fetchrow_hashref ) {
1743             my $discount = $data2->{'rentaldiscount'};
1744             if ( $discount eq 'NULL' ) {
1745                 $discount = 0;
1746             }
1747             $charge = ( $charge * ( 100 - $discount ) ) / 100;
1748         }
1749         $sth2->finish;
1750     }
1751
1752     $sth1->finish;
1753     return ( $charge, $item_type );
1754 }
1755
1756 =head2 AddIssuingCharge
1757
1758 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
1759
1760 =cut
1761
1762 sub AddIssuingCharge {
1763     my ( $itemnumber, $borrowernumber, $charge ) = @_;
1764     my $dbh = C4::Context->dbh;
1765     my $nextaccntno = getnextacctno( $borrowernumber );
1766     my $query ="
1767         INSERT INTO accountlines
1768             (borrowernumber, itemnumber, accountno,
1769             date, amount, description, accounttype,
1770             amountoutstanding)
1771         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
1772     ";
1773     my $sth = $dbh->prepare($query);
1774     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
1775     $sth->finish;
1776 }
1777
1778 =head2 GetTransfers
1779
1780 GetTransfers($itemnumber);
1781
1782 =cut
1783
1784 sub GetTransfers {
1785     my ($itemnumber) = @_;
1786
1787     my $dbh = C4::Context->dbh;
1788
1789     my $query = '
1790         SELECT datesent,
1791                frombranch,
1792                tobranch
1793         FROM branchtransfers
1794         WHERE itemnumber = ?
1795           AND datearrived IS NULL
1796         ';
1797     my $sth = $dbh->prepare($query);
1798     $sth->execute($itemnumber);
1799     my @row = $sth->fetchrow_array();
1800     $sth->finish;
1801     return @row;
1802 }
1803
1804
1805 =head2 GetTransfersFromTo
1806
1807 @results = GetTransfersFromTo($frombranch,$tobranch);
1808
1809 Returns the list of pending transfers between $from and $to branch
1810
1811 =cut
1812
1813 sub GetTransfersFromTo {
1814     my ( $frombranch, $tobranch ) = @_;
1815     return unless ( $frombranch && $tobranch );
1816     my $dbh   = C4::Context->dbh;
1817     my $query = "
1818         SELECT itemnumber,datesent,frombranch
1819         FROM   branchtransfers
1820         WHERE  frombranch=?
1821           AND  tobranch=?
1822           AND datearrived IS NULL
1823     ";
1824     my $sth = $dbh->prepare($query);
1825     $sth->execute( $frombranch, $tobranch );
1826     my @gettransfers;
1827
1828     while ( my $data = $sth->fetchrow_hashref ) {
1829         push @gettransfers, $data;
1830     }
1831     $sth->finish;
1832     return (@gettransfers);
1833 }
1834
1835 =head2 DeleteTransfer
1836
1837 &DeleteTransfer($itemnumber);
1838
1839 =cut
1840
1841 sub DeleteTransfer {
1842     my ($itemnumber) = @_;
1843     my $dbh          = C4::Context->dbh;
1844     my $sth          = $dbh->prepare(
1845         "DELETE FROM branchtransfers
1846          WHERE itemnumber=?
1847          AND datearrived IS NULL "
1848     );
1849     $sth->execute($itemnumber);
1850     $sth->finish;
1851 }
1852
1853 =head2 AnonymiseIssueHistory
1854
1855 $rows = AnonymiseIssueHistory($borrowernumber,$date)
1856
1857 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
1858 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
1859
1860 return the number of affected rows.
1861
1862 =cut
1863
1864 sub AnonymiseIssueHistory {
1865     my $date           = shift;
1866     my $borrowernumber = shift;
1867     my $dbh            = C4::Context->dbh;
1868     my $query          = "
1869         UPDATE issues
1870         SET    borrowernumber = NULL
1871         WHERE  returndate < '".$date."'
1872           AND borrowernumber IS NOT NULL
1873     ";
1874     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
1875     my $rows_affected = $dbh->do($query);
1876     return $rows_affected;
1877 }
1878
1879 =head2 updateWrongTransfer
1880
1881 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
1882
1883 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
1884
1885 =cut
1886
1887 sub updateWrongTransfer {
1888         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
1889         my $dbh = C4::Context->dbh;
1890 # first step validate the actual line of transfert .
1891         my $sth =
1892                 $dbh->prepare(
1893                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
1894                 );
1895                 $sth->execute($FromLibrary,$itemNumber);
1896                 $sth->finish;
1897
1898 # second step create a new line of branchtransfer to the right location .
1899         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
1900
1901 #third step changing holdingbranch of item
1902         UpdateHoldingbranch($FromLibrary,$itemNumber);
1903 }
1904
1905 =head2 UpdateHoldingbranch
1906
1907 $items = UpdateHoldingbranch($branch,$itmenumber);
1908 Simple methode for updating hodlingbranch in items BDD line
1909 =cut
1910
1911 sub UpdateHoldingbranch {
1912         my ( $branch,$itmenumber ) = @_;
1913         my $dbh = C4::Context->dbh;
1914 # first step validate the actual line of transfert .
1915         my $sth =
1916                 $dbh->prepare(
1917                         "update items set holdingbranch = ? where itemnumber= ?"
1918                 );
1919                 $sth->execute($branch,$itmenumber);
1920                 $sth->finish;
1921
1922
1923 }
1924 =head2 CheckValidDatedue
1925
1926 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
1927 this function return a new date due after checked if it's a repeatable or special holiday
1928 C<$date_due>   = returndate calculate with no day check
1929 C<$itemnumber>  = itemnumber
1930 C<$branchcode>  = localisation of issue
1931 =cut
1932 sub CheckValidDatedue{
1933 my ($date_due,$itemnumber,$branchcode)=@_;
1934 my @datedue=split('-',$date_due);
1935 my $years=$datedue[0];
1936 my $month=$datedue[1];
1937 my $day=$datedue[2];
1938 my $dow;
1939 for (my $i=0;$i<2;$i++){
1940         $dow=Day_of_Week($years,$month,$day);
1941         ($dow=0) if ($dow>6);
1942         my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
1943         my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
1944                 if (($result ne '0') or ($countspecial ne '0') ){
1945                 $i=0;
1946                 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
1947                 }
1948         }
1949 my $newdatedue=$years."-".$month."-".$day;
1950 return $newdatedue;
1951 }
1952 =head2 CheckRepeatableHolidays
1953
1954 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
1955 this function check if the date due is a repeatable holiday
1956 C<$date_due>   = returndate calculate with no day check
1957 C<$itemnumber>  = itemnumber
1958 C<$branchcode>  = localisation of issue
1959
1960 =cut
1961
1962 sub CheckRepeatableHolidays{
1963 my($itemnumber,$week_day,$branchcode)=@_;
1964 my $dbh = C4::Context->dbh;
1965 my $query = qq|SELECT count(*)
1966         FROM repeatable_holidays
1967         WHERE branchcode=?
1968         AND weekday=?|;
1969 my $sth = $dbh->prepare($query);
1970 $sth->execute($branchcode,$week_day);
1971 my $result=$sth->fetchrow;
1972 $sth->finish;
1973 return $result;
1974 }
1975
1976
1977 =head2 CheckSpecialHolidays
1978
1979 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
1980 this function check if the date is a special holiday
1981 C<$years>   = the years of datedue
1982 C<$month>   = the month of datedue
1983 C<$day>     = the day of datedue
1984 C<$itemnumber>  = itemnumber
1985 C<$branchcode>  = localisation of issue
1986 =cut
1987 sub CheckSpecialHolidays{
1988 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
1989 my $dbh = C4::Context->dbh;
1990 my $query=qq|SELECT count(*)
1991              FROM `special_holidays`
1992              WHERE year=?
1993              AND month=?
1994              AND day=?
1995              AND branchcode=?
1996             |;
1997 my $sth = $dbh->prepare($query);
1998 $sth->execute($years,$month,$day,$branchcode);
1999 my $countspecial=$sth->fetchrow ;
2000 $sth->finish;
2001 return $countspecial;
2002 }
2003
2004 sub CheckValidBarcode{
2005 my ($barcode) = @_;
2006 my $dbh = C4::Context->dbh;
2007 my $query=qq|SELECT count(*)
2008              FROM items
2009              WHERE barcode=?
2010             |;
2011 my $sth = $dbh->prepare($query);
2012 $sth->execute($barcode);
2013 my $exist=$sth->fetchrow ;
2014 $sth->finish;
2015 return $exist;
2016 }
2017
2018 1;
2019
2020 __END__
2021
2022 =head1 AUTHOR
2023
2024 Koha Developement team <info@koha.org>
2025
2026 =cut
2027