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 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
 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 ( $borrower->{'dateexpiry'} eq '0000-00-00') {
 685         $issuingimpossible{EXPIRED} = 1;
 686     } else {
 687         if ( Date_to_Days(Today) >
 688             Date_to_Days( split "-", $borrower->{'dateexpiry'} ) )
 689         {
 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             $needsconfirmation{RENEW_ISSUE} = 1;
 766         }
 767     }
 768     elsif ($issue->{borrowernumber}) {
 769
 770         # issued to someone else
 771         my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
 772
 773 #        warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
 774         $needsconfirmation{ISSUED_TO_ANOTHER} =
 775 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
 776     }
 777
 778     # See if the item is on reserve.
 779     my ( $restype, $res ) = CheckReserves( $item->{'itemnumber'} );
 780     if ($restype) {
 781         my $resbor = $res->{'borrowernumber'};
 782         if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
 783         {
 784
 785             # The item is on reserve and waiting, but has been
 786             # reserved by some other patron.
 787             my ( $resborrower, $flags ) =
 788               GetMemberDetails( $resbor, 0 );
 789             my $branches   = GetBranches();
 790             my $branchname =
 791               $branches->{ $res->{'branchcode'} }->{'branchname'};
 792             $needsconfirmation{RESERVE_WAITING} =
 793 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
 794
 795 # CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine.
 796         }
 797         elsif ( $restype eq "Reserved" ) {
 798
 799             # The item is on reserve for someone else.
 800             my ( $resborrower, $flags ) =
 801               GetMemberDetails( $resbor, 0 );
 802             my $branches   = GetBranches();
 803             my $branchname =
 804               $branches->{ $res->{'branchcode'} }->{'branchname'};
 805             $needsconfirmation{RESERVED} =
 806 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
 807         }
 808     }
 809     if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) {
 810         if ( $borrower->{'categorycode'} eq 'W' ) {
 811             my %issuingimpossible;
 812             return ( \%issuingimpossible, \%needsconfirmation );
 813         } else {
 814             return ( \%issuingimpossible, \%needsconfirmation );
 815         }
 816     } else {
 817         return ( \%issuingimpossible, \%needsconfirmation );
 818     }
 819 }
 820
 821 =head2 AddIssue
 822
 823 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
 824
 825 &AddIssue($borrower,$barcode,$date)
 826
 827 =over 4
 828
 829 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
 830
 831 =item C<$barcode> is the bar code of the book being issued.
 832
 833 =item C<$date> contains the max date of return. calculated if empty.
 834
 835 AddIssue does the following things :
 836 - step 01: check that there is a borrowernumber & a barcode provided
 837 - check for RENEWAL (book issued & being issued to the same patron)
 838     - renewal YES = Calculate Charge & renew
 839     - renewal NO  =
 840         * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
 841         * RESERVE PLACED ?
 842             - fill reserve if reserve to this patron
 843             - cancel reserve or not, otherwise
 844         * TRANSFERT PENDING ?
 845             - complete the transfert
 846         * ISSUE THE BOOK
 847
 848 =back
 849
 850 =cut
 851
 852 sub AddIssue {
 853     my ( $borrower, $barcode, $date, $cancelreserve ) = @_;
 854     my $dbh = C4::Context->dbh;
 855 my $barcodecheck=CheckValidBarcode($barcode);
 856 if ($borrower and $barcode and $barcodecheck ne '0'){
 857 #   my ($borrower, $flags) = &GetMemberDetails($borrowernumber, 0);
 858     # find which item we issue
 859     my $item = GetItem('', $barcode);
 860
 861     # get actual issuing if there is one
 862     my $actualissue = GetItemIssue( $item->{itemnumber});
 863
 864     # get biblioinformation for this item
 865     my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
 866
 867     #
 868     # check if we just renew the issue.
 869     #
 870     if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
 871         # we renew, do we need to add some charge ?
 872         my ( $charge, $itemtype ) = GetIssuingCharges(
 873             $item->{'itemnumber'},
 874             $borrower->{'borrowernumber'}
 875         );
 876         if ( $charge > 0 ) {
 877             AddIssuingCharge(
 878                 $item->{'itemnumber'},
 879                 $borrower->{'borrowernumber'}, $charge
 880             );
 881             $item->{'charge'} = $charge;
 882         }
 883         &UpdateStats(
 884             C4::Context->userenv->{'branch'},
 885             'renew',                        $charge,
 886             '',                             $item->{'itemnumber'},
 887             $biblio->{'itemtype'}, $borrower->{'borrowernumber'}
 888         );
 889         AddRenewal(
 890             $borrower->{'borrowernumber'},
 891             $item->{'itemnumber'}
 892         );
 893     }
 894     else {# it's NOT a renewal
 895         if ( $actualissue->{borrowernumber}) {
 896             # This book is currently on loan, but not to the person
 897             # who wants to borrow it now. mark it returned before issuing to the new borrower
 898             AddReturn(
 899                 $item->{'barcode'},
 900                 C4::Context->userenv->{'branch'}
 901             );
 902         }
 903
 904         # See if the item is on reserve.
 905         my ( $restype, $res ) =
 906           CheckReserves( $item->{'itemnumber'} );
 907         if ($restype) {
 908             my $resbor = $res->{'borrowernumber'};
 909             if ( $resbor eq $borrower->{'borrowernumber'} ) {
 910
 911                 # The item is reserved by the current patron
 912                 ModReserveFill($res);
 913             }
 914             elsif ( $restype eq "Waiting" ) {
 915
 916                 # warn "Waiting";
 917                 # The item is on reserve and waiting, but has been
 918                 # reserved by some other patron.
 919                 my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
 920                 my $branches   = GetBranches();
 921                 my $branchname =
 922                   $branches->{ $res->{'branchcode'} }->{'branchname'};
 923             }
 924             elsif ( $restype eq "Reserved" ) {
 925
 926                 # warn "Reserved";
 927                 # The item is reserved by someone else.
 928                 my ( $resborrower, $flags ) =
 929                   GetMemberDetails( $resbor, 0 );
 930                 my $branches   = GetBranches();
 931                 my $branchname =
 932                   $branches->{ $res->{'branchcode'} }->{'branchname'};
 933                 if ($cancelreserve) { # cancel reserves on this item
 934                     CancelReserve( 0, $res->{'itemnumber'},
 935                         $res->{'borrowernumber'} );
 936                 }
 937             }
 938             if ($cancelreserve) {
 939                 CancelReserve( $res->{'biblionumber'}, 0,
 940                     $res->{'borrowernumber'} );
 941             }
 942             else {
 943     # set waiting reserve to first in reserve queue as book isn't waiting now
 944                 ModReserve(
 945                     1,
 946                     $res->{'biblionumber'},
 947                     $res->{'borrowernumber'},
 948                     $res->{'branchcode'}
 949                 );
 950             }
 951         }
 952
 953         # Starting process for transfer job (checking transfert and validate it if we have one)
 954             my ($datesent) = GetTransfers($item->{'itemnumber'});
 955             if ($datesent) {
 956         #       updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
 957             my $sth =
 958                     $dbh->prepare(
 959                     "UPDATE branchtransfers
 960                         SET datearrived = now(),
 961                         tobranch = ?,
 962                         comments = 'Forced branchtransfert'
 963                     WHERE itemnumber= ? AND datearrived IS NULL"
 964                     );
 965                     $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
 966                     $sth->finish;
 967             }
 968
 969         # Record in the database the fact that the book was issued.
 970         my $sth =
 971           $dbh->prepare(
 972                 "INSERT INTO issues
 973                     (borrowernumber, itemnumber,issuedate, date_due, branchcode)
 974                 VALUES (?,?,?,?,?)"
 975           );
 976         my $loanlength = GetLoanLength(
 977             $borrower->{'categorycode'},
 978             $biblio->{'itemtype'},
 979             $borrower->{'branchcode'}
 980         );
 981         my $datedue  = time + ($loanlength) * 86400;
 982         my @datearr  = localtime($datedue);
 983         my $dateduef =
 984             sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]);
 985         if ($date) {
 986             $dateduef = $date;
 987         }
 988        $dateduef=CheckValidDatedue($dateduef,$item->{'itemnumber'},C4::Context->userenv->{'branch'});
 989        # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
 990         if ( C4::Context->preference('ReturnBeforeExpiry')
 991             && $dateduef gt $borrower->{dateexpiry} )
 992         {
 993             $dateduef = $borrower->{dateexpiry};
 994         }
 995         $sth->execute(
 996             $borrower->{'borrowernumber'},
 997             $item->{'itemnumber'},
 998             strftime( "%Y-%m-%d", localtime ),$dateduef, C4::Context->userenv->{'branch'}
 999         );
