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