C4/Circulation.pm

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