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