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