C4/Circulation.pm

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