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