C4/Circulation.pm

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