C4/Circulation.pm

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