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