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