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
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21
  22 use strict;
  23 #use warnings; FIXME - Bug 2505
  24 use DateTime;
  25 use Koha::DateUtils;
  26 use C4::Context;
  27 use C4::Stats;
  28 use C4::Reserves;
  29 use C4::Biblio;
  30 use C4::Items;
  31 use C4::Members;
  32 use C4::Accounts;
  33 use C4::ItemCirculationAlertPreference;
  34 use C4::Message;
  35 use C4::Debug;
  36 use C4::Branch; # GetBranches
  37 use C4::Log; # logaction
  38 use C4::Koha qw(
  39     GetAuthorisedValueByCode
  40     GetAuthValCode
  41     GetKohaAuthorisedValueLib
  42 );
  43 use C4::Overdues qw(CalcFine UpdateFine get_chargeable_units);
  44 use C4::RotatingCollections qw(GetCollectionItemBranches);
  45 use Algorithm::CheckDigits;
  46
  47 use Data::Dumper;
  48 use Koha::DateUtils;
  49 use Koha::Calendar;
  50 use Koha::Items;
  51 use Koha::Borrowers;
  52 use Koha::Borrower::Debarments;
  53 use Koha::Database;
  54 use Carp;
  55 use List::MoreUtils qw( uniq );
  56 use Date::Calc qw(
  57   Today
  58   Today_and_Now
  59   Add_Delta_YM
  60   Add_Delta_DHMS
  61   Date_to_Days
  62   Day_of_Week
  63   Add_Delta_Days
  64 );
  65 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  66
  67 BEGIN {
  68         require Exporter;
  69     $VERSION = 3.07.00.049;     # for version checking
  70         @ISA    = qw(Exporter);
  71
  72         # FIXME subs that should probably be elsewhere
  73         push @EXPORT, qw(
  74                 &barcodedecode
  75         &LostItem
  76         &ReturnLostItem
  77         &GetPendingOnSiteCheckouts
  78         );
  79
  80         # subs to deal with issuing a book
  81         push @EXPORT, qw(
  82                 &CanBookBeIssued
  83                 &CanBookBeRenewed
  84                 &AddIssue
  85                 &AddRenewal
  86                 &GetRenewCount
  87         &GetSoonestRenewDate
  88                 &GetItemIssue
  89                 &GetItemIssues
  90                 &GetIssuingCharges
  91                 &GetIssuingRule
  92         &GetBranchBorrowerCircRule
  93         &GetBranchItemRule
  94                 &GetBiblioIssues
  95                 &GetOpenIssue
  96                 &AnonymiseIssueHistory
  97         &CheckIfIssuedToPatron
  98         &IsItemIssued
  99         GetTopIssues
 100         );
 101
 102         # subs to deal with returns
 103         push @EXPORT, qw(
 104                 &AddReturn
 105         &MarkIssueReturned
 106         );
 107
 108         # subs to deal with transfers
 109         push @EXPORT, qw(
 110                 &transferbook
 111                 &GetTransfers
 112                 &GetTransfersFromTo
 113                 &updateWrongTransfer
 114                 &DeleteTransfer
 115                 &IsBranchTransferAllowed
 116                 &CreateBranchTransferLimit
 117                 &DeleteBranchTransferLimits
 118         &TransferSlip
 119         );
 120
 121     # subs to deal with offline circulation
 122     push @EXPORT, qw(
 123       &GetOfflineOperations
 124       &GetOfflineOperation
 125       &AddOfflineOperation
 126       &DeleteOfflineOperation
 127       &ProcessOfflineOperation
 128     );
 129 }
 130
 131 =head1 NAME
 132
 133 C4::Circulation - Koha circulation module
 134
 135 =head1 SYNOPSIS
 136
 137 use C4::Circulation;
 138
 139 =head1 DESCRIPTION
 140
 141 The functions in this module deal with circulation, issues, and
 142 returns, as well as general information about the library.
 143 Also deals with stocktaking.
 144
 145 =head1 FUNCTIONS
 146
 147 =head2 barcodedecode
 148
 149   $str = &barcodedecode($barcode, [$filter]);
 150
 151 Generic filter function for barcode string.
 152 Called on every circ if the System Pref itemBarcodeInputFilter is set.
 153 Will do some manipulation of the barcode for systems that deliver a barcode
 154 to circulation.pl that differs from the barcode stored for the item.
 155 For proper functioning of this filter, calling the function on the
 156 correct barcode string (items.barcode) should return an unaltered barcode.
 157
 158 The optional $filter argument is to allow for testing or explicit
 159 behavior that ignores the System Pref.  Valid values are the same as the
 160 System Pref options.
 161
 162 =cut
 163
 164 # FIXME -- the &decode fcn below should be wrapped into this one.
 165 # FIXME -- these plugins should be moved out of Circulation.pm
 166 #
 167 sub barcodedecode {
 168     my ($barcode, $filter) = @_;
 169     my $branch = C4::Branch::mybranch();
 170     $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
 171     $filter or return $barcode;     # ensure filter is defined, else return untouched barcode
 172         if ($filter eq 'whitespace') {
 173                 $barcode =~ s/\s//g;
 174         } elsif ($filter eq 'cuecat') {
 175                 chomp($barcode);
 176             my @fields = split( /\./, $barcode );
 177             my @results = map( decode($_), @fields[ 1 .. $#fields ] );
 178             ($#results == 2) and return $results[2];
 179         } elsif ($filter eq 'T-prefix') {
 180                 if ($barcode =~ /^[Tt](\d)/) {
 181                         (defined($1) and $1 eq '0') and return $barcode;
 182             $barcode = substr($barcode, 2) + 0;     # FIXME: probably should be substr($barcode, 1)
 183                 }
 184         return sprintf("T%07d", $barcode);
 185         # FIXME: $barcode could be "T1", causing warning: substr outside of string
 186         # Why drop the nonzero digit after the T?
 187         # Why pass non-digits (or empty string) to "T%07d"?
 188         } elsif ($filter eq 'libsuite8') {
 189                 unless($barcode =~ m/^($branch)-/i){    #if barcode starts with branch code its in Koha style. Skip it.
 190                         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
 191                                 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
 192                         }else{
 193                                 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
 194                         }
 195                 }
 196     } elsif ($filter eq 'EAN13') {
 197         my $ean = CheckDigits('ean');
 198         if ( $ean->is_valid($barcode) ) {
 199             #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
 200             $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
 201         } else {
 202             warn "# [$barcode] not valid EAN-13/UPC-A\n";
 203         }
 204         }
 205     return $barcode;    # return barcode, modified or not
 206 }
 207
 208 =head2 decode
 209
 210   $str = &decode($chunk);
 211
 212 Decodes a segment of a string emitted by a CueCat barcode scanner and
 213 returns it.
 214
 215 FIXME: Should be replaced with Barcode::Cuecat from CPAN
 216 or Javascript based decoding on the client side.
 217
 218 =cut
 219
 220 sub decode {
 221     my ($encoded) = @_;
 222     my $seq =
 223       'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
 224     my @s = map { index( $seq, $_ ); } split( //, $encoded );
 225     my $l = ( $#s + 1 ) % 4;
 226     if ($l) {
 227         if ( $l == 1 ) {
 228             # warn "Error: Cuecat decode parsing failed!";
 229             return;
 230         }
 231         $l = 4 - $l;
 232         $#s += $l;
 233     }
 234     my $r = '';
 235     while ( $#s >= 0 ) {
 236         my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
 237         $r .=
 238             chr( ( $n >> 16 ) ^ 67 )
 239          .chr( ( $n >> 8 & 255 ) ^ 67 )
 240          .chr( ( $n & 255 ) ^ 67 );
 241         @s = @s[ 4 .. $#s ];
 242     }
 243     $r = substr( $r, 0, length($r) - $l );
 244     return $r;
 245 }
 246
 247 =head2 transferbook
 248
 249   ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
 250                                             $barcode, $ignore_reserves);
 251
 252 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
 253
 254 C<$newbranch> is the code for the branch to which the item should be transferred.
 255
 256 C<$barcode> is the barcode of the item to be transferred.
 257
 258 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
 259 Otherwise, if an item is reserved, the transfer fails.
 260
 261 Returns three values:
 262
 263 =over
 264
 265 =item $dotransfer
 266
 267 is true if the transfer was successful.
 268
 269 =item $messages
 270
 271 is a reference-to-hash which may have any of the following keys:
 272
 273 =over
 274
 275 =item C<BadBarcode>
 276
 277 There is no item in the catalog with the given barcode. The value is C<$barcode>.
 278
 279 =item C<IsPermanent>
 280
 281 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.
 282
 283 =item C<DestinationEqualsHolding>
 284
 285 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.
 286
 287 =item C<WasReturned>
 288
 289 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.
 290
 291 =item C<ResFound>
 292
 293 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>.
 294
 295 =item C<WasTransferred>
 296
 297 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
 298
 299 =back
 300
 301 =back
 302
 303 =cut
 304
 305 sub transferbook {
 306     my ( $tbr, $barcode, $ignoreRs ) = @_;
 307     my $messages;
 308     my $dotransfer      = 1;
 309     my $branches        = GetBranches();
 310     my $itemnumber = GetItemnumberFromBarcode( $barcode );
 311     my $issue      = GetItemIssue($itemnumber);
 312     my $biblio = GetBiblioFromItemNumber($itemnumber);
 313
 314     # bad barcode..
 315     if ( not $itemnumber ) {
 316         $messages->{'BadBarcode'} = $barcode;
 317         $dotransfer = 0;
 318     }
 319
 320     # get branches of book...
 321     my $hbr = $biblio->{'homebranch'};
 322     my $fbr = $biblio->{'holdingbranch'};
 323
 324     # if using Branch Transfer Limits
 325     if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
 326         if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
 327             if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
 328                 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
 329                 $dotransfer = 0;
 330             }
 331         } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
 332             $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
 333             $dotransfer = 0;
 334         }
 335     }
 336
 337     # if is permanent...
 338     if ( $hbr && $branches->{$hbr}->{'PE'} ) {
 339         $messages->{'IsPermanent'} = $hbr;
 340         $dotransfer = 0;
 341     }
 342
 343     # can't transfer book if is already there....
 344     if ( $fbr eq $tbr ) {
 345         $messages->{'DestinationEqualsHolding'} = 1;
 346         $dotransfer = 0;
 347     }
 348
 349     # check if it is still issued to someone, return it...
 350     if ($issue->{borrowernumber}) {
 351         AddReturn( $barcode, $fbr );
 352         $messages->{'WasReturned'} = $issue->{borrowernumber};
 353     }
 354
 355     # find reserves.....
 356     # That'll save a database query.
 357     my ( $resfound, $resrec, undef ) =
 358       CheckReserves( $itemnumber );
 359     if ( $resfound and not $ignoreRs ) {
 360         $resrec->{'ResFound'} = $resfound;
 361
 362         #         $messages->{'ResFound'} = $resrec;
 363         $dotransfer = 1;
 364     }
 365
 366     #actually do the transfer....
 367     if ($dotransfer) {
 368         ModItemTransfer( $itemnumber, $fbr, $tbr );
 369
 370         # don't need to update MARC anymore, we do it in batch now
 371         $messages->{'WasTransfered'} = 1;
 372
 373     }
 374     ModDateLastSeen( $itemnumber );
 375     return ( $dotransfer, $messages, $biblio );
 376 }
 377
 378
 379 sub TooMany {
 380     my $borrower        = shift;
 381     my $biblionumber = shift;
 382         my $item                = shift;
 383     my $params = shift;
 384     my $onsite_checkout = $params->{onsite_checkout} || 0;
 385     my $cat_borrower    = $borrower->{'categorycode'};
 386     my $dbh             = C4::Context->dbh;
 387         my $branch;
 388         # Get which branchcode we need
 389         $branch = _GetCircControlBranch($item,$borrower);
 390         my $type = (C4::Context->preference('item-level_itypes'))
 391                         ? $item->{'itype'}         # item-level
 392                         : $item->{'itemtype'};     # biblio-level
 393
 394     # given branch, patron category, and item type, determine
 395     # applicable issuing rule
 396     my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
 397
 398     # if a rule is found and has a loan limit set, count
 399     # how many loans the patron already has that meet that
 400     # rule
 401     if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
 402         my @bind_params;
 403         my $count_query = q|
 404             SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
 405             FROM issues
 406             JOIN items USING (itemnumber)
 407         |;
 408
 409         my $rule_itemtype = $issuing_rule->{itemtype};
 410         if ($rule_itemtype eq "*") {
 411             # matching rule has the default item type, so count only
 412             # those existing loans that don't fall under a more
 413             # specific rule
 414             if (C4::Context->preference('item-level_itypes')) {
 415                 $count_query .= " WHERE items.itype NOT IN (
 416                                     SELECT itemtype FROM issuingrules
 417                                     WHERE branchcode = ?
 418                                     AND   (categorycode = ? OR categorycode = ?)
 419                                     AND   itemtype <> '*'
 420                                   ) ";
 421             } else {
 422                 $count_query .= " JOIN  biblioitems USING (biblionumber)
 423                                   WHERE biblioitems.itemtype NOT IN (
 424                                     SELECT itemtype FROM issuingrules
 425                                     WHERE branchcode = ?
 426                                     AND   (categorycode = ? OR categorycode = ?)
 427                                     AND   itemtype <> '*'
 428                                   ) ";
 429             }
 430             push @bind_params, $issuing_rule->{branchcode};
 431             push @bind_params, $issuing_rule->{categorycode};
 432             push @bind_params, $cat_borrower;
 433         } else {
 434             # rule has specific item type, so count loans of that
 435             # specific item type
 436             if (C4::Context->preference('item-level_itypes')) {
 437                 $count_query .= " WHERE items.itype = ? ";
 438             } else {
 439                 $count_query .= " JOIN  biblioitems USING (biblionumber)
 440                                   WHERE biblioitems.itemtype= ? ";
 441             }
 442             push @bind_params, $type;
 443         }
 444
 445         $count_query .= " AND borrowernumber = ? ";
 446         push @bind_params, $borrower->{'borrowernumber'};
 447         my $rule_branch = $issuing_rule->{branchcode};
 448         if ($rule_branch ne "*") {
 449             if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
 450                 $count_query .= " AND issues.branchcode = ? ";
 451                 push @bind_params, $branch;
 452             } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
 453                 ; # if branch is the patron's home branch, then count all loans by patron
 454             } else {
 455                 $count_query .= " AND items.homebranch = ? ";
 456                 push @bind_params, $branch;
 457             }
 458         }
 459
 460         my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $count_query, {}, @bind_params );
 461
 462         my $max_checkouts_allowed = $issuing_rule->{maxissueqty};
 463         my $max_onsite_checkouts_allowed = $issuing_rule->{maxonsiteissueqty};
 464
 465         if ( $onsite_checkout ) {
 466             if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed )  {
 467                 return {
 468                     reason => 'TOO_MANY_ONSITE_CHECKOUTS',
 469                     count => $onsite_checkout_count,
 470                     max_allowed => $max_onsite_checkouts_allowed,
 471                 }
 472             }
 473         }
 474         if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
 475             if ( $checkout_count >= $max_checkouts_allowed ) {
 476                 return {
 477                     reason => 'TOO_MANY_CHECKOUTS',
 478                     count => $checkout_count,
 479                     max_allowed => $max_checkouts_allowed,
 480                 };
 481             }
 482         } elsif ( not $onsite_checkout ) {
 483             if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed )  {
 484                 return {
 485                     reason => 'TOO_MANY_CHECKOUTS',
 486                     count => $checkout_count - $onsite_checkout_count,
 487                     max_allowed => $max_checkouts_allowed,
 488                 };
 489             }
 490         }
 491     }
 492
 493     # Now count total loans against the limit for the branch
 494     my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
 495     if (defined($branch_borrower_circ_rule->{maxissueqty})) {
 496         my @bind_params = ();
 497         my $branch_count_query = q|
 498             SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
 499             FROM issues
 500             JOIN items USING (itemnumber)
 501             WHERE borrowernumber = ?
 502         |;
 503         push @bind_params, $borrower->{borrowernumber};
 504
 505         if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
 506             $branch_count_query .= " AND issues.branchcode = ? ";
 507             push @bind_params, $branch;
 508         } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
 509             ; # if branch is the patron's home branch, then count all loans by patron
 510         } else {
 511             $branch_count_query .= " AND items.homebranch = ? ";
 512             push @bind_params, $branch;
 513         }
 514         my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $branch_count_query, {}, @bind_params );
 515         my $max_checkouts_allowed = $branch_borrower_circ_rule->{maxissueqty};
 516         my $max_onsite_checkouts_allowed = $branch_borrower_circ_rule->{maxonsiteissueqty};
 517
 518         if ( $onsite_checkout ) {
 519             if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed )  {
 520                 return {
 521                     reason => 'TOO_MANY_ONSITE_CHECKOUTS',
 522                     count => $onsite_checkout_count,
 523                     max_allowed => $max_onsite_checkouts_allowed,
 524                 }
 525             }
 526         }
 527         if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
 528             if ( $checkout_count >= $max_checkouts_allowed ) {
 529                 return {
 530                     reason => 'TOO_MANY_CHECKOUTS',
 531                     count => $checkout_count,
 532                     max_allowed => $max_checkouts_allowed,
 533                 };
 534             }
 535         } elsif ( not $onsite_checkout ) {
 536             if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed )  {
 537                 return {
 538                     reason => 'TOO_MANY_CHECKOUTS',
 539                     count => $checkout_count - $onsite_checkout_count,
 540                     max_allowed => $max_checkouts_allowed,
 541                 };
 542             }
 543         }
 544     }
 545
 546     # OK, the patron can issue !!!
 547     return;
 548 }
 549
 550 =head2 itemissues
 551
 552   @issues = &itemissues($biblioitemnumber, $biblio);
 553
 554 Looks up information about who has borrowed the bookZ<>(s) with the
 555 given biblioitemnumber.
 556
 557 C<$biblio> is ignored.
 558
 559 C<&itemissues> returns an array of references-to-hash. The keys
 560 include the fields from the C<items> table in the Koha database.
 561 Additional keys include:
 562
 563 =over 4
 564
 565 =item C<date_due>
 566
 567 If the item is currently on loan, this gives the due date.
 568
 569 If the item is not on loan, then this is either "Available" or
 570 "Cancelled", if the item has been withdrawn.
 571
 572 =item C<card>
 573
 574 If the item is currently on loan, this gives the card number of the
 575 patron who currently has the item.
 576
 577 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
 578
 579 These give the timestamp for the last three times the item was
 580 borrowed.
 581
 582 =item C<card0>, C<card1>, C<card2>
 583
 584 The card number of the last three patrons who borrowed this item.
 585
 586 =item C<borrower0>, C<borrower1>, C<borrower2>
 587
 588 The borrower number of the last three patrons who borrowed this item.
 589
 590 =back
 591
 592 =cut
 593
 594 #'
 595 sub itemissues {
 596     my ( $bibitem, $biblio ) = @_;
 597     my $dbh = C4::Context->dbh;
 598     my $sth =
 599       $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
 600       || die $dbh->errstr;
 601     my $i = 0;
 602     my @results;
 603
 604     $sth->execute($bibitem) || die $sth->errstr;
 605
 606     while ( my $data = $sth->fetchrow_hashref ) {
 607
 608         # Find out who currently has this item.
 609         # FIXME - Wouldn't it be better to do this as a left join of
 610         # some sort? Currently, this code assumes that if
 611         # fetchrow_hashref() fails, then the book is on the shelf.
 612         # fetchrow_hashref() can fail for any number of reasons (e.g.,
 613         # database server crash), not just because no items match the
 614         # search criteria.
 615         my $sth2 = $dbh->prepare(
 616             "SELECT * FROM issues
 617                 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 618                 WHERE itemnumber = ?
 619             "
 620         );
 621
 622         $sth2->execute( $data->{'itemnumber'} );
 623         if ( my $data2 = $sth2->fetchrow_hashref ) {
 624             $data->{'date_due'} = $data2->{'date_due'};
 625             $data->{'card'}     = $data2->{'cardnumber'};
 626             $data->{'borrower'} = $data2->{'borrowernumber'};
 627         }
 628         else {
 629             $data->{'date_due'} = ($data->{'withdrawn'} eq '1') ? 'Cancelled' : 'Available';
 630         }
 631
 632
 633         # Find the last 3 people who borrowed this item.
 634         $sth2 = $dbh->prepare(
 635             "SELECT * FROM old_issues
 636                 LEFT JOIN borrowers ON  issues.borrowernumber = borrowers.borrowernumber
 637                 WHERE itemnumber = ?
 638                 ORDER BY returndate DESC,timestamp DESC"
 639         );
 640
 641         $sth2->execute( $data->{'itemnumber'} );
 642         for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
 643         {    # FIXME : error if there is less than 3 pple borrowing this item
 644             if ( my $data2 = $sth2->fetchrow_hashref ) {
 645                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
 646                 $data->{"card$i2"}      = $data2->{'cardnumber'};
 647                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
 648             }    # if
 649         }    # for
 650
 651         $results[$i] = $data;
 652         $i++;
 653     }
 654
 655     return (@results);
 656 }
 657
 658 =head2 CanBookBeIssued
 659
 660   ( $issuingimpossible, $needsconfirmation ) =  CanBookBeIssued( $borrower,
 661                       $barcode, $duedate, $inprocess, $ignore_reserves );
 662
 663 Check if a book can be issued.
 664
 665 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
 666
 667 =over 4
 668
 669 =item C<$borrower> hash with borrower informations (from GetMember or GetMemberDetails)
 670
 671 =item C<$barcode> is the bar code of the book being issued.
 672
 673 =item C<$duedates> is a DateTime object.
 674
 675 =item C<$inprocess> boolean switch
 676 =item C<$ignore_reserves> boolean switch
 677
 678 =back
 679
 680 Returns :
 681
 682 =over 4
 683
 684 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
 685 Possible values are :
 686
 687 =back
 688
 689 =head3 INVALID_DATE
 690
 691 sticky due date is invalid
 692
 693 =head3 GNA
 694
 695 borrower gone with no address
 696
 697 =head3 CARD_LOST
 698
 699 borrower declared it's card lost
 700
 701 =head3 DEBARRED
 702
 703 borrower debarred
 704
 705 =head3 UNKNOWN_BARCODE
 706
 707 barcode unknown
 708
 709 =head3 NOT_FOR_LOAN
 710
 711 item is not for loan
 712
 713 =head3 WTHDRAWN
 714
 715 item withdrawn.
 716
 717 =head3 RESTRICTED
 718
 719 item is restricted (set by ??)
 720
 721 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
 722 could be prevented, but ones that can be overriden by the operator.
 723
 724 Possible values are :
 725
 726 =head3 DEBT
 727
 728 borrower has debts.
 729
 730 =head3 RENEW_ISSUE
 731
 732 renewing, not issuing
 733
 734 =head3 ISSUED_TO_ANOTHER
 735
 736 issued to someone else.
 737
 738 =head3 RESERVED
 739
 740 reserved for someone else.
 741
 742 =head3 INVALID_DATE
 743
 744 sticky due date is invalid or due date in the past
 745
 746 =head3 TOO_MANY
 747
 748 if the borrower borrows to much things
 749
 750 =cut
 751
 752 sub CanBookBeIssued {
 753     my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves, $params ) = @_;
 754     my %needsconfirmation;    # filled with problems that needs confirmations
 755     my %issuingimpossible;    # filled with problems that causes the issue to be IMPOSSIBLE
 756     my %alerts;               # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
 757
 758     my $onsite_checkout = $params->{onsite_checkout} || 0;
 759
 760     my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
 761     my $issue = GetItemIssue($item->{itemnumber});
 762         my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
 763         $item->{'itemtype'}=$item->{'itype'};
 764     my $dbh             = C4::Context->dbh;
 765
 766     # MANDATORY CHECKS - unless item exists, nothing else matters
 767     unless ( $item->{barcode} ) {
 768         $issuingimpossible{UNKNOWN_BARCODE} = 1;
 769     }
 770         return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
 771
 772     #
 773     # DUE DATE is OK ? -- should already have checked.
 774     #
 775     if ($duedate && ref $duedate ne 'DateTime') {
 776         $duedate = dt_from_string($duedate);
 777     }
 778     my $now = DateTime->now( time_zone => C4::Context->tz() );
 779     unless ( $duedate ) {
 780         my $issuedate = $now->clone();
 781
 782         my $branch = _GetCircControlBranch($item,$borrower);
 783         my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
 784         $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
 785
 786         # Offline circ calls AddIssue directly, doesn't run through here
 787         #  So issuingimpossible should be ok.
 788     }
 789     if ($duedate) {
 790         my $today = $now->clone();
 791         $today->truncate( to => 'minute');
 792         if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
 793             $needsconfirmation{INVALID_DATE} = output_pref($duedate);
 794         }
 795     } else {
 796             $issuingimpossible{INVALID_DATE} = output_pref($duedate);
 797     }
 798
 799     #
 800     # BORROWER STATUS
 801     #
 802     if ( $borrower->{'category_type'} eq 'X' && (  $item->{barcode}  )) {
 803         # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1  .
 804         &UpdateStats({
 805                      branch => C4::Context->userenv->{'branch'},
 806                      type => 'localuse',
 807                      itemnumber => $item->{'itemnumber'},
 808                      itemtype => $item->{'itemtype'},
 809                      borrowernumber => $borrower->{'borrowernumber'},
 810                      ccode => $item->{'ccode'}}
 811                     );
 812         ModDateLastSeen( $item->{'itemnumber'} );
 813         return( { STATS => 1 }, {});
 814     }
 815     if ( ref $borrower->{flags} ) {
 816         if ( $borrower->{flags}->{GNA} ) {
 817             $issuingimpossible{GNA} = 1;
 818         }
 819         if ( $borrower->{flags}->{'LOST'} ) {
 820             $issuingimpossible{CARD_LOST} = 1;
 821         }
 822         if ( $borrower->{flags}->{'DBARRED'} ) {
 823             $issuingimpossible{DEBARRED} = 1;
 824         }
 825     }
 826     if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
 827         $issuingimpossible{EXPIRED} = 1;
 828     } else {
 829         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'sql', 'floating' );
 830         $expiry_dt->truncate( to => 'day');
 831         my $today = $now->clone()->truncate(to => 'day');
 832         $today->set_time_zone( 'floating' );
 833         if ( DateTime->compare($today, $expiry_dt) == 1 ) {
 834             $issuingimpossible{EXPIRED} = 1;
 835         }
 836     }
 837
 838     #
 839     # BORROWER STATUS
 840     #
 841
 842     # DEBTS
 843     my ($balance, $non_issue_charges, $other_charges) =
 844       C4::Members::GetMemberAccountBalance( $borrower->{'borrowernumber'} );
 845     my $amountlimit = C4::Context->preference("noissuescharge");
 846     my $allowfineoverride = C4::Context->preference("AllowFineOverride");
 847     my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
 848     if ( C4::Context->preference("IssuingInProcess") ) {
 849         if ( $non_issue_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
 850             $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
 851         } elsif ( $non_issue_charges > $amountlimit && !$inprocess && $allowfineoverride) {
 852             $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
 853         } elsif ( $allfinesneedoverride && $non_issue_charges > 0 && $non_issue_charges <= $amountlimit && !$inprocess ) {
 854             $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
 855         }
 856     }
 857     else {
 858         if ( $non_issue_charges > $amountlimit && $allowfineoverride ) {
 859             $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
 860         } elsif ( $non_issue_charges > $amountlimit && !$allowfineoverride) {
 861             $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
 862         } elsif ( $non_issue_charges > 0 && $allfinesneedoverride ) {
 863             $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
 864         }
 865     }
 866     if ($balance > 0 && $other_charges > 0) {
 867         $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
 868     }
 869
 870     my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
 871     if ($blocktype == -1) {
 872         ## patron has outstanding overdue loans
 873             if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
 874                 $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
 875             }
 876             elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
 877                 $needsconfirmation{USERBLOCKEDOVERDUE} = $count;
 878             }
 879     } elsif($blocktype == 1) {
 880         # patron has accrued fine days or has a restriction. $count is a date
 881         if ($count eq '9999-12-31') {
 882             $issuingimpossible{USERBLOCKEDNOENDDATE} = $count;
 883         }
 884         else {
 885             $issuingimpossible{USERBLOCKEDWITHENDDATE} = $count;
 886         }
 887     }
 888
 889 #
 890     # JB34 CHECKS IF BORROWERS DON'T HAVE ISSUE TOO MANY BOOKS
 891     #
 892     my $toomany = TooMany( $borrower, $item->{biblionumber}, $item, { onsite_checkout => $onsite_checkout } );
 893     # if TooMany max_allowed returns 0 the user doesn't have permission to check out this book
 894     if ( $toomany ) {
 895         if ( $toomany->{max_allowed} == 0 ) {
 896             $needsconfirmation{PATRON_CANT} = 1;
 897         }
 898         if ( C4::Context->preference("AllowTooManyOverride") ) {
 899             $needsconfirmation{TOO_MANY} = $toomany->{reason};
 900             $needsconfirmation{current_loan_count} = $toomany->{count};
 901             $needsconfirmation{max_loans_allowed} = $toomany->{max_allowed};
 902         } else {
 903             $needsconfirmation{TOO_MANY} = $toomany->{reason};
 904             $issuingimpossible{current_loan_count} = $toomany->{count};
 905             $issuingimpossible{max_loans_allowed} = $toomany->{max_allowed};
 906         }
 907     }
 908
 909     #
 910     # ITEM CHECKING
 911     #
 912     if ( $item->{'notforloan'} )
 913     {
 914         if(!C4::Context->preference("AllowNotForLoanOverride")){
 915             $issuingimpossible{NOT_FOR_LOAN} = 1;
 916             $issuingimpossible{item_notforloan} = $item->{'notforloan'};
 917         }else{
 918             $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 919             $needsconfirmation{item_notforloan} = $item->{'notforloan'};
 920         }
 921     }
 922     else {
 923         # we have to check itemtypes.notforloan also
 924         if (C4::Context->preference('item-level_itypes')){
 925             # this should probably be a subroutine
 926             my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
 927             $sth->execute($item->{'itemtype'});
 928             my $notforloan=$sth->fetchrow_hashref();
 929             if ($notforloan->{'notforloan'}) {
 930                 if (!C4::Context->preference("AllowNotForLoanOverride")) {
 931                     $issuingimpossible{NOT_FOR_LOAN} = 1;
 932                     $issuingimpossible{itemtype_notforloan} = $item->{'itype'};
 933                 } else {
 934                     $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 935                     $needsconfirmation{itemtype_notforloan} = $item->{'itype'};
 936                 }
 937             }
 938         }
 939         elsif ($biblioitem->{'notforloan'} == 1){
 940             if (!C4::Context->preference("AllowNotForLoanOverride")) {
 941                 $issuingimpossible{NOT_FOR_LOAN} = 1;
 942                 $issuingimpossible{itemtype_notforloan} = $biblioitem->{'itemtype'};
 943             } else {
 944                 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
 945                 $needsconfirmation{itemtype_notforloan} = $biblioitem->{'itemtype'};
 946             }
 947         }
 948     }
 949     if ( $item->{'withdrawn'} && $item->{'withdrawn'} > 0 )
 950     {
 951         $issuingimpossible{WTHDRAWN} = 1;
 952     }
 953     if (   $item->{'restricted'}
 954         && $item->{'restricted'} == 1 )
 955     {
 956         $issuingimpossible{RESTRICTED} = 1;
 957     }
 958     if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
 959         my $code = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
 960         $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
 961         $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
 962     }
 963     if ( C4::Context->preference("IndependentBranches") ) {
 964         my $userenv = C4::Context->userenv;
 965         unless ( C4::Context->IsSuperLibrarian() ) {
 966             if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
 967                 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
 968                 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
 969             }
 970             $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
 971               if ( $borrower->{'branchcode'} ne $userenv->{branch} );
 972         }
 973     }
 974     #
 975     # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
 976     #
 977     my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
 978
 979     if ( $rentalConfirmation ){
 980         my ($rentalCharge) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
 981         if ( $rentalCharge > 0 ){
 982             $rentalCharge = sprintf("%.02f", $rentalCharge);
 983             $needsconfirmation{RENTALCHARGE} = $rentalCharge;
 984         }
 985     }
 986
 987     #
 988     # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
 989     #
 990     if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} ){
 991
 992         # Already issued to current borrower. Ask whether the loan should
 993         # be renewed.
 994         my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
 995             $borrower->{'borrowernumber'},
 996             $item->{'itemnumber'}
 997         );
 998         if ( $CanBookBeRenewed == 0 ) {    # no more renewals allowed
 999             if ( $renewerror eq 'onsite_checkout' ) {
1000                 $issuingimpossible{NO_RENEWAL_FOR_ONSITE_CHECKOUTS} = 1;
1001             }
1002             else {
1003                 $issuingimpossible{NO_MORE_RENEWALS} = 1;
1004             }
1005         }
1006         else {
1007             $needsconfirmation{RENEW_ISSUE} = 1;
1008         }
1009     }
1010     elsif ($issue->{borrowernumber}) {
1011
1012         # issued to someone else
1013         my $currborinfo =    C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
1014
1015 #        warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
1016         $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
1017         $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
1018         $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
1019         $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
1020         $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
1021     }
1022
1023     unless ( $ignore_reserves ) {
1024         # See if the item is on reserve.
1025         my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1026         if ($restype) {
1027             my $resbor = $res->{'borrowernumber'};
1028             if ( $resbor ne $borrower->{'borrowernumber'} ) {
1029                 my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
1030                 my $branchname = GetBranchName( $res->{'branchcode'} );
1031                 if ( $restype eq "Waiting" )
1032                 {
1033                     # The item is on reserve and waiting, but has been
1034                     # reserved by some other patron.
1035                     $needsconfirmation{RESERVE_WAITING} = 1;
1036                     $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
1037                     $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
1038                     $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1039                     $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1040                     $needsconfirmation{'resbranchname'} = $branchname;
1041                     $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
1042                 }
1043                 elsif ( $restype eq "Reserved" ) {
1044                     # The item is on reserve for someone else.
1045                     $needsconfirmation{RESERVED} = 1;
1046                     $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
1047                     $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
1048                     $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1049                     $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1050                     $needsconfirmation{'resbranchname'} = $branchname;
1051                     $needsconfirmation{'resreservedate'} = $res->{'reservedate'};
1052                 }
1053             }
1054         }
1055     }
1056
1057     ## CHECK AGE RESTRICTION
1058     my $agerestriction  = $biblioitem->{'agerestriction'};
1059     my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
1060     if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1061         if ( C4::Context->preference('AgeRestrictionOverride') ) {
1062             $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1063         }
1064         else {
1065             $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1066         }
1067     }
1068
1069     ## check for high holds decreasing loan period
1070     my $decrease_loan = C4::Context->preference('decreaseLoanHighHolds');
1071     if ( $decrease_loan && $decrease_loan == 1 ) {
1072         my ( $reserved, $num, $duration, $returndate ) =
1073           checkHighHolds( $item, $borrower );
1074
1075         if ( $num >= C4::Context->preference('decreaseLoanHighHoldsValue') ) {
1076             $needsconfirmation{HIGHHOLDS} = {
1077                 num_holds  => $num,
1078                 duration   => $duration,
1079                 returndate => output_pref($returndate),
1080             };
1081         }
1082     }
1083
1084     if (
1085         !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1086         # don't do the multiple loans per bib check if we've
1087         # already determined that we've got a loan on the same item
1088         !$issuingimpossible{NO_MORE_RENEWALS} &&
1089         !$needsconfirmation{RENEW_ISSUE}
1090     ) {
1091         # Check if borrower has already issued an item from the same biblio
1092         # Only if it's not a subscription
1093         my $biblionumber = $item->{biblionumber};
1094         require C4::Serials;
1095         my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1096         unless ($is_a_subscription) {
1097             my $issues = GetIssues( {
1098                 borrowernumber => $borrower->{borrowernumber},
1099                 biblionumber   => $biblionumber,
1100             } );
1101             my @issues = $issues ? @$issues : ();
1102             # if we get here, we don't already have a loan on this item,
1103             # so if there are any loans on this bib, ask for confirmation
1104             if (scalar @issues > 0) {
1105                 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1106             }
1107         }
1108     }
1109
1110     return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1111 }
1112
1113 =head2 CanBookBeReturned
1114
1115   ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1116
1117 Check whether the item can be returned to the provided branch
1118
1119 =over 4
1120
1121 =item C<$item> is a hash of item information as returned from GetItem
1122
1123 =item C<$branch> is the branchcode where the return is taking place
1124
1125 =back
1126
1127 Returns:
1128
1129 =over 4
1130
1131 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1132
1133 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1134
1135 =back
1136
1137 =cut
1138
1139 sub CanBookBeReturned {
1140   my ($item, $branch) = @_;
1141   my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1142
1143   # assume return is allowed to start
1144   my $allowed = 1;
1145   my $message;
1146
1147   # identify all cases where return is forbidden
1148   if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1149      $allowed = 0;
1150      $message = $item->{'homebranch'};
1151   } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1152      $allowed = 0;
1153      $message = $item->{'holdingbranch'};
1154   } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1155      $allowed = 0;
1156      $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1157   }
1158
1159   return ($allowed, $message);
1160 }
1161
1162 =head2 CheckHighHolds
1163
1164     used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1165     decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1166     has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1167
1168 =cut
1169
1170 sub checkHighHolds {
1171     my ( $item, $borrower ) = @_;
1172     my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1173     my $branch = _GetCircControlBranch( $item, $borrower );
1174     my $dbh    = C4::Context->dbh;
1175     my $sth    = $dbh->prepare(
1176 'select count(borrowernumber) as num_holds from reserves where biblionumber=?'
1177     );
1178     $sth->execute( $item->{'biblionumber'} );
1179     my ($holds) = $sth->fetchrow_array;
1180     if ($holds) {
1181         my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1182
1183         my $calendar = Koha::Calendar->new( branchcode => $branch );
1184
1185         my $itype =
1186           ( C4::Context->preference('item-level_itypes') )
1187           ? $biblio->{'itype'}
1188           : $biblio->{'itemtype'};
1189         my $orig_due =
1190           C4::Circulation::CalcDateDue( $issuedate, $itype, $branch,
1191             $borrower );
1192
1193         my $reduced_datedue =
1194           $calendar->addDate( $issuedate,
1195             C4::Context->preference('decreaseLoanHighHoldsDuration') );
1196
1197         if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1198             return ( 1, $holds,
1199                 C4::Context->preference('decreaseLoanHighHoldsDuration'),
1200                 $reduced_datedue );
1201         }
1202     }
1203     return ( 0, 0, 0, undef );
1204 }
1205
1206 =head2 AddIssue
1207
1208   &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1209
1210 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1211
1212 =over 4
1213
1214 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).
1215
1216 =item C<$barcode> is the barcode of the item being issued.
1217
1218 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1219 Calculated if empty.
1220
1221 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1222
1223 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1224 Defaults to today.  Unlike C<$datedue>, NOT a DateTime object, unfortunately.
1225
1226 AddIssue does the following things :
1227
1228   - step 01: check that there is a borrowernumber & a barcode provided
1229   - check for RENEWAL (book issued & being issued to the same patron)
1230       - renewal YES = Calculate Charge & renew
1231       - renewal NO  =
1232           * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1233           * RESERVE PLACED ?
1234               - fill reserve if reserve to this patron
1235               - cancel reserve or not, otherwise
1236           * TRANSFERT PENDING ?
1237               - complete the transfert
1238           * ISSUE THE BOOK
1239
1240 =back
1241
1242 =cut
1243
1244 sub AddIssue {
1245     my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1246     my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1247     my $auto_renew = $params && $params->{auto_renew};
1248     my $dbh = C4::Context->dbh;
1249     my $barcodecheck=CheckValidBarcode($barcode);
1250
1251     my $issue;
1252
1253     if ($datedue && ref $datedue ne 'DateTime') {
1254         $datedue = dt_from_string($datedue);
1255     }
1256     # $issuedate defaults to today.
1257     if ( ! defined $issuedate ) {
1258         $issuedate = DateTime->now(time_zone => C4::Context->tz());
1259     }
1260     else {
1261         if ( ref $issuedate ne 'DateTime') {
1262             $issuedate = dt_from_string($issuedate);
1263
1264         }
1265     }
1266         if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf
1267                 # find which item we issue
1268                 my $item = GetItem('', $barcode) or return;     # if we don't get an Item, abort.
1269                 my $branch = _GetCircControlBranch($item,$borrower);
1270
1271                 # get actual issuing if there is one
1272                 my $actualissue = GetItemIssue( $item->{itemnumber});
1273
1274                 # get biblioinformation for this item
1275                 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
1276
1277                 #
1278                 # check if we just renew the issue.
1279                 #
1280                 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
1281                     $datedue = AddRenewal(
1282                         $borrower->{'borrowernumber'},
1283                         $item->{'itemnumber'},
1284                         $branch,
1285                         $datedue,
1286                         $issuedate, # here interpreted as the renewal date
1287                         );
1288                 }
1289                 else {
1290         # it's NOT a renewal
1291                         if ( $actualissue->{borrowernumber}) {
1292                                 # This book is currently on loan, but not to the person
1293                                 # who wants to borrow it now. mark it returned before issuing to the new borrower
1294                                 AddReturn(
1295                                         $item->{'barcode'},
1296                                         C4::Context->userenv->{'branch'}
1297                                 );
1298                         }
1299
1300             MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1301                         # Starting process for transfer job (checking transfert and validate it if we have one)
1302             my ($datesent) = GetTransfers($item->{'itemnumber'});
1303             if ($datesent) {
1304         #       updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1305                 my $sth =
1306                     $dbh->prepare(
1307                     "UPDATE branchtransfers
1308                         SET datearrived = now(),
1309                         tobranch = ?,
1310                         comments = 'Forced branchtransfer'
1311                     WHERE itemnumber= ? AND datearrived IS NULL"
1312                     );
1313                 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
1314             }
1315
1316         # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1317         unless ($auto_renew) {
1318             my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branch);
1319             $auto_renew = $issuingrule->{auto_renew};
1320         }
1321
1322         # Record in the database the fact that the book was issued.
1323         unless ($datedue) {
1324             my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1325             $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1326
1327         }
1328         $datedue->truncate( to => 'minute');
1329
1330         $issue = Koha::Database->new()->schema()->resultset('Issue')->create(
1331             {
1332                 borrowernumber  => $borrower->{'borrowernumber'},
1333                 itemnumber      => $item->{'itemnumber'},
1334                 issuedate       => $issuedate->strftime('%Y-%m-%d %H:%M:%S'),
1335                 date_due        => $datedue->strftime('%Y-%m-%d %H:%M:%S'),
1336                 branchcode      => C4::Context->userenv->{'branch'},
1337                 onsite_checkout => $onsite_checkout,
1338                 auto_renew      => $auto_renew ? 1 : 0
1339             }
1340         );
1341
1342         if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1343           CartToShelf( $item->{'itemnumber'} );
1344         }
1345         $item->{'issues'}++;
1346         if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1347             UpdateTotalIssues($item->{'biblionumber'}, 1);
1348         }
1349
1350         ## If item was lost, it has now been found, reverse any list item charges if necessary.
1351         if ( $item->{'itemlost'} ) {
1352             if ( C4::Context->preference('RefundLostItemFeeOnReturn' ) ) {
1353                 _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef, $item->{'barcode'} );
1354             }
1355         }
1356
1357         ModItem({ issues           => $item->{'issues'},
1358                   holdingbranch    => C4::Context->userenv->{'branch'},
1359                   itemlost         => 0,
1360                   datelastborrowed => DateTime->now(time_zone => C4::Context->tz())->ymd(),
1361                   onloan           => $datedue->ymd(),
1362                 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1363         ModDateLastSeen( $item->{'itemnumber'} );
1364
1365         # If it costs to borrow this book, charge it to the patron's account.
1366         my ( $charge, $itemtype ) = GetIssuingCharges(
1367             $item->{'itemnumber'},
1368             $borrower->{'borrowernumber'}
1369         );
1370         if ( $charge > 0 ) {
1371             AddIssuingCharge(
1372                 $item->{'itemnumber'},
1373                 $borrower->{'borrowernumber'}, $charge
1374             );
1375             $item->{'charge'} = $charge;
1376         }
1377
1378         # Record the fact that this book was issued.
1379         &UpdateStats({
1380                       branch => C4::Context->userenv->{'branch'},
1381                       type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1382                       amount => $charge,
1383                       other => ($sipmode ? "SIP-$sipmode" : ''),
1384                       itemnumber => $item->{'itemnumber'},
1385                       itemtype => $item->{'itype'},
1386                       borrowernumber => $borrower->{'borrowernumber'},
1387                       ccode => $item->{'ccode'}}
1388         );
1389
1390         # Send a checkout slip.
1391         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1392         my %conditions = (
1393             branchcode   => $branch,
1394             categorycode => $borrower->{categorycode},
1395             item_type    => $item->{itype},
1396             notification => 'CHECKOUT',
1397         );
1398         if ($circulation_alert->is_enabled_for(\%conditions)) {
1399             SendCirculationAlert({
1400                 type     => 'CHECKOUT',
1401                 item     => $item,
1402                 borrower => $borrower,
1403                 branch   => $branch,
1404             });
1405         }
1406     }
1407
1408     logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'itemnumber'})
1409         if C4::Context->preference("IssueLog");
1410   }
1411   return $issue;
1412 }
1413
1414 =head2 GetLoanLength
1415
1416   my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1417
1418 Get loan length for an itemtype, a borrower type and a branch
1419
1420 =cut
1421
1422 sub GetLoanLength {
1423     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1424     my $dbh = C4::Context->dbh;
1425     my $sth = $dbh->prepare(qq{
1426         SELECT issuelength, lengthunit, renewalperiod
1427         FROM issuingrules
1428         WHERE   categorycode=?
1429             AND itemtype=?
1430             AND branchcode=?
1431             AND issuelength IS NOT NULL
1432     });
1433
1434     # try to find issuelength & return the 1st available.
1435     # check with borrowertype, itemtype and branchcode, then without one of those parameters
1436     $sth->execute( $borrowertype, $itemtype, $branchcode );
1437     my $loanlength = $sth->fetchrow_hashref;
1438
1439     return $loanlength
1440       if defined($loanlength) && $loanlength->{issuelength};
1441
1442     $sth->execute( $borrowertype, '*', $branchcode );
1443     $loanlength = $sth->fetchrow_hashref;
1444     return $loanlength
1445       if defined($loanlength) && $loanlength->{issuelength};
1446
1447     $sth->execute( '*', $itemtype, $branchcode );
1448     $loanlength = $sth->fetchrow_hashref;
1449     return $loanlength
1450       if defined($loanlength) && $loanlength->{issuelength};
1451
1452     $sth->execute( '*', '*', $branchcode );
1453     $loanlength = $sth->fetchrow_hashref;
1454     return $loanlength
1455       if defined($loanlength) && $loanlength->{issuelength};
1456
1457     $sth->execute( $borrowertype, $itemtype, '*' );
1458     $loanlength = $sth->fetchrow_hashref;
1459     return $loanlength
1460       if defined($loanlength) && $loanlength->{issuelength};
1461
1462     $sth->execute( $borrowertype, '*', '*' );
1463     $loanlength = $sth->fetchrow_hashref;
1464     return $loanlength
1465       if defined($loanlength) && $loanlength->{issuelength};
1466
1467     $sth->execute( '*', $itemtype, '*' );
1468     $loanlength = $sth->fetchrow_hashref;
1469     return $loanlength
1470       if defined($loanlength) && $loanlength->{issuelength};
1471
1472     $sth->execute( '*', '*', '*' );
1473     $loanlength = $sth->fetchrow_hashref;
1474     return $loanlength
1475       if defined($loanlength) && $loanlength->{issuelength};
1476
1477     # if no rule is set => 21 days (hardcoded)
1478     return {
1479         issuelength => 21,
1480         renewalperiod => 21,
1481         lengthunit => 'days',
1482     };
1483
1484 }
1485
1486
1487 =head2 GetHardDueDate
1488
1489   my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1490
1491 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1492
1493 =cut
1494
1495 sub GetHardDueDate {
1496     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1497
1498     my $rule = GetIssuingRule( $borrowertype, $itemtype, $branchcode );
1499
1500     if ( defined( $rule ) ) {
1501         if ( $rule->{hardduedate} ) {
1502             return (dt_from_string($rule->{hardduedate}, 'iso'),$rule->{hardduedatecompare});
1503         } else {
1504             return (undef, undef);
1505         }
1506     }
1507 }
1508
1509 =head2 GetIssuingRule
1510
1511   my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1512
1513 FIXME - This is a copy-paste of GetLoanLength
1514 as a stop-gap.  Do not wish to change API for GetLoanLength
1515 this close to release.
1516
1517 Get the issuing rule for an itemtype, a borrower type and a branch
1518 Returns a hashref from the issuingrules table.
1519
1520 =cut
1521
1522 sub GetIssuingRule {
1523     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1524     my $dbh = C4::Context->dbh;
1525     my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=?"  );
1526     my $irule;
1527
1528     $sth->execute( $borrowertype, $itemtype, $branchcode );
1529     $irule = $sth->fetchrow_hashref;
1530     return $irule if defined($irule) ;
1531
1532     $sth->execute( $borrowertype, "*", $branchcode );
1533     $irule = $sth->fetchrow_hashref;
1534     return $irule if defined($irule) ;
1535
1536     $sth->execute( "*", $itemtype, $branchcode );
1537     $irule = $sth->fetchrow_hashref;
1538     return $irule if defined($irule) ;
1539
1540     $sth->execute( "*", "*", $branchcode );
1541     $irule = $sth->fetchrow_hashref;
1542     return $irule if defined($irule) ;
1543
1544     $sth->execute( $borrowertype, $itemtype, "*" );
1545     $irule = $sth->fetchrow_hashref;
1546     return $irule if defined($irule) ;
1547
1548     $sth->execute( $borrowertype, "*", "*" );
1549     $irule = $sth->fetchrow_hashref;
1550     return $irule if defined($irule) ;
1551
1552     $sth->execute( "*", $itemtype, "*" );
1553     $irule = $sth->fetchrow_hashref;
1554     return $irule if defined($irule) ;
1555
1556     $sth->execute( "*", "*", "*" );
1557     $irule = $sth->fetchrow_hashref;
1558     return $irule if defined($irule) ;
1559
1560     # if no rule matches,
1561     return;
1562 }
1563
1564 =head2 GetBranchBorrowerCircRule
1565
1566   my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1567
1568 Retrieves circulation rule attributes that apply to the given
1569 branch and patron category, regardless of item type.
1570 The return value is a hashref containing the following key:
1571
1572 maxissueqty - maximum number of loans that a
1573 patron of the given category can have at the given
1574 branch.  If the value is undef, no limit.
1575
1576 maxonsiteissueqty - maximum of on-site checkouts that a
1577 patron of the given category can have at the given
1578 branch.  If the value is undef, no limit.
1579
1580 This will first check for a specific branch and
1581 category match from branch_borrower_circ_rules.
1582
1583 If no rule is found, it will then check default_branch_circ_rules
1584 (same branch, default category).  If no rule is found,
1585 it will then check default_borrower_circ_rules (default
1586 branch, same category), then failing that, default_circ_rules
1587 (default branch, default category).
1588
1589 If no rule has been found in the database, it will default to
1590 the buillt in rule:
1591
1592 maxissueqty - undef
1593 maxonsiteissueqty - undef
1594
1595 C<$branchcode> and C<$categorycode> should contain the
1596 literal branch code and patron category code, respectively - no
1597 wildcards.
1598
1599 =cut
1600
1601 sub GetBranchBorrowerCircRule {
1602     my ( $branchcode, $categorycode ) = @_;
1603
1604     my $rules;
1605     my $dbh = C4::Context->dbh();
1606     $rules = $dbh->selectrow_hashref( q|
1607         SELECT maxissueqty, maxonsiteissueqty
1608         FROM branch_borrower_circ_rules
1609         WHERE branchcode = ?
1610         AND   categorycode = ?
1611     |, {}, $branchcode, $categorycode ) ;
1612     return $rules if $rules;
1613
1614     # try same branch, default borrower category
1615     $rules = $dbh->selectrow_hashref( q|
1616         SELECT maxissueqty, maxonsiteissueqty
1617         FROM default_branch_circ_rules
1618         WHERE branchcode = ?
1619     |, {}, $branchcode ) ;
1620     return $rules if $rules;
1621
1622     # try default branch, same borrower category
1623     $rules = $dbh->selectrow_hashref( q|
1624         SELECT maxissueqty, maxonsiteissueqty
1625         FROM default_borrower_circ_rules
1626         WHERE categorycode = ?
1627     |, {}, $categorycode ) ;
1628     return $rules if $rules;
1629
1630     # try default branch, default borrower category
1631     $rules = $dbh->selectrow_hashref( q|
1632         SELECT maxissueqty, maxonsiteissueqty
1633         FROM default_circ_rules
1634     |, {} );
1635     return $rules if $rules;
1636
1637     # built-in default circulation rule
1638     return {
1639         maxissueqty => undef,
1640         maxonsiteissueqty => undef,
1641     };
1642 }
1643
1644 =head2 GetBranchItemRule
1645
1646   my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1647
1648 Retrieves circulation rule attributes that apply to the given
1649 branch and item type, regardless of patron category.
1650
1651 The return value is a hashref containing the following keys:
1652
1653 holdallowed => Hold policy for this branch and itemtype. Possible values:
1654   0: No holds allowed.
1655   1: Holds allowed only by patrons that have the same homebranch as the item.
1656   2: Holds allowed from any patron.
1657
1658 returnbranch => branch to which to return item.  Possible values:
1659   noreturn: do not return, let item remain where checked in (floating collections)
1660   homebranch: return to item's home branch
1661   holdingbranch: return to issuer branch
1662
1663 This searches branchitemrules in the following order:
1664
1665   * Same branchcode and itemtype
1666   * Same branchcode, itemtype '*'
1667   * branchcode '*', same itemtype
1668   * branchcode and itemtype '*'
1669
1670 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1671
1672 =cut
1673
1674 sub GetBranchItemRule {
1675     my ( $branchcode, $itemtype ) = @_;
1676     my $dbh = C4::Context->dbh();
1677     my $result = {};
1678
1679     my @attempts = (
1680         ['SELECT holdallowed, returnbranch
1681             FROM branch_item_rules
1682             WHERE branchcode = ?
1683               AND itemtype = ?', $branchcode, $itemtype],
1684         ['SELECT holdallowed, returnbranch
1685             FROM default_branch_circ_rules
1686             WHERE branchcode = ?', $branchcode],
1687         ['SELECT holdallowed, returnbranch
1688             FROM default_branch_item_rules
1689             WHERE itemtype = ?', $itemtype],
1690         ['SELECT holdallowed, returnbranch
1691             FROM default_circ_rules'],
1692     );
1693
1694     foreach my $attempt (@attempts) {
1695         my ($query, @bind_params) = @{$attempt};
1696         my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1697           or next;
1698
1699         # Since branch/category and branch/itemtype use the same per-branch
1700         # defaults tables, we have to check that the key we want is set, not
1701         # just that a row was returned
1702         $result->{'holdallowed'}  = $search_result->{'holdallowed'}  unless ( defined $result->{'holdallowed'} );
1703         $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1704     }
1705
1706     # built-in default circulation rule
1707     $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1708     $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1709
1710     return $result;
1711 }
1712
1713 =head2 AddReturn
1714
1715   ($doreturn, $messages, $iteminformation, $borrower) =
1716       &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1717
1718 Returns a book.
1719
1720 =over 4
1721
1722 =item C<$barcode> is the bar code of the book being returned.
1723
1724 =item C<$branch> is the code of the branch where the book is being returned.
1725
1726 =item C<$exemptfine> indicates that overdue charges for the item will be
1727 removed. Optional.
1728
1729 =item C<$dropbox> indicates that the check-in date is assumed to be
1730 yesterday, or the last non-holiday as defined in C4::Calendar .  If
1731 overdue charges are applied and C<$dropbox> is true, the last charge
1732 will be removed.  This assumes that the fines accrual script has run
1733 for _today_. Optional.
1734
1735 =item C<$return_date> allows the default return date to be overridden
1736 by the given return date. Optional.
1737
1738 =back
1739
1740 C<&AddReturn> returns a list of four items:
1741
1742 C<$doreturn> is true iff the return succeeded.
1743
1744 C<$messages> is a reference-to-hash giving feedback on the operation.
1745 The keys of the hash are:
1746
1747 =over 4
1748
1749 =item C<BadBarcode>
1750
1751 No item with this barcode exists. The value is C<$barcode>.
1752
1753 =item C<NotIssued>
1754
1755 The book is not currently on loan. The value is C<$barcode>.
1756
1757 =item C<IsPermanent>
1758
1759 The book's home branch is a permanent collection. If you have borrowed
1760 this book, you are not allowed to return it. The value is the code for
1761 the book's home branch.
1762
1763 =item C<withdrawn>
1764
1765 This book has been withdrawn/cancelled. The value should be ignored.
1766
1767 =item C<Wrongbranch>
1768
1769 This book has was returned to the wrong branch.  The value is a hashref
1770 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1771 contain the branchcode of the incorrect and correct return library, respectively.
1772
1773 =item C<ResFound>
1774
1775 The item was reserved. The value is a reference-to-hash whose keys are
1776 fields from the reserves table of the Koha database, and
1777 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1778 either C<Waiting>, C<Reserved>, or 0.
1779
1780 =item C<WasReturned>
1781
1782 Value 1 if return is successful.
1783
1784 =item C<NeedsTransfer>
1785
1786 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
1787
1788 =back
1789
1790 C<$iteminformation> is a reference-to-hash, giving information about the
1791 returned item from the issues table.
1792
1793 C<$borrower> is a reference-to-hash, giving information about the
1794 patron who last borrowed the book.
1795
1796 =cut
1797
1798 sub AddReturn {
1799     my ( $barcode, $branch, $exemptfine, $dropbox, $return_date, $dropboxdate ) = @_;
1800
1801     if ($branch and not GetBranchDetail($branch)) {
1802         warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
1803         undef $branch;
1804     }
1805     $branch = C4::Context->userenv->{'branch'} unless $branch;  # we trust userenv to be a safe fallback/default
1806     my $messages;
1807     my $borrower;
1808     my $biblio;
1809     my $doreturn       = 1;
1810     my $validTransfert = 0;
1811     my $stat_type = 'return';
1812
1813     # get information on item
1814     my $itemnumber = GetItemnumberFromBarcode( $barcode );
1815     unless ($itemnumber) {
1816         return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower.  bail out.
1817     }
1818     my $issue  = GetItemIssue($itemnumber);
1819     if ($issue and $issue->{borrowernumber}) {
1820         $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1821             or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '$issue->{borrowernumber}'\n"
1822                 . Dumper($issue) . "\n";
1823     } else {
1824         $messages->{'NotIssued'} = $barcode;
1825         # even though item is not on loan, it may still be transferred;  therefore, get current branch info
1826         $doreturn = 0;
1827         # No issue, no borrowernumber.  ONLY if $doreturn, *might* you have a $borrower later.
1828         # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1829         if (C4::Context->preference("RecordLocalUseOnReturn")) {
1830            $messages->{'LocalUse'} = 1;
1831            $stat_type = 'localuse';
1832         }
1833     }
1834
1835     my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1836
1837     if ( $item->{'location'} eq 'PROC' ) {
1838         if ( C4::Context->preference("InProcessingToShelvingCart") ) {
1839             $item->{'location'} = 'CART';
1840         }
1841         else {
1842             $item->{location} = $item->{permanent_location};
1843         }
1844
1845         ModItem( $item, $item->{'biblionumber'}, $item->{'itemnumber'} );
1846     }
1847
1848         # full item data, but no borrowernumber or checkout info (no issue)
1849         # we know GetItem should work because GetItemnumberFromBarcode worked
1850     my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1851         # get the proper branch to which to return the item
1852     my $returnbranch = $item->{$hbr} || $branch ;
1853         # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1854
1855     my $borrowernumber = $borrower->{'borrowernumber'} || undef;    # we don't know if we had a borrower or not
1856
1857     my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1858     if ($yaml) {
1859         $yaml = "$yaml\n\n";  # YAML is anal on ending \n. Surplus does not hurt
1860         my $rules;
1861         eval { $rules = YAML::Load($yaml); };
1862         if ($@) {
1863             warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1864         }
1865         else {
1866             foreach my $key ( keys %$rules ) {
1867                 if ( $item->{notforloan} eq $key ) {
1868                     $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
1869                     ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
1870                     last;
1871                 }
1872             }
1873         }
1874     }
1875
1876
1877     # check if the book is in a permanent collection....
1878     # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
1879     if ( $returnbranch ) {
1880         my $branches = GetBranches();    # a potentially expensive call for a non-feature.
1881         $branches->{$returnbranch}->{PE} and $messages->{'IsPermanent'} = $returnbranch;
1882     }
1883
1884     # check if the return is allowed at this branch
1885     my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1886     unless ($returnallowed){
1887         $messages->{'Wrongbranch'} = {
1888             Wrongbranch => $branch,
1889             Rightbranch => $message
1890         };
1891         $doreturn = 0;
1892         return ( $doreturn, $messages, $issue, $borrower );
1893     }
1894
1895     if ( $item->{'withdrawn'} ) { # book has been cancelled
1896         $messages->{'withdrawn'} = 1;
1897         $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1898     }
1899
1900     # case of a return of document (deal with issues and holdingbranch)
1901     my $today = DateTime->now( time_zone => C4::Context->tz() );
1902
1903     if ($doreturn) {
1904         my $datedue = $issue->{date_due};
1905         $borrower or warn "AddReturn without current borrower";
1906                 my $circControlBranch;
1907         if ($dropbox) {
1908             # define circControlBranch only if dropbox mode is set
1909             # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1910             # FIXME: check issuedate > returndate, factoring in holidays
1911
1912             $circControlBranch = _GetCircControlBranch($item,$borrower);
1913             $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $dropboxdate ) == -1 ? 1 : 0;
1914         }
1915
1916         if ($borrowernumber) {
1917             if ( ( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'} ) || $return_date ) {
1918                 # we only need to calculate and change the fines if we want to do that on return
1919                 # Should be on for hourly loans
1920                 my $control = C4::Context->preference('CircControl');
1921                 my $control_branchcode =
1922                     ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
1923                   : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
1924                   :                                     $issue->{branchcode};
1925
1926                 my $date_returned =
1927                   $return_date ? dt_from_string($return_date) : $today;
1928
1929                 my ( $amount, $type, $unitcounttotal ) =
1930                   C4::Overdues::CalcFine( $item, $borrower->{categorycode},
1931                     $control_branchcode, $datedue, $date_returned );
1932
1933                 $type ||= q{};
1934
1935                 if ( C4::Context->preference('finesMode') eq 'production' ) {
1936                     if ( $amount > 0 ) {
1937                         C4::Overdues::UpdateFine( $issue->{itemnumber},
1938                             $issue->{borrowernumber},
1939                             $amount, $type, output_pref($datedue) );
1940                     }
1941                     elsif ($return_date) {
1942
1943                        # Backdated returns may have fines that shouldn't exist,
1944                        # so in this case, we need to drop those fines to 0
1945
1946                         C4::Overdues::UpdateFine( $issue->{itemnumber},
1947                             $issue->{borrowernumber},
1948                             0, $type, output_pref($datedue) );
1949                     }
1950                 }
1951             }
1952
1953             eval {
1954                 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
1955                     $circControlBranch, $return_date, $borrower->{'privacy'} );
1956             };
1957             if ( $@ ) {
1958                 $messages->{'Wrongbranch'} = {
1959                     Wrongbranch => $branch,
1960                     Rightbranch => $message
1961                 };
1962                 carp $@;
1963                 return ( 0, { WasReturned => 0 }, $issue, $borrower );
1964             }
1965
1966             # FIXME is the "= 1" right?  This could be the borrower hash.
1967             $messages->{'WasReturned'} = 1;
1968
1969         }
1970
1971         ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1972     }
1973
1974     # the holdingbranch is updated if the document is returned to another location.
1975     # this is always done regardless of whether the item was on loan or not
1976     if ($item->{'holdingbranch'} ne $branch) {
1977         UpdateHoldingbranch($branch, $item->{'itemnumber'});
1978         $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1979     }
1980     ModDateLastSeen( $item->{'itemnumber'} );
1981
1982     # check if we have a transfer for this document
1983     my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1984
1985     # if we have a transfer to do, we update the line of transfers with the datearrived
1986     my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
1987     if ($datesent) {
1988         if ( $tobranch eq $branch ) {
1989             my $sth = C4::Context->dbh->prepare(
1990                 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1991             );
1992             $sth->execute( $item->{'itemnumber'} );
1993             # if we have a reservation with valid transfer, we can set it's status to 'W'
1994             ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1995             C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1996         } else {
1997             $messages->{'WrongTransfer'}     = $tobranch;
1998             $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1999         }
2000         $validTransfert = 1;
2001     } else {
2002         ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2003     }
2004
2005     # fix up the accounts.....
2006     if ( $item->{'itemlost'} ) {
2007         $messages->{'WasLost'} = 1;
2008
2009         if ( C4::Context->preference('RefundLostItemFeeOnReturn' ) ) {
2010             _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode);    # can tolerate undef $borrowernumber
2011             $messages->{'LostItemFeeRefunded'} = 1;
2012         }
2013     }
2014
2015     # fix up the overdues in accounts...
2016     if ($borrowernumber) {
2017         my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
2018         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!";  # zero is OK, check defined
2019
2020         if ( $issue->{overdue} && $issue->{date_due} ) {
2021         # fix fine days
2022             $today = $dropboxdate if $dropbox;
2023             my ($debardate,$reminder) = _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
2024             if ($reminder){
2025                 $messages->{'PrevDebarred'} = $debardate;
2026             } else {
2027                 $messages->{'Debarred'} = $debardate if $debardate;
2028             }
2029         # there's no overdue on the item but borrower had been previously debarred
2030         } elsif ( $issue->{date_due} and $borrower->{'debarred'} ) {
2031              if ( $borrower->{debarred} eq "9999-12-31") {
2032                 $messages->{'ForeverDebarred'} = $borrower->{'debarred'};
2033              } else {
2034                   my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2035                   $borrower_debar_dt->truncate(to => 'day');
2036                   my $today_dt = $today->clone()->truncate(to => 'day');
2037                   if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2038                       $messages->{'PrevDebarred'} = $borrower->{'debarred'};
2039                   }
2040              }
2041         }
2042     }
2043
2044     # find reserves.....
2045     # if we don't have a reserve with the status W, we launch the Checkreserves routine
2046     my ($resfound, $resrec);
2047     my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2048     ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
2049     if ($resfound) {
2050           $resrec->{'ResFound'} = $resfound;
2051         $messages->{'ResFound'} = $resrec;
2052     }
2053
2054     # Record the fact that this book was returned.
2055     # FIXME itemtype should record item level type, not bibliolevel type
2056     UpdateStats({
2057                 branch => $branch,
2058                 type => $stat_type,
2059                 itemnumber => $item->{'itemnumber'},
2060                 itemtype => $biblio->{'itemtype'},
2061                 borrowernumber => $borrowernumber,
2062                 ccode => $item->{'ccode'}}
2063     );
2064
2065     # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
2066     my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2067     my %conditions = (
2068         branchcode   => $branch,
2069         categorycode => $borrower->{categorycode},
2070         item_type    => $item->{itype},
2071         notification => 'CHECKIN',
2072     );
2073     if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2074         SendCirculationAlert({
2075             type     => 'CHECKIN',
2076             item     => $item,
2077             borrower => $borrower,
2078             branch   => $branch,
2079         });
2080     }
2081
2082     logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2083         if C4::Context->preference("ReturnLog");
2084
2085     # Remove any OVERDUES related debarment if the borrower has no overdues
2086     if ( $borrowernumber
2087       && $borrower->{'debarred'}
2088       && C4::Context->preference('AutoRemoveOverduesRestrictions')
2089       && !C4::Members::HasOverdues( $borrowernumber )
2090       && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2091     ) {
2092         DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2093     }
2094
2095     # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2096     if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2097         if  (C4::Context->preference("AutomaticItemReturn"    ) or
2098             (C4::Context->preference("UseBranchTransferLimits") and
2099              ! IsBranchTransferAllowed($branch, $returnbranch, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2100            )) {
2101             $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $returnbranch;
2102             $debug and warn "item: " . Dumper($item);
2103             ModItemTransfer($item->{'itemnumber'}, $branch, $returnbranch);
2104             $messages->{'WasTransfered'} = 1;
2105         } else {
2106             $messages->{'NeedsTransfer'} = $returnbranch;
2107         }
2108     }
2109
2110     return ( $doreturn, $messages, $issue, $borrower );
2111 }
2112
2113 =head2 MarkIssueReturned
2114
2115   MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2116
2117 Unconditionally marks an issue as being returned by
2118 moving the C<issues> row to C<old_issues> and
2119 setting C<returndate> to the current date, or
2120 the last non-holiday date of the branccode specified in
2121 C<dropbox_branch> .  Assumes you've already checked that
2122 it's safe to do this, i.e. last non-holiday > issuedate.
2123
2124 if C<$returndate> is specified (in iso format), it is used as the date
2125 of the return. It is ignored when a dropbox_branch is passed in.
2126
2127 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2128 the old_issue is immediately anonymised
2129
2130 Ideally, this function would be internal to C<C4::Circulation>,
2131 not exported, but it is currently needed by one
2132 routine in C<C4::Accounts>.
2133
2134 =cut
2135
2136 sub MarkIssueReturned {
2137     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2138
2139     my $anonymouspatron;
2140     if ( $privacy == 2 ) {
2141         # The default of 0 will not work due to foreign key constraints
2142         # The anonymisation will fail if AnonymousPatron is not a valid entry
2143         # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2144         # Note that a warning should appear on the about page (System information tab).
2145         $anonymouspatron = C4::Context->preference('AnonymousPatron');
2146         die "Fatal error: the patron ($borrowernumber) has requested their circulation history be anonymized on check-in, but the AnonymousPatron system preference is empty or not set correctly."
2147             unless C4::Members::GetMember( borrowernumber => $anonymouspatron );
2148     }
2149     my $dbh   = C4::Context->dbh;
2150     my $query = 'UPDATE issues SET returndate=';
2151     my @bind;
2152     if ($dropbox_branch) {
2153         my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2154         my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2155         $query .= ' ? ';
2156         push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2157     } elsif ($returndate) {
2158         $query .= ' ? ';
2159         push @bind, $returndate;
2160     } else {
2161         $query .= ' now() ';
2162     }
2163     $query .= ' WHERE  borrowernumber = ?  AND itemnumber = ?';
2164     push @bind, $borrowernumber, $itemnumber;
2165     # FIXME transaction
2166     my $sth_upd  = $dbh->prepare($query);
2167     $sth_upd->execute(@bind);
2168     my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
2169                                   WHERE borrowernumber = ?
2170                                   AND itemnumber = ?');
2171     $sth_copy->execute($borrowernumber, $itemnumber);
2172     # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2173     if ( $privacy == 2) {
2174         my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
2175                                   WHERE borrowernumber = ?
2176                                   AND itemnumber = ?");
2177        $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
2178     }
2179     my $sth_del  = $dbh->prepare("DELETE FROM issues
2180                                   WHERE borrowernumber = ?
2181                                   AND itemnumber = ?");
2182     $sth_del->execute($borrowernumber, $itemnumber);
2183
2184     ModItem( { 'onloan' => undef }, undef, $itemnumber );
2185
2186     if ( C4::Context->preference('StoreLastBorrower') ) {
2187         my $item = Koha::Items->find( $itemnumber );
2188         my $patron = Koha::Borrowers->find( $borrowernumber );
2189         $item->last_returned_by( $patron );
2190     }
2191 }
2192
2193 =head2 _debar_user_on_return
2194
2195     _debar_user_on_return($borrower, $item, $datedue, today);
2196
2197 C<$borrower> borrower hashref
2198
2199 C<$item> item hashref
2200
2201 C<$datedue> date due DateTime object
2202
2203 C<$today> DateTime object representing the return time
2204
2205 Internal function, called only by AddReturn that calculates and updates
2206  the user fine days, and debars him if necessary.
2207
2208 Should only be called for overdue returns
2209
2210 =cut
2211
2212 sub _debar_user_on_return {
2213     my ( $borrower, $item, $dt_due, $dt_today ) = @_;
2214
2215     my $branchcode = _GetCircControlBranch( $item, $borrower );
2216
2217     my $circcontrol = C4::Context->preference('CircControl');
2218     my $issuingrule =
2219       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2220     my $finedays = $issuingrule->{finedays};
2221     my $unit     = $issuingrule->{lengthunit};
2222     my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $dt_today, $branchcode);
2223
2224     if ($finedays) {
2225
2226         # finedays is in days, so hourly loans must multiply by 24
2227         # thus 1 hour late equals 1 day suspension * finedays rate
2228         $finedays = $finedays * 24 if ( $unit eq 'hours' );
2229
2230         # grace period is measured in the same units as the loan
2231         my $grace =
2232           DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
2233
2234         my $deltadays = DateTime::Duration->new(
2235             days => $chargeable_units
2236         );
2237         if ( $deltadays->subtract($grace)->is_positive() ) {
2238             my $suspension_days = $deltadays * $finedays;
2239
2240             # If the max suspension days is < than the suspension days
2241             # the suspension days is limited to this maximum period.
2242             my $max_sd = $issuingrule->{maxsuspensiondays};
2243             if ( defined $max_sd ) {
2244                 $max_sd = DateTime::Duration->new( days => $max_sd );
2245                 $suspension_days = $max_sd
2246                   if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2247             }
2248
2249             my $new_debar_dt =
2250               $dt_today->clone()->add_duration( $suspension_days );
2251
2252             Koha::Borrower::Debarments::AddUniqueDebarment({
2253                 borrowernumber => $borrower->{borrowernumber},
2254                 expiration     => $new_debar_dt->ymd(),
2255                 type           => 'SUSPENSION',
2256             });
2257             # if borrower was already debarred but does not get an extra debarment
2258             if ( $borrower->{debarred} eq Koha::Borrower::Debarments::IsDebarred($borrower->{borrowernumber}) ) {
2259                     return ($borrower->{debarred},1);
2260             }
2261             return $new_debar_dt->ymd();
2262         }
2263     }
2264     return;
2265 }
2266
2267 =head2 _FixOverduesOnReturn
2268
2269    &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2270
2271 C<$brn> borrowernumber
2272
2273 C<$itm> itemnumber
2274
2275 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2276 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2277
2278 Internal function, called only by AddReturn
2279
2280 =cut
2281
2282 sub _FixOverduesOnReturn {
2283     my ($borrowernumber, $item);
2284     unless ($borrowernumber = shift) {
2285         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2286         return;
2287     }
2288     unless ($item = shift) {
2289         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2290         return;
2291     }
2292     my ($exemptfine, $dropbox) = @_;
2293     my $dbh = C4::Context->dbh;
2294
2295     # check for overdue fine
2296     my $sth = $dbh->prepare(
2297 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2298     );
2299     $sth->execute( $borrowernumber, $item );
2300
2301     # alter fine to show that the book has been returned
2302     my $data = $sth->fetchrow_hashref;
2303     return 0 unless $data;    # no warning, there's just nothing to fix
2304
2305     my $uquery;
2306     my @bind = ($data->{'accountlines_id'});
2307     if ($exemptfine) {
2308         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2309         if (C4::Context->preference("FinesLog")) {
2310             &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2311         }
2312     } elsif ($dropbox && $data->{lastincrement}) {
2313         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2314         my $amt = $data->{amount} - $data->{lastincrement} ;
2315         if (C4::Context->preference("FinesLog")) {
2316             &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2317         }
2318          $uquery = "update accountlines set accounttype='F' ";
2319          if($outstanding  >= 0 && $amt >=0) {
2320             $uquery .= ", amount = ? , amountoutstanding=? ";
2321             unshift @bind, ($amt, $outstanding) ;
2322         }
2323     } else {
2324         $uquery = "update accountlines set accounttype='F' ";
2325     }
2326     $uquery .= " where (accountlines_id = ?)";
2327     my $usth = $dbh->prepare($uquery);
2328     return $usth->execute(@bind);
2329 }
2330
2331 =head2 _FixAccountForLostAndReturned
2332
2333   &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2334
2335 Calculates the charge for a book lost and returned.
2336
2337 Internal function, not exported, called only by AddReturn.
2338
2339 FIXME: This function reflects how inscrutable fines logic is.  Fix both.
2340 FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.
2341
2342 =cut
2343
2344 sub _FixAccountForLostAndReturned {
2345     my $itemnumber     = shift or return;
2346     my $borrowernumber = @_ ? shift : undef;
2347     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
2348     my $dbh = C4::Context->dbh;
2349     # check for charge made for lost book
2350     my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2351     $sth->execute($itemnumber);
2352     my $data = $sth->fetchrow_hashref;
2353     $data or return;    # bail if there is nothing to do
2354     $data->{accounttype} eq 'W' and return;    # Written off
2355
2356     # writeoff this amount
2357     my $offset;
2358     my $amount = $data->{'amount'};
2359     my $acctno = $data->{'accountno'};
2360     my $amountleft;                                             # Starts off undef/zero.
2361     if ($data->{'amountoutstanding'} == $amount) {
2362         $offset     = $data->{'amount'};
2363         $amountleft = 0;                                        # Hey, it's zero here, too.
2364     } else {
2365         $offset     = $amount - $data->{'amountoutstanding'};   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2366         $amountleft = $data->{'amountoutstanding'} - $amount;   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2367     }
2368     my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2369         WHERE (accountlines_id = ?)");
2370     $usth->execute($data->{'accountlines_id'});      # We might be adjusting an account for some OTHER borrowernumber now.  Not the one we passed in.
2371     #check if any credit is left if so writeoff other accounts
2372     my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2373     $amountleft *= -1 if ($amountleft < 0);
2374     if ($amountleft > 0) {
2375         my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2376                             AND (amountoutstanding >0) ORDER BY date");     # might want to order by amountoustanding ASC (pay smallest first)
2377         $msth->execute($data->{'borrowernumber'});
2378         # offset transactions
2379         my $newamtos;
2380         my $accdata;
2381         while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2382             if ($accdata->{'amountoutstanding'} < $amountleft) {
2383                 $newamtos = 0;
2384                 $amountleft -= $accdata->{'amountoutstanding'};
2385             }  else {
2386                 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2387                 $amountleft = 0;
2388             }
2389             my $thisacct = $accdata->{'accountlines_id'};
2390             # FIXME: move prepares outside while loop!
2391             my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2392                     WHERE (accountlines_id = ?)");
2393             $usth->execute($newamtos,$thisacct);
2394             $usth = $dbh->prepare("INSERT INTO accountoffsets
2395                 (borrowernumber, accountno, offsetaccount,  offsetamount)
2396                 VALUES
2397                 (?,?,?,?)");
2398             $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2399         }
2400     }
2401     $amountleft *= -1 if ($amountleft > 0);
2402     my $desc = "Item Returned " . $item_id;
2403     $usth = $dbh->prepare("INSERT INTO accountlines
2404         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2405         VALUES (?,?,now(),?,?,'CR',?)");
2406     $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2407     if ($borrowernumber) {
2408         # FIXME: same as query above.  use 1 sth for both
2409         $usth = $dbh->prepare("INSERT INTO accountoffsets
2410             (borrowernumber, accountno, offsetaccount,  offsetamount)
2411             VALUES (?,?,?,?)");
2412         $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2413     }
2414     ModItem({ paidfor => '' }, undef, $itemnumber);
2415     return;
2416 }
2417
2418 =head2 _GetCircControlBranch
2419
2420    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2421
2422 Internal function :
2423
2424 Return the library code to be used to determine which circulation
2425 policy applies to a transaction.  Looks up the CircControl and
2426 HomeOrHoldingBranch system preferences.
2427
2428 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2429
2430 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2431
2432 =cut
2433
2434 sub _GetCircControlBranch {
2435     my ($item, $borrower) = @_;
2436     my $circcontrol = C4::Context->preference('CircControl');
2437     my $branch;
2438
2439     if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2440         $branch= C4::Context->userenv->{'branch'};
2441     } elsif ($circcontrol eq 'PatronLibrary') {
2442         $branch=$borrower->{branchcode};
2443     } else {
2444         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2445         $branch = $item->{$branchfield};
2446         # default to item home branch if holdingbranch is used
2447         # and is not defined
2448         if (!defined($branch) && $branchfield eq 'holdingbranch') {
2449             $branch = $item->{homebranch};
2450         }
2451     }
2452     return $branch;
2453 }
2454
2455
2456
2457
2458
2459
2460 =head2 GetItemIssue
2461
2462   $issue = &GetItemIssue($itemnumber);
2463
2464 Returns patron currently having a book, or undef if not checked out.
2465
2466 C<$itemnumber> is the itemnumber.
2467
2468 C<$issue> is a hashref of the row from the issues table.
2469
2470 =cut
2471
2472 sub GetItemIssue {
2473     my ($itemnumber) = @_;
2474     return unless $itemnumber;
2475     my $sth = C4::Context->dbh->prepare(
2476         "SELECT items.*, issues.*
2477         FROM issues
2478         LEFT JOIN items ON issues.itemnumber=items.itemnumber
2479         WHERE issues.itemnumber=?");
2480     $sth->execute($itemnumber);
2481     my $data = $sth->fetchrow_hashref;
2482     return unless $data;
2483     $data->{issuedate_sql} = $data->{issuedate};
2484     $data->{date_due_sql} = $data->{date_due};
2485     $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2486     $data->{issuedate}->truncate(to => 'minute');
2487     $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2488     $data->{date_due}->truncate(to => 'minute');
2489     my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2490     $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2491     return $data;
2492 }
2493
2494 =head2 GetOpenIssue
2495
2496   $issue = GetOpenIssue( $itemnumber );
2497
2498 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2499
2500 C<$itemnumber> is the item's itemnumber
2501
2502 Returns a hashref
2503
2504 =cut
2505
2506 sub GetOpenIssue {
2507   my ( $itemnumber ) = @_;
2508   return unless $itemnumber;
2509   my $dbh = C4::Context->dbh;
2510   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2511   $sth->execute( $itemnumber );
2512   return $sth->fetchrow_hashref();
2513
2514 }
2515
2516 =head2 GetIssues
2517
2518     $issues = GetIssues({});    # return all issues!
2519     $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
2520
2521 Returns all pending issues that match given criteria.
2522 Returns a arrayref or undef if an error occurs.
2523
2524 Allowed criteria are:
2525
2526 =over 2
2527
2528 =item * borrowernumber
2529
2530 =item * biblionumber
2531
2532 =item * itemnumber
2533
2534 =back
2535
2536 =cut
2537
2538 sub GetIssues {
2539     my ($criteria) = @_;
2540
2541     # Build filters
2542     my @filters;
2543     my @allowed = qw(borrowernumber biblionumber itemnumber);
2544     foreach (@allowed) {
2545         if (defined $criteria->{$_}) {
2546             push @filters, {
2547                 field => $_,
2548                 value => $criteria->{$_},
2549             };
2550         }
2551     }
2552
2553     # Do we need to join other tables ?
2554     my %join;
2555     if (defined $criteria->{biblionumber}) {
2556         $join{items} = 1;
2557     }
2558
2559     # Build SQL query
2560     my $where = '';
2561     if (@filters) {
2562         $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
2563     }
2564     my $query = q{
2565         SELECT issues.*
2566         FROM issues
2567     };
2568     if (defined $join{items}) {
2569         $query .= q{
2570             LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
2571         };
2572     }
2573     $query .= $where;
2574
2575     # Execute SQL query
2576     my $dbh = C4::Context->dbh;
2577     my $sth = $dbh->prepare($query);
2578     my $rv = $sth->execute(map { $_->{value} } @filters);
2579
2580     return $rv ? $sth->fetchall_arrayref({}) : undef;
2581 }
2582
2583 =head2 GetItemIssues
2584
2585   $issues = &GetItemIssues($itemnumber, $history);
2586
2587 Returns patrons that have issued a book
2588
2589 C<$itemnumber> is the itemnumber
2590 C<$history> is false if you just want the current "issuer" (if any)
2591 and true if you want issues history from old_issues also.
2592
2593 Returns reference to an array of hashes
2594
2595 =cut
2596
2597 sub GetItemIssues {
2598     my ( $itemnumber, $history ) = @_;
2599
2600     my $today = DateTime->now( time_zome => C4::Context->tz);  # get today date
2601     $today->truncate( to => 'minute' );
2602     my $sql = "SELECT * FROM issues
2603               JOIN borrowers USING (borrowernumber)
2604               JOIN items     USING (itemnumber)
2605               WHERE issues.itemnumber = ? ";
2606     if ($history) {
2607         $sql .= "UNION ALL
2608                  SELECT * FROM old_issues
2609                  LEFT JOIN borrowers USING (borrowernumber)
2610                  JOIN items USING (itemnumber)
2611                  WHERE old_issues.itemnumber = ? ";
2612     }
2613     $sql .= "ORDER BY date_due DESC";
2614     my $sth = C4::Context->dbh->prepare($sql);
2615     if ($history) {
2616         $sth->execute($itemnumber, $itemnumber);
2617     } else {
2618         $sth->execute($itemnumber);
2619     }
2620     my $results = $sth->fetchall_arrayref({});
2621     foreach (@$results) {
2622         my $date_due = dt_from_string($_->{date_due},'sql');
2623         $date_due->truncate( to => 'minute' );
2624
2625         $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2626     }
2627     return $results;
2628 }
2629
2630 =head2 GetBiblioIssues
2631
2632   $issues = GetBiblioIssues($biblionumber);
2633
2634 this function get all issues from a biblionumber.
2635
2636 Return:
2637 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2638 tables issues and the firstname,surname & cardnumber from borrowers.
2639
2640 =cut
2641
2642 sub GetBiblioIssues {
2643     my $biblionumber = shift;
2644     return unless $biblionumber;
2645     my $dbh   = C4::Context->dbh;
2646     my $query = "
2647         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2648         FROM issues
2649             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2650             LEFT JOIN items ON issues.itemnumber = items.itemnumber
2651             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2652             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2653         WHERE biblio.biblionumber = ?
2654         UNION ALL
2655         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2656         FROM old_issues
2657             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2658             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2659             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2660             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2661         WHERE biblio.biblionumber = ?
2662         ORDER BY timestamp
2663     ";
2664     my $sth = $dbh->prepare($query);
2665     $sth->execute($biblionumber, $biblionumber);
2666
2667     my @issues;
2668     while ( my $data = $sth->fetchrow_hashref ) {
2669         push @issues, $data;
2670     }
2671     return \@issues;
2672 }
2673
2674 =head2 GetUpcomingDueIssues
2675
2676   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2677
2678 =cut
2679
2680 sub GetUpcomingDueIssues {
2681     my $params = shift;
2682
2683     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2684     my $dbh = C4::Context->dbh;
2685
2686     my $statement = <<END_SQL;
2687 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2688 FROM issues
2689 LEFT JOIN items USING (itemnumber)
2690 LEFT OUTER JOIN branches USING (branchcode)
2691 WHERE returndate is NULL
2692 HAVING days_until_due >= 0 AND days_until_due <= ?
2693 END_SQL
2694
2695     my @bind_parameters = ( $params->{'days_in_advance'} );
2696
2697     my $sth = $dbh->prepare( $statement );
2698     $sth->execute( @bind_parameters );
2699     my $upcoming_dues = $sth->fetchall_arrayref({});
2700
2701     return $upcoming_dues;
2702 }
2703
2704 =head2 CanBookBeRenewed
2705
2706   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2707
2708 Find out whether a borrowed item may be renewed.
2709
2710 C<$borrowernumber> is the borrower number of the patron who currently
2711 has the item on loan.
2712
2713 C<$itemnumber> is the number of the item to renew.
2714
2715 C<$override_limit>, if supplied with a true value, causes
2716 the limit on the number of times that the loan can be renewed
2717 (as controlled by the item type) to be ignored. Overriding also allows
2718 to renew sooner than "No renewal before" and to manually renew loans
2719 that are automatically renewed.
2720
2721 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2722 item must currently be on loan to the specified borrower; renewals
2723 must be allowed for the item's type; and the borrower must not have
2724 already renewed the loan. $error will contain the reason the renewal can not proceed
2725
2726 =cut
2727
2728 sub CanBookBeRenewed {
2729     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2730
2731     my $dbh    = C4::Context->dbh;
2732     my $renews = 1;
2733
2734     my $item      = GetItem($itemnumber)      or return ( 0, 'no_item' );
2735     my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
2736     return ( 0, 'onsite_checkout' ) if $itemissue->{onsite_checkout};
2737
2738     $borrowernumber ||= $itemissue->{borrowernumber};
2739     my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2740       or return;
2741
2742     my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2743
2744     # This item can fill one or more unfilled reserve, can those unfilled reserves
2745     # all be filled by other available items?
2746     if ( $resfound
2747         && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2748     {
2749         my $schema = Koha::Database->new()->schema();
2750
2751         my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2752         if ($item_holds) {
2753             # There is an item level hold on this item, no other item can fill the hold
2754             $resfound = 1;
2755         }
2756         else {
2757
2758             # Get all other items that could possibly fill reserves
2759             my @itemnumbers = $schema->resultset('Item')->search(
2760                 {
2761                     biblionumber => $resrec->{biblionumber},
2762                     onloan       => undef,
2763                     notforloan   => 0,
2764                     -not         => { itemnumber => $itemnumber }
2765                 },
2766                 { columns => 'itemnumber' }
2767             )->get_column('itemnumber')->all();
2768
2769             # Get all other reserves that could have been filled by this item
2770             my @borrowernumbers;
2771             while (1) {
2772                 my ( $reserve_found, $reserve, undef ) =
2773                   C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2774
2775                 if ($reserve_found) {
2776                     push( @borrowernumbers, $reserve->{borrowernumber} );
2777                 }
2778                 else {
2779                     last;
2780                 }
2781             }
2782
2783             # If the count of the union of the lists of reservable items for each borrower
2784             # is equal or greater than the number of borrowers, we know that all reserves
2785             # can be filled with available items. We can get the union of the sets simply
2786             # by pushing all the elements onto an array and removing the duplicates.
2787             my @reservable;
2788             foreach my $b (@borrowernumbers) {
2789                 my ($borr) = C4::Members::GetMemberDetails($b);
2790                 foreach my $i (@itemnumbers) {
2791                     my $item = GetItem($i);
2792                     if (   IsAvailableForItemLevelRequest( $item, $borr )
2793                         && CanItemBeReserved( $b, $i )
2794                         && !IsItemOnHoldAndFound($i) )
2795                     {
2796                         push( @reservable, $i );
2797                     }
2798                 }
2799             }
2800
2801             @reservable = uniq(@reservable);
2802
2803             if ( @reservable >= @borrowernumbers ) {
2804                 $resfound = 0;
2805             }
2806         }
2807     }
2808     return ( 0, "on_reserve" ) if $resfound;    # '' when no hold was found
2809
2810     return ( 1, undef ) if $override_limit;
2811
2812     my $branchcode = _GetCircControlBranch( $item, $borrower );
2813     my $issuingrule =
2814       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2815
2816     return ( 0, "too_many" )
2817       if $issuingrule->{renewalsallowed} <= $itemissue->{renewals};
2818
2819     my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2820     my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2821     my $restricted = Koha::Borrower::Debarments::IsDebarred($borrowernumber);
2822     my $hasoverdues = C4::Members::HasOverdues($borrowernumber);
2823
2824     if ( $restricted and $restrictionblockrenewing ) {
2825         return ( 0, 'restriction');
2826     } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($itemissue->{overdue} and $overduesblockrenewing eq 'blockitem') ) {
2827         return ( 0, 'overdue');
2828     }
2829
2830     if ( defined $issuingrule->{norenewalbefore}
2831         and $issuingrule->{norenewalbefore} ne "" )
2832     {
2833
2834         # Get current time and add norenewalbefore.
2835         # If this is smaller than date_due, it's too soon for renewal.
2836         my $now = dt_from_string;
2837         if (
2838             $now->add(
2839                 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore}
2840             ) < $itemissue->{date_due}
2841           )
2842         {
2843             return ( 0, "auto_too_soon" ) if $itemissue->{auto_renew};
2844             return ( 0, "too_soon" );
2845         }
2846         elsif ( $itemissue->{auto_renew} ) {
2847             return ( 0, "auto_renew" );
2848         }
2849     }
2850
2851     # Fallback for automatic renewals:
2852     # If norenewalbefore is undef, don't renew before due date.
2853     elsif ( $itemissue->{auto_renew} ) {
2854         my $now = dt_from_string;
2855         return ( 0, "auto_renew" )
2856           if $now >= $itemissue->{date_due};
2857         return ( 0, "auto_too_soon" );
2858     }
2859
2860     return ( 1, undef );
2861 }
2862
2863 =head2 AddRenewal
2864
2865   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2866
2867 Renews a loan.
2868
2869 C<$borrowernumber> is the borrower number of the patron who currently
2870 has the item.
2871
2872 C<$itemnumber> is the number of the item to renew.
2873
2874 C<$branch> is the library where the renewal took place (if any).
2875            The library that controls the circ policies for the renewal is retrieved from the issues record.
2876
2877 C<$datedue> can be a DateTime object used to set the due date.
2878
2879 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2880 this parameter is not supplied, lastreneweddate is set to the current date.
2881
2882 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2883 from the book's item type.
2884
2885 =cut
2886
2887 sub AddRenewal {
2888     my $borrowernumber  = shift;
2889     my $itemnumber      = shift or return;
2890     my $branch          = shift;
2891     my $datedue         = shift;
2892     my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2893
2894     my $item   = GetItem($itemnumber) or return;
2895     my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
2896
2897     my $dbh = C4::Context->dbh;
2898
2899     # Find the issues record for this book
2900     my $sth =
2901       $dbh->prepare("SELECT * FROM issues WHERE itemnumber = ?");
2902     $sth->execute( $itemnumber );
2903     my $issuedata = $sth->fetchrow_hashref;
2904
2905     return unless ( $issuedata );
2906
2907     $borrowernumber ||= $issuedata->{borrowernumber};
2908
2909     if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2910         carp 'Invalid date passed to AddRenewal.';
2911         return;
2912     }
2913
2914     # If the due date wasn't specified, calculate it by adding the
2915     # book's loan length to today's date or the current due date
2916     # based on the value of the RenewalPeriodBase syspref.
2917     unless ($datedue) {
2918
2919         my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
2920         my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2921
2922         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2923                                         dt_from_string( $issuedata->{date_due} ) :
2924                                         DateTime->now( time_zone => C4::Context->tz());
2925         $datedue =  CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
2926     }
2927
2928     # Update the issues record to have the new due date, and a new count
2929     # of how many times it has been renewed.
2930     my $renews = $issuedata->{'renewals'} + 1;
2931     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2932                             WHERE borrowernumber=?
2933                             AND itemnumber=?"
2934     );
2935
2936     $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2937
2938     # Update the renewal count on the item, and tell zebra to reindex
2939     $renews = $biblio->{'renewals'} + 1;
2940     ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2941
2942     # Charge a new rental fee, if applicable?
2943     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2944     if ( $charge > 0 ) {
2945         my $accountno = getnextacctno( $borrowernumber );
2946         my $item = GetBiblioFromItemNumber($itemnumber);
2947         my $manager_id = 0;
2948         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2949         $sth = $dbh->prepare(
2950                 "INSERT INTO accountlines
2951                     (date, borrowernumber, accountno, amount, manager_id,
2952                     description,accounttype, amountoutstanding, itemnumber)
2953                     VALUES (now(),?,?,?,?,?,?,?,?)"
2954         );
2955         $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2956             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2957             'Rent', $charge, $itemnumber );
2958     }
2959
2960     # Send a renewal slip according to checkout alert preferencei
2961     if ( C4::Context->preference('RenewalSendNotice') eq '1') {
2962         my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
2963         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2964         my %conditions = (
2965                 branchcode   => $branch,
2966                 categorycode => $borrower->{categorycode},
2967                 item_type    => $item->{itype},
2968                 notification => 'CHECKOUT',
2969         );
2970         if ($circulation_alert->is_enabled_for(\%conditions)) {
2971                 SendCirculationAlert({
2972                         type     => 'RENEWAL',
2973                         item     => $item,
2974                 borrower => $borrower,
2975                 branch   => $branch,
2976                 });
2977         }
2978     }
2979
2980     # Remove any OVERDUES related debarment if the borrower has no overdues
2981     my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
2982     if ( $borrowernumber
2983       && $borrower->{'debarred'}
2984       && !C4::Members::HasOverdues( $borrowernumber )
2985       && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2986     ) {
2987         DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2988     }
2989
2990     # Log the renewal
2991     UpdateStats({branch => $branch,
2992                 type => 'renew',
2993                 amount => $charge,
2994                 itemnumber => $itemnumber,
2995                 itemtype => $item->{itype},
2996                 borrowernumber => $borrowernumber,
2997                 ccode => $item->{'ccode'}}
2998                 );
2999         return $datedue;
3000 }
3001
3002 sub GetRenewCount {
3003     # check renewal status
3004     my ( $bornum, $itemno ) = @_;
3005     my $dbh           = C4::Context->dbh;
3006     my $renewcount    = 0;
3007     my $renewsallowed = 0;
3008     my $renewsleft    = 0;
3009
3010     my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
3011     my $item     = GetItem($itemno);
3012
3013     # Look in the issues table for this item, lent to this borrower,
3014     # and not yet returned.
3015
3016     # FIXME - I think this function could be redone to use only one SQL call.
3017     my $sth = $dbh->prepare(
3018         "select * from issues
3019                                 where (borrowernumber = ?)
3020                                 and (itemnumber = ?)"
3021     );
3022     $sth->execute( $bornum, $itemno );
3023     my $data = $sth->fetchrow_hashref;
3024     $renewcount = $data->{'renewals'} if $data->{'renewals'};
3025     # $item and $borrower should be calculated
3026     my $branchcode = _GetCircControlBranch($item, $borrower);
3027
3028     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
3029
3030     $renewsallowed = $issuingrule->{'renewalsallowed'};
3031     $renewsleft    = $renewsallowed - $renewcount;
3032     if($renewsleft < 0){ $renewsleft = 0; }
3033     return ( $renewcount, $renewsallowed, $renewsleft );
3034 }
3035
3036 =head2 GetSoonestRenewDate
3037
3038   $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3039
3040 Find out the soonest possible renew date of a borrowed item.
3041
3042 C<$borrowernumber> is the borrower number of the patron who currently
3043 has the item on loan.
3044
3045 C<$itemnumber> is the number of the item to renew.
3046
3047 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3048 renew date, based on the value "No renewal before" of the applicable
3049 issuing rule. Returns the current date if the item can already be
3050 renewed, and returns undefined if the borrower, loan, or item
3051 cannot be found.
3052
3053 =cut
3054
3055 sub GetSoonestRenewDate {
3056     my ( $borrowernumber, $itemnumber ) = @_;
3057
3058     my $dbh = C4::Context->dbh;
3059
3060     my $item      = GetItem($itemnumber)      or return;
3061     my $itemissue = GetItemIssue($itemnumber) or return;
3062
3063     $borrowernumber ||= $itemissue->{borrowernumber};
3064     my $borrower = C4::Members::GetMemberDetails($borrowernumber)
3065       or return;
3066
3067     my $branchcode = _GetCircControlBranch( $item, $borrower );
3068     my $issuingrule =
3069       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
3070
3071     my $now = dt_from_string;
3072
3073     if ( defined $issuingrule->{norenewalbefore}
3074         and $issuingrule->{norenewalbefore} ne "" )
3075     {
3076         my $soonestrenewal =
3077           $itemissue->{date_due}->subtract(
3078             $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
3079
3080         $soonestrenewal = $now > $soonestrenewal ? $now : $soonestrenewal;
3081         return $soonestrenewal;
3082     }
3083     return $now;
3084 }
3085
3086 =head2 GetIssuingCharges
3087
3088   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3089
3090 Calculate how much it would cost for a given patron to borrow a given
3091 item, including any applicable discounts.
3092
3093 C<$itemnumber> is the item number of item the patron wishes to borrow.
3094
3095 C<$borrowernumber> is the patron's borrower number.
3096
3097 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3098 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3099 if it's a video).
3100
3101 =cut
3102
3103 sub GetIssuingCharges {
3104
3105     # calculate charges due
3106     my ( $itemnumber, $borrowernumber ) = @_;
3107     my $charge = 0;
3108     my $dbh    = C4::Context->dbh;
3109     my $item_type;
3110
3111     # Get the book's item type and rental charge (via its biblioitem).
3112     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3113         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3114     $charge_query .= (C4::Context->preference('item-level_itypes'))
3115         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3116         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3117
3118     $charge_query .= ' WHERE items.itemnumber =?';
3119
3120     my $sth = $dbh->prepare($charge_query);
3121     $sth->execute($itemnumber);
3122     if ( my $item_data = $sth->fetchrow_hashref ) {
3123         $item_type = $item_data->{itemtype};
3124         $charge    = $item_data->{rentalcharge};
3125         my $branch = C4::Branch::mybranch();
3126         my $discount_query = q|SELECT rentaldiscount,
3127             issuingrules.itemtype, issuingrules.branchcode
3128             FROM borrowers
3129             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3130             WHERE borrowers.borrowernumber = ?
3131             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3132             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3133         my $discount_sth = $dbh->prepare($discount_query);
3134         $discount_sth->execute( $borrowernumber, $item_type, $branch );
3135         my $discount_rules = $discount_sth->fetchall_arrayref({});
3136         if (@{$discount_rules}) {
3137             # We may have multiple rules so get the most specific
3138             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3139             $charge = ( $charge * ( 100 - $discount ) ) / 100;
3140         }
3141     }
3142
3143     return ( $charge, $item_type );
3144 }
3145
3146 # Select most appropriate discount rule from those returned
3147 sub _get_discount_from_rule {
3148     my ($rules_ref, $branch, $itemtype) = @_;
3149     my $discount;
3150
3151     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3152         $discount = $rules_ref->[0]->{rentaldiscount};
3153         return (defined $discount) ? $discount : 0;
3154     }
3155     # could have up to 4 does one match $branch and $itemtype
3156     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3157     if (@d) {
3158         $discount = $d[0]->{rentaldiscount};
3159         return (defined $discount) ? $discount : 0;
3160     }
3161     # do we have item type + all branches
3162     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3163     if (@d) {
3164         $discount = $d[0]->{rentaldiscount};
3165         return (defined $discount) ? $discount : 0;
3166     }
3167     # do we all item types + this branch
3168     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3169     if (@d) {
3170         $discount = $d[0]->{rentaldiscount};
3171         return (defined $discount) ? $discount : 0;
3172     }
3173     # so all and all (surely we wont get here)
3174     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3175     if (@d) {
3176         $discount = $d[0]->{rentaldiscount};
3177         return (defined $discount) ? $discount : 0;
3178     }
3179     # none of the above
3180     return 0;
3181 }
3182
3183 =head2 AddIssuingCharge
3184
3185   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3186
3187 =cut
3188
3189 sub AddIssuingCharge {
3190     my ( $itemnumber, $borrowernumber, $charge ) = @_;
3191     my $dbh = C4::Context->dbh;
3192     my $nextaccntno = getnextacctno( $borrowernumber );
3193     my $manager_id = 0;
3194     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3195     my $query ="
3196         INSERT INTO accountlines
3197             (borrowernumber, itemnumber, accountno,
3198             date, amount, description, accounttype,
3199             amountoutstanding, manager_id)
3200         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3201     ";
3202     my $sth = $dbh->prepare($query);
3203     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3204 }
3205
3206 =head2 GetTransfers
3207
3208   GetTransfers($itemnumber);
3209
3210 =cut
3211
3212 sub GetTransfers {
3213     my ($itemnumber) = @_;
3214
3215     my $dbh = C4::Context->dbh;
3216
3217     my $query = '
3218         SELECT datesent,
3219                frombranch,
3220                tobranch
3221         FROM branchtransfers
3222         WHERE itemnumber = ?
3223           AND datearrived IS NULL
3224         ';
3225     my $sth = $dbh->prepare($query);
3226     $sth->execute($itemnumber);
3227     my @row = $sth->fetchrow_array();
3228     return @row;
3229 }
3230
3231 =head2 GetTransfersFromTo
3232
3233   @results = GetTransfersFromTo($frombranch,$tobranch);
3234
3235 Returns the list of pending transfers between $from and $to branch
3236
3237 =cut
3238
3239 sub GetTransfersFromTo {
3240     my ( $frombranch, $tobranch ) = @_;
3241     return unless ( $frombranch && $tobranch );
3242     my $dbh   = C4::Context->dbh;
3243     my $query = "
3244         SELECT itemnumber,datesent,frombranch
3245         FROM   branchtransfers
3246         WHERE  frombranch=?
3247           AND  tobranch=?
3248           AND datearrived IS NULL
3249     ";
3250     my $sth = $dbh->prepare($query);
3251     $sth->execute( $frombranch, $tobranch );
3252     my @gettransfers;
3253
3254     while ( my $data = $sth->fetchrow_hashref ) {
3255         push @gettransfers, $data;
3256     }
3257     return (@gettransfers);
3258 }
3259
3260 =head2 DeleteTransfer
3261
3262   &DeleteTransfer($itemnumber);
3263
3264 =cut
3265
3266 sub DeleteTransfer {
3267     my ($itemnumber) = @_;
3268     return unless $itemnumber;
3269     my $dbh          = C4::Context->dbh;
3270     my $sth          = $dbh->prepare(
3271         "DELETE FROM branchtransfers
3272          WHERE itemnumber=?
3273          AND datearrived IS NULL "
3274     );
3275     return $sth->execute($itemnumber);
3276 }
3277
3278 =head2 AnonymiseIssueHistory
3279
3280   ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3281
3282 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3283 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3284
3285 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3286 setting (force delete).
3287
3288 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3289
3290 =cut
3291
3292 sub AnonymiseIssueHistory {
3293     my $date           = shift;
3294     my $borrowernumber = shift;
3295     my $dbh            = C4::Context->dbh;
3296     my $query          = "
3297         UPDATE old_issues
3298         SET    borrowernumber = ?
3299         WHERE  returndate < ?
3300           AND borrowernumber IS NOT NULL
3301     ";
3302
3303     # The default of 0 does not work due to foreign key constraints
3304     # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
3305     # Set it to undef (NULL)
3306     my $anonymouspatron = C4::Context->preference('AnonymousPatron') || undef;
3307     my @bind_params = ($anonymouspatron, $date);
3308     if (defined $borrowernumber) {
3309        $query .= " AND borrowernumber = ?";
3310        push @bind_params, $borrowernumber;
3311     } else {
3312        $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3313     }
3314     my $sth = $dbh->prepare($query);
3315     $sth->execute(@bind_params);
3316     my $anonymisation_err = $dbh->err;
3317     my $rows_affected = $sth->rows;  ### doublecheck row count return function
3318     return ($rows_affected, $anonymisation_err);
3319 }
3320
3321 =head2 SendCirculationAlert
3322
3323 Send out a C<check-in> or C<checkout> alert using the messaging system.
3324
3325 B<Parameters>:
3326
3327 =over 4
3328
3329 =item type
3330
3331 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3332
3333 =item item
3334
3335 Hashref of information about the item being checked in or out.
3336
3337 =item borrower
3338
3339 Hashref of information about the borrower of the item.
3340
3341 =item branch
3342
3343 The branchcode from where the checkout or check-in took place.
3344
3345 =back
3346
3347 B<Example>:
3348
3349     SendCirculationAlert({
3350         type     => 'CHECKOUT',
3351         item     => $item,
3352         borrower => $borrower,
3353         branch   => $branch,
3354     });
3355
3356 =cut
3357
3358 sub SendCirculationAlert {
3359     my ($opts) = @_;
3360     my ($type, $item, $borrower, $branch) =
3361         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3362     my %message_name = (
3363         CHECKIN  => 'Item_Check_in',
3364         CHECKOUT => 'Item_Checkout',
3365         RENEWAL  => 'Item_Checkout',
3366     );
3367     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3368         borrowernumber => $borrower->{borrowernumber},
3369         message_name   => $message_name{$type},
3370     });
3371     my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3372
3373     my @transports = keys %{ $borrower_preferences->{transports} };
3374     # warn "no transports" unless @transports;
3375     for (@transports) {
3376         # warn "transport: $_";
3377         my $message = C4::Message->find_last_message($borrower, $type, $_);
3378         if (!$message) {
3379             #warn "create new message";
3380             my $letter =  C4::Letters::GetPreparedLetter (
3381                 module => 'circulation',
3382                 letter_code => $type,
3383                 branchcode => $branch,
3384                 message_transport_type => $_,
3385                 tables => {
3386                     $issues_table => $item->{itemnumber},
3387                     'items'       => $item->{itemnumber},
3388                     'biblio'      => $item->{biblionumber},
3389                     'biblioitems' => $item->{biblionumber},
3390                     'borrowers'   => $borrower,
3391                     'branches'    => $branch,
3392                 }
3393             ) or next;
3394             C4::Message->enqueue($letter, $borrower, $_);
3395         } else {
3396             #warn "append to old message";
3397             my $letter =  C4::Letters::GetPreparedLetter (
3398                 module => 'circulation',
3399                 letter_code => $type,
3400                 branchcode => $branch,
3401                 message_transport_type => $_,
3402                 tables => {
3403                     $issues_table => $item->{itemnumber},
3404                     'items'       => $item->{itemnumber},
3405                     'biblio'      => $item->{biblionumber},
3406                     'biblioitems' => $item->{biblionumber},
3407                     'borrowers'   => $borrower,
3408                     'branches'    => $branch,
3409                 }
3410             ) or next;
3411             $message->append($letter);
3412             $message->update;
3413         }
3414     }
3415
3416     return;
3417 }
3418
3419 =head2 updateWrongTransfer
3420
3421   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3422
3423 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
3424
3425 =cut
3426
3427 sub updateWrongTransfer {
3428         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3429         my $dbh = C4::Context->dbh;
3430 # first step validate the actual line of transfert .
3431         my $sth =
3432                 $dbh->prepare(
3433                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3434                 );
3435                 $sth->execute($FromLibrary,$itemNumber);
3436
3437 # second step create a new line of branchtransfer to the right location .
3438         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3439
3440 #third step changing holdingbranch of item
3441         UpdateHoldingbranch($FromLibrary,$itemNumber);
3442 }
3443
3444 =head2 UpdateHoldingbranch
3445
3446   $items = UpdateHoldingbranch($branch,$itmenumber);
3447
3448 Simple methode for updating hodlingbranch in items BDD line
3449
3450 =cut
3451
3452 sub UpdateHoldingbranch {
3453         my ( $branch,$itemnumber ) = @_;
3454     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3455 }
3456
3457 =head2 CalcDateDue
3458
3459 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3460
3461 this function calculates the due date given the start date and configured circulation rules,
3462 checking against the holidays calendar as per the 'useDaysMode' syspref.
3463 C<$startdate>   = DateTime object representing start date of loan period (assumed to be today)
3464 C<$itemtype>  = itemtype code of item in question
3465 C<$branch>  = location whose calendar to use
3466 C<$borrower> = Borrower object
3467 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3468
3469 =cut
3470
3471 sub CalcDateDue {
3472     my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3473
3474     $isrenewal ||= 0;
3475
3476     # loanlength now a href
3477     my $loanlength =
3478             GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3479
3480     my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3481             ? qq{renewalperiod}
3482             : qq{issuelength};
3483
3484     my $datedue;
3485     if ( $startdate ) {
3486         if (ref $startdate ne 'DateTime' ) {
3487             $datedue = dt_from_string($datedue);
3488         } else {
3489             $datedue = $startdate->clone;
3490         }
3491     } else {
3492         $datedue =
3493           DateTime->now( time_zone => C4::Context->tz() )
3494           ->truncate( to => 'minute' );
3495     }
3496
3497
3498     # calculate the datedue as normal
3499     if ( C4::Context->preference('useDaysMode') eq 'Days' )
3500     {    # ignoring calendar
3501         if ( $loanlength->{lengthunit} eq 'hours' ) {
3502             $datedue->add( hours => $loanlength->{$length_key} );
3503         } else {    # days
3504             $datedue->add( days => $loanlength->{$length_key} );
3505             $datedue->set_hour(23);
3506             $datedue->set_minute(59);
3507         }
3508     } else {
3509         my $dur;
3510         if ($loanlength->{lengthunit} eq 'hours') {
3511             $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3512         }
3513         else { # days
3514             $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3515         }
3516         my $calendar = Koha::Calendar->new( branchcode => $branch );
3517         $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3518         if ($loanlength->{lengthunit} eq 'days') {
3519             $datedue->set_hour(23);
3520             $datedue->set_minute(59);
3521         }
3522     }
3523
3524     # if Hard Due Dates are used, retrieve them and apply as necessary
3525     my ( $hardduedate, $hardduedatecompare ) =
3526       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3527     if ($hardduedate) {    # hardduedates are currently dates
3528         $hardduedate->truncate( to => 'minute' );
3529         $hardduedate->set_hour(23);
3530         $hardduedate->set_minute(59);
3531         my $cmp = DateTime->compare( $hardduedate, $datedue );
3532
3533 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3534 # if the calculated date is before the 'after' Hard Due Date (floor), override
3535 # if the hard due date is set to 'exactly', overrride
3536         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3537             $datedue = $hardduedate->clone;
3538         }
3539
3540         # in all other cases, keep the date due as it is
3541
3542     }
3543
3544     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3545     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3546         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3547         if( $expiry_dt ) { #skip empty expiry date..
3548             $expiry_dt->set( hour => 23, minute => 59);
3549             my $d1= $datedue->clone->set_time_zone('floating');
3550             if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3551                 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3552             }
3553         }
3554     }
3555
3556     return $datedue;
3557 }
3558
3559
3560 sub CheckValidBarcode{
3561 my ($barcode) = @_;
3562 my $dbh = C4::Context->dbh;
3563 my $query=qq|SELECT count(*)
3564              FROM items
3565              WHERE barcode=?
3566             |;
3567 my $sth = $dbh->prepare($query);
3568 $sth->execute($barcode);
3569 my $exist=$sth->fetchrow ;
3570 return $exist;
3571 }
3572
3573 =head2 IsBranchTransferAllowed
3574
3575   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3576
3577 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3578
3579 =cut
3580
3581 sub IsBranchTransferAllowed {
3582         my ( $toBranch, $fromBranch, $code ) = @_;
3583
3584         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3585
3586         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3587         my $dbh = C4::Context->dbh;
3588
3589         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3590         $sth->execute( $toBranch, $fromBranch, $code );
3591         my $limit = $sth->fetchrow_hashref();
3592
3593         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3594         if ( $limit->{'limitId'} ) {
3595                 return 0;
3596         } else {
3597                 return 1;
3598         }
3599 }
3600
3601 =head2 CreateBranchTransferLimit
3602
3603   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3604
3605 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3606
3607 =cut
3608
3609 sub CreateBranchTransferLimit {
3610    my ( $toBranch, $fromBranch, $code ) = @_;
3611    return unless defined($toBranch) && defined($fromBranch);
3612    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3613
3614    my $dbh = C4::Context->dbh;
3615
3616    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3617    return $sth->execute( $code, $toBranch, $fromBranch );
3618 }
3619
3620 =head2 DeleteBranchTransferLimits
3621
3622     my $result = DeleteBranchTransferLimits($frombranch);
3623
3624 Deletes all the library transfer limits for one library.  Returns the
3625 number of limits deleted, 0e0 if no limits were deleted, or undef if
3626 no arguments are supplied.
3627
3628 =cut
3629
3630 sub DeleteBranchTransferLimits {
3631     my $branch = shift;
3632     return unless defined $branch;
3633     my $dbh    = C4::Context->dbh;
3634     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3635     return $sth->execute($branch);
3636 }
3637
3638 sub ReturnLostItem{
3639     my ( $borrowernumber, $itemnum ) = @_;
3640
3641     MarkIssueReturned( $borrowernumber, $itemnum );
3642     my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3643     my $item = C4::Items::GetItem( $itemnum );
3644     my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3645     my @datearr = localtime(time);
3646     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3647     my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3648     ModItem({ paidfor =>  $old_note."Paid for by $bor $date" }, undef, $itemnum);
3649 }
3650
3651
3652 sub LostItem{
3653     my ($itemnumber, $mark_returned) = @_;
3654
3655     my $dbh = C4::Context->dbh();
3656     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3657                            FROM issues
3658                            JOIN items USING (itemnumber)
3659                            JOIN biblio USING (biblionumber)
3660                            WHERE issues.itemnumber=?");
3661     $sth->execute($itemnumber);
3662     my $issues=$sth->fetchrow_hashref();
3663
3664     # If a borrower lost the item, add a replacement cost to the their record
3665     if ( my $borrowernumber = $issues->{borrowernumber} ){
3666         my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3667
3668         if (C4::Context->preference('WhenLostForgiveFine')){
3669             my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3670             defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!";  # zero is OK, check defined
3671         }
3672         if (C4::Context->preference('WhenLostChargeReplacementFee')){
3673             C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3674             #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3675             #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3676         }
3677
3678         MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3679     }
3680 }
3681
3682 sub GetOfflineOperations {
3683     my $dbh = C4::Context->dbh;
3684     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3685     $sth->execute(C4::Context->userenv->{'branch'});
3686     my $results = $sth->fetchall_arrayref({});
3687     return $results;
3688 }
3689
3690 sub GetOfflineOperation {
3691     my $operationid = shift;
3692     return unless $operationid;
3693     my $dbh = C4::Context->dbh;
3694     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3695     $sth->execute( $operationid );
3696     return $sth->fetchrow_hashref;
3697 }
3698
3699 sub AddOfflineOperation {
3700     my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3701     my $dbh = C4::Context->dbh;
3702     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3703     $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3704     return "Added.";
3705 }
3706
3707 sub DeleteOfflineOperation {
3708     my $dbh = C4::Context->dbh;
3709     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3710     $sth->execute( shift );
3711     return "Deleted.";
3712 }
3713
3714 sub ProcessOfflineOperation {
3715     my $operation = shift;
3716
3717     my $report;
3718     if ( $operation->{action} eq 'return' ) {
3719         $report = ProcessOfflineReturn( $operation );
3720     } elsif ( $operation->{action} eq 'issue' ) {
3721         $report = ProcessOfflineIssue( $operation );
3722     } elsif ( $operation->{action} eq 'payment' ) {
3723         $report = ProcessOfflinePayment( $operation );
3724     }
3725
3726     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3727
3728     return $report;
3729 }
3730
3731 sub ProcessOfflineReturn {
3732     my $operation = shift;
3733
3734     my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3735
3736     if ( $itemnumber ) {
3737         my $issue = GetOpenIssue( $itemnumber );
3738         if ( $issue ) {
3739             MarkIssueReturned(
3740                 $issue->{borrowernumber},
3741                 $itemnumber,
3742                 undef,
3743                 $operation->{timestamp},
3744             );
3745             ModItem(
3746                 { renewals => 0, onloan => undef },
3747                 $issue->{'biblionumber'},
3748                 $itemnumber
3749             );
3750             return "Success.";
3751         } else {
3752             return "Item not issued.";
3753         }
3754     } else {
3755         return "Item not found.";
3756     }
3757 }
3758
3759 sub ProcessOfflineIssue {
3760     my $operation = shift;
3761
3762     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3763
3764     if ( $borrower->{borrowernumber} ) {
3765         my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3766         unless ($itemnumber) {
3767             return "Barcode not found.";
3768         }
3769         my $issue = GetOpenIssue( $itemnumber );
3770
3771         if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3772             MarkIssueReturned(
3773                 $issue->{borrowernumber},
3774                 $itemnumber,
3775                 undef,
3776                 $operation->{timestamp},
3777             );
3778         }
3779         AddIssue(
3780             $borrower,
3781             $operation->{'barcode'},
3782             undef,
3783             1,
3784             $operation->{timestamp},
3785             undef,
3786         );
3787         return "Success.";
3788     } else {
3789         return "Borrower not found.";
3790     }
3791 }
3792
3793 sub ProcessOfflinePayment {
3794     my $operation = shift;
3795
3796     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3797     my $amount = $operation->{amount};
3798
3799     recordpayment( $borrower->{borrowernumber}, $amount );
3800
3801     return "Success."
3802 }
3803
3804
3805 =head2 TransferSlip
3806
3807   TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3808
3809   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3810
3811 =cut
3812
3813 sub TransferSlip {
3814     my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3815
3816     my $item =  GetItem( $itemnumber, $barcode )
3817       or return;
3818
3819     return C4::Letters::GetPreparedLetter (
3820         module => 'circulation',
3821         letter_code => 'TRANSFERSLIP',
3822         branchcode => $branch,
3823         tables => {
3824             'branches'    => $to_branch,
3825             'biblio'      => $item->{biblionumber},
3826             'items'       => $item,
3827         },
3828     );
3829 }
3830
3831 =head2 CheckIfIssuedToPatron
3832
3833   CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3834
3835   Return 1 if any record item is issued to patron, otherwise return 0
3836
3837 =cut
3838
3839 sub CheckIfIssuedToPatron {
3840     my ($borrowernumber, $biblionumber) = @_;
3841
3842     my $dbh = C4::Context->dbh;
3843     my $query = q|
3844         SELECT COUNT(*) FROM issues
3845         LEFT JOIN items ON items.itemnumber = issues.itemnumber
3846         WHERE items.biblionumber = ?
3847         AND issues.borrowernumber = ?
3848     |;
3849     my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3850     return 1 if $is_issued;
3851     return;
3852 }
3853
3854 =head2 IsItemIssued
3855
3856   IsItemIssued( $itemnumber )
3857
3858   Return 1 if the item is on loan, otherwise return 0
3859
3860 =cut
3861
3862 sub IsItemIssued {
3863     my $itemnumber = shift;
3864     my $dbh = C4::Context->dbh;
3865     my $sth = $dbh->prepare(q{
3866         SELECT COUNT(*)
3867         FROM issues
3868         WHERE itemnumber = ?
3869     });
3870     $sth->execute($itemnumber);
3871     return $sth->fetchrow;
3872 }
3873
3874 =head2 GetAgeRestriction
3875
3876   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3877   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3878
3879   if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
3880   if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3881
3882 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3883 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3884 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3885          Negative days mean the borrower has gone past the age restriction age.
3886
3887 =cut
3888
3889 sub GetAgeRestriction {
3890     my ($record_restrictions, $borrower) = @_;
3891     my $markers = C4::Context->preference('AgeRestrictionMarker');
3892
3893     # Split $record_restrictions to something like FSK 16 or PEGI 6
3894     my @values = split ' ', uc($record_restrictions);
3895     return unless @values;
3896
3897     # Search first occurrence of one of the markers
3898     my @markers = split /\|/, uc($markers);
3899     return unless @markers;
3900
3901     my $index            = 0;
3902     my $restriction_year = 0;
3903     for my $value (@values) {
3904         $index++;
3905         for my $marker (@markers) {
3906             $marker =~ s/^\s+//;    #remove leading spaces
3907             $marker =~ s/\s+$//;    #remove trailing spaces
3908             if ( $marker eq $value ) {
3909                 if ( $index <= $#values ) {
3910                     $restriction_year += $values[$index];
3911                 }
3912                 last;
3913             }
3914             elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3915
3916                 # Perhaps it is something like "K16" (as in Finland)
3917                 $restriction_year += $1;
3918                 last;
3919             }
3920         }
3921         last if ( $restriction_year > 0 );
3922     }
3923
3924     #Check if the borrower is age restricted for this material and for how long.
3925     if ($restriction_year && $borrower) {
3926         if ( $borrower->{'dateofbirth'} ) {
3927             my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3928             $alloweddate[0] += $restriction_year;
3929
3930             #Prevent runime eror on leap year (invalid date)
3931             if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3932                 $alloweddate[2] = 28;
3933             }
3934
3935             #Get how many days the borrower has to reach the age restriction
3936             my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(Today);
3937             #Negative days means the borrower went past the age restriction age
3938             return ($restriction_year, $daysToAgeRestriction);
3939         }
3940     }
3941
3942     return ($restriction_year);
3943 }
3944
3945
3946 =head2 GetPendingOnSiteCheckouts
3947
3948 =cut
3949
3950 sub GetPendingOnSiteCheckouts {
3951     my $dbh = C4::Context->dbh;
3952     return $dbh->selectall_arrayref(q|
3953         SELECT
3954           items.barcode,
3955           items.biblionumber,
3956           items.itemnumber,
3957           items.itemnotes,
3958           items.itemcallnumber,
3959           items.location,
3960           issues.date_due,
3961           issues.branchcode,
3962           issues.date_due < NOW() AS is_overdue,
3963           biblio.author,
3964           biblio.title,
3965           borrowers.firstname,
3966           borrowers.surname,
3967           borrowers.cardnumber,
3968           borrowers.borrowernumber
3969         FROM items
3970         LEFT JOIN issues ON items.itemnumber = issues.itemnumber
3971         LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
3972         LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
3973         WHERE issues.onsite_checkout = 1
3974     |, { Slice => {} } );
3975 }
3976
3977 sub GetTopIssues {
3978     my ($params) = @_;
3979
3980     my ($count, $branch, $itemtype, $ccode, $newness)
3981         = @$params{qw(count branch itemtype ccode newness)};
3982
3983     my $dbh = C4::Context->dbh;
3984     my $query = q{
3985         SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
3986           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
3987           i.ccode, SUM(i.issues) AS count
3988         FROM biblio b
3989         LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
3990         LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
3991     };
3992
3993     my (@where_strs, @where_args);
3994
3995     if ($branch) {
3996         push @where_strs, 'i.homebranch = ?';
3997         push @where_args, $branch;
3998     }
3999     if ($itemtype) {
4000         if (C4::Context->preference('item-level_itypes')){
4001             push @where_strs, 'i.itype = ?';
4002             push @where_args, $itemtype;
4003         } else {
4004             push @where_strs, 'bi.itemtype = ?';
4005             push @where_args, $itemtype;
4006         }
4007     }
4008     if ($ccode) {
4009         push @where_strs, 'i.ccode = ?';
4010         push @where_args, $ccode;
4011     }
4012     if ($newness) {
4013         push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4014         push @where_args, $newness;
4015     }
4016
4017     if (@where_strs) {
4018         $query .= 'WHERE ' . join(' AND ', @where_strs);
4019     }
4020
4021     $query .= q{
4022         GROUP BY b.biblionumber
4023         HAVING count > 0
4024         ORDER BY count DESC
4025     };
4026
4027     $count = int($count);
4028     if ($count > 0) {
4029         $query .= "LIMIT $count";
4030     }
4031
4032     my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4033
4034     return @$rows;
4035 }
4036
4037 1;
4038 __END__
4039
4040 =head1 AUTHOR
4041
4042 Koha Development Team <http://koha-community.org/>
4043
4044 =cut
4045