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