C4/Circulation.pm

   1 package C4::Circulation;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 # copyright 2010 BibLibre
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along
  18 # with Koha; if not, write to the Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  20
  21
  22 use strict;
  23 #use warnings; FIXME - Bug 2505
  24 use DateTime;
  25 use C4::Context;
  26 use C4::Stats;
  27 use C4::Reserves;
  28 use C4::Biblio;
  29 use C4::Items;
  30 use C4::Members;
  31 use C4::Dates;
  32 use C4::Dates qw(format_date);
  33 use C4::Accounts;
  34 use C4::ItemCirculationAlertPreference;
  35 use C4::Message;
  36 use C4::Debug;
  37 use C4::Branch; # GetBranches
  38 use C4::Log; # logaction
  39 use C4::Koha qw(GetAuthorisedValueByCode);
  40 use C4::Overdues qw(CalcFine UpdateFine);
  41 use Data::Dumper;
  42 use Koha::DateUtils;
  43 use Koha::Calendar;
  44 use Carp;
  45
  46 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  47
  48 BEGIN {
  49         require Exporter;
  50         $VERSION = 3.02;        # for version checking
  51         @ISA    = qw(Exporter);
  52
  53         # FIXME subs that should probably be elsewhere
  54         push @EXPORT, qw(
  55                 &barcodedecode
  56         &LostItem
  57         &ReturnLostItem
  58         );
  59
  60         # subs to deal with issuing a book
  61         push @EXPORT, qw(
  62                 &CanBookBeIssued
  63                 &CanBookBeRenewed
  64                 &AddIssue
  65                 &AddRenewal
  66                 &GetRenewCount
  67                 &GetItemIssue
  68                 &GetItemIssues
  69                 &GetIssuingCharges
  70                 &GetIssuingRule
  71         &GetBranchBorrowerCircRule
  72         &GetBranchItemRule
  73                 &GetBiblioIssues
  74                 &GetOpenIssue
  75                 &AnonymiseIssueHistory
  76         );
  77
  78         # subs to deal with returns
  79         push @EXPORT, qw(
  80                 &AddReturn
  81         &MarkIssueReturned
  82         );
  83
  84         # subs to deal with transfers
  85         push @EXPORT, qw(
  86                 &transferbook
  87                 &GetTransfers
  88                 &GetTransfersFromTo
  89                 &updateWrongTransfer
  90                 &DeleteTransfer
  91                 &IsBranchTransferAllowed
  92                 &CreateBranchTransferLimit
  93                 &DeleteBranchTransferLimits
  94         &TransferSlip
  95         );
  96
  97     # subs to deal with offline circulation
  98     push @EXPORT, qw(
  99       &GetOfflineOperations
 100       &GetOfflineOperation
 101       &AddOfflineOperation
 102       &DeleteOfflineOperation
 103       &ProcessOfflineOperation
 104     );
 105 }
 106
 107 =head1 NAME
 108
 109 C4::Circulation - Koha circulation module
 110
 111 =head1 SYNOPSIS
 112
 113 use C4::Circulation;
 114
 115 =head1 DESCRIPTION
 116
 117 The functions in this module deal with circulation, issues, and
 118 returns, as well as general information about the library.
 119 Also deals with stocktaking.
 120
 121 =head1 FUNCTIONS
 122
 123 =head2 barcodedecode
 124
 125   $str = &barcodedecode($barcode, [$filter]);
 126
 127 Generic filter function for barcode string.
 128 Called on every circ if the System Pref itemBarcodeInputFilter is set.
 129 Will do some manipulation of the barcode for systems that deliver a barcode
 130 to circulation.pl that differs from the barcode stored for the item.
 131 For proper functioning of this filter, calling the function on the
 132 correct barcode string (items.barcode) should return an unaltered barcode.
 133
 134 The optional $filter argument is to allow for testing or explicit
 135 behavior that ignores the System Pref.  Valid values are the same as the
 136 System Pref options.
 137
 138 =cut
 139
 140 # FIXME -- the &decode fcn below should be wrapped into this one.
 141 # FIXME -- these plugins should be moved out of Circulation.pm
 142 #
 143 sub barcodedecode {
 144     my ($barcode, $filter) = @_;
 145     my $branch = C4::Branch::mybranch();
 146     $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
 147     $filter or return $barcode;     # ensure filter is defined, else return untouched barcode
 148         if ($filter eq 'whitespace') {
 149                 $barcode =~ s/\s//g;
 150         } elsif ($filter eq 'cuecat') {
 151                 chomp($barcode);
 152             my @fields = split( /\./, $barcode );
 153             my @results = map( decode($_), @fields[ 1 .. $#fields ] );
 154             ($#results == 2) and return $results[2];
 155         } elsif ($filter eq 'T-prefix') {
 156                 if ($barcode =~ /^[Tt](\d)/) {
 157                         (defined($1) and $1 eq '0') and return $barcode;
 158             $barcode = substr($barcode, 2) + 0;     # FIXME: probably should be substr($barcode, 1)
 159                 }
 160         return sprintf("T%07d", $barcode);
 161         # FIXME: $barcode could be "T1", causing warning: substr outside of string
 162         # Why drop the nonzero digit after the T?
 163         # Why pass non-digits (or empty string) to "T%07d"?
 164         } elsif ($filter eq 'libsuite8') {
 165                 unless($barcode =~ m/^($branch)-/i){    #if barcode starts with branch code its in Koha style. Skip it.
 166                         if($barcode =~ m/^(\d)/i){      #Some barcodes even start with 0's & numbers and are assumed to have b as the item type in the libsuite8 software
 167                                 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
 168                         }else{
 169                                 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
 170                         }
 171                 }
 172         }
 173     return $barcode;    # return barcode, modified or not
 174 }
 175
 176 =head2 decode
 177
 178   $str = &decode($chunk);
 179
 180 Decodes a segment of a string emitted by a CueCat barcode scanner and
 181 returns it.
 182
 183 FIXME: Should be replaced with Barcode::Cuecat from CPAN
 184 or Javascript based decoding on the client side.
 185
 186 =cut
 187
 188 sub decode {
 189     my ($encoded) = @_;
 190     my $seq =
 191       'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
 192     my @s = map { index( $seq, $_ ); } split( //, $encoded );
 193     my $l = ( $#s + 1 ) % 4;
 194     if ($l) {
 195         if ( $l == 1 ) {
 196             # warn "Error: Cuecat decode parsing failed!";
 197             return;
 198         }
 199         $l = 4 - $l;
 200         $#s += $l;
 201     }
 202     my $r = '';
 203     while ( $#s >= 0 ) {
 204         my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
 205         $r .=
 206             chr( ( $n >> 16 ) ^ 67 )
 207          .chr( ( $n >> 8 & 255 ) ^ 67 )
 208          .chr( ( $n & 255 ) ^ 67 );
 209         @s = @s[ 4 .. $#s ];
 210     }
 211     $r = substr( $r, 0, length($r) - $l );
 212     return $r;
 213 }
 214
 215 =head2 transferbook
 216
 217   ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
 218                                             $barcode, $ignore_reserves);
 219
 220 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
 221
 222 C<$newbranch> is the code for the branch to which the item should be transferred.
 223
 224 C<$barcode> is the barcode of the item to be transferred.
 225
 226 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
 227 Otherwise, if an item is reserved, the transfer fails.
 228
 229 Returns three values:
 230
 231 =over
 232
 233 =item $dotransfer
 234
 235 is true if the transfer was successful.
 236
 237 =item $messages
 238
 239 is a reference-to-hash which may have any of the following keys:
 240
 241 =over
 242
 243 =item C<BadBarcode>
 244
 245 There is no item in the catalog with the given barcode. The value is C<$barcode>.
 246
 247 =item C<IsPermanent>
 248
 249 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.
 250
 251 =item C<DestinationEqualsHolding>
 252
 253 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.
 254
 255 =item C<WasReturned>
 256
 257 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.
 258
 259 =item C<ResFound>
 260
 261 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>.
 262
 263 =item C<WasTransferred>
 264
 265 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
 266
 267 =back
 268
 269 =back
 270
 271 =cut
 272
 273 sub transferbook {
 274     my ( $tbr, $barcode, $ignoreRs ) = @_;
 275     my $messages;
 276     my $dotransfer      = 1;
 277     my $branches        = GetBranches();
 278     my $itemnumber = GetItemnumberFromBarcode( $barcode );
 279     my $issue      = GetItemIssue($itemnumber);
 280     my $biblio = GetBiblioFromItemNumber($itemnumber);
 281
 282     # bad barcode..
 283     if ( not $itemnumber ) {
 284         $messages->{'BadBarcode'} = $barcode;
 285         $dotransfer = 0;
 286     }
 287
 288     # get branches of book...
 289     my $hbr = $biblio->{'homebranch'};
 290     my $fbr = $biblio->{'holdingbranch'};
 291
 292     # if using Branch Transfer Limits
 293     if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
 294         if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
 295             if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
 296                 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
 297                 $dotransfer = 0;
 298             }
 299         } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
 300             $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
 301             $dotransfer = 0;
 302         }
 303     }
 304
 305     # if is permanent...
 306     if ( $hbr && $branches->{$hbr}->{'PE'} ) {
 307         $messages->{'IsPermanent'} = $hbr;
 308         $dotransfer = 0;
 309     }
 310
 311     # can't transfer book if is already there....
 312     if ( $fbr eq $tbr ) {
 313         $messages->{'DestinationEqualsHolding'} = 1;
 314         $dotransfer = 0;
 315     }
 316
 317     # check if it is still issued to someone, return it...
 318     if ($issue->{borrowernumber}) {
 319         AddReturn( $barcode, $fbr );
 320         $messages->{'WasReturned'} = $issue->{borrowernumber};
 321     }
 322
 323     # find reserves.....
 324     # That'll save a database query.
 325     my ( $resfound, $resrec, undef ) =
 326       CheckReserves( $itemnumber );
 327     if ( $resfound and not $ignoreRs ) {
 328         $resrec->{'ResFound'} = $resfound;
 329
 330         #         $messages->{'ResFound'} = $resrec;
 331         $dotransfer = 1;
 332     }
 333
 334     #actually do the transfer....
 335     if ($dotransfer) {
 336         ModItemTransfer( $itemnumber, $fbr, $tbr );
 337
 338         # don't need to update MARC anymore, we do it in batch now
 339         $messages->{'WasTransfered'} = 1;
 340
 341     }
 342     ModDateLastSeen( $itemnumber );
 343     return ( $dotransfer, $messages, $biblio );
 344 }
 345
 346
 347 sub TooMany {
 348     my $borrower        = shift;
 349     my $biblionumber = shift;
 350         my $item                = shift;
 351     my $cat_borrower    = $borrower->{'categorycode'};
 352     my $dbh             = C4::Context->dbh;
 353         my $branch;
 354         # Get which branchcode we need
 355         $branch = _GetCircControlBranch($item,$borrower);
 356         my $type = (C4::Context->preference('item-level_itypes'))
 357                         ? $item->{'itype'}         # item-level
 358                         : $item->{'itemtype'};     # biblio-level
 359
 360     # given branch, patron category, and item type, determine
 361     # applicable issuing rule
 362     my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
 363
 364     # if a rule is found and has a loan limit set, count
 365     # how many loans the patron already has that meet that
 366     # rule
 367     if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
 368         my @bind_params;
 369         my $count_query = "SELECT COUNT(*) FROM issues
 370                            JOIN items USING (itemnumber) ";
 371
 372         my $rule_itemtype = $issuing_rule->{itemtype};
 373         if ($rule_itemtype eq "*") {
 374             # matching rule has the default item type, so count only
 375             # those existing loans that don't fall under a more
 376             # specific rule
 377             if (C4::Context->preference('item-level_itypes')) {
 378                 $count_query .= " WHERE items.itype NOT IN (
 379                                     SELECT itemtype FROM issuingrules
 380                                     WHERE branchcode = ?
 381                                     AND   (categorycode = ? OR categorycode = ?)
 382                                     AND   itemtype <> '*'
 383                                   ) ";
 384             } else {
 385                 $count_query .= " JOIN  biblioitems USING (biblionumber)
 386                                   WHERE biblioitems.itemtype NOT IN (
 387                                     SELECT itemtype FROM issuingrules
 388                                     WHERE branchcode = ?
 389                                     AND   (categorycode = ? OR categorycode = ?)
 390                                     AND   itemtype <> '*'
 391                                   ) ";
 392             }
 393             push @bind_params, $issuing_rule->{branchcode};
 394             push @bind_params, $issuing_rule->{categorycode};
 395             push @bind_params, $cat_borrower;
 396         } else {
 397             # rule has specific item type, so count loans of that
 398             # specific item type
 399             if (C4::Context->preference('item-level_itypes')) {
 400                 $count_query .= " WHERE items.itype = ? ";
 401             } else {
 402                 $count_query .= " JOIN  biblioitems USING (biblionumber)
 403                                   WHERE biblioitems.itemtype= ? ";
 404             }
 405             push @bind_params, $type;
 406         }
 407
 408         $count_query .= " AND borrowernumber = ? ";
 409         push @bind_params, $borrower->{'borrowernumber'};
 410         my $rule_branch = $issuing_rule->{branchcode};
 411         if ($rule_branch ne "*") {
 412             if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
 413                 $count_query .= " AND issues.branchcode = ? ";
 414                 push @bind_params, $branch;
 415             } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
 416                 ; # if branch is the patron's home branch, then count all loans by patron
 417             } else {
 418                 $count_query .= " AND items.homebranch = ? ";
 419                 push @bind_params, $branch;
 420             }
 421         }
 422
 423         my $count_sth = $dbh->prepare($count_query);
 424         $count_sth->execute(@bind_params);
 425         my ($current_loan_count) = $count_sth->fetchrow_array;
 426
 427         my $max_loans_allowed = $issuing_rule->{'maxissueqty'};
 428         if ($current_loan_count >= $max_loans_allowed) {
 429             return ($current_loan_count, $max_loans_allowed);
 430         }
 431     }
 432
 433     # Now count total loans against the limit for the branch
 434     my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
 435     if (defined($branch_borrower_circ_rule->{maxissueqty})) {
 436         my @bind_params = ();
 437         my $branch_count_query = "SELECT COUNT(*) FROM issues
 438                                   JOIN items USING (itemnumber)
 439                                   WHERE borrowernumber = ? ";
 440         push @bind_params, $borrower->{borrowernumber};
 441
 442         if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
 443             $branch_count_query .= " AND issues.branchcode = ? ";
 444             push @bind_params, $branch;
 445         } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
 446             ; # if branch is the patron's home branch, then count all loans by patron
 447         } else {
 448             $branch_count_query .= " AND items.homebranch = ? ";
 449             push @bind_params, $branch;
 450         }
 451         my $branch_count_sth = $dbh->prepare($branch_count_query);
 452         $branch_count_sth->execute(@bind_params);
 453         my ($current_loan_count) = $branch_count_sth->fetchrow_array;
 454
 455         my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty};
 456         if ($current_loan_count >= $max_loans_allowed) {
 457             return ($current_loan_count, $max_loans_allowed);
 458         }
 459     }
 460
 461     # OK, the patron can issue !!!
 462     return;
 463 }
 464
 465 =head2 itemissues
 466
 467   @issues = &itemissues($biblioitemnumber, $biblio);
 468
 469 Looks up information about who has borrowed the bookZ<>(s) with the
 470 given biblioitemnumber.
 471
 472 C<$biblio> is ignored.
 473
 474 C<&itemissues> returns an array of references-to-hash. The keys
 475 include the fields from the C<items> table in the Koha database.
 476 Additional keys include:
 477
 478 =over 4
 479
 480 =item C<date_due>
 481
 482 If the item is currently on loan, this gives the due date.
 483
 484 If the item is not on loan, then this is either "Available" or
 485 "Cancelled", if the item has been withdrawn.
 486
 487 =item C<card>
 488
 489 If the item is currently on loan, this gives the card number of the
 490 patron who currently has the item.
 491
 492 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
 493
 494 These give the timestamp for the last three times the item was
 495 borrowed.
 496
 497 =item C<card0>, C<card1>, C<card2>
 498
 499 The card number of the last three patrons who borrowed this item.
 500
 501 =item C<borrower0>, C<borrower1>, C<borrower2>
 502
 503 The borrower number of the last three patrons who borrowed this item.
 504
 505 =back
 506
 507 =cut
 508
 509 #'
 510 sub itemissues {
 511     my ( $bibitem, $biblio ) = @_;
 512     my $dbh = C4::Context->dbh;
 513     my $sth =
 514       $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
 515       || die $dbh->errstr;
 516     my $i = 0;
 517     my @results;
 518
 519     $sth->execute($bibitem) || die $sth->errstr;
 520
 521     while ( my $data = $sth->fetchrow_hashref ) {
 522
 523         # Find out who currently has this item.
 524         # FIXME - Wouldn't it be better to do this as a left join of
 525         # some sort? Currently, this code assumes that if
 526         # fetchrow_hashref() fails, then the book is on the shelf.
 527         # fetchrow_hashref() can fail for any number of reasons (e.g.,
 528         # database server crash), not just because no items match the
 529         # search criteria.
 530         my $sth2 = $dbh->prepare(
 531             "SELECT * FROM issues
 532                 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 533                 WHERE itemnumber = ?
 534             "
 535         );
 536
 537         $sth2->execute( $data->{'itemnumber'} );
 538         if ( my $data2 = $sth2->fetchrow_hashref ) {
 539             $data->{'date_due'} = $data2->{'date_due'};
 540             $data->{'card'}     = $data2->{'cardnumber'};
 541             $data->{'borrower'} = $data2->{'borrowernumber'};
 542         }
 543         else {
 544             $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
 545         }
 546
 547
 548         # Find the last 3 people who borrowed this item.
 549         $sth2 = $dbh->prepare(
 550             "SELECT * FROM old_issues
 551                 LEFT JOIN borrowers ON  issues.borrowernumber = borrowers.borrowernumber
 552                 WHERE itemnumber = ?
 553                 ORDER BY returndate DESC,timestamp DESC"
 554         );
 555
 556         $sth2->execute( $data->{'itemnumber'} );
 557         for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
 558         {    # FIXME : error if there is less than 3 pple borrowing this item
 559             if ( my $data2 = $sth2->fetchrow_hashref ) {
 560                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
 561                 $data->{"card$i2"}      = $data2->{'cardnumber'};
 562                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
 563             }    # if
 564         }    # for
 565
 566         $results[$i] = $data;
 567         $i++;
 568     }
 569
 570     return (@results);
 571 }
 572
 573 =head2 CanBookBeIssued
 574
 575   ( $issuingimpossible, $needsconfirmation ) =  CanBookBeIssued( $borrower,
 576                       $barcode, $duedatespec, $inprocess, $ignore_reserves );
 577
 578 Check if a book can be issued.
 579
 580 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
 581
 582 =over 4
 583
 584 =item C<$borrower> hash with borrower informations (from GetMember or GetMemberDetails)
 585
 586 =item C<$barcode> is the bar code of the book being issued.
 587
 588 =item C<$duedatespec> is a C4::Dates object.
 589
 590 =item C<$inprocess> boolean switch
 591 =item C<$ignore_reserves> boolean switch
 592
 593 =back
 594
 595 Returns :
 596
 597 =over 4
 598
 599 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
 600 Possible values are :
 601
 602 =back
 603
 604 =head3 INVALID_DATE
 605
 606 sticky due date is invalid
 607
 608 =head3 GNA
 609
 610 borrower gone with no address
 611
 612 =head3 CARD_LOST
 613
 614 borrower declared it's card lost
 615
 616 =head3 DEBARRED
 617
 618 borrower debarred
 619
 620 =head3 UNKNOWN_BARCODE
 621
 622 barcode unknown
 623
 624 =head3 NOT_FOR_LOAN
 625
 626 item is not for loan
 627
 628 =head3 WTHDRAWN
 629
 630 item withdrawn.
 631
 632 =head3 RESTRICTED
 633
 634 item is restricted (set by ??)
 635
 636 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
 637 could be prevented, but ones that can be overriden by the operator.
 638
 639 Possible values are :
 640
 641 =head3 DEBT
 642
 643 borrower has debts.
 644
 645 =head3 RENEW_ISSUE
 646
 647 renewing, not issuing
 648
 649 =head3 ISSUED_TO_ANOTHER
 650
 651 issued to someone else.
 652
 653 =head3 RESERVED
 654
 655 reserved for someone else.
 656
 657 =head3 INVALID_DATE
 658
 659 sticky due date is invalid or due date in the past
 660
 661 =head3 TOO_MANY
 662
 663 if the borrower borrows to much things
 664
 665 =cut
 666
 667 sub CanBookBeIssued {
 668     my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves ) = @_;
 669     my %needsconfirmation;    # filled with problems that needs confirmations
 670     my %issuingimpossible;    # filled with problems that causes the issue to be IMPOSSIBLE
 671     my %alerts;               # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
 672
 673     my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
 674     my $issue = GetItemIssue($item->{itemnumber});
 675         my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
 676         $item->{'itemtype'}=$item->{'itype'};
 677     my $dbh             = C4::Context->dbh;
 678
 679     # MANDATORY CHECKS - unless item exists, nothing else matters
 680     unless ( $item->{barcode} ) {
 681         $issuingimpossible{UNKNOWN_BARCODE} = 1;
 682     }
 683         return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
 684
 685     #
 686     # DUE DATE is OK ? -- should already have checked.
 687     #
 688     if ($duedate && ref $duedate ne 'DateTime') {
 689         $duedate = dt_from_string($duedate);
 690     }
 691     my $now = DateTime->now( time_zone => C4::Context->tz() );
 692     unless ( $duedate ) {
 693         my $issuedate = $now->clone();
 694
 695         my $branch = _GetCircControlBranch($item,$borrower);
 696         my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
 697         $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
 698
 699         # Offline circ calls AddIssue directly, doesn't run through here
 700         #  So issuingimpossible should be ok.
 701     }
 702     if ($duedate) {
 703         my $today = $now->clone();
 704         $today->truncate( to => 'minutes');
 705         if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
 706             $needsconfirmation{INVALID_DATE} = output_pref($duedate);
 707         }
 708     } else {
 709             $issuingimpossible{INVALID_DATE} = output_pref($duedate);
 710     }
 711
 712     #
 713     # BORROWER STATUS
 714     #
 715     if ( $borrower->{'category_type'} eq 'X' && (  $item->{barcode}  )) {
 716         # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1  .
 717         &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
 718         ModDateLastSeen( $item->{'itemnumber'} );
 719         return( { STATS => 1 }, {});
 720     }
 721     if ( $borrower->{flags}->{GNA} ) {
 722         $issuingimpossible{GNA} = 1;
 723     }
 724     if ( $borrower->{flags}->{'LOST'} ) {
 725         $issuingimpossible{CARD_LOST} = 1;
 726     }
 727     if ( $borrower->{flags}->{'DBARRED'} ) {
 728         $issuingimpossible{DEBARRED} = 1;
 729     }
 730     if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
 731         $issuingimpossible{EXPIRED} = 1;
 732     } else {
 733         my ($y, $m, $d) =  split /-/,$borrower->{'dateexpiry'};
 734         if ($y && $m && $d) { # are we really writing oinvalid dates to borrs
 735             my $expiry_dt = DateTime->new(
 736                 year => $y,
 737                 month => $m,
 738                 day   => $d,
 739                 time_zone => C4::Context->tz,
 740             );
 741             $expiry_dt->truncate( to => 'days');
 742             my $today = $now->clone()->truncate(to => 'days');
 743             if (DateTime->compare($today, $expiry_dt) == 1) {
 744                 $issuingimpossible{EXPIRED} = 1;
 745             }
 746         } else {
 747             carp("Invalid expity date in borr");
 748             $issuingimpossible{EXPIRED} = 1;
 749         }
 750     }
 751     #
 752     # BORROWER STATUS
 753     #
 754
 755     # DEBTS
 756     my ($amount) =
 757       C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->ymd() );
 758     my $amountlimit = C4::Context->preference("noissuescharge");
 759     my $allowfineoverride = C4::Context->preference("AllowFineOverride");
 760     my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
 761     if ( C4::Context->preference("IssuingInProcess") ) {
 762         if ( $amount > $amountlimit && !$inprocess && !$allowfineoverride) {
 763             $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
 764         } elsif ( $amount > $amountlimit && !$inprocess && $allowfineoverride) {
 765             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
 766         } elsif ( $allfinesneedoverride && $amount > 0 && $amount <= $amountlimit && !$inprocess ) {
 767             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
 768         }
 769     }
 770     else {
 771         if ( $amount > $amountlimit && $allowfineoverride ) {
 772             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
 773         } elsif ( $amount > $amountlimit && !$allowfineoverride) {
 774             $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
 775         } elsif ( $amount > 0 && $allfinesneedoverride ) {
 776             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
 777         }
 778     }
 779
 780     my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
 781     if ($blocktype == -1) {
 782         ## patron has outstanding overdue loans
 783             if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
 784                 $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
 785             }
 786             elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
 787                 $needsconfirmation{USERBLOCKEDOVERDUE} = $count;
 788             }
 789     } elsif($blocktype == 1) {
 790         # patron has accrued fine days
 791         $issuingimpossible{USERBLOCKEDREMAINING} = $count;
 792     }
 793
 794 #
 795     # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
 796     #
 797         my ($current_loan_count, $max_loans_allowed) = TooMany( $borrower, $item->{biblionumber}, $item );
 798     # if TooMany max_loans_allowed returns 0 the user doesn't have permission to check out this book
 799     if (defined $max_loans_allowed && $max_loans_allowed == 0) {
 800         $needsconfirmation{PATRON_CANT} = 1;
 801     } else {
 802         if($max_loans_allowed){
 803             $needsconfirmation{TOO_MANY} = 1;
 804             $needsconfirmation{current_loan_count} = $current_loan_count;
 805             $needsconfirmation{max_loans_allowed} = $max_loans_allowed;
 806         }
 807     }
 808
 809     #
 810     # ITEM CHECKING
 811     #
 812     if (   $item->{'notforloan'}
 813         && $item->{'notforloan'} > 0 )
 814     {
 815         if(!C4::Context->preference("AllowNotForLoanOverride")){
 816             $issuingimpossible{NOT_FOR_LOAN} = 1;
 817         }else{
 818             $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 819         }
 820     }
 821     elsif ( !$item->{'notforloan'} ){
 822         # we have to check itemtypes.notforloan also
 823         if (C4::Context->preference('item-level_itypes')){
 824             # this should probably be a subroutine
 825             my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
 826             $sth->execute($item->{'itemtype'});
 827             my $notforloan=$sth->fetchrow_hashref();
 828             $sth->finish();
 829             if ($notforloan->{'notforloan'}) {
 830                 if (!C4::Context->preference("AllowNotForLoanOverride")) {
 831                     $issuingimpossible{NOT_FOR_LOAN} = 1;
 832                 } else {
 833                     $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 834                 }
 835             }
 836         }
 837         elsif ($biblioitem->{'notforloan'} == 1){
 838             if (!C4::Context->preference("AllowNotForLoanOverride")) {
 839                 $issuingimpossible{NOT_FOR_LOAN} = 1;
 840             } else {
 841                 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 842             }
 843         }
 844     }
 845     if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} > 0 )
 846     {
 847         $issuingimpossible{WTHDRAWN} = 1;
 848     }
 849     if (   $item->{'restricted'}
 850         && $item->{'restricted'} == 1 )
 851     {
 852         $issuingimpossible{RESTRICTED} = 1;
 853     }
 854     if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
 855         my $code = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
 856         $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
 857         $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
 858     }
 859     if ( C4::Context->preference("IndependantBranches") ) {
 860         my $userenv = C4::Context->userenv;
 861         if ( ($userenv) && ( $userenv->{flags} % 2 != 1 ) ) {
 862             $issuingimpossible{ITEMNOTSAMEBRANCH} = 1
 863               if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
 864             $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
 865               if ( $borrower->{'branchcode'} ne $userenv->{branch} );
 866         }
 867     }
 868
 869     #
 870     # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
 871     #
 872     if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
 873     {
 874
 875         # Already issued to current borrower. Ask whether the loan should
 876         # be renewed.
 877         my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
 878             $borrower->{'borrowernumber'},
 879             $item->{'itemnumber'}
 880         );
 881         if ( $CanBookBeRenewed == 0 ) {    # no more renewals allowed
 882             $issuingimpossible{NO_MORE_RENEWALS} = 1;
 883         }
 884         else {
 885             $needsconfirmation{RENEW_ISSUE} = 1;
 886         }
 887     }
 888     elsif ($issue->{borrowernumber}) {
 889
 890         # issued to someone else
 891         my $currborinfo =    C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
 892
 893 #        warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
 894         $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
 895         $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
 896         $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
 897         $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
 898         $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
 899     }
 900
 901     unless ( $ignore_reserves ) {
 902         # See if the item is on reserve.
 903         my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
 904         if ($restype) {
 905             my $resbor = $res->{'borrowernumber'};
 906             if ( $resbor ne $borrower->{'borrowernumber'} ) {
 907                 my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
 908                 my $branchname = GetBranchName( $res->{'branchcode'} );
 909                 if ( $restype eq "Waiting" )
 910                 {
 911                     # The item is on reserve and waiting, but has been
 912                     # reserved by some other patron.
 913                     $needsconfirmation{RESERVE_WAITING} = 1;
 914                     $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
 915                     $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
 916                     $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
 917                     $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
 918                     $needsconfirmation{'resbranchname'} = $branchname;
 919                     $needsconfirmation{'reswaitingdate'} = format_date($res->{'waitingdate'});
 920                 }
 921                 elsif ( $restype eq "Reserved" ) {
 922                     # The item is on reserve for someone else.
 923                     $needsconfirmation{RESERVED} = 1;
 924                     $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
 925                     $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
 926                     $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
 927                     $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
 928                     $needsconfirmation{'resbranchname'} = $branchname;
 929                     $needsconfirmation{'resreservedate'} = format_date($res->{'reservedate'});
 930                 }
 931             }
 932         }
 933     }
 934     return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
 935 }
 936
 937 =head2 AddIssue
 938
 939   &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
 940
 941 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
 942
 943 =over 4
 944
 945 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).
 946
 947 =item C<$barcode> is the barcode of the item being issued.
 948
 949 =item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional).
 950 Calculated if empty.
 951
 952 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
 953
 954 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
 955 Defaults to today.  Unlike C<$datedue>, NOT a C4::Dates object, unfortunately.
 956
 957 AddIssue does the following things :
 958
 959   - step 01: check that there is a borrowernumber & a barcode provided
 960   - check for RENEWAL (book issued & being issued to the same patron)
 961       - renewal YES = Calculate Charge & renew
 962       - renewal NO  =
 963           * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
 964           * RESERVE PLACED ?
 965               - fill reserve if reserve to this patron
 966               - cancel reserve or not, otherwise
 967           * TRANSFERT PENDING ?
 968               - complete the transfert
 969           * ISSUE THE BOOK
 970
 971 =back
 972
 973 =cut
 974
 975 sub AddIssue {
 976     my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_;
 977     my $dbh = C4::Context->dbh;
 978         my $barcodecheck=CheckValidBarcode($barcode);
 979     if ($datedue && ref $datedue ne 'DateTime') {
 980         $datedue = dt_from_string($datedue);
 981     }
 982     # $issuedate defaults to today.
 983     if ( ! defined $issuedate ) {
 984         $issuedate = DateTime->now(time_zone => C4::Context->tz());
 985     }
 986     else {
 987         if ( ref $issuedate ne 'DateTime') {
 988             $issuedate = dt_from_string($issuedate);
 989
 990         }
 991     }
 992         if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf
 993                 # find which item we issue
 994                 my $item = GetItem('', $barcode) or return undef;       # if we don't get an Item, abort.
 995                 my $branch = _GetCircControlBranch($item,$borrower);
 996
 997                 # get actual issuing if there is one
 998                 my $actualissue = GetItemIssue( $item->{itemnumber});
 999
1000                 # get biblioinformation for this item
1001                 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
1002
1003                 #
1004                 # check if we just renew the issue.
1005                 #
1006                 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
1007                     $datedue = AddRenewal(
1008                         $borrower->{'borrowernumber'},
1009                         $item->{'itemnumber'},
1010                         $branch,
1011                         $datedue,
1012                         $issuedate, # here interpreted as the renewal date
1013                         );
1014                 }
1015                 else {
1016         # it's NOT a renewal
1017                         if ( $actualissue->{borrowernumber}) {
1018                                 # This book is currently on loan, but not to the person
1019                                 # who wants to borrow it now. mark it returned before issuing to the new borrower
1020                                 AddReturn(
1021                                         $item->{'barcode'},
1022                                         C4::Context->userenv->{'branch'}
1023                                 );
1024                         }
1025
1026             MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1027                         # Starting process for transfer job (checking transfert and validate it if we have one)
1028             my ($datesent) = GetTransfers($item->{'itemnumber'});
1029             if ($datesent) {
1030         #       updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1031                 my $sth =
1032                     $dbh->prepare(
1033                     "UPDATE branchtransfers
1034                         SET datearrived = now(),
1035                         tobranch = ?,
1036                         comments = 'Forced branchtransfer'
1037                     WHERE itemnumber= ? AND datearrived IS NULL"
1038                     );
1039                 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
1040             }
1041
1042         # Record in the database the fact that the book was issued.
1043         my $sth =
1044           $dbh->prepare(
1045                 "INSERT INTO issues
1046                     (borrowernumber, itemnumber,issuedate, date_due, branchcode)
1047                 VALUES (?,?,?,?,?)"
1048           );
1049         unless ($datedue) {
1050             my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1051             $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1052
1053         }
1054         $datedue->truncate( to => 'minutes');
1055         $sth->execute(
1056             $borrower->{'borrowernumber'},      # borrowernumber
1057             $item->{'itemnumber'},              # itemnumber
1058             $issuedate->strftime('%Y-%m-%d %H:%M:00'), # issuedate
1059             $datedue->strftime('%Y-%m-%d %H:%M:00'),   # date_due
1060             C4::Context->userenv->{'branch'}    # branchcode
1061         );
1062         if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1063           CartToShelf( $item->{'itemnumber'} );
1064         }
1065         $item->{'issues'}++;
1066
1067         ## If item was lost, it has now been found, reverse any list item charges if neccessary.
1068         if ( $item->{'itemlost'} ) {
1069             _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef, $item->{'barcode'} );
1070         }
1071
1072         ModItem({ issues           => $item->{'issues'},
1073                   holdingbranch    => C4::Context->userenv->{'branch'},
1074                   itemlost         => 0,
1075                   datelastborrowed => DateTime->now(time_zone => C4::Context->tz())->ymd(),
1076                   onloan           => $datedue->ymd(),
1077                 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1078         ModDateLastSeen( $item->{'itemnumber'} );
1079
1080         # If it costs to borrow this book, charge it to the patron's account.
1081         my ( $charge, $itemtype ) = GetIssuingCharges(
1082             $item->{'itemnumber'},
1083             $borrower->{'borrowernumber'}
1084         );
1085         if ( $charge > 0 ) {
1086             AddIssuingCharge(
1087                 $item->{'itemnumber'},
1088                 $borrower->{'borrowernumber'}, $charge
1089             );
1090             $item->{'charge'} = $charge;
1091         }
1092
1093         # Record the fact that this book was issued.
1094         &UpdateStats(
1095             C4::Context->userenv->{'branch'},
1096             'issue', $charge,
1097             ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
1098             $item->{'itype'}, $borrower->{'borrowernumber'}
1099         );
1100
1101         # Send a checkout slip.
1102         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1103         my %conditions = (
1104             branchcode   => $branch,
1105             categorycode => $borrower->{categorycode},
1106             item_type    => $item->{itype},
1107             notification => 'CHECKOUT',
1108         );
1109         if ($circulation_alert->is_enabled_for(\%conditions)) {
1110             SendCirculationAlert({
1111                 type     => 'CHECKOUT',
1112                 item     => $item,
1113                 borrower => $borrower,
1114                 branch   => $branch,
1115             });
1116         }
1117     }
1118
1119     logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1120         if C4::Context->preference("IssueLog");
1121   }
1122   return ($datedue);    # not necessarily the same as when it came in!
1123 }
1124
1125 =head2 GetLoanLength
1126
1127   my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1128
1129 Get loan length for an itemtype, a borrower type and a branch
1130
1131 =cut
1132
1133 sub GetLoanLength {
1134     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1135     my $dbh = C4::Context->dbh;
1136     my $sth =
1137       $dbh->prepare(
1138 'select issuelength, lengthunit from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null'
1139       );
1140 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1141 # try to find issuelength & return the 1st available.
1142 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1143     $sth->execute( $borrowertype, $itemtype, $branchcode );
1144     my $loanlength = $sth->fetchrow_hashref;
1145     return $loanlength
1146       if defined($loanlength) && $loanlength->{issuelength};
1147
1148     $sth->execute( $borrowertype, '*', $branchcode );
1149     $loanlength = $sth->fetchrow_hashref;
1150     return $loanlength
1151       if defined($loanlength) && $loanlength->{issuelength};
1152
1153     $sth->execute( '*', $itemtype, $branchcode );
1154     $loanlength = $sth->fetchrow_hashref;
1155     return $loanlength
1156       if defined($loanlength) && $loanlength->{issuelength};
1157
1158     $sth->execute( '*', '*', $branchcode );
1159     $loanlength = $sth->fetchrow_hashref;
1160     return $loanlength
1161       if defined($loanlength) && $loanlength->{issuelength};
1162
1163     $sth->execute( $borrowertype, $itemtype, '*' );
1164     $loanlength = $sth->fetchrow_hashref;
1165     return $loanlength
1166       if defined($loanlength) && $loanlength->{issuelength};
1167
1168     $sth->execute( $borrowertype, '*', '*' );
1169     $loanlength = $sth->fetchrow_hashref;
1170     return $loanlength
1171       if defined($loanlength) && $loanlength->{issuelength};
1172
1173     $sth->execute( '*', $itemtype, '*' );
1174     $loanlength = $sth->fetchrow_hashref;
1175     return $loanlength
1176       if defined($loanlength) && $loanlength->{issuelength};
1177
1178     $sth->execute( '*', '*', '*' );
1179     $loanlength = $sth->fetchrow_hashref;
1180     return $loanlength
1181       if defined($loanlength) && $loanlength->{issuelength};
1182
1183     # if no rule is set => 21 days (hardcoded)
1184     return {
1185         issuelength => 21,
1186         lengthunit => 'days',
1187     };
1188
1189 }
1190
1191
1192 =head2 GetHardDueDate
1193
1194   my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1195
1196 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1197
1198 =cut
1199
1200 sub GetHardDueDate {
1201     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1202     my $dbh = C4::Context->dbh;
1203     my $sth =
1204       $dbh->prepare(
1205 "select hardduedate, hardduedatecompare from issuingrules where categorycode=? and itemtype=? and branchcode=?"
1206       );
1207     $sth->execute( $borrowertype, $itemtype, $branchcode );
1208     my $results = $sth->fetchrow_hashref;
1209     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1210       if defined($results) && $results->{hardduedate};
1211
1212     $sth->execute( $borrowertype, "*", $branchcode );
1213     $results = $sth->fetchrow_hashref;
1214     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1215       if defined($results) && $results->{hardduedate};
1216
1217     $sth->execute( "*", $itemtype, $branchcode );
1218     $results = $sth->fetchrow_hashref;
1219     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1220       if defined($results) && $results->{hardduedate};
1221
1222     $sth->execute( "*", "*", $branchcode );
1223     $results = $sth->fetchrow_hashref;
1224     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1225       if defined($results) && $results->{hardduedate};
1226
1227     $sth->execute( $borrowertype, $itemtype, "*" );
1228     $results = $sth->fetchrow_hashref;
1229     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1230       if defined($results) && $results->{hardduedate};
1231
1232     $sth->execute( $borrowertype, "*", "*" );
1233     $results = $sth->fetchrow_hashref;
1234     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1235       if defined($results) && $results->{hardduedate};
1236
1237     $sth->execute( "*", $itemtype, "*" );
1238     $results = $sth->fetchrow_hashref;
1239     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1240       if defined($results) && $results->{hardduedate};
1241
1242     $sth->execute( "*", "*", "*" );
1243     $results = $sth->fetchrow_hashref;
1244     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1245       if defined($results) && $results->{hardduedate};
1246
1247     # if no rule is set => return undefined
1248     return (undef, undef);
1249 }
1250
1251 =head2 GetIssuingRule
1252
1253   my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1254
1255 FIXME - This is a copy-paste of GetLoanLength
1256 as a stop-gap.  Do not wish to change API for GetLoanLength
1257 this close to release, however, Overdues::GetIssuingRules is broken.
1258
1259 Get the issuing rule for an itemtype, a borrower type and a branch
1260 Returns a hashref from the issuingrules table.
1261
1262 =cut
1263
1264 sub GetIssuingRule {
1265     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1266     my $dbh = C4::Context->dbh;
1267     my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"  );
1268     my $irule;
1269
1270         $sth->execute( $borrowertype, $itemtype, $branchcode );
1271     $irule = $sth->fetchrow_hashref;
1272     return $irule if defined($irule) ;
1273
1274     $sth->execute( $borrowertype, "*", $branchcode );
1275     $irule = $sth->fetchrow_hashref;
1276     return $irule if defined($irule) ;
1277
1278     $sth->execute( "*", $itemtype, $branchcode );
1279     $irule = $sth->fetchrow_hashref;
1280     return $irule if defined($irule) ;
1281
1282     $sth->execute( "*", "*", $branchcode );
1283     $irule = $sth->fetchrow_hashref;
1284     return $irule if defined($irule) ;
1285
1286     $sth->execute( $borrowertype, $itemtype, "*" );
1287     $irule = $sth->fetchrow_hashref;
1288     return $irule if defined($irule) ;
1289
1290     $sth->execute( $borrowertype, "*", "*" );
1291     $irule = $sth->fetchrow_hashref;
1292     return $irule if defined($irule) ;
1293
1294     $sth->execute( "*", $itemtype, "*" );
1295     $irule = $sth->fetchrow_hashref;
1296     return $irule if defined($irule) ;
1297
1298     $sth->execute( "*", "*", "*" );
1299     $irule = $sth->fetchrow_hashref;
1300     return $irule if defined($irule) ;
1301
1302     # if no rule matches,
1303     return undef;
1304 }
1305
1306 =head2 GetBranchBorrowerCircRule
1307
1308   my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1309
1310 Retrieves circulation rule attributes that apply to the given
1311 branch and patron category, regardless of item type.
1312 The return value is a hashref containing the following key:
1313
1314 maxissueqty - maximum number of loans that a
1315 patron of the given category can have at the given
1316 branch.  If the value is undef, no limit.
1317
1318 This will first check for a specific branch and
1319 category match from branch_borrower_circ_rules.
1320
1321 If no rule is found, it will then check default_branch_circ_rules
1322 (same branch, default category).  If no rule is found,
1323 it will then check default_borrower_circ_rules (default
1324 branch, same category), then failing that, default_circ_rules
1325 (default branch, default category).
1326
1327 If no rule has been found in the database, it will default to
1328 the buillt in rule:
1329
1330 maxissueqty - undef
1331
1332 C<$branchcode> and C<$categorycode> should contain the
1333 literal branch code and patron category code, respectively - no
1334 wildcards.
1335
1336 =cut
1337
1338 sub GetBranchBorrowerCircRule {
1339     my $branchcode = shift;
1340     my $categorycode = shift;
1341
1342     my $branch_cat_query = "SELECT maxissueqty
1343                             FROM branch_borrower_circ_rules
1344                             WHERE branchcode = ?
1345                             AND   categorycode = ?";
1346     my $dbh = C4::Context->dbh();
1347     my $sth = $dbh->prepare($branch_cat_query);
1348     $sth->execute($branchcode, $categorycode);
1349     my $result;
1350     if ($result = $sth->fetchrow_hashref()) {
1351         return $result;
1352     }
1353
1354     # try same branch, default borrower category
1355     my $branch_query = "SELECT maxissueqty
1356                         FROM default_branch_circ_rules
1357                         WHERE branchcode = ?";
1358     $sth = $dbh->prepare($branch_query);
1359     $sth->execute($branchcode);
1360     if ($result = $sth->fetchrow_hashref()) {
1361         return $result;
1362     }
1363
1364     # try default branch, same borrower category
1365     my $category_query = "SELECT maxissueqty
1366                           FROM default_borrower_circ_rules
1367                           WHERE categorycode = ?";
1368     $sth = $dbh->prepare($category_query);
1369     $sth->execute($categorycode);
1370     if ($result = $sth->fetchrow_hashref()) {
1371         return $result;
1372     }
1373
1374     # try default branch, default borrower category
1375     my $default_query = "SELECT maxissueqty
1376                           FROM default_circ_rules";
1377     $sth = $dbh->prepare($default_query);
1378     $sth->execute();
1379     if ($result = $sth->fetchrow_hashref()) {
1380         return $result;
1381     }
1382
1383     # built-in default circulation rule
1384     return {
1385         maxissueqty => undef,
1386     };
1387 }
1388
1389 =head2 GetBranchItemRule
1390
1391   my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1392
1393 Retrieves circulation rule attributes that apply to the given
1394 branch and item type, regardless of patron category.
1395
1396 The return value is a hashref containing the following keys:
1397
1398 holdallowed => Hold policy for this branch and itemtype. Possible values:
1399   0: No holds allowed.
1400   1: Holds allowed only by patrons that have the same homebranch as the item.
1401   2: Holds allowed from any patron.
1402
1403 returnbranch => branch to which to return item.  Possible values:
1404   noreturn: do not return, let item remain where checked in (floating collections)
1405   homebranch: return to item's home branch
1406
1407 This searches branchitemrules in the following order:
1408
1409   * Same branchcode and itemtype
1410   * Same branchcode, itemtype '*'
1411   * branchcode '*', same itemtype
1412   * branchcode and itemtype '*'
1413
1414 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1415
1416 =cut
1417
1418 sub GetBranchItemRule {
1419     my ( $branchcode, $itemtype ) = @_;
1420     my $dbh = C4::Context->dbh();
1421     my $result = {};
1422
1423     my @attempts = (
1424         ['SELECT holdallowed, returnbranch
1425             FROM branch_item_rules
1426             WHERE branchcode = ?
1427               AND itemtype = ?', $branchcode, $itemtype],
1428         ['SELECT holdallowed, returnbranch
1429             FROM default_branch_circ_rules
1430             WHERE branchcode = ?', $branchcode],
1431         ['SELECT holdallowed, returnbranch
1432             FROM default_branch_item_rules
1433             WHERE itemtype = ?', $itemtype],
1434         ['SELECT holdallowed, returnbranch
1435             FROM default_circ_rules'],
1436     );
1437
1438     foreach my $attempt (@attempts) {
1439         my ($query, @bind_params) = @{$attempt};
1440         my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params );
1441
1442         # Since branch/category and branch/itemtype use the same per-branch
1443         # defaults tables, we have to check that the key we want is set, not
1444         # just that a row was returned
1445         $result->{'holdallowed'}  = $search_result->{'holdallowed'}  unless ( defined $result->{'holdallowed'} );
1446         $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1447     }
1448
1449     # built-in default circulation rule
1450     $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1451     $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1452
1453     return $result;
1454 }
1455
1456 =head2 AddReturn
1457
1458   ($doreturn, $messages, $iteminformation, $borrower) =
1459       &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1460
1461 Returns a book.
1462
1463 =over 4
1464
1465 =item C<$barcode> is the bar code of the book being returned.
1466
1467 =item C<$branch> is the code of the branch where the book is being returned.
1468
1469 =item C<$exemptfine> indicates that overdue charges for the item will be
1470 removed.
1471
1472 =item C<$dropbox> indicates that the check-in date is assumed to be
1473 yesterday, or the last non-holiday as defined in C4::Calendar .  If
1474 overdue charges are applied and C<$dropbox> is true, the last charge
1475 will be removed.  This assumes that the fines accrual script has run
1476 for _today_.
1477
1478 =back
1479
1480 C<&AddReturn> returns a list of four items:
1481
1482 C<$doreturn> is true iff the return succeeded.
1483
1484 C<$messages> is a reference-to-hash giving feedback on the operation.
1485 The keys of the hash are:
1486
1487 =over 4
1488
1489 =item C<BadBarcode>
1490
1491 No item with this barcode exists. The value is C<$barcode>.
1492
1493 =item C<NotIssued>
1494
1495 The book is not currently on loan. The value is C<$barcode>.
1496
1497 =item C<IsPermanent>
1498
1499 The book's home branch is a permanent collection. If you have borrowed
1500 this book, you are not allowed to return it. The value is the code for
1501 the book's home branch.
1502
1503 =item C<wthdrawn>
1504
1505 This book has been withdrawn/cancelled. The value should be ignored.
1506
1507 =item C<Wrongbranch>
1508
1509 This book has was returned to the wrong branch.  The value is a hashref
1510 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1511 contain the branchcode of the incorrect and correct return library, respectively.
1512
1513 =item C<ResFound>
1514
1515 The item was reserved. The value is a reference-to-hash whose keys are
1516 fields from the reserves table of the Koha database, and
1517 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1518 either C<Waiting>, C<Reserved>, or 0.
1519
1520 =back
1521
1522 C<$iteminformation> is a reference-to-hash, giving information about the
1523 returned item from the issues table.
1524
1525 C<$borrower> is a reference-to-hash, giving information about the
1526 patron who last borrowed the book.
1527
1528 =cut
1529
1530 sub AddReturn {
1531     my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1532     if ($branch and not GetBranchDetail($branch)) {
1533         warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
1534         undef $branch;
1535     }
1536     $branch = C4::Context->userenv->{'branch'} unless $branch;  # we trust userenv to be a safe fallback/default
1537     my $messages;
1538     my $borrower;
1539     my $biblio;
1540     my $doreturn       = 1;
1541     my $validTransfert = 0;
1542     my $stat_type = 'return';
1543
1544     # get information on item
1545     my $itemnumber = GetItemnumberFromBarcode( $barcode );
1546     unless ($itemnumber) {
1547         return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower.  bail out.
1548     }
1549     my $issue  = GetItemIssue($itemnumber);
1550 #   warn Dumper($iteminformation);
1551     if ($issue and $issue->{borrowernumber}) {
1552         $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1553             or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existant borrowernumber '$issue->{borrowernumber}'\n"
1554                 . Dumper($issue) . "\n";
1555     } else {
1556         $messages->{'NotIssued'} = $barcode;
1557         # even though item is not on loan, it may still be transferred;  therefore, get current branch info
1558         $doreturn = 0;
1559         # No issue, no borrowernumber.  ONLY if $doreturn, *might* you have a $borrower later.
1560         # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1561         if (C4::Context->preference("RecordLocalUseOnReturn")) {
1562            $messages->{'LocalUse'} = 1;
1563            $stat_type = 'localuse';
1564         }
1565     }
1566
1567     my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1568         # full item data, but no borrowernumber or checkout info (no issue)
1569         # we know GetItem should work because GetItemnumberFromBarcode worked
1570     my $hbr      = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1571         # get the proper branch to which to return the item
1572     $hbr = $item->{$hbr} || $branch ;
1573         # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1574
1575     my $borrowernumber = $borrower->{'borrowernumber'} || undef;    # we don't know if we had a borrower or not
1576
1577     # check if the book is in a permanent collection....
1578     # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
1579     if ( $hbr ) {
1580         my $branches = GetBranches();    # a potentially expensive call for a non-feature.
1581         $branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr;
1582     }
1583
1584     # if indy branches and returning to different branch, refuse the return unless canreservefromotherbranches is turned on
1585     if ($hbr ne $branch && C4::Context->preference("IndependantBranches") && !(C4::Context->preference("canreservefromotherbranches"))){
1586         $messages->{'Wrongbranch'} = {
1587             Wrongbranch => $branch,
1588             Rightbranch => $hbr,
1589         };
1590         $doreturn = 0;
1591         # bailing out here - in this case, current desired behavior
1592         # is to act as if no return ever happened at all.
1593         # FIXME - even in an indy branches situation, there should
1594         # still be an option for the library to accept the item
1595         # and transfer it to its owning library.
1596         return ( $doreturn, $messages, $issue, $borrower );
1597     }
1598
1599     if ( $item->{'wthdrawn'} ) { # book has been cancelled
1600         $messages->{'wthdrawn'} = 1;
1601         $doreturn = 0;
1602     }
1603
1604     # case of a return of document (deal with issues and holdingbranch)
1605     if ($doreturn) {
1606     my $today = DateTime->now( time_zone => C4::Context->tz() );
1607     my $datedue = $issue->{date_due};
1608         $borrower or warn "AddReturn without current borrower";
1609                 my $circControlBranch;
1610         if ($dropbox) {
1611             # define circControlBranch only if dropbox mode is set
1612             # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1613             # FIXME: check issuedate > returndate, factoring in holidays
1614             #$circControlBranch = _GetCircControlBranch($item,$borrower) unless ( $item->{'issuedate'} eq C4::Dates->today('iso') );;
1615             $circControlBranch = _GetCircControlBranch($item,$borrower);
1616         my $datedue = $issue->{date_due};
1617         $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $today ) == -1 ? 1 : 0;
1618         }
1619
1620         if ($borrowernumber) {
1621         if($issue->{'overdue'}){
1622                 my ( $amount, $type, $daycounttotal ) = C4::Overdues::CalcFine( $item, $borrower->{categorycode},$branch, $datedue, $today );
1623                 $type ||= q{};
1624         if ( $amount > 0 && ( C4::Context->preference('finesMode') eq 'production' )) {
1625           C4::Overdues::UpdateFine(
1626               $issue->{itemnumber},
1627               $issue->{borrowernumber},
1628                       $amount, $type, output_pref($datedue)
1629               );
1630         }
1631             }
1632             MarkIssueReturned($borrowernumber, $item->{'itemnumber'}, $circControlBranch, '', $borrower->{'privacy'});
1633             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?  This could be the borrower hash.
1634         }
1635
1636         ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1637     }
1638
1639     # the holdingbranch is updated if the document is returned to another location.
1640     # this is always done regardless of whether the item was on loan or not
1641     if ($item->{'holdingbranch'} ne $branch) {
1642         UpdateHoldingbranch($branch, $item->{'itemnumber'});
1643         $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1644     }
1645     ModDateLastSeen( $item->{'itemnumber'} );
1646
1647     # check if we have a transfer for this document
1648     my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1649
1650     # if we have a transfer to do, we update the line of transfers with the datearrived
1651     if ($datesent) {
1652         if ( $tobranch eq $branch ) {
1653             my $sth = C4::Context->dbh->prepare(
1654                 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1655             );
1656             $sth->execute( $item->{'itemnumber'} );
1657             # if we have a reservation with valid transfer, we can set it's status to 'W'
1658             C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1659         } else {
1660             $messages->{'WrongTransfer'}     = $tobranch;
1661             $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1662         }
1663         $validTransfert = 1;
1664     }
1665
1666     # fix up the accounts.....
1667     if ($item->{'itemlost'}) {
1668         _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode);    # can tolerate undef $borrowernumber
1669         $messages->{'WasLost'} = 1;
1670     }
1671
1672     # fix up the overdues in accounts...
1673     if ($borrowernumber) {
1674         my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1675         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!";  # zero is OK, check defined
1676
1677         # fix fine days
1678         my $debardate = _FixFineDaysOnReturn( $borrower, $item, $issue->{date_due} );
1679         $messages->{'Debarred'} = $debardate if ($debardate);
1680     }
1681
1682     # find reserves.....
1683     # if we don't have a reserve with the status W, we launch the Checkreserves routine
1684     my ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1685     if ($resfound) {
1686           $resrec->{'ResFound'} = $resfound;
1687         $messages->{'ResFound'} = $resrec;
1688     }
1689
1690     # update stats?
1691     # Record the fact that this book was returned.
1692     UpdateStats(
1693         $branch, $stat_type, '0', '',
1694         $item->{'itemnumber'},
1695         $biblio->{'itemtype'},
1696         $borrowernumber
1697     );
1698
1699     # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
1700     my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1701     my %conditions = (
1702         branchcode   => $branch,
1703         categorycode => $borrower->{categorycode},
1704         item_type    => $item->{itype},
1705         notification => 'CHECKIN',
1706     );
1707     if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
1708         SendCirculationAlert({
1709             type     => 'CHECKIN',
1710             item     => $item,
1711             borrower => $borrower,
1712             branch   => $branch,
1713         });
1714     }
1715
1716     logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'})
1717         if C4::Context->preference("ReturnLog");
1718
1719     # FIXME: make this comment intelligible.
1720     #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1721     #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1722
1723     if (($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $hbr) and not $messages->{'WrongTransfer'}){
1724         if ( C4::Context->preference("AutomaticItemReturn"    ) or
1725             (C4::Context->preference("UseBranchTransferLimits") and
1726              ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} )
1727            )) {
1728             $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
1729             $debug and warn "item: " . Dumper($item);
1730             ModItemTransfer($item->{'itemnumber'}, $branch, $hbr);
1731             $messages->{'WasTransfered'} = 1;
1732         } else {
1733             $messages->{'NeedsTransfer'} = 1;   # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
1734         }
1735     }
1736     return ( $doreturn, $messages, $issue, $borrower );
1737 }
1738
1739 =head2 MarkIssueReturned
1740
1741   MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
1742
1743 Unconditionally marks an issue as being returned by
1744 moving the C<issues> row to C<old_issues> and
1745 setting C<returndate> to the current date, or
1746 the last non-holiday date of the branccode specified in
1747 C<dropbox_branch> .  Assumes you've already checked that
1748 it's safe to do this, i.e. last non-holiday > issuedate.
1749
1750 if C<$returndate> is specified (in iso format), it is used as the date
1751 of the return. It is ignored when a dropbox_branch is passed in.
1752
1753 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
1754 the old_issue is immediately anonymised
1755
1756 Ideally, this function would be internal to C<C4::Circulation>,
1757 not exported, but it is currently needed by one
1758 routine in C<C4::Accounts>.
1759
1760 =cut
1761
1762 sub MarkIssueReturned {
1763     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
1764     my $dbh   = C4::Context->dbh;
1765     my $query = 'UPDATE issues SET returndate=';
1766     my @bind;
1767     if ($dropbox_branch) {
1768         my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
1769         my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
1770         $query .= ' ? ';
1771         push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
1772     } elsif ($returndate) {
1773         $query .= ' ? ';
1774         push @bind, $returndate;
1775     } else {
1776         $query .= ' now() ';
1777     }
1778     $query .= ' WHERE  borrowernumber = ?  AND itemnumber = ?';
1779     push @bind, $borrowernumber, $itemnumber;
1780     # FIXME transaction
1781     my $sth_upd  = $dbh->prepare($query);
1782     $sth_upd->execute(@bind);
1783     my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
1784                                   WHERE borrowernumber = ?
1785                                   AND itemnumber = ?');
1786     $sth_copy->execute($borrowernumber, $itemnumber);
1787     # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
1788     if ( $privacy == 2) {
1789         # The default of 0 does not work due to foreign key constraints
1790         # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
1791         my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
1792         my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
1793                                   WHERE borrowernumber = ?
1794                                   AND itemnumber = ?");
1795        $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
1796     }
1797     my $sth_del  = $dbh->prepare("DELETE FROM issues
1798                                   WHERE borrowernumber = ?
1799                                   AND itemnumber = ?");
1800     $sth_del->execute($borrowernumber, $itemnumber);
1801 }
1802
1803 =head2 _FixFineDaysOnReturn
1804
1805     &_FixFineDaysOnReturn($borrower, $item, $datedue);
1806
1807 C<$borrower> borrower hashref
1808
1809 C<$item> item hashref
1810
1811 C<$datedue> date due
1812
1813 Internal function, called only by AddReturn that calculate and update the user fine days, and debars him
1814
1815 =cut
1816
1817 sub _FixFineDaysOnReturn {
1818     my ( $borrower, $item, $datedue ) = @_;
1819     return unless ($datedue);
1820
1821     my $dt_due =  dt_from_string( $datedue );
1822     my $dt_today = DateTime->now( time_zone => C4::Context->tz() );
1823
1824     my $branchcode = _GetCircControlBranch( $item, $borrower );
1825     my $calendar = Koha::Calendar->new( branchcode => $branchcode );
1826
1827     # $deltadays is a DateTime::Duration object
1828     my $deltadays = $calendar->days_between( $dt_due, $dt_today );
1829
1830     my $circcontrol = C4::Context::preference('CircControl');
1831     my $issuingrule = GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
1832     my $finedays    = $issuingrule->{finedays};
1833     my $unit        = $issuingrule->{lengthunit};
1834
1835     # exit if no finedays defined
1836     return unless $finedays;
1837     # finedays is in days, so hourly loans must multiply by 24
1838     # thus 1 hour late equals 1 day suspension * finedays rate
1839     $finedays       = $finedays * 24 if ($unit eq 'hours');
1840
1841     # grace period is measured in the same units as the loan
1842     my $grace = DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
1843
1844     if ( ( $deltadays - $grace )->is_positive ) { # you can't compare DateTime::Durations with logical operators
1845         my $new_debar_dt = $dt_today->clone()->add_duration( $deltadays * $finedays );
1846         my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
1847         # check to see if the current debar date is a valid date
1848         if ( $borrower->{debarred} && $borrower_debar_dt ) {
1849         # if so, is it before the new date?  update only if true
1850             if ( DateTime->compare( $borrower_debar_dt, $new_debar_dt ) == -1 ) {
1851                 C4::Members::DebarMember( $borrower->{borrowernumber}, $new_debar_dt->ymd() );
1852                 return $new_debar_dt->ymd();
1853             }
1854         # if the borrower's debar date is not set or valid, debar them
1855         } else {
1856             C4::Members::DebarMember( $borrower->{borrowernumber}, $new_debar_dt->ymd() );
1857             return $new_debar_dt->ymd();
1858         }
1859     }
1860 }
1861
1862 =head2 _FixOverduesOnReturn
1863
1864    &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1865
1866 C<$brn> borrowernumber
1867
1868 C<$itm> itemnumber
1869
1870 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1871 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1872
1873 Internal function, called only by AddReturn
1874
1875 =cut
1876
1877 sub _FixOverduesOnReturn {
1878     my ($borrowernumber, $item);
1879     unless ($borrowernumber = shift) {
1880         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
1881         return;
1882     }
1883     unless ($item = shift) {
1884         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
1885         return;
1886     }
1887     my ($exemptfine, $dropbox) = @_;
1888     my $dbh = C4::Context->dbh;
1889
1890     # check for overdue fine
1891     my $sth = $dbh->prepare(
1892 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1893     );
1894     $sth->execute( $borrowernumber, $item );
1895
1896     # alter fine to show that the book has been returned
1897     my $data = $sth->fetchrow_hashref;
1898     return 0 unless $data;    # no warning, there's just nothing to fix
1899
1900     my $uquery;
1901     my @bind = ($borrowernumber, $item, $data->{'accountno'});
1902     if ($exemptfine) {
1903         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1904         if (C4::Context->preference("FinesLog")) {
1905             &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1906         }
1907     } elsif ($dropbox && $data->{lastincrement}) {
1908         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1909         my $amt = $data->{amount} - $data->{lastincrement} ;
1910         if (C4::Context->preference("FinesLog")) {
1911             &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1912         }
1913          $uquery = "update accountlines set accounttype='F' ";
1914          if($outstanding  >= 0 && $amt >=0) {
1915             $uquery .= ", amount = ? , amountoutstanding=? ";
1916             unshift @bind, ($amt, $outstanding) ;
1917         }
1918     } else {
1919         $uquery = "update accountlines set accounttype='F' ";
1920     }
1921     $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1922     my $usth = $dbh->prepare($uquery);
1923     return $usth->execute(@bind);
1924 }
1925
1926 =head2 _FixAccountForLostAndReturned
1927
1928   &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
1929
1930 Calculates the charge for a book lost and returned.
1931
1932 Internal function, not exported, called only by AddReturn.
1933
1934 FIXME: This function reflects how inscrutable fines logic is.  Fix both.
1935 FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.
1936
1937 =cut
1938
1939 sub _FixAccountForLostAndReturned {
1940     my $itemnumber     = shift or return;
1941     my $borrowernumber = @_ ? shift : undef;
1942     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
1943     my $dbh = C4::Context->dbh;
1944     # check for charge made for lost book
1945     my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
1946     $sth->execute($itemnumber);
1947     my $data = $sth->fetchrow_hashref;
1948     $data or return;    # bail if there is nothing to do
1949     $data->{accounttype} eq 'W' and return;    # Written off
1950
1951     # writeoff this amount
1952     my $offset;
1953     my $amount = $data->{'amount'};
1954     my $acctno = $data->{'accountno'};
1955     my $amountleft;                                             # Starts off undef/zero.
1956     if ($data->{'amountoutstanding'} == $amount) {
1957         $offset     = $data->{'amount'};
1958         $amountleft = 0;                                        # Hey, it's zero here, too.
1959     } else {
1960         $offset     = $amount - $data->{'amountoutstanding'};   # Um, isn't this the same as ZERO?  We just tested those two things are ==
1961         $amountleft = $data->{'amountoutstanding'} - $amount;   # Um, isn't this the same as ZERO?  We just tested those two things are ==
1962     }
1963     my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1964         WHERE (borrowernumber = ?)
1965         AND (itemnumber = ?) AND (accountno = ?) ");
1966     $usth->execute($data->{'borrowernumber'},$itemnumber,$acctno);      # We might be adjusting an account for some OTHER borrowernumber now.  Not the one we passed in.
1967     #check if any credit is left if so writeoff other accounts
1968     my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1969     $amountleft *= -1 if ($amountleft < 0);
1970     if ($amountleft > 0) {
1971         my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1972                             AND (amountoutstanding >0) ORDER BY date");     # might want to order by amountoustanding ASC (pay smallest first)
1973         $msth->execute($data->{'borrowernumber'});
1974         # offset transactions
1975         my $newamtos;
1976         my $accdata;
1977         while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1978             if ($accdata->{'amountoutstanding'} < $amountleft) {
1979                 $newamtos = 0;
1980                 $amountleft -= $accdata->{'amountoutstanding'};
1981             }  else {
1982                 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1983                 $amountleft = 0;
1984             }
1985             my $thisacct = $accdata->{'accountno'};
1986             # FIXME: move prepares outside while loop!
1987             my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1988                     WHERE (borrowernumber = ?)
1989                     AND (accountno=?)");
1990             $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');    # FIXME: '$thisacct' is a string literal!
1991             $usth = $dbh->prepare("INSERT INTO accountoffsets
1992                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1993                 VALUES
1994                 (?,?,?,?)");
1995             $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1996         }
1997         $msth->finish;  # $msth might actually have data left
1998     }
1999     $amountleft *= -1 if ($amountleft > 0);
2000     my $desc = "Item Returned " . $item_id;
2001     $usth = $dbh->prepare("INSERT INTO accountlines
2002         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2003         VALUES (?,?,now(),?,?,'CR',?)");
2004     $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2005     if ($borrowernumber) {
2006         # FIXME: same as query above.  use 1 sth for both
2007         $usth = $dbh->prepare("INSERT INTO accountoffsets
2008             (borrowernumber, accountno, offsetaccount,  offsetamount)
2009             VALUES (?,?,?,?)");
2010         $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2011     }
2012     ModItem({ paidfor => '' }, undef, $itemnumber);
2013     return;
2014 }
2015
2016 =head2 _GetCircControlBranch
2017
2018    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2019
2020 Internal function :
2021
2022 Return the library code to be used to determine which circulation
2023 policy applies to a transaction.  Looks up the CircControl and
2024 HomeOrHoldingBranch system preferences.
2025
2026 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2027
2028 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2029
2030 =cut
2031
2032 sub _GetCircControlBranch {
2033     my ($item, $borrower) = @_;
2034     my $circcontrol = C4::Context->preference('CircControl');
2035     my $branch;
2036
2037     if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2038         $branch= C4::Context->userenv->{'branch'};
2039     } elsif ($circcontrol eq 'PatronLibrary') {
2040         $branch=$borrower->{branchcode};
2041     } else {
2042         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2043         $branch = $item->{$branchfield};
2044         # default to item home branch if holdingbranch is used
2045         # and is not defined
2046         if (!defined($branch) && $branchfield eq 'holdingbranch') {
2047             $branch = $item->{homebranch};
2048         }
2049     }
2050     return $branch;
2051 }
2052
2053
2054
2055
2056
2057
2058 =head2 GetItemIssue
2059
2060   $issue = &GetItemIssue($itemnumber);
2061
2062 Returns patron currently having a book, or undef if not checked out.
2063
2064 C<$itemnumber> is the itemnumber.
2065
2066 C<$issue> is a hashref of the row from the issues table.
2067
2068 =cut
2069
2070 sub GetItemIssue {
2071     my ($itemnumber) = @_;
2072     return unless $itemnumber;
2073     my $sth = C4::Context->dbh->prepare(
2074         "SELECT *
2075         FROM issues
2076         LEFT JOIN items ON issues.itemnumber=items.itemnumber
2077         WHERE issues.itemnumber=?");
2078     $sth->execute($itemnumber);
2079     my $data = $sth->fetchrow_hashref;
2080     return unless $data;
2081     $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2082     $data->{issuedate}->truncate(to => 'minutes');
2083     $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2084     $data->{date_due}->truncate(to => 'minutes');
2085     my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minutes');
2086     $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2087     return $data;
2088 }
2089
2090 =head2 GetOpenIssue
2091
2092   $issue = GetOpenIssue( $itemnumber );
2093
2094 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2095
2096 C<$itemnumber> is the item's itemnumber
2097
2098 Returns a hashref
2099
2100 =cut
2101
2102 sub GetOpenIssue {
2103   my ( $itemnumber ) = @_;
2104
2105   my $dbh = C4::Context->dbh;
2106   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2107   $sth->execute( $itemnumber );
2108   my $issue = $sth->fetchrow_hashref();
2109   return $issue;
2110 }
2111
2112 =head2 GetItemIssues
2113
2114   $issues = &GetItemIssues($itemnumber, $history);
2115
2116 Returns patrons that have issued a book
2117
2118 C<$itemnumber> is the itemnumber
2119 C<$history> is false if you just want the current "issuer" (if any)
2120 and true if you want issues history from old_issues also.
2121
2122 Returns reference to an array of hashes
2123
2124 =cut
2125
2126 sub GetItemIssues {
2127     my ( $itemnumber, $history ) = @_;
2128
2129     my $today = DateTime->now( time_zome => C4::Context->tz);  # get today date
2130     $today->truncate( to => 'minutes' );
2131     my $sql = "SELECT * FROM issues
2132               JOIN borrowers USING (borrowernumber)
2133               JOIN items     USING (itemnumber)
2134               WHERE issues.itemnumber = ? ";
2135     if ($history) {
2136         $sql .= "UNION ALL
2137                  SELECT * FROM old_issues
2138                  LEFT JOIN borrowers USING (borrowernumber)
2139                  JOIN items USING (itemnumber)
2140                  WHERE old_issues.itemnumber = ? ";
2141     }
2142     $sql .= "ORDER BY date_due DESC";
2143     my $sth = C4::Context->dbh->prepare($sql);
2144     if ($history) {
2145         $sth->execute($itemnumber, $itemnumber);
2146     } else {
2147         $sth->execute($itemnumber);
2148     }
2149     my $results = $sth->fetchall_arrayref({});
2150     foreach (@$results) {
2151         my $date_due = dt_from_string($_->{date_due},'sql');
2152         $date_due->truncate( to => 'minutes' );
2153
2154         $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2155     }
2156     return $results;
2157 }
2158
2159 =head2 GetBiblioIssues
2160
2161   $issues = GetBiblioIssues($biblionumber);
2162
2163 this function get all issues from a biblionumber.
2164
2165 Return:
2166 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2167 tables issues and the firstname,surname & cardnumber from borrowers.
2168
2169 =cut
2170
2171 sub GetBiblioIssues {
2172     my $biblionumber = shift;
2173     return undef unless $biblionumber;
2174     my $dbh   = C4::Context->dbh;
2175     my $query = "
2176         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2177         FROM issues
2178             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2179             LEFT JOIN items ON issues.itemnumber = items.itemnumber
2180             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2181             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2182         WHERE biblio.biblionumber = ?
2183         UNION ALL
2184         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2185         FROM old_issues
2186             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2187             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2188             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2189             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2190         WHERE biblio.biblionumber = ?
2191         ORDER BY timestamp
2192     ";
2193     my $sth = $dbh->prepare($query);
2194     $sth->execute($biblionumber, $biblionumber);
2195
2196     my @issues;
2197     while ( my $data = $sth->fetchrow_hashref ) {
2198         push @issues, $data;
2199     }
2200     return \@issues;
2201 }
2202
2203 =head2 GetUpcomingDueIssues
2204
2205   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2206
2207 =cut
2208
2209 sub GetUpcomingDueIssues {
2210     my $params = shift;
2211
2212     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2213     my $dbh = C4::Context->dbh;
2214
2215     my $statement = <<END_SQL;
2216 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2217 FROM issues
2218 LEFT JOIN items USING (itemnumber)
2219 LEFT OUTER JOIN branches USING (branchcode)
2220 WhERE returndate is NULL
2221 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
2222 END_SQL
2223
2224     my @bind_parameters = ( $params->{'days_in_advance'} );
2225
2226     my $sth = $dbh->prepare( $statement );
2227     $sth->execute( @bind_parameters );
2228     my $upcoming_dues = $sth->fetchall_arrayref({});
2229     $sth->finish;
2230
2231     return $upcoming_dues;
2232 }
2233
2234 =head2 CanBookBeRenewed
2235
2236   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2237
2238 Find out whether a borrowed item may be renewed.
2239
2240 C<$dbh> is a DBI handle to the Koha database.
2241
2242 C<$borrowernumber> is the borrower number of the patron who currently
2243 has the item on loan.
2244
2245 C<$itemnumber> is the number of the item to renew.
2246
2247 C<$override_limit>, if supplied with a true value, causes
2248 the limit on the number of times that the loan can be renewed
2249 (as controlled by the item type) to be ignored.
2250
2251 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
2252 item must currently be on loan to the specified borrower; renewals
2253 must be allowed for the item's type; and the borrower must not have
2254 already renewed the loan. $error will contain the reason the renewal can not proceed
2255
2256 =cut
2257
2258 sub CanBookBeRenewed {
2259
2260     # check renewal status
2261     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2262     my $dbh       = C4::Context->dbh;
2263     my $renews    = 1;
2264     my $renewokay = 0;
2265         my $error;
2266
2267     # Look in the issues table for this item, lent to this borrower,
2268     # and not yet returned.
2269
2270     # Look in the issues table for this item, lent to this borrower,
2271     # and not yet returned.
2272     my %branch = (
2273             'ItemHomeLibrary' => 'items.homebranch',
2274             'PickupLibrary'   => 'items.holdingbranch',
2275             'PatronLibrary'   => 'borrowers.branchcode'
2276             );
2277     my $controlbranch = $branch{C4::Context->preference('CircControl')};
2278     my $itype         = C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype';
2279
2280     my $sthcount = $dbh->prepare("
2281                    SELECT
2282                     borrowers.categorycode, biblioitems.itemtype, issues.renewals, renewalsallowed, $controlbranch
2283                    FROM  issuingrules,
2284                    issues
2285                    LEFT JOIN items USING (itemnumber)
2286                    LEFT JOIN borrowers USING (borrowernumber)
2287                    LEFT JOIN biblioitems USING (biblioitemnumber)
2288
2289                    WHERE
2290                     (issuingrules.categorycode = borrowers.categorycode OR issuingrules.categorycode = '*')
2291                    AND
2292                     (issuingrules.itemtype = $itype OR issuingrules.itemtype = '*')
2293                    AND
2294                     (issuingrules.branchcode = $controlbranch OR issuingrules.branchcode = '*')
2295                    AND
2296                     borrowernumber = ?
2297                    AND
2298                     itemnumber = ?
2299                    ORDER BY
2300                     issuingrules.categorycode desc,
2301                     issuingrules.itemtype desc,
2302                     issuingrules.branchcode desc
2303                    LIMIT 1;
2304                   ");
2305
2306     $sthcount->execute( $borrowernumber, $itemnumber );
2307     if ( my $data1 = $sthcount->fetchrow_hashref ) {
2308
2309         if ( ( $data1->{renewalsallowed} && $data1->{renewalsallowed} > $data1->{renewals} ) || $override_limit ) {
2310             $renewokay = 1;
2311         }
2312         else {
2313                         $error="too_many";
2314                 }
2315
2316         my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2317         if ($resfound) {
2318             $renewokay = 0;
2319                         $error="on_reserve"
2320         }
2321
2322     }
2323     return ($renewokay,$error);
2324 }
2325
2326 =head2 AddRenewal
2327
2328   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2329
2330 Renews a loan.
2331
2332 C<$borrowernumber> is the borrower number of the patron who currently
2333 has the item.
2334
2335 C<$itemnumber> is the number of the item to renew.
2336
2337 C<$branch> is the library where the renewal took place (if any).
2338            The library that controls the circ policies for the renewal is retrieved from the issues record.
2339
2340 C<$datedue> can be a C4::Dates object used to set the due date.
2341
2342 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2343 this parameter is not supplied, lastreneweddate is set to the current date.
2344
2345 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2346 from the book's item type.
2347
2348 =cut
2349
2350 sub AddRenewal {
2351     my $borrowernumber  = shift or return undef;
2352     my $itemnumber      = shift or return undef;
2353     my $branch          = shift;
2354     my $datedue         = shift;
2355     my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2356     my $item   = GetItem($itemnumber) or return undef;
2357     my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
2358
2359     my $dbh = C4::Context->dbh;
2360     # Find the issues record for this book
2361     my $sth =
2362       $dbh->prepare("SELECT * FROM issues
2363                         WHERE borrowernumber=?
2364                         AND itemnumber=?"
2365       );
2366     $sth->execute( $borrowernumber, $itemnumber );
2367     my $issuedata = $sth->fetchrow_hashref;
2368     $sth->finish;
2369     if(defined $datedue && ref $datedue ne 'DateTime' ) {
2370         carp 'Invalid date passed to AddRenewal.';
2371         return;
2372     }
2373     # If the due date wasn't specified, calculate it by adding the
2374     # book's loan length to today's date or the current due date
2375     # based on the value of the RenewalPeriodBase syspref.
2376     unless ($datedue) {
2377
2378         my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return undef;
2379         my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2380
2381         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2382                                         $issuedata->{date_due} :
2383                                         DateTime->now( time_zone => C4::Context->tz());
2384         $datedue =  CalcDateDue($datedue,$itemtype,$issuedata->{'branchcode'},$borrower);
2385     }
2386
2387     # Update the issues record to have the new due date, and a new count
2388     # of how many times it has been renewed.
2389     my $renews = $issuedata->{'renewals'} + 1;
2390     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2391                             WHERE borrowernumber=?
2392                             AND itemnumber=?"
2393     );
2394
2395     $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2396     $sth->finish;
2397
2398     # Update the renewal count on the item, and tell zebra to reindex
2399     $renews = $biblio->{'renewals'} + 1;
2400     ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2401
2402     # Charge a new rental fee, if applicable?
2403     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2404     if ( $charge > 0 ) {
2405         my $accountno = getnextacctno( $borrowernumber );
2406         my $item = GetBiblioFromItemNumber($itemnumber);
2407         my $manager_id = 0;
2408         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2409         $sth = $dbh->prepare(
2410                 "INSERT INTO accountlines
2411                     (date, borrowernumber, accountno, amount, manager_id,
2412                     description,accounttype, amountoutstanding, itemnumber)
2413                     VALUES (now(),?,?,?,?,?,?,?,?)"
2414         );
2415         $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2416             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2417             'Rent', $charge, $itemnumber );
2418     }
2419     # Log the renewal
2420     UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2421         return $datedue;
2422 }
2423
2424 sub GetRenewCount {
2425     # check renewal status
2426     my ( $bornum, $itemno ) = @_;
2427     my $dbh           = C4::Context->dbh;
2428     my $renewcount    = 0;
2429     my $renewsallowed = 0;
2430     my $renewsleft    = 0;
2431
2432     my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
2433     my $item     = GetItem($itemno);
2434
2435     # Look in the issues table for this item, lent to this borrower,
2436     # and not yet returned.
2437
2438     # FIXME - I think this function could be redone to use only one SQL call.
2439     my $sth = $dbh->prepare(
2440         "select * from issues
2441                                 where (borrowernumber = ?)
2442                                 and (itemnumber = ?)"
2443     );
2444     $sth->execute( $bornum, $itemno );
2445     my $data = $sth->fetchrow_hashref;
2446     $renewcount = $data->{'renewals'} if $data->{'renewals'};
2447     $sth->finish;
2448     # $item and $borrower should be calculated
2449     my $branchcode = _GetCircControlBranch($item, $borrower);
2450
2451     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2452
2453     $renewsallowed = $issuingrule->{'renewalsallowed'};
2454     $renewsleft    = $renewsallowed - $renewcount;
2455     if($renewsleft < 0){ $renewsleft = 0; }
2456     return ( $renewcount, $renewsallowed, $renewsleft );
2457 }
2458
2459 =head2 GetIssuingCharges
2460
2461   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2462
2463 Calculate how much it would cost for a given patron to borrow a given
2464 item, including any applicable discounts.
2465
2466 C<$itemnumber> is the item number of item the patron wishes to borrow.
2467
2468 C<$borrowernumber> is the patron's borrower number.
2469
2470 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2471 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2472 if it's a video).
2473
2474 =cut
2475
2476 sub GetIssuingCharges {
2477
2478     # calculate charges due
2479     my ( $itemnumber, $borrowernumber ) = @_;
2480     my $charge = 0;
2481     my $dbh    = C4::Context->dbh;
2482     my $item_type;
2483
2484     # Get the book's item type and rental charge (via its biblioitem).
2485     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
2486         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
2487     $charge_query .= (C4::Context->preference('item-level_itypes'))
2488         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
2489         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
2490
2491     $charge_query .= ' WHERE items.itemnumber =?';
2492
2493     my $sth = $dbh->prepare($charge_query);
2494     $sth->execute($itemnumber);
2495     if ( my $item_data = $sth->fetchrow_hashref ) {
2496         $item_type = $item_data->{itemtype};
2497         $charge    = $item_data->{rentalcharge};
2498         my $branch = C4::Branch::mybranch();
2499         my $discount_query = q|SELECT rentaldiscount,
2500             issuingrules.itemtype, issuingrules.branchcode
2501             FROM borrowers
2502             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2503             WHERE borrowers.borrowernumber = ?
2504             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
2505             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
2506         my $discount_sth = $dbh->prepare($discount_query);
2507         $discount_sth->execute( $borrowernumber, $item_type, $branch );
2508         my $discount_rules = $discount_sth->fetchall_arrayref({});
2509         if (@{$discount_rules}) {
2510             # We may have multiple rules so get the most specific
2511             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
2512             $charge = ( $charge * ( 100 - $discount ) ) / 100;
2513         }
2514     }
2515
2516     $sth->finish; # we havent _explicitly_ fetched all rows
2517     return ( $charge, $item_type );
2518 }
2519
2520 # Select most appropriate discount rule from those returned
2521 sub _get_discount_from_rule {
2522     my ($rules_ref, $branch, $itemtype) = @_;
2523     my $discount;
2524
2525     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
2526         $discount = $rules_ref->[0]->{rentaldiscount};
2527         return (defined $discount) ? $discount : 0;
2528     }
2529     # could have up to 4 does one match $branch and $itemtype
2530     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
2531     if (@d) {
2532         $discount = $d[0]->{rentaldiscount};
2533         return (defined $discount) ? $discount : 0;
2534     }
2535     # do we have item type + all branches
2536     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
2537     if (@d) {
2538         $discount = $d[0]->{rentaldiscount};
2539         return (defined $discount) ? $discount : 0;
2540     }
2541     # do we all item types + this branch
2542     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
2543     if (@d) {
2544         $discount = $d[0]->{rentaldiscount};
2545         return (defined $discount) ? $discount : 0;
2546     }
2547     # so all and all (surely we wont get here)
2548     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
2549     if (@d) {
2550         $discount = $d[0]->{rentaldiscount};
2551         return (defined $discount) ? $discount : 0;
2552     }
2553     # none of the above
2554     return 0;
2555 }
2556
2557 =head2 AddIssuingCharge
2558
2559   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2560
2561 =cut
2562
2563 sub AddIssuingCharge {
2564     my ( $itemnumber, $borrowernumber, $charge ) = @_;
2565     my $dbh = C4::Context->dbh;
2566     my $nextaccntno = getnextacctno( $borrowernumber );
2567     my $manager_id = 0;
2568     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2569     my $query ="
2570         INSERT INTO accountlines
2571             (borrowernumber, itemnumber, accountno,
2572             date, amount, description, accounttype,
2573             amountoutstanding, manager_id)
2574         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
2575     ";
2576     my $sth = $dbh->prepare($query);
2577     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
2578     $sth->finish;
2579 }
2580
2581 =head2 GetTransfers
2582
2583   GetTransfers($itemnumber);
2584
2585 =cut
2586
2587 sub GetTransfers {
2588     my ($itemnumber) = @_;
2589
2590     my $dbh = C4::Context->dbh;
2591
2592     my $query = '
2593         SELECT datesent,
2594                frombranch,
2595                tobranch
2596         FROM branchtransfers
2597         WHERE itemnumber = ?
2598           AND datearrived IS NULL
2599         ';
2600     my $sth = $dbh->prepare($query);
2601     $sth->execute($itemnumber);
2602     my @row = $sth->fetchrow_array();
2603     $sth->finish;
2604     return @row;
2605 }
2606
2607 =head2 GetTransfersFromTo
2608
2609   @results = GetTransfersFromTo($frombranch,$tobranch);
2610
2611 Returns the list of pending transfers between $from and $to branch
2612
2613 =cut
2614
2615 sub GetTransfersFromTo {
2616     my ( $frombranch, $tobranch ) = @_;
2617     return unless ( $frombranch && $tobranch );
2618     my $dbh   = C4::Context->dbh;
2619     my $query = "
2620         SELECT itemnumber,datesent,frombranch
2621         FROM   branchtransfers
2622         WHERE  frombranch=?
2623           AND  tobranch=?
2624           AND datearrived IS NULL
2625     ";
2626     my $sth = $dbh->prepare($query);
2627     $sth->execute( $frombranch, $tobranch );
2628     my @gettransfers;
2629
2630     while ( my $data = $sth->fetchrow_hashref ) {
2631         push @gettransfers, $data;
2632     }
2633     $sth->finish;
2634     return (@gettransfers);
2635 }
2636
2637 =head2 DeleteTransfer
2638
2639   &DeleteTransfer($itemnumber);
2640
2641 =cut
2642
2643 sub DeleteTransfer {
2644     my ($itemnumber) = @_;
2645     my $dbh          = C4::Context->dbh;
2646     my $sth          = $dbh->prepare(
2647         "DELETE FROM branchtransfers
2648          WHERE itemnumber=?
2649          AND datearrived IS NULL "
2650     );
2651     $sth->execute($itemnumber);
2652     $sth->finish;
2653 }
2654
2655 =head2 AnonymiseIssueHistory
2656
2657   $rows = AnonymiseIssueHistory($date,$borrowernumber)
2658
2659 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2660 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2661
2662 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
2663 setting (force delete).
2664
2665 return the number of affected rows.
2666
2667 =cut
2668
2669 sub AnonymiseIssueHistory {
2670     my $date           = shift;
2671     my $borrowernumber = shift;
2672     my $dbh            = C4::Context->dbh;
2673     my $query          = "
2674         UPDATE old_issues
2675         SET    borrowernumber = ?
2676         WHERE  returndate < ?
2677           AND borrowernumber IS NOT NULL
2678     ";
2679
2680     # The default of 0 does not work due to foreign key constraints
2681     # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
2682     my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
2683     my @bind_params = ($anonymouspatron, $date);
2684     if (defined $borrowernumber) {
2685        $query .= " AND borrowernumber = ?";
2686        push @bind_params, $borrowernumber;
2687     } else {
2688        $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
2689     }
2690     my $sth = $dbh->prepare($query);
2691     $sth->execute(@bind_params);
2692     my $rows_affected = $sth->rows;  ### doublecheck row count return function
2693     return $rows_affected;
2694 }
2695
2696 =head2 SendCirculationAlert
2697
2698 Send out a C<check-in> or C<checkout> alert using the messaging system.
2699
2700 B<Parameters>:
2701
2702 =over 4
2703
2704 =item type
2705
2706 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
2707
2708 =item item
2709
2710 Hashref of information about the item being checked in or out.
2711
2712 =item borrower
2713
2714 Hashref of information about the borrower of the item.
2715
2716 =item branch
2717
2718 The branchcode from where the checkout or check-in took place.
2719
2720 =back
2721
2722 B<Example>:
2723
2724     SendCirculationAlert({
2725         type     => 'CHECKOUT',
2726         item     => $item,
2727         borrower => $borrower,
2728         branch   => $branch,
2729     });
2730
2731 =cut
2732
2733 sub SendCirculationAlert {
2734     my ($opts) = @_;
2735     my ($type, $item, $borrower, $branch) =
2736         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
2737     my %message_name = (
2738         CHECKIN  => 'Item_Check_in',
2739         CHECKOUT => 'Item_Checkout',
2740     );
2741     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
2742         borrowernumber => $borrower->{borrowernumber},
2743         message_name   => $message_name{$type},
2744     });
2745     my $letter =  C4::Letters::GetPreparedLetter (
2746         module => 'circulation',
2747         letter_code => $type,
2748         branchcode => $branch,
2749         tables => {
2750             'biblio'      => $item->{biblionumber},
2751             'biblioitems' => $item->{biblionumber},
2752             'borrowers'   => $borrower,
2753             'branches'    => $branch,
2754         }
2755     ) or return;
2756
2757     my @transports = @{ $borrower_preferences->{transports} };
2758     # warn "no transports" unless @transports;
2759     for (@transports) {
2760         # warn "transport: $_";
2761         my $message = C4::Message->find_last_message($borrower, $type, $_);
2762         if (!$message) {
2763             #warn "create new message";
2764             C4::Message->enqueue($letter, $borrower, $_);
2765         } else {
2766             #warn "append to old message";
2767             $message->append($letter);
2768             $message->update;
2769         }
2770     }
2771
2772     return $letter;
2773 }
2774
2775 =head2 updateWrongTransfer
2776
2777   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2778
2779 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
2780
2781 =cut
2782
2783 sub updateWrongTransfer {
2784         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2785         my $dbh = C4::Context->dbh;
2786 # first step validate the actual line of transfert .
2787         my $sth =
2788                 $dbh->prepare(
2789                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2790                 );
2791                 $sth->execute($FromLibrary,$itemNumber);
2792                 $sth->finish;
2793
2794 # second step create a new line of branchtransfer to the right location .
2795         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2796
2797 #third step changing holdingbranch of item
2798         UpdateHoldingbranch($FromLibrary,$itemNumber);
2799 }
2800
2801 =head2 UpdateHoldingbranch
2802
2803   $items = UpdateHoldingbranch($branch,$itmenumber);
2804
2805 Simple methode for updating hodlingbranch in items BDD line
2806
2807 =cut
2808
2809 sub UpdateHoldingbranch {
2810         my ( $branch,$itemnumber ) = @_;
2811     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2812 }
2813
2814 =head2 CalcDateDue
2815
2816 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
2817
2818 this function calculates the due date given the start date and configured circulation rules,
2819 checking against the holidays calendar as per the 'useDaysMode' syspref.
2820 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2821 C<$itemtype>  = itemtype code of item in question
2822 C<$branch>  = location whose calendar to use
2823 C<$borrower> = Borrower object
2824
2825 =cut
2826
2827 sub CalcDateDue {
2828     my ( $startdate, $itemtype, $branch, $borrower ) = @_;
2829
2830     # loanlength now a href
2831     my $loanlength =
2832       GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
2833
2834     my $datedue;
2835
2836     # if globalDueDate ON the datedue is set to that date
2837     if (C4::Context->preference('globalDueDate')
2838         && ( C4::Context->preference('globalDueDate') =~
2839             C4::Dates->regexp('syspref') )
2840       ) {
2841         $datedue = dt_from_string(
2842             C4::Context->preference('globalDueDate'),
2843             C4::Context->preference('dateformat')
2844         );
2845     } else {
2846
2847         # otherwise, calculate the datedue as normal
2848         if ( C4::Context->preference('useDaysMode') eq 'Days' )
2849         {    # ignoring calendar
2850             my $dt =
2851               DateTime->now( time_zone => C4::Context->tz() )
2852               ->truncate( to => 'minute' );
2853             if ( $loanlength->{lengthunit} eq 'hours' ) {
2854                 $dt->add( hours => $loanlength->{issuelength} );
2855                 return $dt;
2856             } else {    # days
2857                 $dt->add( days => $loanlength->{issuelength} );
2858                 $dt->set_hour(23);
2859                 $dt->set_minute(59);
2860                 return $dt;
2861             }
2862         } else {
2863             my $dur;
2864             if ($loanlength->{lengthunit} eq 'hours') {
2865                 $dur = DateTime::Duration->new( hours => $loanlength->{issuelength});
2866             }
2867             else { # days
2868                 $dur = DateTime::Duration->new( days => $loanlength->{issuelength});
2869             }
2870             if (ref $startdate ne 'DateTime' ) {
2871                 $startdate = dt_from_string($startdate);
2872             }
2873             my $calendar = Koha::Calendar->new( branchcode => $branch );
2874             $datedue = $calendar->addDate( $startdate, $dur, $loanlength->{lengthunit} );
2875             if ($loanlength->{lengthunit} eq 'days') {
2876                 $datedue->set_hour(23);
2877                 $datedue->set_minute(59);
2878             }
2879         }
2880     }
2881
2882     # if Hard Due Dates are used, retreive them and apply as necessary
2883     my ( $hardduedate, $hardduedatecompare ) =
2884       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
2885     if ($hardduedate) {    # hardduedates are currently dates
2886         $hardduedate->truncate( to => 'minute' );
2887         $hardduedate->set_hour(23);
2888         $hardduedate->set_minute(59);
2889         my $cmp = DateTime->compare( $hardduedate, $datedue );
2890
2891 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
2892 # if the calculated date is before the 'after' Hard Due Date (floor), override
2893 # if the hard due date is set to 'exactly', overrride
2894         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
2895             $datedue = $hardduedate->clone;
2896         }
2897
2898         # in all other cases, keep the date due as it is
2899     }
2900
2901     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
2902     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
2903         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso' );
2904         if ( DateTime->compare( $datedue, $expiry_dt ) == 1 ) {
2905             $datedue = $expiry_dt->clone;
2906         }
2907     }
2908
2909     return $datedue;
2910 }
2911
2912
2913 =head2 CheckRepeatableHolidays
2914
2915   $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2916
2917 This function checks if the date due is a repeatable holiday
2918
2919 C<$date_due>   = returndate calculate with no day check
2920 C<$itemnumber>  = itemnumber
2921 C<$branchcode>  = localisation of issue
2922
2923 =cut
2924
2925 sub CheckRepeatableHolidays{
2926 my($itemnumber,$week_day,$branchcode)=@_;
2927 my $dbh = C4::Context->dbh;
2928 my $query = qq|SELECT count(*)
2929         FROM repeatable_holidays
2930         WHERE branchcode=?
2931         AND weekday=?|;
2932 my $sth = $dbh->prepare($query);
2933 $sth->execute($branchcode,$week_day);
2934 my $result=$sth->fetchrow;
2935 $sth->finish;
2936 return $result;
2937 }
2938
2939
2940 =head2 CheckSpecialHolidays
2941
2942   $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2943
2944 This function check if the date is a special holiday
2945
2946 C<$years>   = the years of datedue
2947 C<$month>   = the month of datedue
2948 C<$day>     = the day of datedue
2949 C<$itemnumber>  = itemnumber
2950 C<$branchcode>  = localisation of issue
2951
2952 =cut
2953
2954 sub CheckSpecialHolidays{
2955 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2956 my $dbh = C4::Context->dbh;
2957 my $query=qq|SELECT count(*)
2958              FROM `special_holidays`
2959              WHERE year=?
2960              AND month=?
2961              AND day=?
2962              AND branchcode=?
2963             |;
2964 my $sth = $dbh->prepare($query);
2965 $sth->execute($years,$month,$day,$branchcode);
2966 my $countspecial=$sth->fetchrow ;
2967 $sth->finish;
2968 return $countspecial;
2969 }
2970
2971 =head2 CheckRepeatableSpecialHolidays
2972
2973   $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2974
2975 This function check if the date is a repeatble special holidays
2976
2977 C<$month>   = the month of datedue
2978 C<$day>     = the day of datedue
2979 C<$itemnumber>  = itemnumber
2980 C<$branchcode>  = localisation of issue
2981
2982 =cut
2983
2984 sub CheckRepeatableSpecialHolidays{
2985 my ($month,$day,$itemnumber,$branchcode) = @_;
2986 my $dbh = C4::Context->dbh;
2987 my $query=qq|SELECT count(*)
2988              FROM `repeatable_holidays`
2989              WHERE month=?
2990              AND day=?
2991              AND branchcode=?
2992             |;
2993 my $sth = $dbh->prepare($query);
2994 $sth->execute($month,$day,$branchcode);
2995 my $countspecial=$sth->fetchrow ;
2996 $sth->finish;
2997 return $countspecial;
2998 }
2999
3000
3001
3002 sub CheckValidBarcode{
3003 my ($barcode) = @_;
3004 my $dbh = C4::Context->dbh;
3005 my $query=qq|SELECT count(*)
3006              FROM items
3007              WHERE barcode=?
3008             |;
3009 my $sth = $dbh->prepare($query);
3010 $sth->execute($barcode);
3011 my $exist=$sth->fetchrow ;
3012 $sth->finish;
3013 return $exist;
3014 }
3015
3016 =head2 IsBranchTransferAllowed
3017
3018   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3019
3020 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3021
3022 =cut
3023
3024 sub IsBranchTransferAllowed {
3025         my ( $toBranch, $fromBranch, $code ) = @_;
3026
3027         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3028
3029         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3030         my $dbh = C4::Context->dbh;
3031
3032         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3033         $sth->execute( $toBranch, $fromBranch, $code );
3034         my $limit = $sth->fetchrow_hashref();
3035
3036         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3037         if ( $limit->{'limitId'} ) {
3038                 return 0;
3039         } else {
3040                 return 1;
3041         }
3042 }
3043
3044 =head2 CreateBranchTransferLimit
3045
3046   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3047
3048 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3049
3050 =cut
3051
3052 sub CreateBranchTransferLimit {
3053    my ( $toBranch, $fromBranch, $code ) = @_;
3054
3055    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3056
3057    my $dbh = C4::Context->dbh;
3058
3059    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3060    $sth->execute( $code, $toBranch, $fromBranch );
3061 }
3062
3063 =head2 DeleteBranchTransferLimits
3064
3065 DeleteBranchTransferLimits($frombranch);
3066
3067 Deletes all the branch transfer limits for one branch
3068
3069 =cut
3070
3071 sub DeleteBranchTransferLimits {
3072     my $branch = shift;
3073     my $dbh    = C4::Context->dbh;
3074     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3075     $sth->execute($branch);
3076 }
3077
3078 sub ReturnLostItem{
3079     my ( $borrowernumber, $itemnum ) = @_;
3080
3081     MarkIssueReturned( $borrowernumber, $itemnum );
3082     my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3083     my @datearr = localtime(time);
3084     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3085     my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3086     ModItem({ paidfor =>  "Paid for by $bor $date" }, undef, $itemnum);
3087 }
3088
3089
3090 sub LostItem{
3091     my ($itemnumber, $mark_returned, $charge_fee) = @_;
3092
3093     my $dbh = C4::Context->dbh();
3094     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3095                            FROM issues
3096                            JOIN items USING (itemnumber)
3097                            JOIN biblio USING (biblionumber)
3098                            WHERE issues.itemnumber=?");
3099     $sth->execute($itemnumber);
3100     my $issues=$sth->fetchrow_hashref();
3101     $sth->finish;
3102
3103     # if a borrower lost the item, add a replacement cost to the their record
3104     if ( my $borrowernumber = $issues->{borrowernumber} ){
3105
3106         C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}")
3107           if $charge_fee;
3108         #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3109         #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3110         MarkIssueReturned($borrowernumber,$itemnumber) if $mark_returned;
3111     }
3112 }
3113
3114 sub GetOfflineOperations {
3115     my $dbh = C4::Context->dbh;
3116     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3117     $sth->execute(C4::Context->userenv->{'branch'});
3118     my $results = $sth->fetchall_arrayref({});
3119     $sth->finish;
3120     return $results;
3121 }
3122
3123 sub GetOfflineOperation {
3124     my $dbh = C4::Context->dbh;
3125     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3126     $sth->execute( shift );
3127     my $result = $sth->fetchrow_hashref;
3128     $sth->finish;
3129     return $result;
3130 }
3131
3132 sub AddOfflineOperation {
3133     my $dbh = C4::Context->dbh;
3134     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber) VALUES(?,?,?,?,?,?)");
3135     $sth->execute( @_ );
3136     return "Added.";
3137 }
3138
3139 sub DeleteOfflineOperation {
3140     my $dbh = C4::Context->dbh;
3141     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3142     $sth->execute( shift );
3143     return "Deleted.";
3144 }
3145
3146 sub ProcessOfflineOperation {
3147     my $operation = shift;
3148
3149     my $report;
3150     if ( $operation->{action} eq 'return' ) {
3151         $report = ProcessOfflineReturn( $operation );
3152     } elsif ( $operation->{action} eq 'issue' ) {
3153         $report = ProcessOfflineIssue( $operation );
3154     }
3155
3156     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3157
3158     return $report;
3159 }
3160
3161 sub ProcessOfflineReturn {
3162     my $operation = shift;
3163
3164     my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3165
3166     if ( $itemnumber ) {
3167         my $issue = GetOpenIssue( $itemnumber );
3168         if ( $issue ) {
3169             MarkIssueReturned(
3170                 $issue->{borrowernumber},
3171                 $itemnumber,
3172                 undef,
3173                 $operation->{timestamp},
3174             );
3175             ModItem(
3176                 { renewals => 0, onloan => undef },
3177                 $issue->{'biblionumber'},
3178                 $itemnumber
3179             );
3180             return "Success.";
3181         } else {
3182             return "Item not issued.";
3183         }
3184     } else {
3185         return "Item not found.";
3186     }
3187 }
3188
3189 sub ProcessOfflineIssue {
3190     my $operation = shift;
3191
3192     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3193
3194     if ( $borrower->{borrowernumber} ) {
3195         my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3196         unless ($itemnumber) {
3197             return "Barcode not found.";
3198         }
3199         my $issue = GetOpenIssue( $itemnumber );
3200
3201         if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3202             MarkIssueReturned(
3203                 $issue->{borrowernumber},
3204                 $itemnumber,
3205                 undef,
3206                 $operation->{timestamp},
3207             );
3208         }
3209         AddIssue(
3210             $borrower,
3211             $operation->{'barcode'},
3212             undef,
3213             1,
3214             $operation->{timestamp},
3215             undef,
3216         );
3217         return "Success.";
3218     } else {
3219         return "Borrower not found.";
3220     }
3221 }
3222
3223
3224
3225 =head2 TransferSlip
3226
3227   TransferSlip($user_branch, $itemnumber, $to_branch)
3228
3229   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3230
3231 =cut
3232
3233 sub TransferSlip {
3234     my ($branch, $itemnumber, $to_branch) = @_;
3235
3236     my $item =  GetItem( $itemnumber )
3237       or return;
3238
3239     my $pulldate = C4::Dates->new();
3240
3241     return C4::Letters::GetPreparedLetter (
3242         module => 'circulation',
3243         letter_code => 'TRANSFERSLIP',
3244         branchcode => $branch,
3245         tables => {
3246             'branches'    => $to_branch,
3247             'biblio'      => $item->{biblionumber},
3248             'items'       => $item,
3249         },
3250     );
3251 }
3252
3253
3254 1;
3255
3256 __END__
3257
3258 =head1 AUTHOR
3259
3260 Koha Development Team <http://koha-community.org/>
3261
3262 =cut
3263