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
 370
 371 sub TooMany ($$) {
 372     my $borrower        = shift;
 373     my $biblionumber = shift;
 374     my $cat_borrower    = $borrower->{'categorycode'};
 375     my $branch_borrower = $borrower->{'branchcode'};
 376     my $dbh             = C4::Context->dbh;
 377
 378     my $sth =
 379       $dbh->prepare('SELECT itemtype FROM biblioitems WHERE biblionumber = ?');
 380     $sth->execute($biblionumber);
 381     my $type = $sth->fetchrow;
 382     $sth =
 383       $dbh->prepare(
 384                 'SELECT * FROM issuingrules
 385                         WHERE categorycode = ?
 386                             AND itemtype = ?
 387                             AND branchcode = ?'
 388       );
 389
 390     my $sth2 =
 391       $dbh->prepare(
 392             "SELECT  COUNT(*) FROM issues i, biblioitems s1, items s2
 393                 WHERE i.borrowernumber = ?
 394                     AND i.returndate IS NULL
 395                     AND i.itemnumber = s2.itemnumber
 396                     AND s1.itemtype LIKE ?
 397                     AND s1.biblioitemnumber = s2.biblioitemnumber"
 398       );
 399     my $sth3 =
 400       $dbh->prepare(
 401             'SELECT COUNT(*) FROM issues
 402                 WHERE borrowernumber = ?
 403                     AND returndate IS NULL'
 404             );
 405     my $alreadyissued;
 406
 407     # check the 3 parameters (branch / itemtype / category code
 408     $sth->execute( $cat_borrower, $type, $branch_borrower );
 409     my $result = $sth->fetchrow_hashref;
 410 #     warn "$cat_borrower, $type, $branch_borrower = ".Data::Dumper::Dumper($result);
 411
 412     if ( $result->{maxissueqty} ne '' ) {
 413 #         warn "checking on everything set";
 414         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
 415         my $alreadyissued = $sth2->fetchrow;
 416         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 417             return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/itemtype failed)" );
 418         }
 419         # now checking for total
 420         $sth->execute( $cat_borrower, '', $branch_borrower );
 421         my $result = $sth->fetchrow_hashref;
 422         if ( $result->{maxissueqty} ne '*' ) {
 423             $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
 424             my $alreadyissued = $sth2->fetchrow;
 425             if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 426                 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/total failed)"  );
 427             }
 428         }
 429     }
 430
 431     # check the 2 parameters (branch / itemtype / default categorycode
 432     $sth->execute( '*', $type, $branch_borrower );
 433     my $result = $sth->fetchrow_hashref;
 434 #     warn "*, $type, $branch_borrower = ".Data::Dumper::Dumper($result);
 435
 436     if ( $result->{maxissueqty} ne '' ) {
 437 #         warn "checking on 2 parameters (default categorycode)";
 438         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
 439         my $alreadyissued = $sth2->fetchrow;
 440         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 441             return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / itemtype failed)"  );
 442         }
 443         # now checking for total
 444         $sth->execute( '*', '*', $branch_borrower );
 445         my $result = $sth->fetchrow_hashref;
 446         if ( $result->{maxissueqty} ne '' ) {
 447             $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
 448             my $alreadyissued = $sth2->fetchrow;
 449             if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 450                 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / total failed)" );
 451             }
 452         }
 453     }
 454
 455     # check the 1 parameters (default branch / itemtype / categorycode
 456     $sth->execute( $cat_borrower, $type, '*' );
 457     my $result = $sth->fetchrow_hashref;
 458 #     warn "$cat_borrower, $type, * = ".Data::Dumper::Dumper($result);
 459
 460     if ( $result->{maxissueqty} ne '' ) {
 461 #         warn "checking on 1 parameter (default branch + categorycode)";
 462         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
 463         my $alreadyissued = $sth2->fetchrow;
 464         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 465             return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch/category/itemtype failed)"  );
 466         }
 467         # now checking for total
 468         $sth->execute( $cat_borrower, '*', '*' );
 469         my $result = $sth->fetchrow_hashref;
 470         if ( $result->{maxissueqty} ne '' ) {
 471             $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
 472             my $alreadyissued = $sth2->fetchrow;
 473             if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 474                 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / category / total failed)"  );
 475             }
 476         }
 477     }
 478
 479     # check the 0 parameters (default branch / itemtype / default categorycode
 480     $sth->execute( '*', $type, '*' );
 481     my $result = $sth->fetchrow_hashref;
 482 #     warn "*, $type, * = ".Data::Dumper::Dumper($result);
 483
 484     if ( $result->{maxissueqty} ne '' ) {
 485 #         warn "checking on default branch and default categorycode";
 486         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
 487         my $alreadyissued = $sth2->fetchrow;
 488         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 489             return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / itemtype failed)"  );
 490         }
 491         # now checking for total
 492         $sth->execute( '*', '*', '*' );
 493         my $result = $sth->fetchrow_hashref;
 494         if ( $result->{maxissueqty} ne '' ) {
 495             $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
 496             my $alreadyissued = $sth2->fetchrow;
 497             if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 498                 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / total failed)"  );
 499             }
 500         }
 501     }
 502
 503     #OK, the patron can issue !!!
 504     return;
 505 }
 506
 507 =head2 itemissues
 508
 509   @issues = &itemissues($biblioitemnumber, $biblio);
 510
 511 Looks up information about who has borrowed the bookZ<>(s) with the
 512 given biblioitemnumber.
 513
 514 C<$biblio> is ignored.
 515
 516 C<&itemissues> returns an array of references-to-hash. The keys
 517 include the fields from the C<items> table in the Koha database.
 518 Additional keys include:
 519
 520 =over 4
 521
 522 =item C<date_due>
 523
 524 If the item is currently on loan, this gives the due date.
 525
 526 If the item is not on loan, then this is either "Available" or
 527 "Cancelled", if the item has been withdrawn.
 528
 529 =item C<card>
 530
 531 If the item is currently on loan, this gives the card number of the
 532 patron who currently has the item.
 533
 534 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
 535
 536 These give the timestamp for the last three times the item was
 537 borrowed.
 538
 539 =item C<card0>, C<card1>, C<card2>
 540
 541 The card number of the last three patrons who borrowed this item.
 542
 543 =item C<borrower0>, C<borrower1>, C<borrower2>
 544
 545 The borrower number of the last three patrons who borrowed this item.
 546
 547 =back
 548
 549 =cut
 550
 551 #'
 552 sub itemissues {
 553     my ( $bibitem, $biblio ) = @_;
 554     my $dbh = C4::Context->dbh;
 555
 556     # FIXME - If this function die()s, the script will abort, and the
 557     # user won't get anything; depending on how far the script has
 558     # gotten, the user might get a blank page. It would be much better
 559     # to at least print an error message. The easiest way to do this
 560     # is to set $SIG{__DIE__}.
 561     my $sth =
 562       $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
 563       || die $dbh->errstr;
 564     my $i = 0;
 565     my @results;
 566
 567     $sth->execute($bibitem) || die $sth->errstr;
 568
 569     while ( my $data = $sth->fetchrow_hashref ) {
 570
 571         # Find out who currently has this item.
 572         # FIXME - Wouldn't it be better to do this as a left join of
 573         # some sort? Currently, this code assumes that if
 574         # fetchrow_hashref() fails, then the book is on the shelf.
 575         # fetchrow_hashref() can fail for any number of reasons (e.g.,
 576         # database server crash), not just because no items match the
 577         # search criteria.
 578         my $sth2 = $dbh->prepare(
 579             "SELECT * FROM issues
 580                 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 581                 WHERE itemnumber = ?
 582                     AND returndate IS NULL
 583             "
 584         );
 585
 586         $sth2->execute( $data->{'itemnumber'} );
 587         if ( my $data2 = $sth2->fetchrow_hashref ) {
 588             $data->{'date_due'} = $data2->{'date_due'};
 589             $data->{'card'}     = $data2->{'cardnumber'};
 590             $data->{'borrower'} = $data2->{'borrowernumber'};
 591         }
 592         else {
 593             if ( $data->{'wthdrawn'} eq '1' ) {
 594                 $data->{'date_due'} = 'Cancelled';
 595             }
 596             else {
 597                 $data->{'date_due'} = 'Available';
 598             }    # else
 599         }    # else
 600
 601         $sth2->finish;
 602
 603         # Find the last 3 people who borrowed this item.
 604         $sth2 = $dbh->prepare(
 605             "SELECT * FROM issues
 606                 LEFT JOIN borrowers ON  issues.borrowernumber = borrowers.borrowernumber
 607                 WHERE itemnumber = ?
 608                 AND returndate IS NOT NULL
 609                 ORDER BY returndate DESC,timestamp DESC"
 610         );
 611
 612 #        $sth2 = $dbh->prepare("
 613 #            SELECT *
 614 #            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->execute( $data->{'itemnumber'} );
 622         for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
 623         {    # FIXME : error if there is less than 3 pple borrowing this item
 624             if ( my $data2 = $sth2->fetchrow_hashref ) {
 625                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
 626                 $data->{"card$i2"}      = $data2->{'cardnumber'};
 627                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
 628             }    # if
 629         }    # for
 630
 631         $sth2->finish;
 632         $results[$i] = $data;
 633         $i++;
 634     }
 635
 636     $sth->finish;
 637     return (@results);
 638 }
 639
 640 =head2 CanBookBeIssued
 641
 642 $issuingimpossible, $needsconfirmation =
 643         CanBookBeIssued( $borrower, $barcode, $year, $month, $day, $inprocess );
 644
 645 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
 646
 647 =cut
 648
 649 sub CanBookBeIssued {
 650     my ( $borrower, $barcode, $year, $month, $day, $inprocess ) = @_;
 651     my %needsconfirmation;    # filled with problems that needs confirmations
 652     my %issuingimpossible;    # filled with problems that causes the issue to be IMPOSSIBLE
 653     my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
 654     my $issue = GetItemIssue($item->{itemnumber});
 655     my $dbh             = C4::Context->dbh;
 656
 657     #
 658     # DUE DATE is OK ?
 659     #
 660     my ( $duedate, $invalidduedate ) = fixdate( $year, $month, $day );
 661     $issuingimpossible{INVALID_DATE} = 1 if ($invalidduedate);
 662
 663     #
 664     # BORROWER STATUS
 665     #
 666     if ( $borrower->{flags}->{GNA} ) {
 667         $issuingimpossible{GNA} = 1;
 668     }
 669     if ( $borrower->{flags}->{'LOST'} ) {
 670         $issuingimpossible{CARD_LOST} = 1;
 671     }
 672     if ( $borrower->{flags}->{'DBARRED'} ) {
 673         $issuingimpossible{DEBARRED} = 1;
 674     }
 675     if ( $borrower->{'dateexpiry'} eq '0000-00-00') {
 676         $issuingimpossible{EXPIRED} = 1;
 677     } else {
 678         my @expirydate=  split /-/,$borrower->{'dateexpiry'};
 679         if($expirydate[0]==0 || $expirydate[1]==0|| $expirydate[2]==0 ||
 680             Date_to_Days(Today) > Date_to_Days( @expirydate )) {
 681             $issuingimpossible{EXPIRED} = 1;
 682         }
 683     }
 684     #
 685     # BORROWER STATUS
 686     #
 687
 688     # DEBTS
 689     my ($amount) =
 690       GetMemberAccountRecords( $borrower->{'borrowernumber'}, $duedate );
 691     if ( C4::Context->preference("IssuingInProcess") ) {
 692         my $amountlimit = C4::Context->preference("noissuescharge");
 693         if ( $amount > $amountlimit && !$inprocess ) {
 694             $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
 695         }
 696         elsif ( $amount <= $amountlimit && !$inprocess ) {
 697             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
 698         }
 699     }
 700     else {
 701         if ( $amount > 0 ) {
 702             $needsconfirmation{DEBT} = $amount;
 703         }
 704     }
 705
 706     #
 707     # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
 708     #
 709     my $toomany = TooMany( $borrower, $item->{biblionumber} );
 710     $needsconfirmation{TOO_MANY} = $toomany if $toomany;
 711
 712     #
 713     # ITEM CHECKING
 714     #
 715     unless ( $item->{barcode} ) {
 716         $issuingimpossible{UNKNOWN_BARCODE} = 1;
 717     }
 718     if (   $item->{'notforloan'}
 719         && $item->{'notforloan'} > 0 )
 720     {
 721         $issuingimpossible{NOT_FOR_LOAN} = 1;
 722     }
 723     if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
 724     {
 725         $issuingimpossible{WTHDRAWN} = 1;
 726     }
 727     if (   $item->{'restricted'}
 728         && $item->{'restricted'} == 1 )
 729     {
 730         $issuingimpossible{RESTRICTED} = 1;
 731     }
 732     if ( C4::Context->preference("IndependantBranches") ) {
 733         my $userenv = C4::Context->userenv;
 734         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 735             $issuingimpossible{NOTSAMEBRANCH} = 1
 736               if ( $item->{'holdingbranch'} ne $userenv->{branch} );
 737         }
 738     }
 739
 740     #
 741     # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
 742     #
 743     if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
 744     {
 745
 746         # Already issued to current borrower. Ask whether the loan should
 747         # be renewed.
 748         my ($CanBookBeRenewed) = CanBookBeRenewed(
 749             $borrower->{'borrowernumber'},
 750             $item->{'itemnumber'}
 751         );
 752         if ( $CanBookBeRenewed == 0 ) {    # no more renewals allowed
 753             $issuingimpossible{NO_MORE_RENEWALS} = 1;
 754         }
 755         else {
 756             $needsconfirmation{RENEW_ISSUE} = 1;
 757         }
 758     }
 759     elsif ($issue->{borrowernumber}) {
 760
 761         # issued to someone else
 762         my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
 763
 764 #        warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
 765         $needsconfirmation{ISSUED_TO_ANOTHER} =
 766 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
 767     }
 768
 769     # See if the item is on reserve.
 770     my ( $restype, $res ) = CheckReserves( $item->{'itemnumber'} );
 771     if ($restype) {
 772         my $resbor = $res->{'borrowernumber'};
 773         if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
 774         {
 775
 776             # The item is on reserve and waiting, but has been
 777             # reserved by some other patron.
 778             my ( $resborrower, $flags ) =
 779               GetMemberDetails( $resbor, 0 );
 780             my $branches   = GetBranches();
 781             my $branchname =
 782               $branches->{ $res->{'branchcode'} }->{'branchname'};
 783             $needsconfirmation{RESERVE_WAITING} =
 784 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
 785
 786 # CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine.
 787         }
 788         elsif ( $restype eq "Reserved" ) {
 789
 790             # The item is on reserve for someone else.
 791             my ( $resborrower, $flags ) =
 792               GetMemberDetails( $resbor, 0 );
 793             my $branches   = GetBranches();
 794             my $branchname =
 795               $branches->{ $res->{'branchcode'} }->{'branchname'};
 796             $needsconfirmation{RESERVED} =
 797 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
 798         }
 799     }
 800     if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) {
 801         if ( $borrower->{'categorycode'} eq 'W' ) {
 802             my %issuingimpossible;
 803             return ( \%issuingimpossible, \%needsconfirmation );
 804         } else {
 805             return ( \%issuingimpossible, \%needsconfirmation );
 806         }
 807     } else {
 808         return ( \%issuingimpossible, \%needsconfirmation );
 809     }
 810 }
 811
 812 =head2 AddIssue
 813
 814 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
 815
 816 &AddIssue($borrower,$barcode,$date)
 817
 818 =over 4
 819
 820 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
 821
 822 =item C<$barcode> is the bar code of the book being issued.
 823
 824 =item C<$date> contains the max date of return. calculated if empty.
 825
 826 AddIssue does the following things :
 827 - step 01: check that there is a borrowernumber & a barcode provided
 828 - check for RENEWAL (book issued & being issued to the same patron)
 829     - renewal YES = Calculate Charge & renew
 830     - renewal NO  =
 831         * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
 832         * RESERVE PLACED ?
 833             - fill reserve if reserve to this patron
 834             - cancel reserve or not, otherwise
 835         * TRANSFERT PENDING ?
 836             - complete the transfert
 837         * ISSUE THE BOOK
 838
 839 =back
 840
 841 =cut
 842
 843 sub AddIssue {
 844     my ( $borrower, $barcode, $date, $cancelreserve ) = @_;
 845     my $dbh = C4::Context->dbh;
 846 my $barcodecheck=CheckValidBarcode($barcode);
 847 if ($borrower and $barcode and $barcodecheck ne '0'){
 848 #   my ($borrower, $flags) = &GetMemberDetails($borrowernumber, 0);
 849     # find which item we issue
 850     my $item = GetItem('', $barcode);
 851
 852     # get actual issuing if there is one
 853     my $actualissue = GetItemIssue( $item->{itemnumber});
 854
 855     # get biblioinformation for this item
 856     my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
 857
 858     #
 859     # check if we just renew the issue.
 860     #
 861     if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
 862         # we renew, do we need to add some charge ?
 863         my ( $charge, $itemtype ) = GetIssuingCharges(
 864             $item->{'itemnumber'},
 865             $borrower->{'borrowernumber'}
 866         );
 867         if ( $charge > 0 ) {
 868             AddIssuingCharge(
 869                 $item->{'itemnumber'},
 870                 $borrower->{'borrowernumber'}, $charge
 871             );
 872             $item->{'charge'} = $charge;
 873         }
 874         &UpdateStats(
 875             C4::Context->userenv->{'branch'},
 876             'renew',                        $charge,
 877             '',                             $item->{'itemnumber'},
 878             $biblio->{'itemtype'}, $borrower->{'borrowernumber'}
 879         );
 880         AddRenewal(
 881             $borrower->{'borrowernumber'},
 882             $item->{'itemnumber'}
 883         );
 884     }
 885     else {# it's NOT a renewal
 886         if ( $actualissue->{borrowernumber}) {
 887             # This book is currently on loan, but not to the person
 888             # who wants to borrow it now. mark it returned before issuing to the new borrower
 889             AddReturn(
 890                 $item->{'barcode'},
 891                 C4::Context->userenv->{'branch'}
 892             );
 893         }
 894
 895         # See if the item is on reserve.
 896         my ( $restype, $res ) =
 897           CheckReserves( $item->{'itemnumber'} );
 898         if ($restype) {
 899             my $resbor = $res->{'borrowernumber'};
 900             if ( $resbor eq $borrower->{'borrowernumber'} ) {
 901
 902                 # The item is reserved by the current patron
 903                 ModReserveFill($res);
 904             }
 905             elsif ( $restype eq "Waiting" ) {
 906
 907                 # warn "Waiting";
 908                 # The item is on reserve and waiting, but has been
 909                 # reserved by some other patron.
 910                 my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
 911                 my $branches   = GetBranches();
 912                 my $branchname =
 913                   $branches->{ $res->{'branchcode'} }->{'branchname'};
 914             }
 915             elsif ( $restype eq "Reserved" ) {
 916
 917                 # warn "Reserved";
 918                 # The item is reserved by someone else.
 919                 my ( $resborrower, $flags ) =
 920                   GetMemberDetails( $resbor, 0 );
 921                 my $branches   = GetBranches();
 922                 my $branchname =
 923                   $branches->{ $res->{'branchcode'} }->{'branchname'};
 924                 if ($cancelreserve) { # cancel reserves on this item
 925                     CancelReserve( 0, $res->{'itemnumber'},
 926                         $res->{'borrowernumber'} );
 927                 }
 928             }
 929             if ($cancelreserve) {
 930                 CancelReserve( $res->{'biblionumber'}, 0,
 931                     $res->{'borrowernumber'} );
 932             }
 933             else {
 934     # set waiting reserve to first in reserve queue as book isn't waiting now
 935                 ModReserve(
 936                     1,
 937                     $res->{'biblionumber'},
 938                     $res->{'borrowernumber'},
 939                     $res->{'branchcode'}
 940                 );
 941             }
 942         }
 943
 944         # Starting process for transfer job (checking transfert and validate it if we have one)
 945             my ($datesent) = GetTransfers($item->{'itemnumber'});
 946             if ($datesent) {
 947         #       updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
 948             my $sth =
 949                     $dbh->prepare(
 950                     "UPDATE branchtransfers
 951                         SET datearrived = now(),
 952                         tobranch = ?,
 953                         comments = 'Forced branchtransfert'
 954                     WHERE itemnumber= ? AND datearrived IS NULL"
 955                     );
 956                     $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
 957                     $sth->finish;
 958             }
 959
 960         # Record in the database the fact that the book was issued.
 961         my $sth =
 962           $dbh->prepare(
 963                 "INSERT INTO issues
 964                     (borrowernumber, itemnumber,issuedate, date_due, branchcode)
 965                 VALUES (?,?,?,?,?)"
 966           );
 967         my $loanlength = GetLoanLength(
 968             $borrower->{'categorycode'},
 969             $biblio->{'itemtype'},
 970             $borrower->{'branchcode'}
 971         );
 972         my $datedue  = time + ($loanlength) * 86400;
 973         my @datearr  = localtime($datedue);
 974         my $dateduef =
 975             sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]);
 976         if ($date) {
 977             $dateduef = $date;
 978         }
 979        $dateduef=CheckValidDatedue($dateduef,$item->{'itemnumber'},C4::Context->userenv->{'branch'});
 980        # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
 981         if ( C4::Context->preference('ReturnBeforeExpiry')
 982             && $dateduef gt $borrower->{dateexpiry} )
 983         {
 984             $dateduef = $borrower->{dateexpiry};
 985         }
 986         $sth->execute(
 987             $borrower->{'borrowernumber'},
 988             $item->{'itemnumber'},
 989             strftime( "%Y-%m-%d", localtime ),$dateduef, C4::Context->userenv->{'branch'}
 990         );
 991         $sth->finish;
 992         $item->{'issues'}++;
 993         $sth =
 994           $dbh->prepare(
 995             "UPDATE items SET issues=?, holdingbranch=?, itemlost=0, datelastborrowed  = now() WHERE itemnumber=?");
 996         $sth->execute(
 997             $item->{'issues'},
 998             C4::Context->userenv->{'branch'},
 999             $item->{'itemnumber'}
1000         );
1001         $sth->finish;
1002         &ModDateLastSeen( $item->{'itemnumber'} );
1003         # If it costs to borrow this book, charge it to the patron's account.
1004         my ( $charge, $itemtype ) = GetIssuingCharges(
1005             $item->{'itemnumber'},
1006             $borrower->{'borrowernumber'}
1007         );
1008         if ( $charge > 0 ) {
1009             AddIssuingCharge(
1010                 $item->{'itemnumber'},
1011                 $borrower->{'borrowernumber'}, $charge
1012             );
1013             $item->{'charge'} = $charge;
1014         }
1015
1016         # Record the fact that this book was issued.
1017         &UpdateStats(
1018             C4::Context->userenv->{'branch'},
1019             'issue',                        $charge,
1020             '',                             $item->{'itemnumber'},
1021             $item->{'itemtype'}, $borrower->{'borrowernumber'}
1022         );
1023     }
1024
1025     &logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$biblio->{'biblionumber'})
1026         if C4::Context->preference("IssueLog");
1027   }
1028 }
1029
1030 =head2 GetLoanLength
1031
1032 Get loan length for an itemtype, a borrower type and a branch
1033
1034 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1035
1036 =cut
1037
1038 sub GetLoanLength {
1039     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1040     my $dbh = C4::Context->dbh;
1041     my $sth =
1042       $dbh->prepare(
1043 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=?"
1044       );
1045
1046 # try to find issuelength & return the 1st available.
1047 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1048     $sth->execute( $borrowertype, $itemtype, $branchcode );
1049     my $loanlength = $sth->fetchrow_hashref;
1050     return $loanlength->{issuelength}
1051       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1052
1053     $sth->execute( $borrowertype, $itemtype, "" );
1054     $loanlength = $sth->fetchrow_hashref;
1055     return $loanlength->{issuelength}
1056       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1057
1058     $sth->execute( $borrowertype, "*", $branchcode );
1059     $loanlength = $sth->fetchrow_hashref;
1060     return $loanlength->{issuelength}
1061       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1062
1063     $sth->execute( "*", $itemtype, $branchcode );
1064     $loanlength = $sth->fetchrow_hashref;
1065     return $loanlength->{issuelength}
1066       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1067
1068     $sth->execute( $borrowertype, "*", "" );
1069     $loanlength = $sth->fetchrow_hashref;
1070     return $loanlength->{issuelength}
1071       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1072
1073     $sth->execute( "*", "*", $branchcode );
1074     $loanlength = $sth->fetchrow_hashref;
1075     return $loanlength->{issuelength}
1076       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1077
1078     $sth->execute( "*", $itemtype, "" );
1079     $loanlength = $sth->fetchrow_hashref;
1080     return $loanlength->{issuelength}
1081       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1082
1083     $sth->execute( "*", "*", "" );
1084     $loanlength = $sth->fetchrow_hashref;
1085     return $loanlength->{issuelength}
1086       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1087
1088     # if no rule is set => 21 days (hardcoded)
1089     return 21;
1090 }
1091
1092 =head2 AddReturn
1093
1094 ($doreturn, $messages, $iteminformation, $borrower) =
1095     &AddReturn($barcode, $branch);
1096
1097 Returns a book.
1098
1099 C<$barcode> is the bar code of the book being returned. C<$branch> is
1100 the code of the branch where the book is being returned.
1101
1102 C<&AddReturn> returns a list of four items:
1103
1104 C<$doreturn> is true iff the return succeeded.
1105
1106 C<$messages> is a reference-to-hash giving the reason for failure:
1107
1108 =over 4
1109
1110 =item C<BadBarcode>
1111
1112 No item with this barcode exists. The value is C<$barcode>.
1113
1114 =item C<NotIssued>
1115
1116 The book is not currently on loan. The value is C<$barcode>.
1117
1118 =item C<IsPermanent>
1119
1120 The book's home branch is a permanent collection. If you have borrowed
1121 this book, you are not allowed to return it. The value is the code for
1122 the book's home branch.
1123
1124 =item C<wthdrawn>
1125
1126 This book has been withdrawn/cancelled. The value should be ignored.
1127
1128 =item C<ResFound>
1129
1130 The item was reserved. The value is a reference-to-hash whose keys are
1131 fields from the reserves table of the Koha database, and
1132 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1133 either C<Waiting>, C<Reserved>, or 0.
1134
1135 =back
1136
1137 C<$borrower> is a reference-to-hash, giving information about the
1138 patron who last borrowed the book.
1139
1140 =cut
1141
1142 sub AddReturn {
1143     my ( $barcode, $branch ) = @_;
1144     my $dbh      = C4::Context->dbh;
1145     my $messages;
1146     my $doreturn = 1;
1147     my $borrower;
1148     my $validTransfert = 0;
1149     my $reserveDone = 0;
1150
1151     # get information on item
1152     my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1153     unless ($iteminformation->{'itemnumber'} ) {
1154         $messages->{'BadBarcode'} = $barcode;
1155         $doreturn = 0;
1156     } else {
1157         # find the borrower
1158         if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1159             $messages->{'NotIssued'} = $barcode;
1160             $doreturn = 0;
1161         }
1162
1163         # check if the book is in a permanent collection....
1164         my $hbr      = $iteminformation->{'homebranch'};
1165         my $branches = GetBranches();
1166         if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1167             $messages->{'IsPermanent'} = $hbr;
1168         }
1169
1170         # check that the book has been cancelled
1171         if ( $iteminformation->{'wthdrawn'} ) {
1172             $messages->{'wthdrawn'} = 1;
1173             $doreturn = 0;
1174         }
1175
1176     #     new op dev : if the book returned in an other branch update the holding branch
1177
1178     # update issues, thereby returning book (should push this out into another subroutine
1179         $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1180
1181     # case of a return of document (deal with issues and holdingbranch)
1182
1183         if ($doreturn) {
1184             my $sth =
1185             $dbh->prepare(
1186     "UPDATE issues SET returndate = now() WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (returndate IS NULL)"
1187             );
1188             $sth->execute( $borrower->{'borrowernumber'},
1189                 $iteminformation->{'itemnumber'} );
1190             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?
1191         }
1192
1193     # continue to deal with returns cases, but not only if we have an issue
1194
1195     # the holdingbranch is updated if the document is returned in an other location .
1196     if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} )
1197             {
1198                     UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1199     #           reload iteminformation holdingbranch with the userenv value
1200                     $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1201             }
1202         ModDateLastSeen( $iteminformation->{'itemnumber'} );
1203         ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1204
1205         # fix up the accounts.....
1206         if ( $iteminformation->{'itemlost'} ) {
1207             $messages->{'WasLost'} = 1;
1208         }
1209
1210     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1211     #     check if we have a transfer for this document
1212         my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1213
1214     #     if we have a transfer to do, we update the line of transfers with the datearrived
1215         if ($datesent) {
1216             if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1217                     my $sth =
1218                     $dbh->prepare(
1219                             "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1220                     );
1221                     $sth->execute( $iteminformation->{'itemnumber'} );
1222                     $sth->finish;
1223     #         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'
1224             C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1225             }
1226         else {
1227             $messages->{'WrongTransfer'} = $tobranch;
1228             $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1229         }
1230         $validTransfert = 1;
1231         }
1232
1233     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1234         # fix up the accounts.....
1235         if ($iteminformation->{'itemlost'}) {
1236                 FixAccountForLostAndReturned($iteminformation, $borrower);
1237                 $messages->{'WasLost'} = 1;
1238         }
1239         # fix up the overdues in accounts...
1240         FixOverduesOnReturn( $borrower->{'borrowernumber'},
1241             $iteminformation->{'itemnumber'} );
1242
1243     # find reserves.....
1244     #     if we don't have a reserve with the status W, we launch the Checkreserves routine
1245         my ( $resfound, $resrec ) =
1246         C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1247         if ($resfound) {
1248             $resrec->{'ResFound'}   = $resfound;
1249             $messages->{'ResFound'} = $resrec;
1250             $reserveDone = 1;
1251         }
1252
1253         # update stats?
1254         # Record the fact that this book was returned.
1255         UpdateStats(
1256             $branch, 'return', '0', '',
1257             $iteminformation->{'itemnumber'},
1258             $iteminformation->{'itemtype'},
1259             $borrower->{'borrowernumber'}
1260         );
1261
1262         &logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$iteminformation->{borrowernumber},$iteminformation->{'biblionumber'})
1263             if C4::Context->preference("ReturnLog");
1264
1265         #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1266         #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1267
1268         if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1269                     if (C4::Context->preference("AutomaticItemReturn") == 1) {
1270                     ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1271                     $messages->{'WasTransfered'} = 1;
1272                     warn "was transfered";
1273                     }
1274         }
1275     }
1276     return ( $doreturn, $messages, $iteminformation, $borrower );
1277 }
1278
1279 =head2 FixOverduesOnReturn
1280
1281     &FixOverduesOnReturn($brn,$itm);
1282
1283 C<$brn> borrowernumber
1284
1285 C<$itm> itemnumber
1286
1287 internal function, called only by AddReturn
1288
1289 =cut
1290
1291 sub FixOverduesOnReturn {
1292     my ( $borrowernumber, $item ) = @_;
1293     my $dbh = C4::Context->dbh;
1294
1295     # check for overdue fine
1296     my $sth =
1297       $dbh->prepare(
1298 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1299       );
1300     $sth->execute( $borrowernumber, $item );
1301
1302     # alter fine to show that the book has been returned
1303     if ( my $data = $sth->fetchrow_hashref ) {
1304         my $usth =
1305           $dbh->prepare(
1306 "UPDATE accountlines SET accounttype='F' WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accountno = ?)"
1307           );
1308         $usth->execute( $borrowernumber, $item, $data->{'accountno'} );
1309         $usth->finish();
1310     }
1311     $sth->finish();
1312     return;
1313 }
1314
1315 =head2 FixAccountForLostAndReturned
1316
1317         &FixAccountForLostAndReturned($iteminfo,$borrower);
1318
1319 Calculates the charge for a book lost and returned (Not exported & used only once)
1320
1321 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1322
1323 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1324
1325 Internal function, called by AddReturn
1326
1327 =cut
1328
1329 sub FixAccountForLostAndReturned {
1330         my ($iteminfo, $borrower) = @_;
1331         my %env;
1332         my $dbh = C4::Context->dbh;
1333         my $itm = $iteminfo->{'itemnumber'};
1334         # check for charge made for lost book
1335         my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1336         $sth->execute($itm);
1337         if (my $data = $sth->fetchrow_hashref) {
1338         # writeoff this amount
1339                 my $offset;
1340                 my $amount = $data->{'amount'};
1341                 my $acctno = $data->{'accountno'};
1342                 my $amountleft;
1343                 if ($data->{'amountoutstanding'} == $amount) {
1344                 $offset = $data->{'amount'};
1345                 $amountleft = 0;
1346                 } else {
1347                 $offset = $amount - $data->{'amountoutstanding'};
1348                 $amountleft = $data->{'amountoutstanding'} - $amount;
1349                 }
1350                 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1351                         WHERE (borrowernumber = ?)
1352                         AND (itemnumber = ?) AND (accountno = ?) ");
1353                 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1354                 $usth->finish;
1355         #check if any credit is left if so writeoff other accounts
1356                 my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
1357                 if ($amountleft < 0){
1358                 $amountleft*=-1;
1359                 }
1360                 if ($amountleft > 0){
1361                 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1362                                                         AND (amountoutstanding >0) ORDER BY date");
1363                 $msth->execute($data->{'borrowernumber'});
1364         # offset transactions
1365                 my $newamtos;
1366                 my $accdata;
1367                 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1368                         if ($accdata->{'amountoutstanding'} < $amountleft) {
1369                         $newamtos = 0;
1370                         $amountleft -= $accdata->{'amountoutstanding'};
1371                         }  else {
1372                         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1373                         $amountleft = 0;
1374                         }
1375                         my $thisacct = $accdata->{'accountno'};
1376                         my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1377                                         WHERE (borrowernumber = ?)
1378                                         AND (accountno=?)");
1379                         $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1380                         $usth->finish;
1381                         $usth = $dbh->prepare("INSERT INTO accountoffsets
1382                                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1383                                 VALUES
1384                                 (?,?,?,?)");
1385                         $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1386                         $usth->finish;
1387                 }
1388                 $msth->finish;
1389                 }
1390                 if ($amountleft > 0){
1391                         $amountleft*=-1;
1392                 }
1393                 my $desc="Book Returned ".$iteminfo->{'barcode'};
1394                 $usth = $dbh->prepare("INSERT INTO accountlines
1395                         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1396                         VALUES (?,?,now(),?,?,'CR',?)");
1397                 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1398                 $usth->finish;
1399                 $usth = $dbh->prepare("INSERT INTO accountoffsets
1400                         (borrowernumber, accountno, offsetaccount,  offsetamount)
1401                         VALUES (?,?,?,?)");
1402                 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1403                 $usth->finish;
1404                 $usth = $dbh->prepare("UPDATE items SET paidfor='' WHERE itemnumber=?");
1405                 $usth->execute($itm);
1406                 $usth->finish;
1407         }
1408         $sth->finish;
1409         return;
1410 }
1411
1412 =head2 GetItemIssue
1413
1414 $issues = &GetItemIssue($itemnumber);
1415
1416 Returns patrons currently having a book. nothing if item is not issued atm
1417
1418 C<$itemnumber> is the itemnumber
1419
1420 Returns an array of hashes
1421 =cut
1422
1423 sub GetItemIssue {
1424     my ( $itemnumber) = @_;
1425     return unless $itemnumber;
1426     my $dbh = C4::Context->dbh;
1427     my @GetItemIssues;
1428
1429     # get today date
1430     my $today = POSIX::strftime("%Y%m%d", localtime);
1431
1432     my $sth = $dbh->prepare(
1433         "SELECT * FROM issues
1434         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1435     WHERE
1436     issues.itemnumber=?  AND returndate IS NULL ");
1437     $sth->execute($itemnumber);
1438     my $data = $sth->fetchrow_hashref;
1439     my $datedue = $data->{'date_due'};
1440     $datedue =~ s/-//g;
1441     if ( $datedue < $today ) {
1442         $data->{'overdue'} = 1;
1443     }
1444     $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1445     $sth->finish;
1446     return ($data);
1447 }
1448
1449 =head2 GetItemIssues
1450
1451 $issues = &GetItemIssues($itemnumber, $history);
1452
1453 Returns patrons that have issued a book
1454
1455 C<$itemnumber> is the itemnumber
1456 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1457
1458 Returns an array of hashes
1459 =cut
1460
1461 sub GetItemIssues {
1462     my ( $itemnumber,$history ) = @_;
1463     my $dbh = C4::Context->dbh;
1464     my @GetItemIssues;
1465
1466     # get today date
1467     my $today = POSIX::strftime("%Y%m%d", localtime);
1468
1469     my $sth = $dbh->prepare(
1470         "SELECT * FROM issues
1471     WHERE
1472     itemnumber=?".($history?"":" AND returndate IS NULL ").
1473     "ORDER BY issues.date_due DESC"
1474     );
1475     $sth->execute($itemnumber);
1476     while ( my $data = $sth->fetchrow_hashref ) {
1477         my $datedue = $data->{'date_due'};
1478         $datedue =~ s/-//g;
1479         if ( $datedue < $today ) {
1480             $data->{'overdue'} = 1;
1481         }
1482         my $itemnumber = $data->{'itemnumber'};
1483
1484         push @GetItemIssues, $data;
1485     }
1486     $sth->finish;
1487     return ( \@GetItemIssues );
1488 }
1489
1490 =head2 GetBiblioIssues
1491
1492 $issues = GetBiblioIssues($biblionumber);
1493
1494 this function get all issues from a biblionumber.
1495
1496 Return:
1497 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1498 tables issues and the firstname,surname & cardnumber from borrowers.
1499
1500 =cut
1501
1502 sub GetBiblioIssues {
1503     my $biblionumber = shift;
1504     return undef unless $biblionumber;
1505     my $dbh   = C4::Context->dbh;
1506     my $query = "
1507         SELECT issues.*,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1508         FROM issues
1509             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1510             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1511             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1512             LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1513         WHERE biblio.biblionumber = ?
1514         ORDER BY issues.timestamp
1515     ";
1516     my $sth = $dbh->prepare($query);
1517     $sth->execute($biblionumber);
1518
1519     my @issues;
1520     while ( my $data = $sth->fetchrow_hashref ) {
1521         push @issues, $data;
1522     }
1523     return \@issues;
1524 }
1525
1526 =head2 CanBookBeRenewed
1527
1528 $ok = &CanBookBeRenewed($borrowernumber, $itemnumber);
1529
1530 Find out whether a borrowed item may be renewed.
1531
1532 C<$dbh> is a DBI handle to the Koha database.
1533
1534 C<$borrowernumber> is the borrower number of the patron who currently
1535 has the item on loan.
1536
1537 C<$itemnumber> is the number of the item to renew.
1538
1539 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1540 item must currently be on loan to the specified borrower; renewals
1541 must be allowed for the item's type; and the borrower must not have
1542 already renewed the loan.
1543
1544 =cut
1545
1546 sub CanBookBeRenewed {
1547
1548     # check renewal status
1549     my ( $borrowernumber, $itemnumber ) = @_;
1550     my $dbh       = C4::Context->dbh;
1551     my $renews    = 1;
1552     my $renewokay = 0;
1553
1554     # Look in the issues table for this item, lent to this borrower,
1555     # and not yet returned.
1556
1557     # FIXME - I think this function could be redone to use only one SQL call.
1558     my $sth1 = $dbh->prepare(
1559         "SELECT * FROM issues
1560             WHERE borrowernumber = ?
1561             AND itemnumber = ?
1562             AND returndate IS NULL"
1563     );
1564     $sth1->execute( $borrowernumber, $itemnumber );
1565     if ( my $data1 = $sth1->fetchrow_hashref ) {
1566
1567         # Found a matching item
1568
1569         # See if this item may be renewed. This query is convoluted
1570         # because it's a bit messy: given the item number, we need to find
1571         # the biblioitem, which gives us the itemtype, which tells us
1572         # whether it may be renewed.
1573         my $sth2 = $dbh->prepare(
1574             "SELECT renewalsallowed FROM items
1575                 LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1576                 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1577                 WHERE items.itemnumber = ?
1578                 "
1579         );
1580         $sth2->execute($itemnumber);
1581         if ( my $data2 = $sth2->fetchrow_hashref ) {
1582             $renews = $data2->{'renewalsallowed'};
1583         }
1584         if ( $renews && $renews >= $data1->{'renewals'} ) {
1585             $renewokay = 1;
1586         }
1587         $sth2->finish;
1588         my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1589         if ($resfound) {
1590             $renewokay = 0;
1591         }
1592
1593     }
1594     $sth1->finish;
1595     return ($renewokay);
1596 }
1597
1598 =head2 AddRenewal
1599
1600 &AddRenewal($borrowernumber, $itemnumber, $datedue);
1601
1602 Renews a loan.
1603
1604 C<$borrowernumber> is the borrower number of the patron who currently
1605 has the item.
1606
1607 C<$itemnumber> is the number of the item to renew.
1608
1609 C<$datedue> can be used to set the due date. If C<$datedue> is the
1610 empty string, C<&AddRenewal> will calculate the due date automatically
1611 from the book's item type. If you wish to set the due date manually,
1612 C<$datedue> should be in the form YYYY-MM-DD.
1613
1614 =cut
1615
1616 sub AddRenewal {
1617
1618     my ( $borrowernumber, $itemnumber, $branch ,$datedue ) = @_;
1619     my $dbh = C4::Context->dbh;
1620
1621     # If the due date wasn't specified, calculate it by adding the
1622     # book's loan length to today's date.
1623     if ( $datedue eq "" ) {
1624
1625         my $biblio = GetBiblioFromItemNumber($itemnumber);
1626         my $borrower = GetMemberDetails( $borrowernumber, 0 );
1627         my $loanlength = GetLoanLength(
1628             $borrower->{'categorycode'},
1629             $biblio->{'itemtype'},
1630             $borrower->{'branchcode'}
1631         );
1632         my ( $due_year, $due_month, $due_day ) =
1633           Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
1634         $datedue = "$due_year-$due_month-$due_day";
1635         $datedue=CheckValidDatedue($datedue,$itemnumber,$branch);
1636     }
1637
1638     # Find the issues record for this book
1639     my $sth =
1640       $dbh->prepare("SELECT * FROM issues
1641                         WHERE borrowernumber=?
1642                         AND itemnumber=?
1643                         AND returndate IS NULL"
1644       );
1645     $sth->execute( $borrowernumber, $itemnumber );
1646     my $issuedata = $sth->fetchrow_hashref;
1647     $sth->finish;
1648
1649     # Update the issues record to have the new due date, and a new count
1650     # of how many times it has been renewed.
1651     my $renews = $issuedata->{'renewals'} + 1;
1652     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1653                             WHERE borrowernumber=?
1654                             AND itemnumber=?
1655                             AND returndate IS NULL"
1656     );
1657     $sth->execute( $datedue, $renews, $borrowernumber, $itemnumber );
1658     $sth->finish;
1659
1660     # Log the renewal
1661     UpdateStats( C4::Context->userenv->{'branchcode'}, 'renew', '', '', $itemnumber );
1662
1663     # Charge a new rental fee, if applicable?
1664     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1665     if ( $charge > 0 ) {
1666         my $accountno = getnextacctno( $borrowernumber );
1667         my $item = GetBiblioFromItemNumber($itemnumber);
1668         $sth = $dbh->prepare(
1669                 "INSERT INTO accountlines
1670                     (borrowernumber,accountno,date,amount,
1671                         description,accounttype,amountoutstanding,
1672                     itemnumber)
1673                     VALUES (?,?,now(),?,?,?,?,?)"
1674         );
1675         $sth->execute( $borrowernumber, $accountno, $charge,
1676             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1677             'Rent', $charge, $itemnumber );
1678         $sth->finish;
1679     }
1680 }
1681
1682 =head2 GetIssuingCharges
1683
1684 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
1685
1686 Calculate how much it would cost for a given patron to borrow a given
1687 item, including any applicable discounts.
1688
1689 C<$itemnumber> is the item number of item the patron wishes to borrow.
1690
1691 C<$borrowernumber> is the patron's borrower number.
1692
1693 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
1694 and C<$item_type> is the code for the item's item type (e.g., C<VID>
1695 if it's a video).
1696
1697 =cut
1698
1699 sub GetIssuingCharges {
1700
1701     # calculate charges due
1702     my ( $itemnumber, $borrowernumber ) = @_;
1703     my $charge = 0;
1704     my $dbh    = C4::Context->dbh;
1705     my $item_type;
1706
1707     # Get the book's item type and rental charge (via its biblioitem).
1708     my $sth1 = $dbh->prepare(
1709         "SELECT itemtypes.itemtype,rentalcharge FROM items
1710             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1711             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1712             WHERE items.itemnumber =?
1713         "
1714     );
1715     $sth1->execute($itemnumber);
1716     if ( my $data1 = $sth1->fetchrow_hashref ) {
1717         $item_type = $data1->{'itemtype'};
1718         $charge    = $data1->{'rentalcharge'};
1719         my $q2 = "SELECT rentaldiscount FROM borrowers
1720             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
1721             WHERE borrowers.borrowernumber = ?
1722             AND issuingrules.itemtype = ?";
1723         my $sth2 = $dbh->prepare($q2);
1724         $sth2->execute( $borrowernumber, $item_type );
1725         if ( my $data2 = $sth2->fetchrow_hashref ) {
1726             my $discount = $data2->{'rentaldiscount'};
1727             if ( $discount eq 'NULL' ) {
1728                 $discount = 0;
1729             }
1730             $charge = ( $charge * ( 100 - $discount ) ) / 100;
1731         }
1732         $sth2->finish;
1733     }
1734
1735     $sth1->finish;
1736     return ( $charge, $item_type );
1737 }
1738
1739 =head2 AddIssuingCharge
1740
1741 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
1742
1743 =cut
1744
1745 sub AddIssuingCharge {
1746     my ( $itemnumber, $borrowernumber, $charge ) = @_;
1747     my $dbh = C4::Context->dbh;
1748     my $nextaccntno = getnextacctno( $borrowernumber );
1749     my $query ="
1750         INSERT INTO accountlines
1751             (borrowernumber, itemnumber, accountno,
1752             date, amount, description, accounttype,
1753             amountoutstanding)
1754         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
1755     ";
1756     my $sth = $dbh->prepare($query);
1757     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
1758     $sth->finish;
1759 }
1760
1761 =head2 GetTransfers
1762
1763 GetTransfers($itemnumber);
1764
1765 =cut
1766
1767 sub GetTransfers {
1768     my ($itemnumber) = @_;
1769
1770     my $dbh = C4::Context->dbh;
1771
1772     my $query = '
1773         SELECT datesent,
1774                frombranch,
1775                tobranch
1776         FROM branchtransfers
1777         WHERE itemnumber = ?
1778           AND datearrived IS NULL
1779         ';
1780     my $sth = $dbh->prepare($query);
1781     $sth->execute($itemnumber);
1782     my @row = $sth->fetchrow_array();
1783     $sth->finish;
1784     return @row;
1785 }
1786
1787
1788 =head2 GetTransfersFromTo
1789
1790 @results = GetTransfersFromTo($frombranch,$tobranch);
1791
1792 Returns the list of pending transfers between $from and $to branch
1793
1794 =cut
1795
1796 sub GetTransfersFromTo {
1797     my ( $frombranch, $tobranch ) = @_;
1798     return unless ( $frombranch && $tobranch );
1799     my $dbh   = C4::Context->dbh;
1800     my $query = "
1801         SELECT itemnumber,datesent,frombranch
1802         FROM   branchtransfers
1803         WHERE  frombranch=?
1804           AND  tobranch=?
1805           AND datearrived IS NULL
1806     ";
1807     my $sth = $dbh->prepare($query);
1808     $sth->execute( $frombranch, $tobranch );
1809     my @gettransfers;
1810
1811     while ( my $data = $sth->fetchrow_hashref ) {
1812         push @gettransfers, $data;
1813     }
1814     $sth->finish;
1815     return (@gettransfers);
1816 }
1817
1818 =head2 DeleteTransfer
1819
1820 &DeleteTransfer($itemnumber);
1821
1822 =cut
1823
1824 sub DeleteTransfer {
1825     my ($itemnumber) = @_;
1826     my $dbh          = C4::Context->dbh;
1827     my $sth          = $dbh->prepare(
1828         "DELETE FROM branchtransfers
1829          WHERE itemnumber=?
1830          AND datearrived IS NULL "
1831     );
1832     $sth->execute($itemnumber);
1833     $sth->finish;
1834 }
1835
1836 =head2 AnonymiseIssueHistory
1837
1838 $rows = AnonymiseIssueHistory($borrowernumber,$date)
1839
1840 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
1841 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
1842
1843 return the number of affected rows.
1844
1845 =cut
1846
1847 sub AnonymiseIssueHistory {
1848     my $date           = shift;
1849     my $borrowernumber = shift;
1850     my $dbh            = C4::Context->dbh;
1851     my $query          = "
1852         UPDATE issues
1853         SET    borrowernumber = NULL
1854         WHERE  returndate < '".$date."'
1855           AND borrowernumber IS NOT NULL
1856     ";
1857     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
1858     my $rows_affected = $dbh->do($query);
1859     return $rows_affected;
1860 }
1861
1862 =head2 updateWrongTransfer
1863
1864 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
1865
1866 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
1867
1868 =cut
1869
1870 sub updateWrongTransfer {
1871         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
1872         my $dbh = C4::Context->dbh;
1873 # first step validate the actual line of transfert .
1874         my $sth =
1875                 $dbh->prepare(
1876                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
1877                 );
1878                 $sth->execute($FromLibrary,$itemNumber);
1879                 $sth->finish;
1880
1881 # second step create a new line of branchtransfer to the right location .
1882         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
1883
1884 #third step changing holdingbranch of item
1885         UpdateHoldingbranch($FromLibrary,$itemNumber);
1886 }
1887
1888 =head2 UpdateHoldingbranch
1889
1890 $items = UpdateHoldingbranch($branch,$itmenumber);
1891 Simple methode for updating hodlingbranch in items BDD line
1892 =cut
1893
1894 sub UpdateHoldingbranch {
1895         my ( $branch,$itmenumber ) = @_;
1896         my $dbh = C4::Context->dbh;
1897 # first step validate the actual line of transfert .
1898         my $sth =
1899                 $dbh->prepare(
1900                         "update items set holdingbranch = ? where itemnumber= ?"
1901                 );
1902                 $sth->execute($branch,$itmenumber);
1903                 $sth->finish;
1904
1905
1906 }
1907 =head2 CheckValidDatedue
1908
1909 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
1910 this function return a new date due after checked if it's a repeatable or special holiday
1911 C<$date_due>   = returndate calculate with no day check
1912 C<$itemnumber>  = itemnumber
1913 C<$branchcode>  = localisation of issue
1914 =cut
1915 sub CheckValidDatedue{
1916 my ($date_due,$itemnumber,$branchcode)=@_;
1917 my @datedue=split('-',$date_due);
1918 my $years=$datedue[0];
1919 my $month=$datedue[1];
1920 my $day=$datedue[2];
1921 my $dow;
1922 for (my $i=0;$i<2;$i++){
1923         $dow=Day_of_Week($years,$month,$day);
1924         ($dow=0) if ($dow>6);
1925         my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
1926         my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
1927         my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
1928                 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
1929                 $i=0;
1930                 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
1931                 }
1932         }
1933 my $newdatedue=$years."-".$month."-".$day;
1934 return $newdatedue;
1935 }
1936 =head2 CheckRepeatableHolidays
1937
1938 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
1939 this function check if the date due is a repeatable holiday
1940 C<$date_due>   = returndate calculate with no day check
1941 C<$itemnumber>  = itemnumber
1942 C<$branchcode>  = localisation of issue
1943
1944 =cut
1945
1946 sub CheckRepeatableHolidays{
1947 my($itemnumber,$week_day,$branchcode)=@_;
1948 my $dbh = C4::Context->dbh;
1949 my $query = qq|SELECT count(*)
1950         FROM repeatable_holidays
1951         WHERE branchcode=?
1952         AND weekday=?|;
1953 my $sth = $dbh->prepare($query);
1954 $sth->execute($branchcode,$week_day);
1955 my $result=$sth->fetchrow;
1956 $sth->finish;
1957 return $result;
1958 }
1959
1960
1961 =head2 CheckSpecialHolidays
1962
1963 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
1964 this function check if the date is a special holiday
1965 C<$years>   = the years of datedue
1966 C<$month>   = the month of datedue
1967 C<$day>     = the day of datedue
1968 C<$itemnumber>  = itemnumber
1969 C<$branchcode>  = localisation of issue
1970 =cut
1971 sub CheckSpecialHolidays{
1972 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
1973 my $dbh = C4::Context->dbh;
1974 my $query=qq|SELECT count(*)
1975              FROM `special_holidays`
1976              WHERE year=?
1977              AND month=?
1978              AND day=?
1979              AND branchcode=?
1980             |;
1981 my $sth = $dbh->prepare($query);
1982 $sth->execute($years,$month,$day,$branchcode);
1983 my $countspecial=$sth->fetchrow ;
1984 $sth->finish;
1985 return $countspecial;
1986 }
1987
1988 =head2 CheckRepeatableSpecialHolidays
1989
1990 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
1991 this function check if the date is a repeatble special holidays
1992 C<$month>   = the month of datedue
1993 C<$day>     = the day of datedue
1994 C<$itemnumber>  = itemnumber
1995 C<$branchcode>  = localisation of issue
1996 =cut
1997 sub CheckRepeatableSpecialHolidays{
1998 my ($month,$day,$itemnumber,$branchcode) = @_;
1999 my $dbh = C4::Context->dbh;
2000 my $query=qq|SELECT count(*)
2001              FROM `repeatable_holidays`
2002              WHERE month=?
2003              AND day=?
2004              AND branchcode=?
2005             |;
2006 my $sth = $dbh->prepare($query);
2007 $sth->execute($month,$day,$branchcode);
2008 my $countspecial=$sth->fetchrow ;
2009 $sth->finish;
2010 return $countspecial;
2011 }
2012
2013
2014
2015 sub CheckValidBarcode{
2016 my ($barcode) = @_;
2017 my $dbh = C4::Context->dbh;
2018 my $query=qq|SELECT count(*)
2019              FROM items
2020              WHERE barcode=?
2021             |;
2022 my $sth = $dbh->prepare($query);
2023 $sth->execute($barcode);
2024 my $exist=$sth->fetchrow ;
2025 $sth->finish;
2026 return $exist;
2027 }
2028
2029 1;
2030
2031 __END__
2032
2033 =head1 AUTHOR
2034
2035 Koha Developement team <info@koha.org>
2036
2037 =cut
2038