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