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