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