C4/Circulation.pm

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