C4/Circulation.pm

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