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 if C4::Context->preference("BlockReturnOfWithdrawnItems");
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);
1837     ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'} ) unless ( $item->{'wthdrawn'} );
1838     if ($resfound) {
1839           $resrec->{'ResFound'} = $resfound;
1840         $messages->{'ResFound'} = $resrec;
1841     }
1842
1843     # update stats?
1844     # Record the fact that this book was returned.
1845     UpdateStats(
1846         $branch, $stat_type, '0', '',
1847         $item->{'itemnumber'},
1848         $biblio->{'itemtype'},
1849         $borrowernumber, undef, $item->{'ccode'}
1850     );
1851
1852     # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
1853     my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1854     my %conditions = (
1855         branchcode   => $branch,
1856         categorycode => $borrower->{categorycode},
1857         item_type    => $item->{itype},
1858         notification => 'CHECKIN',
1859     );
1860     if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
1861         SendCirculationAlert({
1862             type     => 'CHECKIN',
1863             item     => $item,
1864             borrower => $borrower,
1865             branch   => $branch,
1866         });
1867     }
1868
1869     logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'})
1870         if C4::Context->preference("ReturnLog");
1871
1872     # FIXME: make this comment intelligible.
1873     #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1874     #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1875
1876     if (($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $hbr) and not $messages->{'WrongTransfer'}){
1877         if ( C4::Context->preference("AutomaticItemReturn"    ) or
1878             (C4::Context->preference("UseBranchTransferLimits") and
1879              ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} )
1880            )) {
1881             $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
1882             $debug and warn "item: " . Dumper($item);
1883             ModItemTransfer($item->{'itemnumber'}, $branch, $hbr);
1884             $messages->{'WasTransfered'} = 1;
1885         } else {
1886             $messages->{'NeedsTransfer'} = 1;   # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
1887         }
1888     }
1889     return ( $doreturn, $messages, $issue, $borrower );
1890 }
1891
1892 =head2 MarkIssueReturned
1893
1894   MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
1895
1896 Unconditionally marks an issue as being returned by
1897 moving the C<issues> row to C<old_issues> and
1898 setting C<returndate> to the current date, or
1899 the last non-holiday date of the branccode specified in
1900 C<dropbox_branch> .  Assumes you've already checked that
1901 it's safe to do this, i.e. last non-holiday > issuedate.
1902
1903 if C<$returndate> is specified (in iso format), it is used as the date
1904 of the return. It is ignored when a dropbox_branch is passed in.
1905
1906 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
1907 the old_issue is immediately anonymised
1908
1909 Ideally, this function would be internal to C<C4::Circulation>,
1910 not exported, but it is currently needed by one
1911 routine in C<C4::Accounts>.
1912
1913 =cut
1914
1915 sub MarkIssueReturned {
1916     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
1917
1918     my $dbh   = C4::Context->dbh;
1919     my $query = 'UPDATE issues SET returndate=';
1920     my @bind;
1921     if ($dropbox_branch) {
1922         my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
1923         my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
1924         $query .= ' ? ';
1925         push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
1926     } elsif ($returndate) {
1927         $query .= ' ? ';
1928         push @bind, $returndate;
1929     } else {
1930         $query .= ' now() ';
1931     }
1932     $query .= ' WHERE  borrowernumber = ?  AND itemnumber = ?';
1933     push @bind, $borrowernumber, $itemnumber;
1934     # FIXME transaction
1935     my $sth_upd  = $dbh->prepare($query);
1936     $sth_upd->execute(@bind);
1937     my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
1938                                   WHERE borrowernumber = ?
1939                                   AND itemnumber = ?');
1940     $sth_copy->execute($borrowernumber, $itemnumber);
1941     # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
1942     if ( $privacy == 2) {
1943         # The default of 0 does not work due to foreign key constraints
1944         # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
1945         my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
1946         my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
1947                                   WHERE borrowernumber = ?
1948                                   AND itemnumber = ?");
1949        $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
1950     }
1951     my $sth_del  = $dbh->prepare("DELETE FROM issues
1952                                   WHERE borrowernumber = ?
1953                                   AND itemnumber = ?");
1954     $sth_del->execute($borrowernumber, $itemnumber);
1955 }
1956
1957 =head2 _debar_user_on_return
1958
1959     _debar_user_on_return($borrower, $item, $datedue, today);
1960
1961 C<$borrower> borrower hashref
1962
1963 C<$item> item hashref
1964
1965 C<$datedue> date due DateTime object
1966
1967 C<$today> DateTime object representing the return time
1968
1969 Internal function, called only by AddReturn that calculates and updates
1970  the user fine days, and debars him if necessary.
1971
1972 Should only be called for overdue returns
1973
1974 =cut
1975
1976 sub _debar_user_on_return {
1977     my ( $borrower, $item, $dt_due, $dt_today ) = @_;
1978
1979     my $branchcode = _GetCircControlBranch( $item, $borrower );
1980     my $calendar = Koha::Calendar->new( branchcode => $branchcode );
1981
1982     # $deltadays is a DateTime::Duration object
1983     my $deltadays = $calendar->days_between( $dt_due, $dt_today );
1984
1985     my $circcontrol = C4::Context->preference('CircControl');
1986     my $issuingrule =
1987       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
1988     my $finedays = $issuingrule->{finedays};
1989     my $unit     = $issuingrule->{lengthunit};
1990
1991     if ($finedays) {
1992
1993         # finedays is in days, so hourly loans must multiply by 24
1994         # thus 1 hour late equals 1 day suspension * finedays rate
1995         $finedays = $finedays * 24 if ( $unit eq 'hours' );
1996
1997         # grace period is measured in the same units as the loan
1998         my $grace =
1999           DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
2000         if ( $deltadays->subtract($grace)->is_positive() ) {
2001
2002             my $new_debar_dt =
2003               $dt_today->clone()->add_duration( $deltadays * $finedays );
2004             if ( $borrower->{debarred} ) {
2005                 my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2006
2007                 # Update patron only if new date > old
2008                 if ( DateTime->compare( $borrower_debar_dt, $new_debar_dt ) !=
2009                     -1 )
2010                 {
2011                     return;
2012                 }
2013
2014             }
2015             C4::Members::DebarMember( $borrower->{borrowernumber},
2016                 $new_debar_dt->ymd() );
2017             return $new_debar_dt->ymd();
2018         }
2019     }
2020     return;
2021 }
2022
2023 =head2 _FixOverduesOnReturn
2024
2025    &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2026
2027 C<$brn> borrowernumber
2028
2029 C<$itm> itemnumber
2030
2031 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2032 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2033
2034 Internal function, called only by AddReturn
2035
2036 =cut
2037
2038 sub _FixOverduesOnReturn {
2039     my ($borrowernumber, $item);
2040     unless ($borrowernumber = shift) {
2041         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2042         return;
2043     }
2044     unless ($item = shift) {
2045         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2046         return;
2047     }
2048     my ($exemptfine, $dropbox) = @_;
2049     my $dbh = C4::Context->dbh;
2050
2051     # check for overdue fine
2052     my $sth = $dbh->prepare(
2053 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2054     );
2055     $sth->execute( $borrowernumber, $item );
2056
2057     # alter fine to show that the book has been returned
2058     my $data = $sth->fetchrow_hashref;
2059     return 0 unless $data;    # no warning, there's just nothing to fix
2060
2061     my $uquery;
2062     my @bind = ($data->{'accountlines_id'});
2063     if ($exemptfine) {
2064         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2065         if (C4::Context->preference("FinesLog")) {
2066             &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2067         }
2068     } elsif ($dropbox && $data->{lastincrement}) {
2069         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2070         my $amt = $data->{amount} - $data->{lastincrement} ;
2071         if (C4::Context->preference("FinesLog")) {
2072             &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2073         }
2074          $uquery = "update accountlines set accounttype='F' ";
2075          if($outstanding  >= 0 && $amt >=0) {
2076             $uquery .= ", amount = ? , amountoutstanding=? ";
2077             unshift @bind, ($amt, $outstanding) ;
2078         }
2079     } else {
2080         $uquery = "update accountlines set accounttype='F' ";
2081     }
2082     $uquery .= " where (accountlines_id = ?)";
2083     my $usth = $dbh->prepare($uquery);
2084     return $usth->execute(@bind);
2085 }
2086
2087 =head2 _FixAccountForLostAndReturned
2088
2089   &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2090
2091 Calculates the charge for a book lost and returned.
2092
2093 Internal function, not exported, called only by AddReturn.
2094
2095 FIXME: This function reflects how inscrutable fines logic is.  Fix both.
2096 FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.
2097
2098 =cut
2099
2100 sub _FixAccountForLostAndReturned {
2101     my $itemnumber     = shift or return;
2102     my $borrowernumber = @_ ? shift : undef;
2103     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
2104     my $dbh = C4::Context->dbh;
2105     # check for charge made for lost book
2106     my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2107     $sth->execute($itemnumber);
2108     my $data = $sth->fetchrow_hashref;
2109     $data or return;    # bail if there is nothing to do
2110     $data->{accounttype} eq 'W' and return;    # Written off
2111
2112     # writeoff this amount
2113     my $offset;
2114     my $amount = $data->{'amount'};
2115     my $acctno = $data->{'accountno'};
2116     my $amountleft;                                             # Starts off undef/zero.
2117     if ($data->{'amountoutstanding'} == $amount) {
2118         $offset     = $data->{'amount'};
2119         $amountleft = 0;                                        # Hey, it's zero here, too.
2120     } else {
2121         $offset     = $amount - $data->{'amountoutstanding'};   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2122         $amountleft = $data->{'amountoutstanding'} - $amount;   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2123     }
2124     my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2125         WHERE (accountlines_id = ?)");
2126     $usth->execute($data->{'accountlines_id'});      # We might be adjusting an account for some OTHER borrowernumber now.  Not the one we passed in.
2127     #check if any credit is left if so writeoff other accounts
2128     my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2129     $amountleft *= -1 if ($amountleft < 0);
2130     if ($amountleft > 0) {
2131         my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2132                             AND (amountoutstanding >0) ORDER BY date");     # might want to order by amountoustanding ASC (pay smallest first)
2133         $msth->execute($data->{'borrowernumber'});
2134         # offset transactions
2135         my $newamtos;
2136         my $accdata;
2137         while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2138             if ($accdata->{'amountoutstanding'} < $amountleft) {
2139                 $newamtos = 0;
2140                 $amountleft -= $accdata->{'amountoutstanding'};
2141             }  else {
2142                 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2143                 $amountleft = 0;
2144             }
2145             my $thisacct = $accdata->{'accountlines_id'};
2146             # FIXME: move prepares outside while loop!
2147             my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2148                     WHERE (accountlines_id = ?)");
2149             $usth->execute($newamtos,'$thisacct');    # FIXME: '$thisacct' is a string literal!
2150             $usth = $dbh->prepare("INSERT INTO accountoffsets
2151                 (borrowernumber, accountno, offsetaccount,  offsetamount)
2152                 VALUES
2153                 (?,?,?,?)");
2154             $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2155         }
2156         $msth->finish;  # $msth might actually have data left
2157     }
2158     $amountleft *= -1 if ($amountleft > 0);
2159     my $desc = "Item Returned " . $item_id;
2160     $usth = $dbh->prepare("INSERT INTO accountlines
2161         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2162         VALUES (?,?,now(),?,?,'CR',?)");
2163     $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2164     if ($borrowernumber) {
2165         # FIXME: same as query above.  use 1 sth for both
2166         $usth = $dbh->prepare("INSERT INTO accountoffsets
2167             (borrowernumber, accountno, offsetaccount,  offsetamount)
2168             VALUES (?,?,?,?)");
2169         $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2170     }
2171     ModItem({ paidfor => '' }, undef, $itemnumber);
2172     return;
2173 }
2174
2175 =head2 _GetCircControlBranch
2176
2177    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2178
2179 Internal function :
2180
2181 Return the library code to be used to determine which circulation
2182 policy applies to a transaction.  Looks up the CircControl and
2183 HomeOrHoldingBranch system preferences.
2184
2185 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2186
2187 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2188
2189 =cut
2190
2191 sub _GetCircControlBranch {
2192     my ($item, $borrower) = @_;
2193     my $circcontrol = C4::Context->preference('CircControl');
2194     my $branch;
2195
2196     if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2197         $branch= C4::Context->userenv->{'branch'};
2198     } elsif ($circcontrol eq 'PatronLibrary') {
2199         $branch=$borrower->{branchcode};
2200     } else {
2201         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2202         $branch = $item->{$branchfield};
2203         # default to item home branch if holdingbranch is used
2204         # and is not defined
2205         if (!defined($branch) && $branchfield eq 'holdingbranch') {
2206             $branch = $item->{homebranch};
2207         }
2208     }
2209     return $branch;
2210 }
2211
2212
2213
2214
2215
2216
2217 =head2 GetItemIssue
2218
2219   $issue = &GetItemIssue($itemnumber);
2220
2221 Returns patron currently having a book, or undef if not checked out.
2222
2223 C<$itemnumber> is the itemnumber.
2224
2225 C<$issue> is a hashref of the row from the issues table.
2226
2227 =cut
2228
2229 sub GetItemIssue {
2230     my ($itemnumber) = @_;
2231     return unless $itemnumber;
2232     my $sth = C4::Context->dbh->prepare(
2233         "SELECT *
2234         FROM issues
2235         LEFT JOIN items ON issues.itemnumber=items.itemnumber
2236         WHERE issues.itemnumber=?");
2237     $sth->execute($itemnumber);
2238     my $data = $sth->fetchrow_hashref;
2239     return unless $data;
2240     $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2241     $data->{issuedate}->truncate(to => 'minute');
2242     $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2243     $data->{date_due}->truncate(to => 'minute');
2244     my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2245     $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2246     return $data;
2247 }
2248
2249 =head2 GetOpenIssue
2250
2251   $issue = GetOpenIssue( $itemnumber );
2252
2253 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2254
2255 C<$itemnumber> is the item's itemnumber
2256
2257 Returns a hashref
2258
2259 =cut
2260
2261 sub GetOpenIssue {
2262   my ( $itemnumber ) = @_;
2263
2264   my $dbh = C4::Context->dbh;
2265   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2266   $sth->execute( $itemnumber );
2267   my $issue = $sth->fetchrow_hashref();
2268   return $issue;
2269 }
2270
2271 =head2 GetItemIssues
2272
2273   $issues = &GetItemIssues($itemnumber, $history);
2274
2275 Returns patrons that have issued a book
2276
2277 C<$itemnumber> is the itemnumber
2278 C<$history> is false if you just want the current "issuer" (if any)
2279 and true if you want issues history from old_issues also.
2280
2281 Returns reference to an array of hashes
2282
2283 =cut
2284
2285 sub GetItemIssues {
2286     my ( $itemnumber, $history ) = @_;
2287
2288     my $today = DateTime->now( time_zome => C4::Context->tz);  # get today date
2289     $today->truncate( to => 'minute' );
2290     my $sql = "SELECT * FROM issues
2291               JOIN borrowers USING (borrowernumber)
2292               JOIN items     USING (itemnumber)
2293               WHERE issues.itemnumber = ? ";
2294     if ($history) {
2295         $sql .= "UNION ALL
2296                  SELECT * FROM old_issues
2297                  LEFT JOIN borrowers USING (borrowernumber)
2298                  JOIN items USING (itemnumber)
2299                  WHERE old_issues.itemnumber = ? ";
2300     }
2301     $sql .= "ORDER BY date_due DESC";
2302     my $sth = C4::Context->dbh->prepare($sql);
2303     if ($history) {
2304         $sth->execute($itemnumber, $itemnumber);
2305     } else {
2306         $sth->execute($itemnumber);
2307     }
2308     my $results = $sth->fetchall_arrayref({});
2309     foreach (@$results) {
2310         my $date_due = dt_from_string($_->{date_due},'sql');
2311         $date_due->truncate( to => 'minute' );
2312
2313         $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2314     }
2315     return $results;
2316 }
2317
2318 =head2 GetBiblioIssues
2319
2320   $issues = GetBiblioIssues($biblionumber);
2321
2322 this function get all issues from a biblionumber.
2323
2324 Return:
2325 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2326 tables issues and the firstname,surname & cardnumber from borrowers.
2327
2328 =cut
2329
2330 sub GetBiblioIssues {
2331     my $biblionumber = shift;
2332     return unless $biblionumber;
2333     my $dbh   = C4::Context->dbh;
2334     my $query = "
2335         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2336         FROM issues
2337             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2338             LEFT JOIN items ON issues.itemnumber = items.itemnumber
2339             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2340             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2341         WHERE biblio.biblionumber = ?
2342         UNION ALL
2343         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2344         FROM old_issues
2345             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2346             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2347             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2348             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2349         WHERE biblio.biblionumber = ?
2350         ORDER BY timestamp
2351     ";
2352     my $sth = $dbh->prepare($query);
2353     $sth->execute($biblionumber, $biblionumber);
2354
2355     my @issues;
2356     while ( my $data = $sth->fetchrow_hashref ) {
2357         push @issues, $data;
2358     }
2359     return \@issues;
2360 }
2361
2362 =head2 GetUpcomingDueIssues
2363
2364   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2365
2366 =cut
2367
2368 sub GetUpcomingDueIssues {
2369     my $params = shift;
2370
2371     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2372     my $dbh = C4::Context->dbh;
2373
2374     my $statement = <<END_SQL;
2375 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2376 FROM issues
2377 LEFT JOIN items USING (itemnumber)
2378 LEFT OUTER JOIN branches USING (branchcode)
2379 WhERE returndate is NULL
2380 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
2381 END_SQL
2382
2383     my @bind_parameters = ( $params->{'days_in_advance'} );
2384
2385     my $sth = $dbh->prepare( $statement );
2386     $sth->execute( @bind_parameters );
2387     my $upcoming_dues = $sth->fetchall_arrayref({});
2388     $sth->finish;
2389
2390     return $upcoming_dues;
2391 }
2392
2393 =head2 CanBookBeRenewed
2394
2395   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2396
2397 Find out whether a borrowed item may be renewed.
2398
2399 C<$dbh> is a DBI handle to the Koha database.
2400
2401 C<$borrowernumber> is the borrower number of the patron who currently
2402 has the item on loan.
2403
2404 C<$itemnumber> is the number of the item to renew.
2405
2406 C<$override_limit>, if supplied with a true value, causes
2407 the limit on the number of times that the loan can be renewed
2408 (as controlled by the item type) to be ignored.
2409
2410 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
2411 item must currently be on loan to the specified borrower; renewals
2412 must be allowed for the item's type; and the borrower must not have
2413 already renewed the loan. $error will contain the reason the renewal can not proceed
2414
2415 =cut
2416
2417 sub CanBookBeRenewed {
2418
2419     # check renewal status
2420     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2421     my $dbh       = C4::Context->dbh;
2422     my $renews    = 1;
2423     my $renewokay = 0;
2424         my $error;
2425
2426     # Look in the issues table for this item, lent to this borrower,
2427     # and not yet returned.
2428
2429     # Look in the issues table for this item, lent to this borrower,
2430     # and not yet returned.
2431     my %branch = (
2432             'ItemHomeLibrary' => 'items.homebranch',
2433             'PickupLibrary'   => 'items.holdingbranch',
2434             'PatronLibrary'   => 'borrowers.branchcode'
2435             );
2436     my $controlbranch = $branch{C4::Context->preference('CircControl')};
2437     my $itype         = C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype';
2438
2439     my $sthcount = $dbh->prepare("
2440                    SELECT
2441                     borrowers.categorycode, biblioitems.itemtype, issues.renewals, renewalsallowed, $controlbranch
2442                    FROM  issuingrules,
2443                    issues
2444                    LEFT JOIN items USING (itemnumber)
2445                    LEFT JOIN borrowers USING (borrowernumber)
2446                    LEFT JOIN biblioitems USING (biblioitemnumber)
2447
2448                    WHERE
2449                     (issuingrules.categorycode = borrowers.categorycode OR issuingrules.categorycode = '*')
2450                    AND
2451                     (issuingrules.itemtype = $itype OR issuingrules.itemtype = '*')
2452                    AND
2453                     (issuingrules.branchcode = $controlbranch OR issuingrules.branchcode = '*')
2454                    AND
2455                     borrowernumber = ?
2456                    AND
2457                     itemnumber = ?
2458                    ORDER BY
2459                     issuingrules.categorycode desc,
2460                     issuingrules.itemtype desc,
2461                     issuingrules.branchcode desc
2462                    LIMIT 1;
2463                   ");
2464
2465     $sthcount->execute( $borrowernumber, $itemnumber );
2466     if ( my $data1 = $sthcount->fetchrow_hashref ) {
2467
2468         if ( ( $data1->{renewalsallowed} && $data1->{renewalsallowed} > $data1->{renewals} ) || $override_limit ) {
2469             $renewokay = 1;
2470         }
2471         else {
2472                         $error="too_many";
2473                 }
2474
2475         my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2476         if ($resfound) {
2477             $renewokay = 0;
2478                         $error="on_reserve"
2479         }
2480
2481     }
2482     return ($renewokay,$error);
2483 }
2484
2485 =head2 AddRenewal
2486
2487   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2488
2489 Renews a loan.
2490
2491 C<$borrowernumber> is the borrower number of the patron who currently
2492 has the item.
2493
2494 C<$itemnumber> is the number of the item to renew.
2495
2496 C<$branch> is the library where the renewal took place (if any).
2497            The library that controls the circ policies for the renewal is retrieved from the issues record.
2498
2499 C<$datedue> can be a C4::Dates object used to set the due date.
2500
2501 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2502 this parameter is not supplied, lastreneweddate is set to the current date.
2503
2504 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2505 from the book's item type.
2506
2507 =cut
2508
2509 sub AddRenewal {
2510     my $borrowernumber  = shift or return;
2511     my $itemnumber      = shift or return;
2512     my $branch          = shift;
2513     my $datedue         = shift;
2514     my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2515     my $item   = GetItem($itemnumber) or return;
2516     my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
2517
2518     my $dbh = C4::Context->dbh;
2519     # Find the issues record for this book
2520     my $sth =
2521       $dbh->prepare("SELECT * FROM issues
2522                         WHERE borrowernumber=?
2523                         AND itemnumber=?"
2524       );
2525     $sth->execute( $borrowernumber, $itemnumber );
2526     my $issuedata = $sth->fetchrow_hashref;
2527     $sth->finish;
2528     if(defined $datedue && ref $datedue ne 'DateTime' ) {
2529         carp 'Invalid date passed to AddRenewal.';
2530         return;
2531     }
2532     # If the due date wasn't specified, calculate it by adding the
2533     # book's loan length to today's date or the current due date
2534     # based on the value of the RenewalPeriodBase syspref.
2535     unless ($datedue) {
2536
2537         my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
2538         my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2539
2540         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2541                                         $issuedata->{date_due} :
2542                                         DateTime->now( time_zone => C4::Context->tz());
2543         $datedue =  CalcDateDue($datedue,$itemtype,$issuedata->{'branchcode'},$borrower);
2544     }
2545
2546     # Update the issues record to have the new due date, and a new count
2547     # of how many times it has been renewed.
2548     my $renews = $issuedata->{'renewals'} + 1;
2549     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2550                             WHERE borrowernumber=?
2551                             AND itemnumber=?"
2552     );
2553
2554     $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2555     $sth->finish;
2556
2557     # Update the renewal count on the item, and tell zebra to reindex
2558     $renews = $biblio->{'renewals'} + 1;
2559     ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2560
2561     # Charge a new rental fee, if applicable?
2562     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2563     if ( $charge > 0 ) {
2564         my $accountno = getnextacctno( $borrowernumber );
2565         my $item = GetBiblioFromItemNumber($itemnumber);
2566         my $manager_id = 0;
2567         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2568         $sth = $dbh->prepare(
2569                 "INSERT INTO accountlines
2570                     (date, borrowernumber, accountno, amount, manager_id,
2571                     description,accounttype, amountoutstanding, itemnumber)
2572                     VALUES (now(),?,?,?,?,?,?,?,?)"
2573         );
2574         $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2575             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2576             'Rent', $charge, $itemnumber );
2577     }
2578     # Log the renewal
2579     UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'});
2580         return $datedue;
2581 }
2582
2583 sub GetRenewCount {
2584     # check renewal status
2585     my ( $bornum, $itemno ) = @_;
2586     my $dbh           = C4::Context->dbh;
2587     my $renewcount    = 0;
2588     my $renewsallowed = 0;
2589     my $renewsleft    = 0;
2590
2591     my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
2592     my $item     = GetItem($itemno);
2593
2594     # Look in the issues table for this item, lent to this borrower,
2595     # and not yet returned.
2596
2597     # FIXME - I think this function could be redone to use only one SQL call.
2598     my $sth = $dbh->prepare(
2599         "select * from issues
2600                                 where (borrowernumber = ?)
2601                                 and (itemnumber = ?)"
2602     );
2603     $sth->execute( $bornum, $itemno );
2604     my $data = $sth->fetchrow_hashref;
2605     $renewcount = $data->{'renewals'} if $data->{'renewals'};
2606     $sth->finish;
2607     # $item and $borrower should be calculated
2608     my $branchcode = _GetCircControlBranch($item, $borrower);
2609
2610     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2611
2612     $renewsallowed = $issuingrule->{'renewalsallowed'};
2613     $renewsleft    = $renewsallowed - $renewcount;
2614     if($renewsleft < 0){ $renewsleft = 0; }
2615     return ( $renewcount, $renewsallowed, $renewsleft );
2616 }
2617
2618 =head2 GetIssuingCharges
2619
2620   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2621
2622 Calculate how much it would cost for a given patron to borrow a given
2623 item, including any applicable discounts.
2624
2625 C<$itemnumber> is the item number of item the patron wishes to borrow.
2626
2627 C<$borrowernumber> is the patron's borrower number.
2628
2629 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2630 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2631 if it's a video).
2632
2633 =cut
2634
2635 sub GetIssuingCharges {
2636
2637     # calculate charges due
2638     my ( $itemnumber, $borrowernumber ) = @_;
2639     my $charge = 0;
2640     my $dbh    = C4::Context->dbh;
2641     my $item_type;
2642
2643     # Get the book's item type and rental charge (via its biblioitem).
2644     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
2645         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
2646     $charge_query .= (C4::Context->preference('item-level_itypes'))
2647         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
2648         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
2649
2650     $charge_query .= ' WHERE items.itemnumber =?';
2651
2652     my $sth = $dbh->prepare($charge_query);
2653     $sth->execute($itemnumber);
2654     if ( my $item_data = $sth->fetchrow_hashref ) {
2655         $item_type = $item_data->{itemtype};
2656         $charge    = $item_data->{rentalcharge};
2657         my $branch = C4::Branch::mybranch();
2658         my $discount_query = q|SELECT rentaldiscount,
2659             issuingrules.itemtype, issuingrules.branchcode
2660             FROM borrowers
2661             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2662             WHERE borrowers.borrowernumber = ?
2663             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
2664             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
2665         my $discount_sth = $dbh->prepare($discount_query);
2666         $discount_sth->execute( $borrowernumber, $item_type, $branch );
2667         my $discount_rules = $discount_sth->fetchall_arrayref({});
2668         if (@{$discount_rules}) {
2669             # We may have multiple rules so get the most specific
2670             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
2671             $charge = ( $charge * ( 100 - $discount ) ) / 100;
2672         }
2673     }
2674
2675     $sth->finish; # we havent _explicitly_ fetched all rows
2676     return ( $charge, $item_type );
2677 }
2678
2679 # Select most appropriate discount rule from those returned
2680 sub _get_discount_from_rule {
2681     my ($rules_ref, $branch, $itemtype) = @_;
2682     my $discount;
2683
2684     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
2685         $discount = $rules_ref->[0]->{rentaldiscount};
2686         return (defined $discount) ? $discount : 0;
2687     }
2688     # could have up to 4 does one match $branch and $itemtype
2689     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
2690     if (@d) {
2691         $discount = $d[0]->{rentaldiscount};
2692         return (defined $discount) ? $discount : 0;
2693     }
2694     # do we have item type + all branches
2695     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
2696     if (@d) {
2697         $discount = $d[0]->{rentaldiscount};
2698         return (defined $discount) ? $discount : 0;
2699     }
2700     # do we all item types + this branch
2701     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
2702     if (@d) {
2703         $discount = $d[0]->{rentaldiscount};
2704         return (defined $discount) ? $discount : 0;
2705     }
2706     # so all and all (surely we wont get here)
2707     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
2708     if (@d) {
2709         $discount = $d[0]->{rentaldiscount};
2710         return (defined $discount) ? $discount : 0;
2711     }
2712     # none of the above
2713     return 0;
2714 }
2715
2716 =head2 AddIssuingCharge
2717
2718   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2719
2720 =cut
2721
2722 sub AddIssuingCharge {
2723     my ( $itemnumber, $borrowernumber, $charge ) = @_;
2724     my $dbh = C4::Context->dbh;
2725     my $nextaccntno = getnextacctno( $borrowernumber );
2726     my $manager_id = 0;
2727     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2728     my $query ="
2729         INSERT INTO accountlines
2730             (borrowernumber, itemnumber, accountno,
2731             date, amount, description, accounttype,
2732             amountoutstanding, manager_id)
2733         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
2734     ";
2735     my $sth = $dbh->prepare($query);
2736     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
2737     $sth->finish;
2738 }
2739
2740 =head2 GetTransfers
2741
2742   GetTransfers($itemnumber);
2743
2744 =cut
2745
2746 sub GetTransfers {
2747     my ($itemnumber) = @_;
2748
2749     my $dbh = C4::Context->dbh;
2750
2751     my $query = '
2752         SELECT datesent,
2753                frombranch,
2754                tobranch
2755         FROM branchtransfers
2756         WHERE itemnumber = ?
2757           AND datearrived IS NULL
2758         ';
2759     my $sth = $dbh->prepare($query);
2760     $sth->execute($itemnumber);
2761     my @row = $sth->fetchrow_array();
2762     $sth->finish;
2763     return @row;
2764 }
2765
2766 =head2 GetTransfersFromTo
2767
2768   @results = GetTransfersFromTo($frombranch,$tobranch);
2769
2770 Returns the list of pending transfers between $from and $to branch
2771
2772 =cut
2773
2774 sub GetTransfersFromTo {
2775     my ( $frombranch, $tobranch ) = @_;
2776     return unless ( $frombranch && $tobranch );
2777     my $dbh   = C4::Context->dbh;
2778     my $query = "
2779         SELECT itemnumber,datesent,frombranch
2780         FROM   branchtransfers
2781         WHERE  frombranch=?
2782           AND  tobranch=?
2783           AND datearrived IS NULL
2784     ";
2785     my $sth = $dbh->prepare($query);
2786     $sth->execute( $frombranch, $tobranch );
2787     my @gettransfers;
2788
2789     while ( my $data = $sth->fetchrow_hashref ) {
2790         push @gettransfers, $data;
2791     }
2792     $sth->finish;
2793     return (@gettransfers);
2794 }
2795
2796 =head2 DeleteTransfer
2797
2798   &DeleteTransfer($itemnumber);
2799
2800 =cut
2801
2802 sub DeleteTransfer {
2803     my ($itemnumber) = @_;
2804     my $dbh          = C4::Context->dbh;
2805     my $sth          = $dbh->prepare(
2806         "DELETE FROM branchtransfers
2807          WHERE itemnumber=?
2808          AND datearrived IS NULL "
2809     );
2810     $sth->execute($itemnumber);
2811     $sth->finish;
2812 }
2813
2814 =head2 AnonymiseIssueHistory
2815
2816   $rows = AnonymiseIssueHistory($date,$borrowernumber)
2817
2818 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2819 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2820
2821 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
2822 setting (force delete).
2823
2824 return the number of affected rows.
2825
2826 =cut
2827
2828 sub AnonymiseIssueHistory {
2829     my $date           = shift;
2830     my $borrowernumber = shift;
2831     my $dbh            = C4::Context->dbh;
2832     my $query          = "
2833         UPDATE old_issues
2834         SET    borrowernumber = ?
2835         WHERE  returndate < ?
2836           AND borrowernumber IS NOT NULL
2837     ";
2838
2839     # The default of 0 does not work due to foreign key constraints
2840     # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
2841     my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
2842     my @bind_params = ($anonymouspatron, $date);
2843     if (defined $borrowernumber) {
2844        $query .= " AND borrowernumber = ?";
2845        push @bind_params, $borrowernumber;
2846     } else {
2847        $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
2848     }
2849     my $sth = $dbh->prepare($query);
2850     $sth->execute(@bind_params);
2851     my $rows_affected = $sth->rows;  ### doublecheck row count return function
2852     return $rows_affected;
2853 }
2854
2855 =head2 SendCirculationAlert
2856
2857 Send out a C<check-in> or C<checkout> alert using the messaging system.
2858
2859 B<Parameters>:
2860
2861 =over 4
2862
2863 =item type
2864
2865 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
2866
2867 =item item
2868
2869 Hashref of information about the item being checked in or out.
2870
2871 =item borrower
2872
2873 Hashref of information about the borrower of the item.
2874
2875 =item branch
2876
2877 The branchcode from where the checkout or check-in took place.
2878
2879 =back
2880
2881 B<Example>:
2882
2883     SendCirculationAlert({
2884         type     => 'CHECKOUT',
2885         item     => $item,
2886         borrower => $borrower,
2887         branch   => $branch,
2888     });
2889
2890 =cut
2891
2892 sub SendCirculationAlert {
2893     my ($opts) = @_;
2894     my ($type, $item, $borrower, $branch) =
2895         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
2896     my %message_name = (
2897         CHECKIN  => 'Item_Check_in',
2898         CHECKOUT => 'Item_Checkout',
2899     );
2900     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
2901         borrowernumber => $borrower->{borrowernumber},
2902         message_name   => $message_name{$type},
2903     });
2904     my $issues_table = ( $type eq 'CHECKOUT' ) ? 'issues' : 'old_issues';
2905     my $letter =  C4::Letters::GetPreparedLetter (
2906         module => 'circulation',
2907         letter_code => $type,
2908         branchcode => $branch,
2909         tables => {
2910             $issues_table => $item->{itemnumber},
2911             'items'       => $item->{itemnumber},
2912             'biblio'      => $item->{biblionumber},
2913             'biblioitems' => $item->{biblionumber},
2914             'borrowers'   => $borrower,
2915             'branches'    => $branch,
2916         }
2917     ) or return;
2918
2919     my @transports = keys %{ $borrower_preferences->{transports} };
2920     # warn "no transports" unless @transports;
2921     for (@transports) {
2922         # warn "transport: $_";
2923         my $message = C4::Message->find_last_message($borrower, $type, $_);
2924         if (!$message) {
2925             #warn "create new message";
2926             C4::Message->enqueue($letter, $borrower, $_);
2927         } else {
2928             #warn "append to old message";
2929             $message->append($letter);
2930             $message->update;
2931         }
2932     }
2933
2934     return $letter;
2935 }
2936
2937 =head2 updateWrongTransfer
2938
2939   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2940
2941 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
2942
2943 =cut
2944
2945 sub updateWrongTransfer {
2946         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2947         my $dbh = C4::Context->dbh;
2948 # first step validate the actual line of transfert .
2949         my $sth =
2950                 $dbh->prepare(
2951                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2952                 );
2953                 $sth->execute($FromLibrary,$itemNumber);
2954                 $sth->finish;
2955
2956 # second step create a new line of branchtransfer to the right location .
2957         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2958
2959 #third step changing holdingbranch of item
2960         UpdateHoldingbranch($FromLibrary,$itemNumber);
2961 }
2962
2963 =head2 UpdateHoldingbranch
2964
2965   $items = UpdateHoldingbranch($branch,$itmenumber);
2966
2967 Simple methode for updating hodlingbranch in items BDD line
2968
2969 =cut
2970
2971 sub UpdateHoldingbranch {
2972         my ( $branch,$itemnumber ) = @_;
2973     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2974 }
2975
2976 =head2 CalcDateDue
2977
2978 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
2979
2980 this function calculates the due date given the start date and configured circulation rules,
2981 checking against the holidays calendar as per the 'useDaysMode' syspref.
2982 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2983 C<$itemtype>  = itemtype code of item in question
2984 C<$branch>  = location whose calendar to use
2985 C<$borrower> = Borrower object
2986
2987 =cut
2988
2989 sub CalcDateDue {
2990     my ( $startdate, $itemtype, $branch, $borrower ) = @_;
2991
2992     # loanlength now a href
2993     my $loanlength =
2994       GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
2995
2996     my $datedue;
2997
2998     # if globalDueDate ON the datedue is set to that date
2999     if (C4::Context->preference('globalDueDate')
3000         && ( C4::Context->preference('globalDueDate') =~
3001             C4::Dates->regexp('syspref') )
3002       ) {
3003         $datedue = dt_from_string(
3004             C4::Context->preference('globalDueDate'),
3005             C4::Context->preference('dateformat')
3006         );
3007     } else {
3008
3009         # otherwise, calculate the datedue as normal
3010         if ( C4::Context->preference('useDaysMode') eq 'Days' )
3011         {    # ignoring calendar
3012             my $dt =
3013               DateTime->now( time_zone => C4::Context->tz() )
3014               ->truncate( to => 'minute' );
3015             if ( $loanlength->{lengthunit} eq 'hours' ) {
3016                 $dt->add( hours => $loanlength->{issuelength} );
3017             } else {    # days
3018                 $dt->add( days => $loanlength->{issuelength} );
3019                 $dt->set_hour(23);
3020                 $dt->set_minute(59);
3021             }
3022             # break
3023             return $dt;
3024
3025         } else {
3026             my $dur;
3027             if ($loanlength->{lengthunit} eq 'hours') {
3028                 $dur = DateTime::Duration->new( hours => $loanlength->{issuelength});
3029             }
3030             else { # days
3031                 $dur = DateTime::Duration->new( days => $loanlength->{issuelength});
3032             }
3033             if (ref $startdate ne 'DateTime' ) {
3034                 $startdate = dt_from_string($startdate);
3035             }
3036             my $calendar = Koha::Calendar->new( branchcode => $branch );
3037             $datedue = $calendar->addDate( $startdate, $dur, $loanlength->{lengthunit} );
3038             if ($loanlength->{lengthunit} eq 'days') {
3039                 $datedue->set_hour(23);
3040                 $datedue->set_minute(59);
3041             }
3042         }
3043     }
3044
3045     # if Hard Due Dates are used, retreive them and apply as necessary
3046     my ( $hardduedate, $hardduedatecompare ) =
3047       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3048     if ($hardduedate) {    # hardduedates are currently dates
3049         $hardduedate->truncate( to => 'minute' );
3050         $hardduedate->set_hour(23);
3051         $hardduedate->set_minute(59);
3052         my $cmp = DateTime->compare( $hardduedate, $datedue );
3053
3054 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3055 # if the calculated date is before the 'after' Hard Due Date (floor), override
3056 # if the hard due date is set to 'exactly', overrride
3057         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3058             $datedue = $hardduedate->clone;
3059         }
3060
3061         # in all other cases, keep the date due as it is
3062     }
3063
3064     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3065     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3066         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso' );
3067         $expiry_dt->set( hour => 23, minute => 59);
3068         if ( DateTime->compare( $datedue, $expiry_dt ) == 1 ) {
3069             $datedue = $expiry_dt->clone;
3070         }
3071     }
3072
3073     return $datedue;
3074 }
3075
3076
3077 =head2 CheckRepeatableHolidays
3078
3079   $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
3080
3081 This function checks if the date due is a repeatable holiday
3082
3083 C<$date_due>   = returndate calculate with no day check
3084 C<$itemnumber>  = itemnumber
3085 C<$branchcode>  = localisation of issue
3086
3087 =cut
3088
3089 sub CheckRepeatableHolidays{
3090 my($itemnumber,$week_day,$branchcode)=@_;
3091 my $dbh = C4::Context->dbh;
3092 my $query = qq|SELECT count(*)
3093         FROM repeatable_holidays
3094         WHERE branchcode=?
3095         AND weekday=?|;
3096 my $sth = $dbh->prepare($query);
3097 $sth->execute($branchcode,$week_day);
3098 my $result=$sth->fetchrow;
3099 $sth->finish;
3100 return $result;
3101 }
3102
3103
3104 =head2 CheckSpecialHolidays
3105
3106   $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
3107
3108 This function check if the date is a special holiday
3109
3110 C<$years>   = the years of datedue
3111 C<$month>   = the month of datedue
3112 C<$day>     = the day of datedue
3113 C<$itemnumber>  = itemnumber
3114 C<$branchcode>  = localisation of issue
3115
3116 =cut
3117
3118 sub CheckSpecialHolidays{
3119 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
3120 my $dbh = C4::Context->dbh;
3121 my $query=qq|SELECT count(*)
3122              FROM `special_holidays`
3123              WHERE year=?
3124              AND month=?
3125              AND day=?
3126              AND branchcode=?
3127             |;
3128 my $sth = $dbh->prepare($query);
3129 $sth->execute($years,$month,$day,$branchcode);
3130 my $countspecial=$sth->fetchrow ;
3131 $sth->finish;
3132 return $countspecial;
3133 }
3134
3135 =head2 CheckRepeatableSpecialHolidays
3136
3137   $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
3138
3139 This function check if the date is a repeatble special holidays
3140
3141 C<$month>   = the month of datedue
3142 C<$day>     = the day of datedue
3143 C<$itemnumber>  = itemnumber
3144 C<$branchcode>  = localisation of issue
3145
3146 =cut
3147
3148 sub CheckRepeatableSpecialHolidays{
3149 my ($month,$day,$itemnumber,$branchcode) = @_;
3150 my $dbh = C4::Context->dbh;
3151 my $query=qq|SELECT count(*)
3152              FROM `repeatable_holidays`
3153              WHERE month=?
3154              AND day=?
3155              AND branchcode=?
3156             |;
3157 my $sth = $dbh->prepare($query);
3158 $sth->execute($month,$day,$branchcode);
3159 my $countspecial=$sth->fetchrow ;
3160 $sth->finish;
3161 return $countspecial;
3162 }
3163
3164
3165
3166 sub CheckValidBarcode{
3167 my ($barcode) = @_;
3168 my $dbh = C4::Context->dbh;
3169 my $query=qq|SELECT count(*)
3170              FROM items
3171              WHERE barcode=?
3172             |;
3173 my $sth = $dbh->prepare($query);
3174 $sth->execute($barcode);
3175 my $exist=$sth->fetchrow ;
3176 $sth->finish;
3177 return $exist;
3178 }
3179
3180 =head2 IsBranchTransferAllowed
3181
3182   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3183
3184 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3185
3186 =cut
3187
3188 sub IsBranchTransferAllowed {
3189         my ( $toBranch, $fromBranch, $code ) = @_;
3190
3191         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3192
3193         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3194         my $dbh = C4::Context->dbh;
3195
3196         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3197         $sth->execute( $toBranch, $fromBranch, $code );
3198         my $limit = $sth->fetchrow_hashref();
3199
3200         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3201         if ( $limit->{'limitId'} ) {
3202                 return 0;
3203         } else {
3204                 return 1;
3205         }
3206 }
3207
3208 =head2 CreateBranchTransferLimit
3209
3210   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3211
3212 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3213
3214 =cut
3215
3216 sub CreateBranchTransferLimit {
3217    my ( $toBranch, $fromBranch, $code ) = @_;
3218
3219    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3220
3221    my $dbh = C4::Context->dbh;
3222
3223    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3224    $sth->execute( $code, $toBranch, $fromBranch );
3225 }
3226
3227 =head2 DeleteBranchTransferLimits
3228
3229 DeleteBranchTransferLimits($frombranch);
3230
3231 Deletes all the branch transfer limits for one branch
3232
3233 =cut
3234
3235 sub DeleteBranchTransferLimits {
3236     my $branch = shift;
3237     my $dbh    = C4::Context->dbh;
3238     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3239     $sth->execute($branch);
3240 }
3241
3242 sub ReturnLostItem{
3243     my ( $borrowernumber, $itemnum ) = @_;
3244
3245     MarkIssueReturned( $borrowernumber, $itemnum );
3246     my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3247     my $item = C4::Items::GetItem( $itemnum );
3248     my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3249     my @datearr = localtime(time);
3250     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3251     my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3252     ModItem({ paidfor =>  $old_note."Paid for by $bor $date" }, undef, $itemnum);
3253 }
3254
3255
3256 sub LostItem{
3257     my ($itemnumber, $mark_returned, $charge_fee) = @_;
3258
3259     my $dbh = C4::Context->dbh();
3260     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3261                            FROM issues
3262                            JOIN items USING (itemnumber)
3263                            JOIN biblio USING (biblionumber)
3264                            WHERE issues.itemnumber=?");
3265     $sth->execute($itemnumber);
3266     my $issues=$sth->fetchrow_hashref();
3267     $sth->finish;
3268
3269     # if a borrower lost the item, add a replacement cost to the their record
3270     if ( my $borrowernumber = $issues->{borrowernumber} ){
3271         my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3272
3273         C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}")
3274           if $charge_fee;
3275         #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3276         #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3277         MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3278     }
3279 }
3280
3281 sub GetOfflineOperations {
3282     my $dbh = C4::Context->dbh;
3283     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3284     $sth->execute(C4::Context->userenv->{'branch'});
3285     my $results = $sth->fetchall_arrayref({});
3286     $sth->finish;
3287     return $results;
3288 }
3289
3290 sub GetOfflineOperation {
3291     my $dbh = C4::Context->dbh;
3292     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3293     $sth->execute( shift );
3294     my $result = $sth->fetchrow_hashref;
3295     $sth->finish;
3296     return $result;
3297 }
3298
3299 sub AddOfflineOperation {
3300     my $dbh = C4::Context->dbh;
3301     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber) VALUES(?,?,?,?,?,?)");
3302     $sth->execute( @_ );
3303     return "Added.";
3304 }
3305
3306 sub DeleteOfflineOperation {
3307     my $dbh = C4::Context->dbh;
3308     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3309     $sth->execute( shift );
3310     return "Deleted.";
3311 }
3312
3313 sub ProcessOfflineOperation {
3314     my $operation = shift;
3315
3316     my $report;
3317     if ( $operation->{action} eq 'return' ) {
3318         $report = ProcessOfflineReturn( $operation );
3319     } elsif ( $operation->{action} eq 'issue' ) {
3320         $report = ProcessOfflineIssue( $operation );
3321     }
3322
3323     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3324
3325     return $report;
3326 }
3327
3328 sub ProcessOfflineReturn {
3329     my $operation = shift;
3330
3331     my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3332
3333     if ( $itemnumber ) {
3334         my $issue = GetOpenIssue( $itemnumber );
3335         if ( $issue ) {
3336             MarkIssueReturned(
3337                 $issue->{borrowernumber},
3338                 $itemnumber,
3339                 undef,
3340                 $operation->{timestamp},
3341             );
3342             ModItem(
3343                 { renewals => 0, onloan => undef },
3344                 $issue->{'biblionumber'},
3345                 $itemnumber
3346             );
3347             return "Success.";
3348         } else {
3349             return "Item not issued.";
3350         }
3351     } else {
3352         return "Item not found.";
3353     }
3354 }
3355
3356 sub ProcessOfflineIssue {
3357     my $operation = shift;
3358
3359     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3360
3361     if ( $borrower->{borrowernumber} ) {
3362         my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3363         unless ($itemnumber) {
3364             return "Barcode not found.";
3365         }
3366         my $issue = GetOpenIssue( $itemnumber );
3367
3368         if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3369             MarkIssueReturned(
3370                 $issue->{borrowernumber},
3371                 $itemnumber,
3372                 undef,
3373                 $operation->{timestamp},
3374             );
3375         }
3376         AddIssue(
3377             $borrower,
3378             $operation->{'barcode'},
3379             undef,
3380             1,
3381             $operation->{timestamp},
3382             undef,
3383         );
3384         return "Success.";
3385     } else {
3386         return "Borrower not found.";
3387     }
3388 }
3389
3390
3391
3392 =head2 TransferSlip
3393
3394   TransferSlip($user_branch, $itemnumber, $to_branch)
3395
3396   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3397
3398 =cut
3399
3400 sub TransferSlip {
3401     my ($branch, $itemnumber, $to_branch) = @_;
3402
3403     my $item =  GetItem( $itemnumber )
3404       or return;
3405
3406     my $pulldate = C4::Dates->new();
3407
3408     return C4::Letters::GetPreparedLetter (
3409         module => 'circulation',
3410         letter_code => 'TRANSFERSLIP',
3411         branchcode => $branch,
3412         tables => {
3413             'branches'    => $to_branch,
3414             'biblio'      => $item->{biblionumber},
3415             'items'       => $item,
3416         },
3417     );
3418 }
3419
3420
3421 1;
3422
3423 __END__
3424
3425 =head1 AUTHOR
3426
3427 Koha Development Team <http://koha-community.org/>
3428
3429 =cut
3430