C4/Circulation.pm

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