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