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