C4/Circulation.pm

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