1000         $sth->finish;
1001         $item->{'issues'}++;
1002         $sth =
1003           $dbh->prepare(
1004             "UPDATE items SET issues=?, holdingbranch=?, itemlost=0, datelastborrowed  = now() WHERE itemnumber=?");
1005         $sth->execute(
1006             $item->{'issues'},
1007             C4::Context->userenv->{'branch'},
1008             $item->{'itemnumber'}
1009         );
1010         $sth->finish;
1011         &ModDateLastSeen( $item->{'itemnumber'} );
1012         # If it costs to borrow this book, charge it to the patron's account.
1013         my ( $charge, $itemtype ) = GetIssuingCharges(
1014             $item->{'itemnumber'},
1015             $borrower->{'borrowernumber'}
1016         );
1017         if ( $charge > 0 ) {
1018             AddIssuingCharge(
1019                 $item->{'itemnumber'},
1020                 $borrower->{'borrowernumber'}, $charge
1021             );
1022             $item->{'charge'} = $charge;
1023         }
1024
1025         # Record the fact that this book was issued.
1026         &UpdateStats(
1027             C4::Context->userenv->{'branch'},
1028             'issue',                        $charge,
1029             '',                             $item->{'itemnumber'},
1030             $item->{'itemtype'}, $borrower->{'borrowernumber'}
1031         );
1032     }
1033
1034     &logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$biblio->{'biblionumber'})
1035         if C4::Context->preference("IssueLog");
1036   }
1037 }
1038
1039 =head2 GetLoanLength
1040
1041 Get loan length for an itemtype, a borrower type and a branch
1042
1043 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1044
1045 =cut
1046
1047 sub GetLoanLength {
1048     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1049     my $dbh = C4::Context->dbh;
1050     my $sth =
1051       $dbh->prepare(
1052 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=?"
1053       );
1054
1055 # try to find issuelength & return the 1st available.
1056 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1057     $sth->execute( $borrowertype, $itemtype, $branchcode );
1058     my $loanlength = $sth->fetchrow_hashref;
1059     return $loanlength->{issuelength}
1060       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1061
1062     $sth->execute( $borrowertype, $itemtype, "" );
1063     $loanlength = $sth->fetchrow_hashref;
1064     return $loanlength->{issuelength}
1065       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1066
1067     $sth->execute( $borrowertype, "*", $branchcode );
1068     $loanlength = $sth->fetchrow_hashref;
1069     return $loanlength->{issuelength}
1070       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1071
1072     $sth->execute( "*", $itemtype, $branchcode );
1073     $loanlength = $sth->fetchrow_hashref;
1074     return $loanlength->{issuelength}
1075       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1076
1077     $sth->execute( $borrowertype, "*", "" );
1078     $loanlength = $sth->fetchrow_hashref;
1079     return $loanlength->{issuelength}
1080       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1081
1082     $sth->execute( "*", "*", $branchcode );
1083     $loanlength = $sth->fetchrow_hashref;
1084     return $loanlength->{issuelength}
1085       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1086
1087     $sth->execute( "*", $itemtype, "" );
1088     $loanlength = $sth->fetchrow_hashref;
1089     return $loanlength->{issuelength}
1090       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1091
1092     $sth->execute( "*", "*", "" );
1093     $loanlength = $sth->fetchrow_hashref;
1094     return $loanlength->{issuelength}
1095       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1096
1097     # if no rule is set => 21 days (hardcoded)
1098     return 21;
1099 }
1100
1101 =head2 AddReturn
1102
1103 ($doreturn, $messages, $iteminformation, $borrower) =
1104     &AddReturn($barcode, $branch);
1105
1106 Returns a book.
1107
1108 C<$barcode> is the bar code of the book being returned. C<$branch> is
1109 the code of the branch where the book is being returned.
1110
1111 C<&AddReturn> returns a list of four items:
1112
1113 C<$doreturn> is true iff the return succeeded.
1114
1115 C<$messages> is a reference-to-hash giving the reason for failure:
1116
1117 =over 4
1118
1119 =item C<BadBarcode>
1120
1121 No item with this barcode exists. The value is C<$barcode>.
1122
1123 =item C<NotIssued>
1124
1125 The book is not currently on loan. The value is C<$barcode>.
1126
1127 =item C<IsPermanent>
1128
1129 The book's home branch is a permanent collection. If you have borrowed
1130 this book, you are not allowed to return it. The value is the code for
1131 the book's home branch.
1132
1133 =item C<wthdrawn>
1134
1135 This book has been withdrawn/cancelled. The value should be ignored.
1136
1137 =item C<ResFound>
1138
1139 The item was reserved. The value is a reference-to-hash whose keys are
1140 fields from the reserves table of the Koha database, and
1141 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1142 either C<Waiting>, C<Reserved>, or 0.
1143
1144 =back
1145
1146 C<$borrower> is a reference-to-hash, giving information about the
1147 patron who last borrowed the book.
1148
1149 =cut
1150
1151 sub AddReturn {
1152     my ( $barcode, $branch ) = @_;
1153     my $dbh      = C4::Context->dbh;
1154     my $messages;
1155     my $doreturn = 1;
1156     my $borrower;
1157     my $validTransfert = 0;
1158     my $reserveDone = 0;
1159
1160     # get information on item
1161     my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1162     unless ($iteminformation->{'itemnumber'} ) {
1163         $messages->{'BadBarcode'} = $barcode;
1164         $doreturn = 0;
1165     } else {
1166         # find the borrower
1167         if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1168             $messages->{'NotIssued'} = $barcode;
1169             $doreturn = 0;
1170         }
1171
1172         # check if the book is in a permanent collection....
1173         my $hbr      = $iteminformation->{'homebranch'};
1174         my $branches = GetBranches();
1175         if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1176             $messages->{'IsPermanent'} = $hbr;
1177         }
1178
1179         # check that the book has been cancelled
1180         if ( $iteminformation->{'wthdrawn'} ) {
1181             $messages->{'wthdrawn'} = 1;
1182             $doreturn = 0;
1183         }
1184
1185     #     new op dev : if the book returned in an other branch update the holding branch
1186
1187     # update issues, thereby returning book (should push this out into another subroutine
1188         $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1189
1190     # case of a return of document (deal with issues and holdingbranch)
1191
1192         if ($doreturn) {
1193             my $sth =
1194             $dbh->prepare(
1195     "UPDATE issues SET returndate = now() WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (returndate IS NULL)"
1196             );
1197             $sth->execute( $borrower->{'borrowernumber'},
1198                 $iteminformation->{'itemnumber'} );
1199             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?
1200         }
1201
1202     # continue to deal with returns cases, but not only if we have an issue
1203
1204     # the holdingbranch is updated if the document is returned in an other location .
1205     if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} )
1206             {
1207                     UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1208     #           reload iteminformation holdingbranch with the userenv value
1209                     $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1210             }
1211         ModDateLastSeen( $iteminformation->{'itemnumber'} );
1212         ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1213
1214         # fix up the accounts.....
1215         if ( $iteminformation->{'itemlost'} ) {
1216             $messages->{'WasLost'} = 1;
1217         }
1218
1219     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1220     #     check if we have a transfer for this document
1221         my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1222
1223     #     if we have a transfer to do, we update the line of transfers with the datearrived
1224         if ($datesent) {
1225             if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1226                     my $sth =
1227                     $dbh->prepare(
1228                             "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1229                     );
1230                     $sth->execute( $iteminformation->{'itemnumber'} );
1231                     $sth->finish;
1232     #         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'
1233             C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1234             }
1235         else {
1236             $messages->{'WrongTransfer'} = $tobranch;
1237             $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1238         }
1239         $validTransfert = 1;
1240         }
1241
1242     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1243         # fix up the accounts.....
1244         if ($iteminformation->{'itemlost'}) {
1245                 FixAccountForLostAndReturned($iteminformation, $borrower);
1246                 $messages->{'WasLost'} = 1;
1247         }
1248         # fix up the overdues in accounts...
1249         FixOverduesOnReturn( $borrower->{'borrowernumber'},
1250             $iteminformation->{'itemnumber'} );
1251
1252     # find reserves.....
1253     #     if we don't have a reserve with the status W, we launch the Checkreserves routine
1254         my ( $resfound, $resrec ) =
1255         C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1256         if ($resfound) {
1257             $resrec->{'ResFound'}   = $resfound;
1258             $messages->{'ResFound'} = $resrec;
1259             $reserveDone = 1;
1260         }
1261
1262         # update stats?
1263         # Record the fact that this book was returned.
1264         UpdateStats(
1265             $branch, 'return', '0', '',
1266             $iteminformation->{'itemnumber'},
1267             $iteminformation->{'itemtype'},
1268             $borrower->{'borrowernumber'}
1269         );
1270
1271         &logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$iteminformation->{borrowernumber},$iteminformation->{'biblionumber'})
1272             if C4::Context->preference("ReturnLog");
1273
1274         #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1275         #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1276
1277         if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1278                     if (C4::Context->preference("AutomaticItemReturn") == 1) {
1279                     ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1280                     $messages->{'WasTransfered'} = 1;
1281                     warn "was transfered";
1282                     }
1283         }
1284     }
1285     return ( $doreturn, $messages, $iteminformation, $borrower );
1286 }
1287
1288 =head2 FixOverduesOnReturn
1289
1290     &FixOverduesOnReturn($brn,$itm);
1291
1292 C<$brn> borrowernumber
1293
1294 C<$itm> itemnumber
1295
1296 internal function, called only by AddReturn
1297
1298 =cut
1299
1300 sub FixOverduesOnReturn {
1301     my ( $borrowernumber, $item ) = @_;
1302     my $dbh = C4::Context->dbh;
1303
1304     # check for overdue fine
1305     my $sth =
1306       $dbh->prepare(
1307 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1308       );
1309     $sth->execute( $borrowernumber, $item );
1310
1311     # alter fine to show that the book has been returned
1312     if ( my $data = $sth->fetchrow_hashref ) {
1313         my $usth =
1314           $dbh->prepare(
1315 "UPDATE accountlines SET accounttype='F' WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accountno = ?)"
1316           );
1317         $usth->execute( $borrowernumber, $item, $data->{'accountno'} );
1318         $usth->finish();
1319     }
1320     $sth->finish();
1321     return;
1322 }
1323
1324 =head2 FixAccountForLostAndReturned
1325
1326         &FixAccountForLostAndReturned($iteminfo,$borrower);
1327
1328 Calculates the charge for a book lost and returned (Not exported & used only once)
1329
1330 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1331
1332 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1333
1334 Internal function, called by AddReturn
1335
1336 =cut
1337
1338 sub FixAccountForLostAndReturned {
1339         my ($iteminfo, $borrower) = @_;
1340         my %env;
1341         my $dbh = C4::Context->dbh;
1342         my $itm = $iteminfo->{'itemnumber'};
1343         # check for charge made for lost book
1344         my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1345         $sth->execute($itm);
1346         if (my $data = $sth->fetchrow_hashref) {
1347         # writeoff this amount
1348                 my $offset;
1349                 my $amount = $data->{'amount'};
1350                 my $acctno = $data->{'accountno'};
1351                 my $amountleft;
1352                 if ($data->{'amountoutstanding'} == $amount) {
1353                 $offset = $data->{'amount'};
1354                 $amountleft = 0;
1355                 } else {
1356                 $offset = $amount - $data->{'amountoutstanding'};
1357                 $amountleft = $data->{'amountoutstanding'} - $amount;
1358                 }
1359                 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1360                         WHERE (borrowernumber = ?)
1361                         AND (itemnumber = ?) AND (accountno = ?) ");
1362                 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1363                 $usth->finish;
1364         #check if any credit is left if so writeoff other accounts
1365                 my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
1366                 if ($amountleft < 0){
1367                 $amountleft*=-1;
1368                 }
1369                 if ($amountleft > 0){
1370                 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1371                                                         AND (amountoutstanding >0) ORDER BY date");
1372                 $msth->execute($data->{'borrowernumber'});
1373         # offset transactions
1374                 my $newamtos;
1375                 my $accdata;
1376                 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1377                         if ($accdata->{'amountoutstanding'} < $amountleft) {
1378                         $newamtos = 0;
1379                         $amountleft -= $accdata->{'amountoutstanding'};
1380                         }  else {
1381                         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1382                         $amountleft = 0;
1383                         }
1384                         my $thisacct = $accdata->{'accountno'};
1385                         my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1386                                         WHERE (borrowernumber = ?)
1387                                         AND (accountno=?)");
1388                         $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1389                         $usth->finish;
1390                         $usth = $dbh->prepare("INSERT INTO accountoffsets
1391                                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1392                                 VALUES
1393                                 (?,?,?,?)");
1394                         $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1395                         $usth->finish;
1396                 }
1397                 $msth->finish;
1398                 }
1399                 if ($amountleft > 0){
1400                         $amountleft*=-1;
1401                 }
1402                 my $desc="Book Returned ".$iteminfo->{'barcode'};
1403                 $usth = $dbh->prepare("INSERT INTO accountlines
1404                         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1405                         VALUES (?,?,now(),?,?,'CR',?)");
1406                 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1407                 $usth->finish;
1408                 $usth = $dbh->prepare("INSERT INTO accountoffsets
1409                         (borrowernumber, accountno, offsetaccount,  offsetamount)
1410                         VALUES (?,?,?,?)");
1411                 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1412                 $usth->finish;
1413                 $usth = $dbh->prepare("UPDATE items SET paidfor='' WHERE itemnumber=?");
1414                 $usth->execute($itm);
1415                 $usth->finish;
1416         }
1417         $sth->finish;
1418         return;
1419 }
1420
1421 =head2 GetItemIssue
1422
1423 $issues = &GetItemIssue($itemnumber);
1424
1425 Returns patrons currently having a book. nothing if item is not issued atm
1426
1427 C<$itemnumber> is the itemnumber
1428
1429 Returns an array of hashes
1430 =cut
1431
1432 sub GetItemIssue {
1433     my ( $itemnumber) = @_;
1434     return unless $itemnumber;
1435     my $dbh = C4::Context->dbh;
1436     my @GetItemIssues;
1437
1438     # get today date
1439     my $today = POSIX::strftime("%Y%m%d", localtime);
1440
1441     my $sth = $dbh->prepare(
1442         "SELECT * FROM issues
1443         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1444     WHERE
1445     issues.itemnumber=?  AND returndate IS NULL ");
1446     $sth->execute($itemnumber);
1447     my $data = $sth->fetchrow_hashref;
1448     my $datedue = $data->{'date_due'};
1449     $datedue =~ s/-//g;
1450     if ( $datedue < $today ) {
1451         $data->{'overdue'} = 1;
1452     }
1453     $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1454     $sth->finish;
1455     return ($data);
1456 }
1457
1458 =head2 GetItemIssues
1459
1460 $issues = &GetItemIssues($itemnumber, $history);
1461
1462 Returns patrons that have issued a book
1463
1464 C<$itemnumber> is the itemnumber
1465 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1466
1467 Returns an array of hashes
1468 =cut
1469
1470 sub GetItemIssues {
1471     my ( $itemnumber,$history ) = @_;
1472     my $dbh = C4::Context->dbh;
1473     my @GetItemIssues;
1474
1475     # get today date
1476     my $today = POSIX::strftime("%Y%m%d", localtime);
1477
1478     my $sth = $dbh->prepare(
1479         "SELECT * FROM issues
1480     WHERE
1481     itemnumber=?".($history?"":" AND returndate IS NULL ").
1482     "ORDER BY issues.date_due DESC"
1483     );
1484     $sth->execute($itemnumber);
1485     while ( my $data = $sth->fetchrow_hashref ) {
1486         my $datedue = $data->{'date_due'};
1487         $datedue =~ s/-//g;
1488         if ( $datedue < $today ) {
1489             $data->{'overdue'} = 1;
1490         }
1491         my $itemnumber = $data->{'itemnumber'};
1492
1493         push @GetItemIssues, $data;
1494     }
1495     $sth->finish;
1496     return ( \@GetItemIssues );
1497 }
1498
1499 =head2 GetBiblioIssues
1500
1501 $issues = GetBiblioIssues($biblionumber);
1502
1503 this function get all issues from a biblionumber.
1504
1505 Return:
1506 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1507 tables issues and the firstname,surname & cardnumber from borrowers.
1508
1509 =cut
1510
1511 sub GetBiblioIssues {
1512     my $biblionumber = shift;
1513     return undef unless $biblionumber;
1514     my $dbh   = C4::Context->dbh;
1515     my $query = "
1516         SELECT issues.*,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1517         FROM issues
1518             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1519             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1520             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1521             LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1522         WHERE biblio.biblionumber = ?
1523         ORDER BY issues.timestamp
1524     ";
1525     my $sth = $dbh->prepare($query);
1526     $sth->execute($biblionumber);
1527
1528     my @issues;
1529     while ( my $data = $sth->fetchrow_hashref ) {
1530         push @issues, $data;
1531     }
1532     return \@issues;
1533 }
1534
1535 =head2 CanBookBeRenewed
1536
1537 $ok = &CanBookBeRenewed($borrowernumber, $itemnumber);
1538
1539 Find out whether a borrowed item may be renewed.
1540
1541 C<$dbh> is a DBI handle to the Koha database.
1542
1543 C<$borrowernumber> is the borrower number of the patron who currently
1544 has the item on loan.
1545
1546 C<$itemnumber> is the number of the item to renew.
1547
1548 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1549 item must currently be on loan to the specified borrower; renewals
1550 must be allowed for the item's type; and the borrower must not have
1551 already renewed the loan.
1552
1553 =cut
1554
1555 sub CanBookBeRenewed {
1556
1557     # check renewal status
1558     my ( $borrowernumber, $itemnumber ) = @_;
1559     my $dbh       = C4::Context->dbh;
1560     my $renews    = 1;
1561     my $renewokay = 0;
1562
1563     # Look in the issues table for this item, lent to this borrower,
1564     # and not yet returned.
1565
1566     # FIXME - I think this function could be redone to use only one SQL call.
1567     my $sth1 = $dbh->prepare(
1568         "SELECT * FROM issues
1569             WHERE borrowernumber = ?
1570             AND itemnumber = ?
1571             AND returndate IS NULL"
1572     );
1573     $sth1->execute( $borrowernumber, $itemnumber );
1574     if ( my $data1 = $sth1->fetchrow_hashref ) {
1575
1576         # Found a matching item
1577
1578         # See if this item may be renewed. This query is convoluted
1579         # because it's a bit messy: given the item number, we need to find
1580         # the biblioitem, which gives us the itemtype, which tells us
1581         # whether it may be renewed.
1582         my $sth2 = $dbh->prepare(
1583             "SELECT renewalsallowed FROM items
1584                 LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1585                 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1586                 WHERE items.itemnumber = ?
1587                 "
1588         );
1589         $sth2->execute($itemnumber);
1590         if ( my $data2 = $sth2->fetchrow_hashref ) {
1591             $renews = $data2->{'renewalsallowed'};
1592         }
1593         if ( $renews && $renews >= $data1->{'renewals'} ) {
1594             $renewokay = 1;
1595         }
1596         $sth2->finish;
1597         my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1598         if ($resfound) {
1599             $renewokay = 0;
1600         }
1601
1602     }
1603     $sth1->finish;
1604     return ($renewokay);
1605 }
1606
1607 =head2 AddRenewal
1608
1609 &AddRenewal($borrowernumber, $itemnumber, $datedue);
1610
1611 Renews a loan.
1612
1613 C<$borrowernumber> is the borrower number of the patron who currently
1614 has the item.
1615
1616 C<$itemnumber> is the number of the item to renew.
1617
1618 C<$datedue> can be used to set the due date. If C<$datedue> is the
1619 empty string, C<&AddRenewal> will calculate the due date automatically
1620 from the book's item type. If you wish to set the due date manually,
1621 C<$datedue> should be in the form YYYY-MM-DD.
1622
1623 =cut
1624
1625 sub AddRenewal {
1626
1627     my ( $borrowernumber, $itemnumber, $branch ,$datedue ) = @_;
1628     my $dbh = C4::Context->dbh;
1629
1630     # If the due date wasn't specified, calculate it by adding the
1631     # book's loan length to today's date.
1632     if ( $datedue eq "" ) {
1633
1634         my $biblio = GetBiblioFromItemNumber($itemnumber);
1635         my $borrower = GetMemberDetails( $borrowernumber, 0 );
1636         my $loanlength = GetLoanLength(
1637             $borrower->{'categorycode'},
1638             $biblio->{'itemtype'},
1639             $borrower->{'branchcode'}
1640         );
1641         my ( $due_year, $due_month, $due_day ) =
1642           Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
1643         $datedue = "$due_year-$due_month-$due_day";
1644         $datedue=CheckValidDatedue($datedue,$itemnumber,$branch);
1645     }
1646
1647     # Find the issues record for this book
1648     my $sth =
1649       $dbh->prepare("SELECT * FROM issues
1650                         WHERE borrowernumber=?
1651                         AND itemnumber=?
1652                         AND returndate IS NULL"
1653       );
1654     $sth->execute( $borrowernumber, $itemnumber );
1655     my $issuedata = $sth->fetchrow_hashref;
1656     $sth->finish;
1657
1658     # Update the issues record to have the new due date, and a new count
1659     # of how many times it has been renewed.
1660     my $renews = $issuedata->{'renewals'} + 1;
1661     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1662                             WHERE borrowernumber=?
1663                             AND itemnumber=?
1664                             AND returndate IS NULL"
1665     );
1666     $sth->execute( $datedue, $renews, $borrowernumber, $itemnumber );
1667     $sth->finish;
1668
1669     # Log the renewal
1670     UpdateStats( C4::Context->userenv->{'branchcode'}, 'renew', '', '', $itemnumber );
1671
1672     # Charge a new rental fee, if applicable?
1673     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1674     if ( $charge > 0 ) {
1675         my $accountno = getnextacctno( $borrowernumber );
1676         my $item = GetBiblioFromItemNumber($itemnumber);
1677         $sth = $dbh->prepare(
1678                 "INSERT INTO accountlines
1679                     (borrowernumber,accountno,date,amount,
1680                         description,accounttype,amountoutstanding,
1681                     itemnumber)
1682                     VALUES (?,?,now(),?,?,?,?,?)"
1683         );
1684         $sth->execute( $borrowernumber, $accountno, $charge,
1685             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1686             'Rent', $charge, $itemnumber );
1687         $sth->finish;
1688     }
1689 }
1690
1691 =head2 GetIssuingCharges
1692
1693 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
1694
1695 Calculate how much it would cost for a given patron to borrow a given
1696 item, including any applicable discounts.
1697
1698 C<$itemnumber> is the item number of item the patron wishes to borrow.
1699
1700 C<$borrowernumber> is the patron's borrower number.
1701
1702 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
1703 and C<$item_type> is the code for the item's item type (e.g., C<VID>
1704 if it's a video).
1705
1706 =cut
1707
1708 sub GetIssuingCharges {
1709
1710     # calculate charges due
1711     my ( $itemnumber, $borrowernumber ) = @_;
1712     my $charge = 0;
1713     my $dbh    = C4::Context->dbh;
1714     my $item_type;
1715
1716     # Get the book's item type and rental charge (via its biblioitem).
1717     my $sth1 = $dbh->prepare(
1718         "SELECT itemtypes.itemtype,rentalcharge FROM items
1719             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1720             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1721             WHERE items.itemnumber =?
1722         "
1723     );
1724     $sth1->execute($itemnumber);
1725     if ( my $data1 = $sth1->fetchrow_hashref ) {
1726         $item_type = $data1->{'itemtype'};
1727         $charge    = $data1->{'rentalcharge'};
1728         my $q2 = "SELECT rentaldiscount FROM borrowers
1729             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
1730             WHERE borrowers.borrowernumber = ?
1731             AND issuingrules.itemtype = ?";
1732         my $sth2 = $dbh->prepare($q2);
1733         $sth2->execute( $borrowernumber, $item_type );
1734         if ( my $data2 = $sth2->fetchrow_hashref ) {
1735             my $discount = $data2->{'rentaldiscount'};
1736             if ( $discount eq 'NULL' ) {
1737                 $discount = 0;
1738             }
1739             $charge = ( $charge * ( 100 - $discount ) ) / 100;
1740         }
1741         $sth2->finish;
1742     }
1743
1744     $sth1->finish;
1745     return ( $charge, $item_type );
1746 }
1747
1748 =head2 AddIssuingCharge
1749
1750 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
1751
1752 =cut
1753
1754 sub AddIssuingCharge {
1755     my ( $itemnumber, $borrowernumber, $charge ) = @_;
1756     my $dbh = C4::Context->dbh;
1757     my $nextaccntno = getnextacctno( $borrowernumber );
1758     my $query ="
1759         INSERT INTO accountlines
1760             (borrowernumber, itemnumber, accountno,
1761             date, amount, description, accounttype,
1762             amountoutstanding)
1763         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
1764     ";
1765     my $sth = $dbh->prepare($query);
1766     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
1767     $sth->finish;
1768 }
1769
1770 =head2 GetTransfers
1771
1772 GetTransfers($itemnumber);
1773
1774 =cut
1775
1776 sub GetTransfers {
1777     my ($itemnumber) = @_;
1778
1779     my $dbh = C4::Context->dbh;
1780
1781     my $query = '
1782         SELECT datesent,
1783                frombranch,
1784                tobranch
1785         FROM branchtransfers
1786         WHERE itemnumber = ?
1787           AND datearrived IS NULL
1788         ';
1789     my $sth = $dbh->prepare($query);
1790     $sth->execute($itemnumber);
1791     my @row = $sth->fetchrow_array();
1792     $sth->finish;
1793     return @row;
1794 }
1795
1796
1797 =head2 GetTransfersFromTo
1798
1799 @results = GetTransfersFromTo($frombranch,$tobranch);
1800
1801 Returns the list of pending transfers between $from and $to branch
1802
1803 =cut
1804
1805 sub GetTransfersFromTo {
1806     my ( $frombranch, $tobranch ) = @_;
1807     return unless ( $frombranch && $tobranch );
1808     my $dbh   = C4::Context->dbh;
1809     my $query = "
1810         SELECT itemnumber,datesent,frombranch
1811         FROM   branchtransfers
1812         WHERE  frombranch=?
1813           AND  tobranch=?
1814           AND datearrived IS NULL
1815     ";
1816     my $sth = $dbh->prepare($query);
1817     $sth->execute( $frombranch, $tobranch );
1818     my @gettransfers;
1819
1820     while ( my $data = $sth->fetchrow_hashref ) {
1821         push @gettransfers, $data;
1822     }
1823     $sth->finish;
1824     return (@gettransfers);
1825 }
1826
1827 =head2 DeleteTransfer
1828
1829 &DeleteTransfer($itemnumber);
1830
1831 =cut
1832
1833 sub DeleteTransfer {
1834     my ($itemnumber) = @_;
1835     my $dbh          = C4::Context->dbh;
1836     my $sth          = $dbh->prepare(
1837         "DELETE FROM branchtransfers
1838          WHERE itemnumber=?
1839          AND datearrived IS NULL "
1840     );
1841     $sth->execute($itemnumber);
1842     $sth->finish;
1843 }
1844
1845 =head2 AnonymiseIssueHistory
1846
1847 $rows = AnonymiseIssueHistory($borrowernumber,$date)
1848
1849 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
1850 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
1851
1852 return the number of affected rows.
1853
1854 =cut
1855
1856 sub AnonymiseIssueHistory {
1857     my $date           = shift;
1858     my $borrowernumber = shift;
1859     my $dbh            = C4::Context->dbh;
1860     my $query          = "
1861         UPDATE issues
1862         SET    borrowernumber = NULL
1863         WHERE  returndate < '".$date."'
1864           AND borrowernumber IS NOT NULL
1865     ";
1866     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
1867     my $rows_affected = $dbh->do($query);
1868     return $rows_affected;
1869 }
1870
1871 =head2 updateWrongTransfer
1872
1873 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
1874
1875 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
1876
1877 =cut
1878
1879 sub updateWrongTransfer {
1880         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
1881         my $dbh = C4::Context->dbh;
1882 # first step validate the actual line of transfert .
1883         my $sth =
1884                 $dbh->prepare(
1885                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
1886                 );
1887                 $sth->execute($FromLibrary,$itemNumber);
1888                 $sth->finish;
1889
1890 # second step create a new line of branchtransfer to the right location .
1891         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
1892
1893 #third step changing holdingbranch of item
1894         UpdateHoldingbranch($FromLibrary,$itemNumber);
1895 }
1896
1897 =head2 UpdateHoldingbranch
1898
1899 $items = UpdateHoldingbranch($branch,$itmenumber);
1900 Simple methode for updating hodlingbranch in items BDD line
1901 =cut
1902
1903 sub UpdateHoldingbranch {
1904         my ( $branch,$itmenumber ) = @_;
1905         my $dbh = C4::Context->dbh;
1906 # first step validate the actual line of transfert .
1907         my $sth =
1908                 $dbh->prepare(
1909                         "update items set holdingbranch = ? where itemnumber= ?"
1910                 );
1911                 $sth->execute($branch,$itmenumber);
1912                 $sth->finish;
1913
1914
1915 }
1916 =head2 CheckValidDatedue
1917
1918 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
1919 this function return a new date due after checked if it's a repeatable or special holiday
1920 C<$date_due>   = returndate calculate with no day check
1921 C<$itemnumber>  = itemnumber
1922 C<$branchcode>  = localisation of issue
1923 =cut
1924 sub CheckValidDatedue{
1925 my ($date_due,$itemnumber,$branchcode)=@_;
1926 my @datedue=split('-',$date_due);
1927 my $years=$datedue[0];
1928 my $month=$datedue[1];
1929 my $day=$datedue[2];
1930 my $dow;
1931 for (my $i=0;$i<2;$i++){
1932         $dow=Day_of_Week($years,$month,$day);
1933         ($dow=0) if ($dow>6);
1934         my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
1935         my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
1936         my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
1937                 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
1938                 $i=0;
1939                 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
1940                 }
1941         }
1942 my $newdatedue=$years."-".$month."-".$day;
1943 return $newdatedue;
1944 }
1945 =head2 CheckRepeatableHolidays
1946
1947 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
1948 this function check if the date due is a repeatable holiday
1949 C<$date_due>   = returndate calculate with no day check
1950 C<$itemnumber>  = itemnumber
1951 C<$branchcode>  = localisation of issue
1952
1953 =cut
1954
1955 sub CheckRepeatableHolidays{
1956 my($itemnumber,$week_day,$branchcode)=@_;
1957 my $dbh = C4::Context->dbh;
1958 my $query = qq|SELECT count(*)
1959         FROM repeatable_holidays
1960         WHERE branchcode=?
1961         AND weekday=?|;
1962 my $sth = $dbh->prepare($query);
1963 $sth->execute($branchcode,$week_day);
1964 my $result=$sth->fetchrow;
1965 $sth->finish;
1966 return $result;
1967 }
1968
1969
1970 =head2 CheckSpecialHolidays
1971
1972 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
1973 this function check if the date is a special holiday
1974 C<$years>   = the years of datedue
1975 C<$month>   = the month of datedue
1976 C<$day>     = the day of datedue
1977 C<$itemnumber>  = itemnumber
1978 C<$branchcode>  = localisation of issue
1979 =cut
1980 sub CheckSpecialHolidays{
1981 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
1982 my $dbh = C4::Context->dbh;
1983 my $query=qq|SELECT count(*)
1984              FROM `special_holidays`
1985              WHERE year=?
1986              AND month=?
1987              AND day=?
1988              AND branchcode=?
1989             |;
1990 my $sth = $dbh->prepare($query);
1991 $sth->execute($years,$month,$day,$branchcode);
1992 my $countspecial=$sth->fetchrow ;
1993 $sth->finish;
1994 return $countspecial;
1995 }
1996
1997 =head2 CheckRepeatableSpecialHolidays
1998
1999 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2000 this function check if the date is a repeatble special holidays
2001 C<$month>   = the month of datedue
2002 C<$day>     = the day of datedue
2003 C<$itemnumber>  = itemnumber
2004 C<$branchcode>  = localisation of issue
2005 =cut
2006 sub CheckRepeatableSpecialHolidays{
2007 my ($month,$day,$itemnumber,$branchcode) = @_;
2008 my $dbh = C4::Context->dbh;
2009 my $query=qq|SELECT count(*)
2010              FROM `repeatable_holidays`
2011              WHERE month=?
2012              AND day=?
2013              AND branchcode=?
2014             |;
2015 my $sth = $dbh->prepare($query);
2016 $sth->execute($month,$day,$branchcode);
2017 my $countspecial=$sth->fetchrow ;
2018 $sth->finish;
2019 return $countspecial;
2020 }
2021
2022
2023
2024 sub CheckValidBarcode{
2025 my ($barcode) = @_;
2026 my $dbh = C4::Context->dbh;
2027 my $query=qq|SELECT count(*)
2028              FROM items
2029              WHERE barcode=?
2030             |;
2031 my $sth = $dbh->prepare($query);
2032 $sth->execute($barcode);
2033 my $exist=$sth->fetchrow ;
2034 $sth->finish;
2035 return $exist;
2036 }
2037
2038 1;
2039
2040 __END__
2041
2042 =head1 AUTHOR
2043
2044 Koha Developement team <info@koha.org>
2045
2046 =cut
2047