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.07.00.049;     # 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 => 'minute');
 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 => 'day');
 742             my $today = $now->clone()->truncate(to => 'day');
 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 => 'minute');
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         if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1067             UpdateTotalIssues($item->{'biblionumber'}, 1);
1068         }
1069
1070         ## If item was lost, it has now been found, reverse any list item charges if neccessary.
1071         if ( $item->{'itemlost'} ) {
1072             _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef, $item->{'barcode'} );
1073         }
1074
1075         ModItem({ issues           => $item->{'issues'},
1076                   holdingbranch    => C4::Context->userenv->{'branch'},
1077                   itemlost         => 0,
1078                   datelastborrowed => DateTime->now(time_zone => C4::Context->tz())->ymd(),
1079                   onloan           => $datedue->ymd(),
1080                 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1081         ModDateLastSeen( $item->{'itemnumber'} );
1082
1083         # If it costs to borrow this book, charge it to the patron's account.
1084         my ( $charge, $itemtype ) = GetIssuingCharges(
1085             $item->{'itemnumber'},
1086             $borrower->{'borrowernumber'}
1087         );
1088         if ( $charge > 0 ) {
1089             AddIssuingCharge(
1090                 $item->{'itemnumber'},
1091                 $borrower->{'borrowernumber'}, $charge
1092             );
1093             $item->{'charge'} = $charge;
1094         }
1095
1096         # Record the fact that this book was issued.
1097         &UpdateStats(
1098             C4::Context->userenv->{'branch'},
1099             'issue', $charge,
1100             ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
1101             $item->{'itype'}, $borrower->{'borrowernumber'}
1102         );
1103
1104         # Send a checkout slip.
1105         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1106         my %conditions = (
1107             branchcode   => $branch,
1108             categorycode => $borrower->{categorycode},
1109             item_type    => $item->{itype},
1110             notification => 'CHECKOUT',
1111         );
1112         if ($circulation_alert->is_enabled_for(\%conditions)) {
1113             SendCirculationAlert({
1114                 type     => 'CHECKOUT',
1115                 item     => $item,
1116                 borrower => $borrower,
1117                 branch   => $branch,
1118             });
1119         }
1120     }
1121
1122     logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1123         if C4::Context->preference("IssueLog");
1124   }
1125   return ($datedue);    # not necessarily the same as when it came in!
1126 }
1127
1128 =head2 GetLoanLength
1129
1130   my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1131
1132 Get loan length for an itemtype, a borrower type and a branch
1133
1134 =cut
1135
1136 sub GetLoanLength {
1137     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1138     my $dbh = C4::Context->dbh;
1139     my $sth =
1140       $dbh->prepare(
1141 'select issuelength, lengthunit from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null'
1142       );
1143 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1144 # try to find issuelength & return the 1st available.
1145 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1146     $sth->execute( $borrowertype, $itemtype, $branchcode );
1147     my $loanlength = $sth->fetchrow_hashref;
1148     return $loanlength
1149       if defined($loanlength) && $loanlength->{issuelength};
1150
1151     $sth->execute( $borrowertype, '*', $branchcode );
1152     $loanlength = $sth->fetchrow_hashref;
1153     return $loanlength
1154       if defined($loanlength) && $loanlength->{issuelength};
1155
1156     $sth->execute( '*', $itemtype, $branchcode );
1157     $loanlength = $sth->fetchrow_hashref;
1158     return $loanlength
1159       if defined($loanlength) && $loanlength->{issuelength};
1160
1161     $sth->execute( '*', '*', $branchcode );
1162     $loanlength = $sth->fetchrow_hashref;
1163     return $loanlength
1164       if defined($loanlength) && $loanlength->{issuelength};
1165
1166     $sth->execute( $borrowertype, $itemtype, '*' );
1167     $loanlength = $sth->fetchrow_hashref;
1168     return $loanlength
1169       if defined($loanlength) && $loanlength->{issuelength};
1170
1171     $sth->execute( $borrowertype, '*', '*' );
1172     $loanlength = $sth->fetchrow_hashref;
1173     return $loanlength
1174       if defined($loanlength) && $loanlength->{issuelength};
1175
1176     $sth->execute( '*', $itemtype, '*' );
1177     $loanlength = $sth->fetchrow_hashref;
1178     return $loanlength
1179       if defined($loanlength) && $loanlength->{issuelength};
1180
1181     $sth->execute( '*', '*', '*' );
1182     $loanlength = $sth->fetchrow_hashref;
1183     return $loanlength
1184       if defined($loanlength) && $loanlength->{issuelength};
1185
1186     # if no rule is set => 21 days (hardcoded)
1187     return {
1188         issuelength => 21,
1189         lengthunit => 'days',
1190     };
1191
1192 }
1193
1194
1195 =head2 GetHardDueDate
1196
1197   my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1198
1199 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1200
1201 =cut
1202
1203 sub GetHardDueDate {
1204     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1205     my $dbh = C4::Context->dbh;
1206     my $sth =
1207       $dbh->prepare(
1208 "select hardduedate, hardduedatecompare from issuingrules where categorycode=? and itemtype=? and branchcode=?"
1209       );
1210     $sth->execute( $borrowertype, $itemtype, $branchcode );
1211     my $results = $sth->fetchrow_hashref;
1212     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1213       if defined($results) && $results->{hardduedate};
1214
1215     $sth->execute( $borrowertype, "*", $branchcode );
1216     $results = $sth->fetchrow_hashref;
1217     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1218       if defined($results) && $results->{hardduedate};
1219
1220     $sth->execute( "*", $itemtype, $branchcode );
1221     $results = $sth->fetchrow_hashref;
1222     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1223       if defined($results) && $results->{hardduedate};
1224
1225     $sth->execute( "*", "*", $branchcode );
1226     $results = $sth->fetchrow_hashref;
1227     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1228       if defined($results) && $results->{hardduedate};
1229
1230     $sth->execute( $borrowertype, $itemtype, "*" );
1231     $results = $sth->fetchrow_hashref;
1232     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1233       if defined($results) && $results->{hardduedate};
1234
1235     $sth->execute( $borrowertype, "*", "*" );
1236     $results = $sth->fetchrow_hashref;
1237     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1238       if defined($results) && $results->{hardduedate};
1239
1240     $sth->execute( "*", $itemtype, "*" );
1241     $results = $sth->fetchrow_hashref;
1242     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1243       if defined($results) && $results->{hardduedate};
1244
1245     $sth->execute( "*", "*", "*" );
1246     $results = $sth->fetchrow_hashref;
1247     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1248       if defined($results) && $results->{hardduedate};
1249
1250     # if no rule is set => return undefined
1251     return (undef, undef);
1252 }
1253
1254 =head2 GetIssuingRule
1255
1256   my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1257
1258 FIXME - This is a copy-paste of GetLoanLength
1259 as a stop-gap.  Do not wish to change API for GetLoanLength
1260 this close to release, however, Overdues::GetIssuingRules is broken.
1261
1262 Get the issuing rule for an itemtype, a borrower type and a branch
1263 Returns a hashref from the issuingrules table.
1264
1265 =cut
1266
1267 sub GetIssuingRule {
1268     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1269     my $dbh = C4::Context->dbh;
1270     my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"  );
1271     my $irule;
1272
1273         $sth->execute( $borrowertype, $itemtype, $branchcode );
1274     $irule = $sth->fetchrow_hashref;
1275     return $irule if defined($irule) ;
1276
1277     $sth->execute( $borrowertype, "*", $branchcode );
1278     $irule = $sth->fetchrow_hashref;
1279     return $irule if defined($irule) ;
1280
1281     $sth->execute( "*", $itemtype, $branchcode );
1282     $irule = $sth->fetchrow_hashref;
1283     return $irule if defined($irule) ;
1284
1285     $sth->execute( "*", "*", $branchcode );
1286     $irule = $sth->fetchrow_hashref;
1287     return $irule if defined($irule) ;
1288
1289     $sth->execute( $borrowertype, $itemtype, "*" );
1290     $irule = $sth->fetchrow_hashref;
1291     return $irule if defined($irule) ;
1292
1293     $sth->execute( $borrowertype, "*", "*" );
1294     $irule = $sth->fetchrow_hashref;
1295     return $irule if defined($irule) ;
1296
1297     $sth->execute( "*", $itemtype, "*" );
1298     $irule = $sth->fetchrow_hashref;
1299     return $irule if defined($irule) ;
1300
1301     $sth->execute( "*", "*", "*" );
1302     $irule = $sth->fetchrow_hashref;
1303     return $irule if defined($irule) ;
1304
1305     # if no rule matches,
1306     return undef;
1307 }
1308
1309 =head2 GetBranchBorrowerCircRule
1310
1311   my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1312
1313 Retrieves circulation rule attributes that apply to the given
1314 branch and patron category, regardless of item type.
1315 The return value is a hashref containing the following key:
1316
1317 maxissueqty - maximum number of loans that a
1318 patron of the given category can have at the given
1319 branch.  If the value is undef, no limit.
1320
1321 This will first check for a specific branch and
1322 category match from branch_borrower_circ_rules.
1323
1324 If no rule is found, it will then check default_branch_circ_rules
1325 (same branch, default category).  If no rule is found,
1326 it will then check default_borrower_circ_rules (default
1327 branch, same category), then failing that, default_circ_rules
1328 (default branch, default category).
1329
1330 If no rule has been found in the database, it will default to
1331 the buillt in rule:
1332
1333 maxissueqty - undef
1334
1335 C<$branchcode> and C<$categorycode> should contain the
1336 literal branch code and patron category code, respectively - no
1337 wildcards.
1338
1339 =cut
1340
1341 sub GetBranchBorrowerCircRule {
1342     my $branchcode = shift;
1343     my $categorycode = shift;
1344
1345     my $branch_cat_query = "SELECT maxissueqty
1346                             FROM branch_borrower_circ_rules
1347                             WHERE branchcode = ?
1348                             AND   categorycode = ?";
1349     my $dbh = C4::Context->dbh();
1350     my $sth = $dbh->prepare($branch_cat_query);
1351     $sth->execute($branchcode, $categorycode);
1352     my $result;
1353     if ($result = $sth->fetchrow_hashref()) {
1354         return $result;
1355     }
1356
1357     # try same branch, default borrower category
1358     my $branch_query = "SELECT maxissueqty
1359                         FROM default_branch_circ_rules
1360                         WHERE branchcode = ?";
1361     $sth = $dbh->prepare($branch_query);
1362     $sth->execute($branchcode);
1363     if ($result = $sth->fetchrow_hashref()) {
1364         return $result;
1365     }
1366
1367     # try default branch, same borrower category
1368     my $category_query = "SELECT maxissueqty
1369                           FROM default_borrower_circ_rules
1370                           WHERE categorycode = ?";
1371     $sth = $dbh->prepare($category_query);
1372     $sth->execute($categorycode);
1373     if ($result = $sth->fetchrow_hashref()) {
1374         return $result;
1375     }
1376
1377     # try default branch, default borrower category
1378     my $default_query = "SELECT maxissueqty
1379                           FROM default_circ_rules";
1380     $sth = $dbh->prepare($default_query);
1381     $sth->execute();
1382     if ($result = $sth->fetchrow_hashref()) {
1383         return $result;
1384     }
1385
1386     # built-in default circulation rule
1387     return {
1388         maxissueqty => undef,
1389     };
1390 }
1391
1392 =head2 GetBranchItemRule
1393
1394   my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1395
1396 Retrieves circulation rule attributes that apply to the given
1397 branch and item type, regardless of patron category.
1398
1399 The return value is a hashref containing the following keys:
1400
1401 holdallowed => Hold policy for this branch and itemtype. Possible values:
1402   0: No holds allowed.
1403   1: Holds allowed only by patrons that have the same homebranch as the item.
1404   2: Holds allowed from any patron.
1405
1406 returnbranch => branch to which to return item.  Possible values:
1407   noreturn: do not return, let item remain where checked in (floating collections)
1408   homebranch: return to item's home branch
1409
1410 This searches branchitemrules in the following order:
1411
1412   * Same branchcode and itemtype
1413   * Same branchcode, itemtype '*'
1414   * branchcode '*', same itemtype
1415   * branchcode and itemtype '*'
1416
1417 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1418
1419 =cut
1420
1421 sub GetBranchItemRule {
1422     my ( $branchcode, $itemtype ) = @_;
1423     my $dbh = C4::Context->dbh();
1424     my $result = {};
1425
1426     my @attempts = (
1427         ['SELECT holdallowed, returnbranch
1428             FROM branch_item_rules
1429             WHERE branchcode = ?
1430               AND itemtype = ?', $branchcode, $itemtype],
1431         ['SELECT holdallowed, returnbranch
1432             FROM default_branch_circ_rules
1433             WHERE branchcode = ?', $branchcode],
1434         ['SELECT holdallowed, returnbranch
1435             FROM default_branch_item_rules
1436             WHERE itemtype = ?', $itemtype],
1437         ['SELECT holdallowed, returnbranch
1438             FROM default_circ_rules'],
1439     );
1440
1441     foreach my $attempt (@attempts) {
1442         my ($query, @bind_params) = @{$attempt};
1443         my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params );
1444
1445         # Since branch/category and branch/itemtype use the same per-branch
1446         # defaults tables, we have to check that the key we want is set, not
1447         # just that a row was returned
1448         $result->{'holdallowed'}  = $search_result->{'holdallowed'}  unless ( defined $result->{'holdallowed'} );
1449         $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1450     }
1451
1452     # built-in default circulation rule
1453     $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1454     $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1455
1456     return $result;
1457 }
1458
1459 =head2 AddReturn
1460
1461   ($doreturn, $messages, $iteminformation, $borrower) =
1462       &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1463
1464 Returns a book.
1465
1466 =over 4
1467
1468 =item C<$barcode> is the bar code of the book being returned.
1469
1470 =item C<$branch> is the code of the branch where the book is being returned.
1471
1472 =item C<$exemptfine> indicates that overdue charges for the item will be
1473 removed.
1474
1475 =item C<$dropbox> indicates that the check-in date is assumed to be
1476 yesterday, or the last non-holiday as defined in C4::Calendar .  If
1477 overdue charges are applied and C<$dropbox> is true, the last charge
1478 will be removed.  This assumes that the fines accrual script has run
1479 for _today_.
1480
1481 =back
1482
1483 C<&AddReturn> returns a list of four items:
1484
1485 C<$doreturn> is true iff the return succeeded.
1486
1487 C<$messages> is a reference-to-hash giving feedback on the operation.
1488 The keys of the hash are:
1489
1490 =over 4
1491
1492 =item C<BadBarcode>
1493
1494 No item with this barcode exists. The value is C<$barcode>.
1495
1496 =item C<NotIssued>
1497
1498 The book is not currently on loan. The value is C<$barcode>.
1499
1500 =item C<IsPermanent>
1501
1502 The book's home branch is a permanent collection. If you have borrowed
1503 this book, you are not allowed to return it. The value is the code for
1504 the book's home branch.
1505
1506 =item C<wthdrawn>
1507
1508 This book has been withdrawn/cancelled. The value should be ignored.
1509
1510 =item C<Wrongbranch>
1511
1512 This book has was returned to the wrong branch.  The value is a hashref
1513 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1514 contain the branchcode of the incorrect and correct return library, respectively.
1515
1516 =item C<ResFound>
1517
1518 The item was reserved. The value is a reference-to-hash whose keys are
1519 fields from the reserves table of the Koha database, and
1520 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1521 either C<Waiting>, C<Reserved>, or 0.
1522
1523 =back
1524
1525 C<$iteminformation> is a reference-to-hash, giving information about the
1526 returned item from the issues table.
1527
1528 C<$borrower> is a reference-to-hash, giving information about the
1529 patron who last borrowed the book.
1530
1531 =cut
1532
1533 sub AddReturn {
1534     my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1535
1536     if ($branch and not GetBranchDetail($branch)) {
1537         warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
1538         undef $branch;
1539     }
1540     $branch = C4::Context->userenv->{'branch'} unless $branch;  # we trust userenv to be a safe fallback/default
1541     my $messages;
1542     my $borrower;
1543     my $biblio;
1544     my $doreturn       = 1;
1545     my $validTransfert = 0;
1546     my $stat_type = 'return';
1547
1548     # get information on item
1549     my $itemnumber = GetItemnumberFromBarcode( $barcode );
1550     unless ($itemnumber) {
1551         return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower.  bail out.
1552     }
1553     my $issue  = GetItemIssue($itemnumber);
1554 #   warn Dumper($iteminformation);
1555     if ($issue and $issue->{borrowernumber}) {
1556         $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1557             or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existant borrowernumber '$issue->{borrowernumber}'\n"
1558                 . Dumper($issue) . "\n";
1559     } else {
1560         $messages->{'NotIssued'} = $barcode;
1561         # even though item is not on loan, it may still be transferred;  therefore, get current branch info
1562         $doreturn = 0;
1563         # No issue, no borrowernumber.  ONLY if $doreturn, *might* you have a $borrower later.
1564         # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1565         if (C4::Context->preference("RecordLocalUseOnReturn")) {
1566            $messages->{'LocalUse'} = 1;
1567            $stat_type = 'localuse';
1568         }
1569     }
1570
1571     my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1572         # full item data, but no borrowernumber or checkout info (no issue)
1573         # we know GetItem should work because GetItemnumberFromBarcode worked
1574     my $hbr      = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1575         # get the proper branch to which to return the item
1576     $hbr = $item->{$hbr} || $branch ;
1577         # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1578
1579     my $borrowernumber = $borrower->{'borrowernumber'} || undef;    # we don't know if we had a borrower or not
1580
1581     # check if the book is in a permanent collection....
1582     # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
1583     if ( $hbr ) {
1584         my $branches = GetBranches();    # a potentially expensive call for a non-feature.
1585         $branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr;
1586     }
1587
1588     # if indy branches and returning to different branch, refuse the return unless canreservefromotherbranches is turned on
1589     if ($hbr ne $branch && C4::Context->preference("IndependantBranches") && !(C4::Context->preference("canreservefromotherbranches"))){
1590         $messages->{'Wrongbranch'} = {
1591             Wrongbranch => $branch,
1592             Rightbranch => $hbr,
1593         };
1594         $doreturn = 0;
1595         # bailing out here - in this case, current desired behavior
1596         # is to act as if no return ever happened at all.
1597         # FIXME - even in an indy branches situation, there should
1598         # still be an option for the library to accept the item
1599         # and transfer it to its owning library.
1600         return ( $doreturn, $messages, $issue, $borrower );
1601     }
1602
1603     if ( $item->{'wthdrawn'} ) { # book has been cancelled
1604         $messages->{'wthdrawn'} = 1;
1605         $doreturn = 0;
1606     }
1607
1608     # case of a return of document (deal with issues and holdingbranch)
1609     if ($doreturn) {
1610     my $today = DateTime->now( time_zone => C4::Context->tz() );
1611     my $datedue = $issue->{date_due};
1612         $borrower or warn "AddReturn without current borrower";
1613                 my $circControlBranch;
1614         if ($dropbox) {
1615             # define circControlBranch only if dropbox mode is set
1616             # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1617             # FIXME: check issuedate > returndate, factoring in holidays
1618             #$circControlBranch = _GetCircControlBranch($item,$borrower) unless ( $item->{'issuedate'} eq C4::Dates->today('iso') );;
1619             $circControlBranch = _GetCircControlBranch($item,$borrower);
1620         my $datedue = $issue->{date_due};
1621         $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $today ) == -1 ? 1 : 0;
1622         }
1623
1624         if ($borrowernumber) {
1625         if($issue->{'overdue'}){
1626                 my ( $amount, $type, $unitcounttotal ) = C4::Overdues::CalcFine( $item, $borrower->{categorycode},$branch, $datedue, $today );
1627                 $type ||= q{};
1628         if ( $amount > 0 && ( C4::Context->preference('finesMode') eq 'production' )) {
1629           C4::Overdues::UpdateFine(
1630               $issue->{itemnumber},
1631               $issue->{borrowernumber},
1632                       $amount, $type, output_pref($datedue)
1633               );
1634         }
1635             }
1636             MarkIssueReturned($borrowernumber, $item->{'itemnumber'}, $circControlBranch, '', $borrower->{'privacy'});
1637             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?  This could be the borrower hash.
1638         }
1639
1640         ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1641     }
1642
1643     # the holdingbranch is updated if the document is returned to another location.
1644     # this is always done regardless of whether the item was on loan or not
1645     if ($item->{'holdingbranch'} ne $branch) {
1646         UpdateHoldingbranch($branch, $item->{'itemnumber'});
1647         $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1648     }
1649     ModDateLastSeen( $item->{'itemnumber'} );
1650
1651     # check if we have a transfer for this document
1652     my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1653
1654     # if we have a transfer to do, we update the line of transfers with the datearrived
1655     if ($datesent) {
1656         if ( $tobranch eq $branch ) {
1657             my $sth = C4::Context->dbh->prepare(
1658                 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1659             );
1660             $sth->execute( $item->{'itemnumber'} );
1661             # if we have a reservation with valid transfer, we can set it's status to 'W'
1662             ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1663             C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1664         } else {
1665             $messages->{'WrongTransfer'}     = $tobranch;
1666             $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1667         }
1668         $validTransfert = 1;
1669     } else {
1670         ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1671     }
1672
1673     # fix up the accounts.....
1674     if ($item->{'itemlost'}) {
1675         _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode);    # can tolerate undef $borrowernumber
1676         $messages->{'WasLost'} = 1;
1677     }
1678
1679     # fix up the overdues in accounts...
1680     if ($borrowernumber) {
1681         my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1682         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!";  # zero is OK, check defined
1683
1684         # fix fine days
1685         my $debardate = _FixFineDaysOnReturn( $borrower, $item, $issue->{date_due} );
1686         $messages->{'Debarred'} = $debardate if ($debardate);
1687     }
1688
1689     # find reserves.....
1690     # if we don't have a reserve with the status W, we launch the Checkreserves routine
1691     my ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1692     if ($resfound) {
1693           $resrec->{'ResFound'} = $resfound;
1694         $messages->{'ResFound'} = $resrec;
1695     }
1696
1697     # update stats?
1698     # Record the fact that this book was returned.
1699     UpdateStats(
1700         $branch, $stat_type, '0', '',
1701         $item->{'itemnumber'},
1702         $biblio->{'itemtype'},
1703         $borrowernumber
1704     );
1705
1706     # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
1707     my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1708     my %conditions = (
1709         branchcode   => $branch,
1710         categorycode => $borrower->{categorycode},
1711         item_type    => $item->{itype},
1712         notification => 'CHECKIN',
1713     );
1714     if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
1715         SendCirculationAlert({
1716             type     => 'CHECKIN',
1717             item     => $item,
1718             borrower => $borrower,
1719             branch   => $branch,
1720         });
1721     }
1722
1723     logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'})
1724         if C4::Context->preference("ReturnLog");
1725
1726     # FIXME: make this comment intelligible.
1727     #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1728     #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1729
1730     if (($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $hbr) and not $messages->{'WrongTransfer'}){
1731         if ( C4::Context->preference("AutomaticItemReturn"    ) or
1732             (C4::Context->preference("UseBranchTransferLimits") and
1733              ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} )
1734            )) {
1735             $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
1736             $debug and warn "item: " . Dumper($item);
1737             ModItemTransfer($item->{'itemnumber'}, $branch, $hbr);
1738             $messages->{'WasTransfered'} = 1;
1739         } else {
1740             $messages->{'NeedsTransfer'} = 1;   # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
1741         }
1742     }
1743     return ( $doreturn, $messages, $issue, $borrower );
1744 }
1745
1746 =head2 MarkIssueReturned
1747
1748   MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
1749
1750 Unconditionally marks an issue as being returned by
1751 moving the C<issues> row to C<old_issues> and
1752 setting C<returndate> to the current date, or
1753 the last non-holiday date of the branccode specified in
1754 C<dropbox_branch> .  Assumes you've already checked that
1755 it's safe to do this, i.e. last non-holiday > issuedate.
1756
1757 if C<$returndate> is specified (in iso format), it is used as the date
1758 of the return. It is ignored when a dropbox_branch is passed in.
1759
1760 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
1761 the old_issue is immediately anonymised
1762
1763 Ideally, this function would be internal to C<C4::Circulation>,
1764 not exported, but it is currently needed by one
1765 routine in C<C4::Accounts>.
1766
1767 =cut
1768
1769 sub MarkIssueReturned {
1770     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
1771
1772     my $dbh   = C4::Context->dbh;
1773     my $query = 'UPDATE issues SET returndate=';
1774     my @bind;
1775     if ($dropbox_branch) {
1776         my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
1777         my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
1778         $query .= ' ? ';
1779         push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
1780     } elsif ($returndate) {
1781         $query .= ' ? ';
1782         push @bind, $returndate;
1783     } else {
1784         $query .= ' now() ';
1785     }
1786     $query .= ' WHERE  borrowernumber = ?  AND itemnumber = ?';
1787     push @bind, $borrowernumber, $itemnumber;
1788     # FIXME transaction
1789     my $sth_upd  = $dbh->prepare($query);
1790     $sth_upd->execute(@bind);
1791     my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
1792                                   WHERE borrowernumber = ?
1793                                   AND itemnumber = ?');
1794     $sth_copy->execute($borrowernumber, $itemnumber);
1795     # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
1796     if ( $privacy == 2) {
1797         # The default of 0 does not work due to foreign key constraints
1798         # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
1799         my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
1800         my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
1801                                   WHERE borrowernumber = ?
1802                                   AND itemnumber = ?");
1803        $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
1804     }
1805     my $sth_del  = $dbh->prepare("DELETE FROM issues
1806                                   WHERE borrowernumber = ?
1807                                   AND itemnumber = ?");
1808     $sth_del->execute($borrowernumber, $itemnumber);
1809 }
1810
1811 =head2 _FixFineDaysOnReturn
1812
1813     &_FixFineDaysOnReturn($borrower, $item, $datedue);
1814
1815 C<$borrower> borrower hashref
1816
1817 C<$item> item hashref
1818
1819 C<$datedue> date due
1820
1821 Internal function, called only by AddReturn that calculate and update the user fine days, and debars him
1822
1823 =cut
1824
1825 sub _FixFineDaysOnReturn {
1826     my ( $borrower, $item, $datedue ) = @_;
1827     return unless ($datedue);
1828
1829     my $dt_due =  dt_from_string( $datedue );
1830     my $dt_today = DateTime->now( time_zone => C4::Context->tz() );
1831
1832     my $branchcode = _GetCircControlBranch( $item, $borrower );
1833     my $calendar = Koha::Calendar->new( branchcode => $branchcode );
1834
1835     # $deltadays is a DateTime::Duration object
1836     my $deltadays = $calendar->days_between( $dt_due, $dt_today );
1837
1838     my $circcontrol = C4::Context::preference('CircControl');
1839     my $issuingrule = GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
1840     my $finedays    = $issuingrule->{finedays};
1841     my $unit        = $issuingrule->{lengthunit};
1842
1843     # exit if no finedays defined
1844     return unless $finedays;
1845     # finedays is in days, so hourly loans must multiply by 24
1846     # thus 1 hour late equals 1 day suspension * finedays rate
1847     $finedays       = $finedays * 24 if ($unit eq 'hours');
1848
1849     # grace period is measured in the same units as the loan
1850     my $grace = DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
1851
1852     if ( ( $deltadays - $grace )->is_positive ) { # you can't compare DateTime::Durations with logical operators
1853         my $new_debar_dt = $dt_today->clone()->add_duration( $deltadays * $finedays );
1854         my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
1855         # check to see if the current debar date is a valid date
1856         if ( $borrower->{debarred} && $borrower_debar_dt ) {
1857         # if so, is it before the new date?  update only if true
1858             if ( DateTime->compare( $borrower_debar_dt, $new_debar_dt ) == -1 ) {
1859                 C4::Members::DebarMember( $borrower->{borrowernumber}, $new_debar_dt->ymd() );
1860                 return $new_debar_dt->ymd();
1861             }
1862         # if the borrower's debar date is not set or valid, debar them
1863         } else {
1864             C4::Members::DebarMember( $borrower->{borrowernumber}, $new_debar_dt->ymd() );
1865             return $new_debar_dt->ymd();
1866         }
1867     }
1868 }
1869
1870 =head2 _FixOverduesOnReturn
1871
1872    &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1873
1874 C<$brn> borrowernumber
1875
1876 C<$itm> itemnumber
1877
1878 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1879 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1880
1881 Internal function, called only by AddReturn
1882
1883 =cut
1884
1885 sub _FixOverduesOnReturn {
1886     my ($borrowernumber, $item);
1887     unless ($borrowernumber = shift) {
1888         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
1889         return;
1890     }
1891     unless ($item = shift) {
1892         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
1893         return;
1894     }
1895     my ($exemptfine, $dropbox) = @_;
1896     my $dbh = C4::Context->dbh;
1897
1898     # check for overdue fine
1899     my $sth = $dbh->prepare(
1900 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1901     );
1902     $sth->execute( $borrowernumber, $item );
1903
1904     # alter fine to show that the book has been returned
1905     my $data = $sth->fetchrow_hashref;
1906     return 0 unless $data;    # no warning, there's just nothing to fix
1907
1908     my $uquery;
1909     my @bind = ($borrowernumber, $item, $data->{'accountno'});
1910     if ($exemptfine) {
1911         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1912         if (C4::Context->preference("FinesLog")) {
1913             &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1914         }
1915     } elsif ($dropbox && $data->{lastincrement}) {
1916         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1917         my $amt = $data->{amount} - $data->{lastincrement} ;
1918         if (C4::Context->preference("FinesLog")) {
1919             &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1920         }
1921          $uquery = "update accountlines set accounttype='F' ";
1922          if($outstanding  >= 0 && $amt >=0) {
1923             $uquery .= ", amount = ? , amountoutstanding=? ";
1924             unshift @bind, ($amt, $outstanding) ;
1925         }
1926     } else {
1927         $uquery = "update accountlines set accounttype='F' ";
1928     }
1929     $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1930     my $usth = $dbh->prepare($uquery);
1931     return $usth->execute(@bind);
1932 }
1933
1934 =head2 _FixAccountForLostAndReturned
1935
1936   &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
1937
1938 Calculates the charge for a book lost and returned.
1939
1940 Internal function, not exported, called only by AddReturn.
1941
1942 FIXME: This function reflects how inscrutable fines logic is.  Fix both.
1943 FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.
1944
1945 =cut
1946
1947 sub _FixAccountForLostAndReturned {
1948     my $itemnumber     = shift or return;
1949     my $borrowernumber = @_ ? shift : undef;
1950     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
1951     my $dbh = C4::Context->dbh;
1952     # check for charge made for lost book
1953     my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
1954     $sth->execute($itemnumber);
1955     my $data = $sth->fetchrow_hashref;
1956     $data or return;    # bail if there is nothing to do
1957     $data->{accounttype} eq 'W' and return;    # Written off
1958
1959     # writeoff this amount
1960     my $offset;
1961     my $amount = $data->{'amount'};
1962     my $acctno = $data->{'accountno'};
1963     my $amountleft;                                             # Starts off undef/zero.
1964     if ($data->{'amountoutstanding'} == $amount) {
1965         $offset     = $data->{'amount'};
1966         $amountleft = 0;                                        # Hey, it's zero here, too.
1967     } else {
1968         $offset     = $amount - $data->{'amountoutstanding'};   # Um, isn't this the same as ZERO?  We just tested those two things are ==
1969         $amountleft = $data->{'amountoutstanding'} - $amount;   # Um, isn't this the same as ZERO?  We just tested those two things are ==
1970     }
1971     my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1972         WHERE (borrowernumber = ?)
1973         AND (itemnumber = ?) AND (accountno = ?) ");
1974     $usth->execute($data->{'borrowernumber'},$itemnumber,$acctno);      # We might be adjusting an account for some OTHER borrowernumber now.  Not the one we passed in.
1975     #check if any credit is left if so writeoff other accounts
1976     my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1977     $amountleft *= -1 if ($amountleft < 0);
1978     if ($amountleft > 0) {
1979         my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1980                             AND (amountoutstanding >0) ORDER BY date");     # might want to order by amountoustanding ASC (pay smallest first)
1981         $msth->execute($data->{'borrowernumber'});
1982         # offset transactions
1983         my $newamtos;
1984         my $accdata;
1985         while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1986             if ($accdata->{'amountoutstanding'} < $amountleft) {
1987                 $newamtos = 0;
1988                 $amountleft -= $accdata->{'amountoutstanding'};
1989             }  else {
1990                 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1991                 $amountleft = 0;
1992             }
1993             my $thisacct = $accdata->{'accountno'};
1994             # FIXME: move prepares outside while loop!
1995             my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1996                     WHERE (borrowernumber = ?)
1997                     AND (accountno=?)");
1998             $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');    # FIXME: '$thisacct' is a string literal!
1999             $usth = $dbh->prepare("INSERT INTO accountoffsets
2000                 (borrowernumber, accountno, offsetaccount,  offsetamount)
2001                 VALUES
2002                 (?,?,?,?)");
2003             $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2004         }
2005         $msth->finish;  # $msth might actually have data left
2006     }
2007     $amountleft *= -1 if ($amountleft > 0);
2008     my $desc = "Item Returned " . $item_id;
2009     $usth = $dbh->prepare("INSERT INTO accountlines
2010         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2011         VALUES (?,?,now(),?,?,'CR',?)");
2012     $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2013     if ($borrowernumber) {
2014         # FIXME: same as query above.  use 1 sth for both
2015         $usth = $dbh->prepare("INSERT INTO accountoffsets
2016             (borrowernumber, accountno, offsetaccount,  offsetamount)
2017             VALUES (?,?,?,?)");
2018         $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2019     }
2020     ModItem({ paidfor => '' }, undef, $itemnumber);
2021     return;
2022 }
2023
2024 =head2 _GetCircControlBranch
2025
2026    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2027
2028 Internal function :
2029
2030 Return the library code to be used to determine which circulation
2031 policy applies to a transaction.  Looks up the CircControl and
2032 HomeOrHoldingBranch system preferences.
2033
2034 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2035
2036 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2037
2038 =cut
2039
2040 sub _GetCircControlBranch {
2041     my ($item, $borrower) = @_;
2042     my $circcontrol = C4::Context->preference('CircControl');
2043     my $branch;
2044
2045     if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2046         $branch= C4::Context->userenv->{'branch'};
2047     } elsif ($circcontrol eq 'PatronLibrary') {
2048         $branch=$borrower->{branchcode};
2049     } else {
2050         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2051         $branch = $item->{$branchfield};
2052         # default to item home branch if holdingbranch is used
2053         # and is not defined
2054         if (!defined($branch) && $branchfield eq 'holdingbranch') {
2055             $branch = $item->{homebranch};
2056         }
2057     }
2058     return $branch;
2059 }
2060
2061
2062
2063
2064
2065
2066 =head2 GetItemIssue
2067
2068   $issue = &GetItemIssue($itemnumber);
2069
2070 Returns patron currently having a book, or undef if not checked out.
2071
2072 C<$itemnumber> is the itemnumber.
2073
2074 C<$issue> is a hashref of the row from the issues table.
2075
2076 =cut
2077
2078 sub GetItemIssue {
2079     my ($itemnumber) = @_;
2080     return unless $itemnumber;
2081     my $sth = C4::Context->dbh->prepare(
2082         "SELECT *
2083         FROM issues
2084         LEFT JOIN items ON issues.itemnumber=items.itemnumber
2085         WHERE issues.itemnumber=?");
2086     $sth->execute($itemnumber);
2087     my $data = $sth->fetchrow_hashref;
2088     return unless $data;
2089     $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2090     $data->{issuedate}->truncate(to => 'minute');
2091     $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2092     $data->{date_due}->truncate(to => 'minute');
2093     my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2094     $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2095     return $data;
2096 }
2097
2098 =head2 GetOpenIssue
2099
2100   $issue = GetOpenIssue( $itemnumber );
2101
2102 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2103
2104 C<$itemnumber> is the item's itemnumber
2105
2106 Returns a hashref
2107
2108 =cut
2109
2110 sub GetOpenIssue {
2111   my ( $itemnumber ) = @_;
2112
2113   my $dbh = C4::Context->dbh;
2114   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2115   $sth->execute( $itemnumber );
2116   my $issue = $sth->fetchrow_hashref();
2117   return $issue;
2118 }
2119
2120 =head2 GetItemIssues
2121
2122   $issues = &GetItemIssues($itemnumber, $history);
2123
2124 Returns patrons that have issued a book
2125
2126 C<$itemnumber> is the itemnumber
2127 C<$history> is false if you just want the current "issuer" (if any)
2128 and true if you want issues history from old_issues also.
2129
2130 Returns reference to an array of hashes
2131
2132 =cut
2133
2134 sub GetItemIssues {
2135     my ( $itemnumber, $history ) = @_;
2136
2137     my $today = DateTime->now( time_zome => C4::Context->tz);  # get today date
2138     $today->truncate( to => 'minute' );
2139     my $sql = "SELECT * FROM issues
2140               JOIN borrowers USING (borrowernumber)
2141               JOIN items     USING (itemnumber)
2142               WHERE issues.itemnumber = ? ";
2143     if ($history) {
2144         $sql .= "UNION ALL
2145                  SELECT * FROM old_issues
2146                  LEFT JOIN borrowers USING (borrowernumber)
2147                  JOIN items USING (itemnumber)
2148                  WHERE old_issues.itemnumber = ? ";
2149     }
2150     $sql .= "ORDER BY date_due DESC";
2151     my $sth = C4::Context->dbh->prepare($sql);
2152     if ($history) {
2153         $sth->execute($itemnumber, $itemnumber);
2154     } else {
2155         $sth->execute($itemnumber);
2156     }
2157     my $results = $sth->fetchall_arrayref({});
2158     foreach (@$results) {
2159         my $date_due = dt_from_string($_->{date_due},'sql');
2160         $date_due->truncate( to => 'minute' );
2161
2162         $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2163     }
2164     return $results;
2165 }
2166
2167 =head2 GetBiblioIssues
2168
2169   $issues = GetBiblioIssues($biblionumber);
2170
2171 this function get all issues from a biblionumber.
2172
2173 Return:
2174 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2175 tables issues and the firstname,surname & cardnumber from borrowers.
2176
2177 =cut
2178
2179 sub GetBiblioIssues {
2180     my $biblionumber = shift;
2181     return undef unless $biblionumber;
2182     my $dbh   = C4::Context->dbh;
2183     my $query = "
2184         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2185         FROM issues
2186             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2187             LEFT JOIN items ON 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         UNION ALL
2192         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2193         FROM old_issues
2194             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2195             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2196             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2197             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2198         WHERE biblio.biblionumber = ?
2199         ORDER BY timestamp
2200     ";
2201     my $sth = $dbh->prepare($query);
2202     $sth->execute($biblionumber, $biblionumber);
2203
2204     my @issues;
2205     while ( my $data = $sth->fetchrow_hashref ) {
2206         push @issues, $data;
2207     }
2208     return \@issues;
2209 }
2210
2211 =head2 GetUpcomingDueIssues
2212
2213   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2214
2215 =cut
2216
2217 sub GetUpcomingDueIssues {
2218     my $params = shift;
2219
2220     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2221     my $dbh = C4::Context->dbh;
2222
2223     my $statement = <<END_SQL;
2224 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2225 FROM issues
2226 LEFT JOIN items USING (itemnumber)
2227 LEFT OUTER JOIN branches USING (branchcode)
2228 WhERE returndate is NULL
2229 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
2230 END_SQL
2231
2232     my @bind_parameters = ( $params->{'days_in_advance'} );
2233
2234     my $sth = $dbh->prepare( $statement );
2235     $sth->execute( @bind_parameters );
2236     my $upcoming_dues = $sth->fetchall_arrayref({});
2237     $sth->finish;
2238
2239     return $upcoming_dues;
2240 }
2241
2242 =head2 CanBookBeRenewed
2243
2244   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2245
2246 Find out whether a borrowed item may be renewed.
2247
2248 C<$dbh> is a DBI handle to the Koha database.
2249
2250 C<$borrowernumber> is the borrower number of the patron who currently
2251 has the item on loan.
2252
2253 C<$itemnumber> is the number of the item to renew.
2254
2255 C<$override_limit>, if supplied with a true value, causes
2256 the limit on the number of times that the loan can be renewed
2257 (as controlled by the item type) to be ignored.
2258
2259 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
2260 item must currently be on loan to the specified borrower; renewals
2261 must be allowed for the item's type; and the borrower must not have
2262 already renewed the loan. $error will contain the reason the renewal can not proceed
2263
2264 =cut
2265
2266 sub CanBookBeRenewed {
2267
2268     # check renewal status
2269     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2270     my $dbh       = C4::Context->dbh;
2271     my $renews    = 1;
2272     my $renewokay = 0;
2273         my $error;
2274
2275     # Look in the issues table for this item, lent to this borrower,
2276     # and not yet returned.
2277
2278     # Look in the issues table for this item, lent to this borrower,
2279     # and not yet returned.
2280     my %branch = (
2281             'ItemHomeLibrary' => 'items.homebranch',
2282             'PickupLibrary'   => 'items.holdingbranch',
2283             'PatronLibrary'   => 'borrowers.branchcode'
2284             );
2285     my $controlbranch = $branch{C4::Context->preference('CircControl')};
2286     my $itype         = C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype';
2287
2288     my $sthcount = $dbh->prepare("
2289                    SELECT
2290                     borrowers.categorycode, biblioitems.itemtype, issues.renewals, renewalsallowed, $controlbranch
2291                    FROM  issuingrules,
2292                    issues
2293                    LEFT JOIN items USING (itemnumber)
2294                    LEFT JOIN borrowers USING (borrowernumber)
2295                    LEFT JOIN biblioitems USING (biblioitemnumber)
2296
2297                    WHERE
2298                     (issuingrules.categorycode = borrowers.categorycode OR issuingrules.categorycode = '*')
2299                    AND
2300                     (issuingrules.itemtype = $itype OR issuingrules.itemtype = '*')
2301                    AND
2302                     (issuingrules.branchcode = $controlbranch OR issuingrules.branchcode = '*')
2303                    AND
2304                     borrowernumber = ?
2305                    AND
2306                     itemnumber = ?
2307                    ORDER BY
2308                     issuingrules.categorycode desc,
2309                     issuingrules.itemtype desc,
2310                     issuingrules.branchcode desc
2311                    LIMIT 1;
2312                   ");
2313
2314     $sthcount->execute( $borrowernumber, $itemnumber );
2315     if ( my $data1 = $sthcount->fetchrow_hashref ) {
2316
2317         if ( ( $data1->{renewalsallowed} && $data1->{renewalsallowed} > $data1->{renewals} ) || $override_limit ) {
2318             $renewokay = 1;
2319         }
2320         else {
2321                         $error="too_many";
2322                 }
2323
2324         my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2325         if ($resfound) {
2326             $renewokay = 0;
2327                         $error="on_reserve"
2328         }
2329
2330     }
2331     return ($renewokay,$error);
2332 }
2333
2334 =head2 AddRenewal
2335
2336   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2337
2338 Renews a loan.
2339
2340 C<$borrowernumber> is the borrower number of the patron who currently
2341 has the item.
2342
2343 C<$itemnumber> is the number of the item to renew.
2344
2345 C<$branch> is the library where the renewal took place (if any).
2346            The library that controls the circ policies for the renewal is retrieved from the issues record.
2347
2348 C<$datedue> can be a C4::Dates object used to set the due date.
2349
2350 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2351 this parameter is not supplied, lastreneweddate is set to the current date.
2352
2353 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2354 from the book's item type.
2355
2356 =cut
2357
2358 sub AddRenewal {
2359     my $borrowernumber  = shift or return undef;
2360     my $itemnumber      = shift or return undef;
2361     my $branch          = shift;
2362     my $datedue         = shift;
2363     my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2364     my $item   = GetItem($itemnumber) or return undef;
2365     my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
2366
2367     my $dbh = C4::Context->dbh;
2368     # Find the issues record for this book
2369     my $sth =
2370       $dbh->prepare("SELECT * FROM issues
2371                         WHERE borrowernumber=?
2372                         AND itemnumber=?"
2373       );
2374     $sth->execute( $borrowernumber, $itemnumber );
2375     my $issuedata = $sth->fetchrow_hashref;
2376     $sth->finish;
2377     if(defined $datedue && ref $datedue ne 'DateTime' ) {
2378         carp 'Invalid date passed to AddRenewal.';
2379         return;
2380     }
2381     # If the due date wasn't specified, calculate it by adding the
2382     # book's loan length to today's date or the current due date
2383     # based on the value of the RenewalPeriodBase syspref.
2384     unless ($datedue) {
2385
2386         my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return undef;
2387         my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2388
2389         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2390                                         $issuedata->{date_due} :
2391                                         DateTime->now( time_zone => C4::Context->tz());
2392         $datedue =  CalcDateDue($datedue,$itemtype,$issuedata->{'branchcode'},$borrower);
2393     }
2394
2395     # Update the issues record to have the new due date, and a new count
2396     # of how many times it has been renewed.
2397     my $renews = $issuedata->{'renewals'} + 1;
2398     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2399                             WHERE borrowernumber=?
2400                             AND itemnumber=?"
2401     );
2402
2403     $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2404     $sth->finish;
2405
2406     # Update the renewal count on the item, and tell zebra to reindex
2407     $renews = $biblio->{'renewals'} + 1;
2408     ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2409
2410     # Charge a new rental fee, if applicable?
2411     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2412     if ( $charge > 0 ) {
2413         my $accountno = getnextacctno( $borrowernumber );
2414         my $item = GetBiblioFromItemNumber($itemnumber);
2415         my $manager_id = 0;
2416         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2417         $sth = $dbh->prepare(
2418                 "INSERT INTO accountlines
2419                     (date, borrowernumber, accountno, amount, manager_id,
2420                     description,accounttype, amountoutstanding, itemnumber)
2421                     VALUES (now(),?,?,?,?,?,?,?,?)"
2422         );
2423         $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2424             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2425             'Rent', $charge, $itemnumber );
2426     }
2427     # Log the renewal
2428     UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2429         return $datedue;
2430 }
2431
2432 sub GetRenewCount {
2433     # check renewal status
2434     my ( $bornum, $itemno ) = @_;
2435     my $dbh           = C4::Context->dbh;
2436     my $renewcount    = 0;
2437     my $renewsallowed = 0;
2438     my $renewsleft    = 0;
2439
2440     my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
2441     my $item     = GetItem($itemno);
2442
2443     # Look in the issues table for this item, lent to this borrower,
2444     # and not yet returned.
2445
2446     # FIXME - I think this function could be redone to use only one SQL call.
2447     my $sth = $dbh->prepare(
2448         "select * from issues
2449                                 where (borrowernumber = ?)
2450                                 and (itemnumber = ?)"
2451     );
2452     $sth->execute( $bornum, $itemno );
2453     my $data = $sth->fetchrow_hashref;
2454     $renewcount = $data->{'renewals'} if $data->{'renewals'};
2455     $sth->finish;
2456     # $item and $borrower should be calculated
2457     my $branchcode = _GetCircControlBranch($item, $borrower);
2458
2459     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2460
2461     $renewsallowed = $issuingrule->{'renewalsallowed'};
2462     $renewsleft    = $renewsallowed - $renewcount;
2463     if($renewsleft < 0){ $renewsleft = 0; }
2464     return ( $renewcount, $renewsallowed, $renewsleft );
2465 }
2466
2467 =head2 GetIssuingCharges
2468
2469   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2470
2471 Calculate how much it would cost for a given patron to borrow a given
2472 item, including any applicable discounts.
2473
2474 C<$itemnumber> is the item number of item the patron wishes to borrow.
2475
2476 C<$borrowernumber> is the patron's borrower number.
2477
2478 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2479 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2480 if it's a video).
2481
2482 =cut
2483
2484 sub GetIssuingCharges {
2485
2486     # calculate charges due
2487     my ( $itemnumber, $borrowernumber ) = @_;
2488     my $charge = 0;
2489     my $dbh    = C4::Context->dbh;
2490     my $item_type;
2491
2492     # Get the book's item type and rental charge (via its biblioitem).
2493     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
2494         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
2495     $charge_query .= (C4::Context->preference('item-level_itypes'))
2496         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
2497         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
2498
2499     $charge_query .= ' WHERE items.itemnumber =?';
2500
2501     my $sth = $dbh->prepare($charge_query);
2502     $sth->execute($itemnumber);
2503     if ( my $item_data = $sth->fetchrow_hashref ) {
2504         $item_type = $item_data->{itemtype};
2505         $charge    = $item_data->{rentalcharge};
2506         my $branch = C4::Branch::mybranch();
2507         my $discount_query = q|SELECT rentaldiscount,
2508             issuingrules.itemtype, issuingrules.branchcode
2509             FROM borrowers
2510             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2511             WHERE borrowers.borrowernumber = ?
2512             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
2513             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
2514         my $discount_sth = $dbh->prepare($discount_query);
2515         $discount_sth->execute( $borrowernumber, $item_type, $branch );
2516         my $discount_rules = $discount_sth->fetchall_arrayref({});
2517         if (@{$discount_rules}) {
2518             # We may have multiple rules so get the most specific
2519             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
2520             $charge = ( $charge * ( 100 - $discount ) ) / 100;
2521         }
2522     }
2523
2524     $sth->finish; # we havent _explicitly_ fetched all rows
2525     return ( $charge, $item_type );
2526 }
2527
2528 # Select most appropriate discount rule from those returned
2529 sub _get_discount_from_rule {
2530     my ($rules_ref, $branch, $itemtype) = @_;
2531     my $discount;
2532
2533     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
2534         $discount = $rules_ref->[0]->{rentaldiscount};
2535         return (defined $discount) ? $discount : 0;
2536     }
2537     # could have up to 4 does one match $branch and $itemtype
2538     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
2539     if (@d) {
2540         $discount = $d[0]->{rentaldiscount};
2541         return (defined $discount) ? $discount : 0;
2542     }
2543     # do we have item type + all branches
2544     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
2545     if (@d) {
2546         $discount = $d[0]->{rentaldiscount};
2547         return (defined $discount) ? $discount : 0;
2548     }
2549     # do we all item types + this branch
2550     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
2551     if (@d) {
2552         $discount = $d[0]->{rentaldiscount};
2553         return (defined $discount) ? $discount : 0;
2554     }
2555     # so all and all (surely we wont get here)
2556     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
2557     if (@d) {
2558         $discount = $d[0]->{rentaldiscount};
2559         return (defined $discount) ? $discount : 0;
2560     }
2561     # none of the above
2562     return 0;
2563 }
2564
2565 =head2 AddIssuingCharge
2566
2567   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2568
2569 =cut
2570
2571 sub AddIssuingCharge {
2572     my ( $itemnumber, $borrowernumber, $charge ) = @_;
2573     my $dbh = C4::Context->dbh;
2574     my $nextaccntno = getnextacctno( $borrowernumber );
2575     my $manager_id = 0;
2576     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2577     my $query ="
2578         INSERT INTO accountlines
2579             (borrowernumber, itemnumber, accountno,
2580             date, amount, description, accounttype,
2581             amountoutstanding, manager_id)
2582         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
2583     ";
2584     my $sth = $dbh->prepare($query);
2585     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
2586     $sth->finish;
2587 }
2588
2589 =head2 GetTransfers
2590
2591   GetTransfers($itemnumber);
2592
2593 =cut
2594
2595 sub GetTransfers {
2596     my ($itemnumber) = @_;
2597
2598     my $dbh = C4::Context->dbh;
2599
2600     my $query = '
2601         SELECT datesent,
2602                frombranch,
2603                tobranch
2604         FROM branchtransfers
2605         WHERE itemnumber = ?
2606           AND datearrived IS NULL
2607         ';
2608     my $sth = $dbh->prepare($query);
2609     $sth->execute($itemnumber);
2610     my @row = $sth->fetchrow_array();
2611     $sth->finish;
2612     return @row;
2613 }
2614
2615 =head2 GetTransfersFromTo
2616
2617   @results = GetTransfersFromTo($frombranch,$tobranch);
2618
2619 Returns the list of pending transfers between $from and $to branch
2620
2621 =cut
2622
2623 sub GetTransfersFromTo {
2624     my ( $frombranch, $tobranch ) = @_;
2625     return unless ( $frombranch && $tobranch );
2626     my $dbh   = C4::Context->dbh;
2627     my $query = "
2628         SELECT itemnumber,datesent,frombranch
2629         FROM   branchtransfers
2630         WHERE  frombranch=?
2631           AND  tobranch=?
2632           AND datearrived IS NULL
2633     ";
2634     my $sth = $dbh->prepare($query);
2635     $sth->execute( $frombranch, $tobranch );
2636     my @gettransfers;
2637
2638     while ( my $data = $sth->fetchrow_hashref ) {
2639         push @gettransfers, $data;
2640     }
2641     $sth->finish;
2642     return (@gettransfers);
2643 }
2644
2645 =head2 DeleteTransfer
2646
2647   &DeleteTransfer($itemnumber);
2648
2649 =cut
2650
2651 sub DeleteTransfer {
2652     my ($itemnumber) = @_;
2653     my $dbh          = C4::Context->dbh;
2654     my $sth          = $dbh->prepare(
2655         "DELETE FROM branchtransfers
2656          WHERE itemnumber=?
2657          AND datearrived IS NULL "
2658     );
2659     $sth->execute($itemnumber);
2660     $sth->finish;
2661 }
2662
2663 =head2 AnonymiseIssueHistory
2664
2665   $rows = AnonymiseIssueHistory($date,$borrowernumber)
2666
2667 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2668 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2669
2670 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
2671 setting (force delete).
2672
2673 return the number of affected rows.
2674
2675 =cut
2676
2677 sub AnonymiseIssueHistory {
2678     my $date           = shift;
2679     my $borrowernumber = shift;
2680     my $dbh            = C4::Context->dbh;
2681     my $query          = "
2682         UPDATE old_issues
2683         SET    borrowernumber = ?
2684         WHERE  returndate < ?
2685           AND borrowernumber IS NOT NULL
2686     ";
2687
2688     # The default of 0 does not work due to foreign key constraints
2689     # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
2690     my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
2691     my @bind_params = ($anonymouspatron, $date);
2692     if (defined $borrowernumber) {
2693        $query .= " AND borrowernumber = ?";
2694        push @bind_params, $borrowernumber;
2695     } else {
2696        $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
2697     }
2698     my $sth = $dbh->prepare($query);
2699     $sth->execute(@bind_params);
2700     my $rows_affected = $sth->rows;  ### doublecheck row count return function
2701     return $rows_affected;
2702 }
2703
2704 =head2 SendCirculationAlert
2705
2706 Send out a C<check-in> or C<checkout> alert using the messaging system.
2707
2708 B<Parameters>:
2709
2710 =over 4
2711
2712 =item type
2713
2714 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
2715
2716 =item item
2717
2718 Hashref of information about the item being checked in or out.
2719
2720 =item borrower
2721
2722 Hashref of information about the borrower of the item.
2723
2724 =item branch
2725
2726 The branchcode from where the checkout or check-in took place.
2727
2728 =back
2729
2730 B<Example>:
2731
2732     SendCirculationAlert({
2733         type     => 'CHECKOUT',
2734         item     => $item,
2735         borrower => $borrower,
2736         branch   => $branch,
2737     });
2738
2739 =cut
2740
2741 sub SendCirculationAlert {
2742     my ($opts) = @_;
2743     my ($type, $item, $borrower, $branch) =
2744         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
2745     my %message_name = (
2746         CHECKIN  => 'Item_Check_in',
2747         CHECKOUT => 'Item_Checkout',
2748     );
2749     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
2750         borrowernumber => $borrower->{borrowernumber},
2751         message_name   => $message_name{$type},
2752     });
2753     my $issues_table = ( $type eq 'CHECKOUT' ) ? 'issues' : 'old_issues';
2754     my $letter =  C4::Letters::GetPreparedLetter (
2755         module => 'circulation',
2756         letter_code => $type,
2757         branchcode => $branch,
2758         tables => {
2759             $issues_table => $item->{itemnumber},
2760             'items'       => $item->{itemnumber},
2761             'biblio'      => $item->{biblionumber},
2762             'biblioitems' => $item->{biblionumber},
2763             'borrowers'   => $borrower,
2764             'branches'    => $branch,
2765         }
2766     ) or return;
2767
2768     my @transports = keys %{ $borrower_preferences->{transports} };
2769     # warn "no transports" unless @transports;
2770     for (@transports) {
2771         # warn "transport: $_";
2772         my $message = C4::Message->find_last_message($borrower, $type, $_);
2773         if (!$message) {
2774             #warn "create new message";
2775             C4::Message->enqueue($letter, $borrower, $_);
2776         } else {
2777             #warn "append to old message";
2778             $message->append($letter);
2779             $message->update;
2780         }
2781     }
2782
2783     return $letter;
2784 }
2785
2786 =head2 updateWrongTransfer
2787
2788   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2789
2790 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
2791
2792 =cut
2793
2794 sub updateWrongTransfer {
2795         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2796         my $dbh = C4::Context->dbh;
2797 # first step validate the actual line of transfert .
2798         my $sth =
2799                 $dbh->prepare(
2800                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2801                 );
2802                 $sth->execute($FromLibrary,$itemNumber);
2803                 $sth->finish;
2804
2805 # second step create a new line of branchtransfer to the right location .
2806         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2807
2808 #third step changing holdingbranch of item
2809         UpdateHoldingbranch($FromLibrary,$itemNumber);
2810 }
2811
2812 =head2 UpdateHoldingbranch
2813
2814   $items = UpdateHoldingbranch($branch,$itmenumber);
2815
2816 Simple methode for updating hodlingbranch in items BDD line
2817
2818 =cut
2819
2820 sub UpdateHoldingbranch {
2821         my ( $branch,$itemnumber ) = @_;
2822     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2823 }
2824
2825 =head2 CalcDateDue
2826
2827 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
2828
2829 this function calculates the due date given the start date and configured circulation rules,
2830 checking against the holidays calendar as per the 'useDaysMode' syspref.
2831 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2832 C<$itemtype>  = itemtype code of item in question
2833 C<$branch>  = location whose calendar to use
2834 C<$borrower> = Borrower object
2835
2836 =cut
2837
2838 sub CalcDateDue {
2839     my ( $startdate, $itemtype, $branch, $borrower ) = @_;
2840
2841     # loanlength now a href
2842     my $loanlength =
2843       GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
2844
2845     my $datedue;
2846
2847     # if globalDueDate ON the datedue is set to that date
2848     if (C4::Context->preference('globalDueDate')
2849         && ( C4::Context->preference('globalDueDate') =~
2850             C4::Dates->regexp('syspref') )
2851       ) {
2852         $datedue = dt_from_string(
2853             C4::Context->preference('globalDueDate'),
2854             C4::Context->preference('dateformat')
2855         );
2856     } else {
2857
2858         # otherwise, calculate the datedue as normal
2859         if ( C4::Context->preference('useDaysMode') eq 'Days' )
2860         {    # ignoring calendar
2861             my $dt =
2862               DateTime->now( time_zone => C4::Context->tz() )
2863               ->truncate( to => 'minute' );
2864             if ( $loanlength->{lengthunit} eq 'hours' ) {
2865                 $dt->add( hours => $loanlength->{issuelength} );
2866                 return $dt;
2867             } else {    # days
2868                 $dt->add( days => $loanlength->{issuelength} );
2869                 $dt->set_hour(23);
2870                 $dt->set_minute(59);
2871                 return $dt;
2872             }
2873         } else {
2874             my $dur;
2875             if ($loanlength->{lengthunit} eq 'hours') {
2876                 $dur = DateTime::Duration->new( hours => $loanlength->{issuelength});
2877             }
2878             else { # days
2879                 $dur = DateTime::Duration->new( days => $loanlength->{issuelength});
2880             }
2881             if (ref $startdate ne 'DateTime' ) {
2882                 $startdate = dt_from_string($startdate);
2883             }
2884             my $calendar = Koha::Calendar->new( branchcode => $branch );
2885             $datedue = $calendar->addDate( $startdate, $dur, $loanlength->{lengthunit} );
2886             if ($loanlength->{lengthunit} eq 'days') {
2887                 $datedue->set_hour(23);
2888                 $datedue->set_minute(59);
2889             }
2890         }
2891     }
2892
2893     # if Hard Due Dates are used, retreive them and apply as necessary
2894     my ( $hardduedate, $hardduedatecompare ) =
2895       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
2896     if ($hardduedate) {    # hardduedates are currently dates
2897         $hardduedate->truncate( to => 'minute' );
2898         $hardduedate->set_hour(23);
2899         $hardduedate->set_minute(59);
2900         my $cmp = DateTime->compare( $hardduedate, $datedue );
2901
2902 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
2903 # if the calculated date is before the 'after' Hard Due Date (floor), override
2904 # if the hard due date is set to 'exactly', overrride
2905         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
2906             $datedue = $hardduedate->clone;
2907         }
2908
2909         # in all other cases, keep the date due as it is
2910     }
2911
2912     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
2913     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
2914         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso' );
2915         if ( DateTime->compare( $datedue, $expiry_dt ) == 1 ) {
2916             $datedue = $expiry_dt->clone;
2917         }
2918     }
2919
2920     return $datedue;
2921 }
2922
2923
2924 =head2 CheckRepeatableHolidays
2925
2926   $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2927
2928 This function checks if the date due is a repeatable holiday
2929
2930 C<$date_due>   = returndate calculate with no day check
2931 C<$itemnumber>  = itemnumber
2932 C<$branchcode>  = localisation of issue
2933
2934 =cut
2935
2936 sub CheckRepeatableHolidays{
2937 my($itemnumber,$week_day,$branchcode)=@_;
2938 my $dbh = C4::Context->dbh;
2939 my $query = qq|SELECT count(*)
2940         FROM repeatable_holidays
2941         WHERE branchcode=?
2942         AND weekday=?|;
2943 my $sth = $dbh->prepare($query);
2944 $sth->execute($branchcode,$week_day);
2945 my $result=$sth->fetchrow;
2946 $sth->finish;
2947 return $result;
2948 }
2949
2950
2951 =head2 CheckSpecialHolidays
2952
2953   $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2954
2955 This function check if the date is a special holiday
2956
2957 C<$years>   = the years of datedue
2958 C<$month>   = the month of datedue
2959 C<$day>     = the day of datedue
2960 C<$itemnumber>  = itemnumber
2961 C<$branchcode>  = localisation of issue
2962
2963 =cut
2964
2965 sub CheckSpecialHolidays{
2966 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2967 my $dbh = C4::Context->dbh;
2968 my $query=qq|SELECT count(*)
2969              FROM `special_holidays`
2970              WHERE year=?
2971              AND month=?
2972              AND day=?
2973              AND branchcode=?
2974             |;
2975 my $sth = $dbh->prepare($query);
2976 $sth->execute($years,$month,$day,$branchcode);
2977 my $countspecial=$sth->fetchrow ;
2978 $sth->finish;
2979 return $countspecial;
2980 }
2981
2982 =head2 CheckRepeatableSpecialHolidays
2983
2984   $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2985
2986 This function check if the date is a repeatble special holidays
2987
2988 C<$month>   = the month of datedue
2989 C<$day>     = the day of datedue
2990 C<$itemnumber>  = itemnumber
2991 C<$branchcode>  = localisation of issue
2992
2993 =cut
2994
2995 sub CheckRepeatableSpecialHolidays{
2996 my ($month,$day,$itemnumber,$branchcode) = @_;
2997 my $dbh = C4::Context->dbh;
2998 my $query=qq|SELECT count(*)
2999              FROM `repeatable_holidays`
3000              WHERE month=?
3001              AND day=?
3002              AND branchcode=?
3003             |;
3004 my $sth = $dbh->prepare($query);
3005 $sth->execute($month,$day,$branchcode);
3006 my $countspecial=$sth->fetchrow ;
3007 $sth->finish;
3008 return $countspecial;
3009 }
3010
3011
3012
3013 sub CheckValidBarcode{
3014 my ($barcode) = @_;
3015 my $dbh = C4::Context->dbh;
3016 my $query=qq|SELECT count(*)
3017              FROM items
3018              WHERE barcode=?
3019             |;
3020 my $sth = $dbh->prepare($query);
3021 $sth->execute($barcode);
3022 my $exist=$sth->fetchrow ;
3023 $sth->finish;
3024 return $exist;
3025 }
3026
3027 =head2 IsBranchTransferAllowed
3028
3029   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3030
3031 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3032
3033 =cut
3034
3035 sub IsBranchTransferAllowed {
3036         my ( $toBranch, $fromBranch, $code ) = @_;
3037
3038         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3039
3040         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3041         my $dbh = C4::Context->dbh;
3042
3043         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3044         $sth->execute( $toBranch, $fromBranch, $code );
3045         my $limit = $sth->fetchrow_hashref();
3046
3047         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3048         if ( $limit->{'limitId'} ) {
3049                 return 0;
3050         } else {
3051                 return 1;
3052         }
3053 }
3054
3055 =head2 CreateBranchTransferLimit
3056
3057   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3058
3059 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3060
3061 =cut
3062
3063 sub CreateBranchTransferLimit {
3064    my ( $toBranch, $fromBranch, $code ) = @_;
3065
3066    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3067
3068    my $dbh = C4::Context->dbh;
3069
3070    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3071    $sth->execute( $code, $toBranch, $fromBranch );
3072 }
3073
3074 =head2 DeleteBranchTransferLimits
3075
3076 DeleteBranchTransferLimits($frombranch);
3077
3078 Deletes all the branch transfer limits for one branch
3079
3080 =cut
3081
3082 sub DeleteBranchTransferLimits {
3083     my $branch = shift;
3084     my $dbh    = C4::Context->dbh;
3085     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3086     $sth->execute($branch);
3087 }
3088
3089 sub ReturnLostItem{
3090     my ( $borrowernumber, $itemnum ) = @_;
3091
3092     MarkIssueReturned( $borrowernumber, $itemnum );
3093     my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3094     my @datearr = localtime(time);
3095     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3096     my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3097     ModItem({ paidfor =>  "Paid for by $bor $date" }, undef, $itemnum);
3098 }
3099
3100
3101 sub LostItem{
3102     my ($itemnumber, $mark_returned, $charge_fee) = @_;
3103
3104     my $dbh = C4::Context->dbh();
3105     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3106                            FROM issues
3107                            JOIN items USING (itemnumber)
3108                            JOIN biblio USING (biblionumber)
3109                            WHERE issues.itemnumber=?");
3110     $sth->execute($itemnumber);
3111     my $issues=$sth->fetchrow_hashref();
3112     $sth->finish;
3113
3114     # if a borrower lost the item, add a replacement cost to the their record
3115     if ( my $borrowernumber = $issues->{borrowernumber} ){
3116         my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3117
3118         C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}")
3119           if $charge_fee;
3120         #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3121         #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3122         MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3123     }
3124 }
3125
3126 sub GetOfflineOperations {
3127     my $dbh = C4::Context->dbh;
3128     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3129     $sth->execute(C4::Context->userenv->{'branch'});
3130     my $results = $sth->fetchall_arrayref({});
3131     $sth->finish;
3132     return $results;
3133 }
3134
3135 sub GetOfflineOperation {
3136     my $dbh = C4::Context->dbh;
3137     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3138     $sth->execute( shift );
3139     my $result = $sth->fetchrow_hashref;
3140     $sth->finish;
3141     return $result;
3142 }
3143
3144 sub AddOfflineOperation {
3145     my $dbh = C4::Context->dbh;
3146     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber) VALUES(?,?,?,?,?,?)");
3147     $sth->execute( @_ );
3148     return "Added.";
3149 }
3150
3151 sub DeleteOfflineOperation {
3152     my $dbh = C4::Context->dbh;
3153     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3154     $sth->execute( shift );
3155     return "Deleted.";
3156 }
3157
3158 sub ProcessOfflineOperation {
3159     my $operation = shift;
3160
3161     my $report;
3162     if ( $operation->{action} eq 'return' ) {
3163         $report = ProcessOfflineReturn( $operation );
3164     } elsif ( $operation->{action} eq 'issue' ) {
3165         $report = ProcessOfflineIssue( $operation );
3166     }
3167
3168     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3169
3170     return $report;
3171 }
3172
3173 sub ProcessOfflineReturn {
3174     my $operation = shift;
3175
3176     my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3177
3178     if ( $itemnumber ) {
3179         my $issue = GetOpenIssue( $itemnumber );
3180         if ( $issue ) {
3181             MarkIssueReturned(
3182                 $issue->{borrowernumber},
3183                 $itemnumber,
3184                 undef,
3185                 $operation->{timestamp},
3186             );
3187             ModItem(
3188                 { renewals => 0, onloan => undef },
3189                 $issue->{'biblionumber'},
3190                 $itemnumber
3191             );
3192             return "Success.";
3193         } else {
3194             return "Item not issued.";
3195         }
3196     } else {
3197         return "Item not found.";
3198     }
3199 }
3200
3201 sub ProcessOfflineIssue {
3202     my $operation = shift;
3203
3204     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3205
3206     if ( $borrower->{borrowernumber} ) {
3207         my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3208         unless ($itemnumber) {
3209             return "Barcode not found.";
3210         }
3211         my $issue = GetOpenIssue( $itemnumber );
3212
3213         if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3214             MarkIssueReturned(
3215                 $issue->{borrowernumber},
3216                 $itemnumber,
3217                 undef,
3218                 $operation->{timestamp},
3219             );
3220         }
3221         AddIssue(
3222             $borrower,
3223             $operation->{'barcode'},
3224             undef,
3225             1,
3226             $operation->{timestamp},
3227             undef,
3228         );
3229         return "Success.";
3230     } else {
3231         return "Borrower not found.";
3232     }
3233 }
3234
3235
3236
3237 =head2 TransferSlip
3238
3239   TransferSlip($user_branch, $itemnumber, $to_branch)
3240
3241   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3242
3243 =cut
3244
3245 sub TransferSlip {
3246     my ($branch, $itemnumber, $to_branch) = @_;
3247
3248     my $item =  GetItem( $itemnumber )
3249       or return;
3250
3251     my $pulldate = C4::Dates->new();
3252
3253     return C4::Letters::GetPreparedLetter (
3254         module => 'circulation',
3255         letter_code => 'TRANSFERSLIP',
3256         branchcode => $branch,
3257         tables => {
3258             'branches'    => $to_branch,
3259             'biblio'      => $item->{biblionumber},
3260             'items'       => $item,
3261         },
3262     );
3263 }
3264
3265
3266 1;
3267
3268 __END__
3269
3270 =head1 AUTHOR
3271
3272 Koha Development Team <http://koha-community.org/>
3273
3274 =cut
3275