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