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