C4/Circulation.pm

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