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'}, undef, $item->{'ccode'});
 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 CanBookBeReturned
1012
1013   ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1014
1015 Check whether the item can be returned to the provided branch
1016
1017 =over 4
1018
1019 =item C<$item> is a hash of item information as returned from GetItem
1020
1021 =item C<$branch> is the branchcode where the return is taking place
1022
1023 =back
1024
1025 Returns:
1026
1027 =over 4
1028
1029 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1030
1031 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1032
1033 =back
1034
1035 =cut
1036
1037 sub CanBookBeReturned {
1038   my ($item, $branch) = @_;
1039   my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1040
1041   # assume return is allowed to start
1042   my $allowed = 1;
1043   my $message;
1044
1045   # identify all cases where return is forbidden
1046   if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1047      $allowed = 0;
1048      $message = $item->{'homebranch'};
1049   } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1050      $allowed = 0;
1051      $message = $item->{'holdingbranch'};
1052   } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1053      $allowed = 0;
1054      $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1055   }
1056
1057   return ($allowed, $message);
1058 }
1059
1060 =head2 AddIssue
1061
1062   &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1063
1064 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1065
1066 =over 4
1067
1068 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).
1069
1070 =item C<$barcode> is the barcode of the item being issued.
1071
1072 =item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional).
1073 Calculated if empty.
1074
1075 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1076
1077 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1078 Defaults to today.  Unlike C<$datedue>, NOT a C4::Dates object, unfortunately.
1079
1080 AddIssue does the following things :
1081
1082   - step 01: check that there is a borrowernumber & a barcode provided
1083   - check for RENEWAL (book issued & being issued to the same patron)
1084       - renewal YES = Calculate Charge & renew
1085       - renewal NO  =
1086           * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1087           * RESERVE PLACED ?
1088               - fill reserve if reserve to this patron
1089               - cancel reserve or not, otherwise
1090           * TRANSFERT PENDING ?
1091               - complete the transfert
1092           * ISSUE THE BOOK
1093
1094 =back
1095
1096 =cut
1097
1098 sub AddIssue {
1099     my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_;
1100     my $dbh = C4::Context->dbh;
1101         my $barcodecheck=CheckValidBarcode($barcode);
1102     if ($datedue && ref $datedue ne 'DateTime') {
1103         $datedue = dt_from_string($datedue);
1104     }
1105     # $issuedate defaults to today.
1106     if ( ! defined $issuedate ) {
1107         $issuedate = DateTime->now(time_zone => C4::Context->tz());
1108     }
1109     else {
1110         if ( ref $issuedate ne 'DateTime') {
1111             $issuedate = dt_from_string($issuedate);
1112
1113         }
1114     }
1115         if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf
1116                 # find which item we issue
1117                 my $item = GetItem('', $barcode) or return undef;       # if we don't get an Item, abort.
1118                 my $branch = _GetCircControlBranch($item,$borrower);
1119
1120                 # get actual issuing if there is one
1121                 my $actualissue = GetItemIssue( $item->{itemnumber});
1122
1123                 # get biblioinformation for this item
1124                 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
1125
1126                 #
1127                 # check if we just renew the issue.
1128                 #
1129                 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
1130                     $datedue = AddRenewal(
1131                         $borrower->{'borrowernumber'},
1132                         $item->{'itemnumber'},
1133                         $branch,
1134                         $datedue,
1135                         $issuedate, # here interpreted as the renewal date
1136                         );
1137                 }
1138                 else {
1139         # it's NOT a renewal
1140                         if ( $actualissue->{borrowernumber}) {
1141                                 # This book is currently on loan, but not to the person
1142                                 # who wants to borrow it now. mark it returned before issuing to the new borrower
1143                                 AddReturn(
1144                                         $item->{'barcode'},
1145                                         C4::Context->userenv->{'branch'}
1146                                 );
1147                         }
1148
1149             MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1150                         # Starting process for transfer job (checking transfert and validate it if we have one)
1151             my ($datesent) = GetTransfers($item->{'itemnumber'});
1152             if ($datesent) {
1153         #       updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1154                 my $sth =
1155                     $dbh->prepare(
1156                     "UPDATE branchtransfers
1157                         SET datearrived = now(),
1158                         tobranch = ?,
1159                         comments = 'Forced branchtransfer'
1160                     WHERE itemnumber= ? AND datearrived IS NULL"
1161                     );
1162                 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
1163             }
1164
1165         # Record in the database the fact that the book was issued.
1166         my $sth =
1167           $dbh->prepare(
1168                 "INSERT INTO issues
1169                     (borrowernumber, itemnumber,issuedate, date_due, branchcode)
1170                 VALUES (?,?,?,?,?)"
1171           );
1172         unless ($datedue) {
1173             my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1174             $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1175
1176         }
1177         $datedue->truncate( to => 'minute');
1178         $sth->execute(
1179             $borrower->{'borrowernumber'},      # borrowernumber
1180             $item->{'itemnumber'},              # itemnumber
1181             $issuedate->strftime('%Y-%m-%d %H:%M:00'), # issuedate
1182             $datedue->strftime('%Y-%m-%d %H:%M:00'),   # date_due
1183             C4::Context->userenv->{'branch'}    # branchcode
1184         );
1185         if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1186           CartToShelf( $item->{'itemnumber'} );
1187         }
1188         $item->{'issues'}++;
1189         if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1190             UpdateTotalIssues($item->{'biblionumber'}, 1);
1191         }
1192
1193         ## If item was lost, it has now been found, reverse any list item charges if neccessary.
1194         if ( $item->{'itemlost'} ) {
1195             _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef, $item->{'barcode'} );
1196         }
1197
1198         ModItem({ issues           => $item->{'issues'},
1199                   holdingbranch    => C4::Context->userenv->{'branch'},
1200                   itemlost         => 0,
1201                   datelastborrowed => DateTime->now(time_zone => C4::Context->tz())->ymd(),
1202                   onloan           => $datedue->ymd(),
1203                 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1204         ModDateLastSeen( $item->{'itemnumber'} );
1205
1206         # If it costs to borrow this book, charge it to the patron's account.
1207         my ( $charge, $itemtype ) = GetIssuingCharges(
1208             $item->{'itemnumber'},
1209             $borrower->{'borrowernumber'}
1210         );
1211         if ( $charge > 0 ) {
1212             AddIssuingCharge(
1213                 $item->{'itemnumber'},
1214                 $borrower->{'borrowernumber'}, $charge
1215             );
1216             $item->{'charge'} = $charge;
1217         }
1218
1219         # Record the fact that this book was issued.
1220         &UpdateStats(
1221             C4::Context->userenv->{'branch'},
1222             'issue', $charge,
1223             ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
1224             $item->{'itype'}, $borrower->{'borrowernumber'}, undef, $item->{'ccode'}
1225         );
1226
1227         # Send a checkout slip.
1228         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1229         my %conditions = (
1230             branchcode   => $branch,
1231             categorycode => $borrower->{categorycode},
1232             item_type    => $item->{itype},
1233             notification => 'CHECKOUT',
1234         );
1235         if ($circulation_alert->is_enabled_for(\%conditions)) {
1236             SendCirculationAlert({
1237                 type     => 'CHECKOUT',
1238                 item     => $item,
1239                 borrower => $borrower,
1240                 branch   => $branch,
1241             });
1242         }
1243     }
1244
1245     logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1246         if C4::Context->preference("IssueLog");
1247   }
1248   return ($datedue);    # not necessarily the same as when it came in!
1249 }
1250
1251 =head2 GetLoanLength
1252
1253   my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1254
1255 Get loan length for an itemtype, a borrower type and a branch
1256
1257 =cut
1258
1259 sub GetLoanLength {
1260     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1261     my $dbh = C4::Context->dbh;
1262     my $sth =
1263       $dbh->prepare(
1264 'select issuelength, lengthunit from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null'
1265       );
1266 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1267 # try to find issuelength & return the 1st available.
1268 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1269     $sth->execute( $borrowertype, $itemtype, $branchcode );
1270     my $loanlength = $sth->fetchrow_hashref;
1271     return $loanlength
1272       if defined($loanlength) && $loanlength->{issuelength};
1273
1274     $sth->execute( $borrowertype, '*', $branchcode );
1275     $loanlength = $sth->fetchrow_hashref;
1276     return $loanlength
1277       if defined($loanlength) && $loanlength->{issuelength};
1278
1279     $sth->execute( '*', $itemtype, $branchcode );
1280     $loanlength = $sth->fetchrow_hashref;
1281     return $loanlength
1282       if defined($loanlength) && $loanlength->{issuelength};
1283
1284     $sth->execute( '*', '*', $branchcode );
1285     $loanlength = $sth->fetchrow_hashref;
1286     return $loanlength
1287       if defined($loanlength) && $loanlength->{issuelength};
1288
1289     $sth->execute( $borrowertype, $itemtype, '*' );
1290     $loanlength = $sth->fetchrow_hashref;
1291     return $loanlength
1292       if defined($loanlength) && $loanlength->{issuelength};
1293
1294     $sth->execute( $borrowertype, '*', '*' );
1295     $loanlength = $sth->fetchrow_hashref;
1296     return $loanlength
1297       if defined($loanlength) && $loanlength->{issuelength};
1298
1299     $sth->execute( '*', $itemtype, '*' );
1300     $loanlength = $sth->fetchrow_hashref;
1301     return $loanlength
1302       if defined($loanlength) && $loanlength->{issuelength};
1303
1304     $sth->execute( '*', '*', '*' );
1305     $loanlength = $sth->fetchrow_hashref;
1306     return $loanlength
1307       if defined($loanlength) && $loanlength->{issuelength};
1308
1309     # if no rule is set => 21 days (hardcoded)
1310     return {
1311         issuelength => 21,
1312         lengthunit => 'days',
1313     };
1314
1315 }
1316
1317
1318 =head2 GetHardDueDate
1319
1320   my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1321
1322 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1323
1324 =cut
1325
1326 sub GetHardDueDate {
1327     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1328
1329     my $rule = GetIssuingRule( $borrowertype, $itemtype, $branchcode );
1330
1331     if ( defined( $rule ) ) {
1332         if ( $rule->{hardduedate} ) {
1333             return (dt_from_string($rule->{hardduedate}, 'iso'),$rule->{hardduedatecompare});
1334         } else {
1335             return (undef, undef);
1336         }
1337     }
1338 }
1339
1340 =head2 GetIssuingRule
1341
1342   my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1343
1344 FIXME - This is a copy-paste of GetLoanLength
1345 as a stop-gap.  Do not wish to change API for GetLoanLength
1346 this close to release, however, Overdues::GetIssuingRules is broken.
1347
1348 Get the issuing rule for an itemtype, a borrower type and a branch
1349 Returns a hashref from the issuingrules table.
1350
1351 =cut
1352
1353 sub GetIssuingRule {
1354     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1355     my $dbh = C4::Context->dbh;
1356     my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"  );
1357     my $irule;
1358
1359         $sth->execute( $borrowertype, $itemtype, $branchcode );
1360     $irule = $sth->fetchrow_hashref;
1361     return $irule if defined($irule) ;
1362
1363     $sth->execute( $borrowertype, "*", $branchcode );
1364     $irule = $sth->fetchrow_hashref;
1365     return $irule if defined($irule) ;
1366
1367     $sth->execute( "*", $itemtype, $branchcode );
1368     $irule = $sth->fetchrow_hashref;
1369     return $irule if defined($irule) ;
1370
1371     $sth->execute( "*", "*", $branchcode );
1372     $irule = $sth->fetchrow_hashref;
1373     return $irule if defined($irule) ;
1374
1375     $sth->execute( $borrowertype, $itemtype, "*" );
1376     $irule = $sth->fetchrow_hashref;
1377     return $irule if defined($irule) ;
1378
1379     $sth->execute( $borrowertype, "*", "*" );
1380     $irule = $sth->fetchrow_hashref;
1381     return $irule if defined($irule) ;
1382
1383     $sth->execute( "*", $itemtype, "*" );
1384     $irule = $sth->fetchrow_hashref;
1385     return $irule if defined($irule) ;
1386
1387     $sth->execute( "*", "*", "*" );
1388     $irule = $sth->fetchrow_hashref;
1389     return $irule if defined($irule) ;
1390
1391     # if no rule matches,
1392     return undef;
1393 }
1394
1395 =head2 GetBranchBorrowerCircRule
1396
1397   my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1398
1399 Retrieves circulation rule attributes that apply to the given
1400 branch and patron category, regardless of item type.
1401 The return value is a hashref containing the following key:
1402
1403 maxissueqty - maximum number of loans that a
1404 patron of the given category can have at the given
1405 branch.  If the value is undef, no limit.
1406
1407 This will first check for a specific branch and
1408 category match from branch_borrower_circ_rules.
1409
1410 If no rule is found, it will then check default_branch_circ_rules
1411 (same branch, default category).  If no rule is found,
1412 it will then check default_borrower_circ_rules (default
1413 branch, same category), then failing that, default_circ_rules
1414 (default branch, default category).
1415
1416 If no rule has been found in the database, it will default to
1417 the buillt in rule:
1418
1419 maxissueqty - undef
1420
1421 C<$branchcode> and C<$categorycode> should contain the
1422 literal branch code and patron category code, respectively - no
1423 wildcards.
1424
1425 =cut
1426
1427 sub GetBranchBorrowerCircRule {
1428     my $branchcode = shift;
1429     my $categorycode = shift;
1430
1431     my $branch_cat_query = "SELECT maxissueqty
1432                             FROM branch_borrower_circ_rules
1433                             WHERE branchcode = ?
1434                             AND   categorycode = ?";
1435     my $dbh = C4::Context->dbh();
1436     my $sth = $dbh->prepare($branch_cat_query);
1437     $sth->execute($branchcode, $categorycode);
1438     my $result;
1439     if ($result = $sth->fetchrow_hashref()) {
1440         return $result;
1441     }
1442
1443     # try same branch, default borrower category
1444     my $branch_query = "SELECT maxissueqty
1445                         FROM default_branch_circ_rules
1446                         WHERE branchcode = ?";
1447     $sth = $dbh->prepare($branch_query);
1448     $sth->execute($branchcode);
1449     if ($result = $sth->fetchrow_hashref()) {
1450         return $result;
1451     }
1452
1453     # try default branch, same borrower category
1454     my $category_query = "SELECT maxissueqty
1455                           FROM default_borrower_circ_rules
1456                           WHERE categorycode = ?";
1457     $sth = $dbh->prepare($category_query);
1458     $sth->execute($categorycode);
1459     if ($result = $sth->fetchrow_hashref()) {
1460         return $result;
1461     }
1462
1463     # try default branch, default borrower category
1464     my $default_query = "SELECT maxissueqty
1465                           FROM default_circ_rules";
1466     $sth = $dbh->prepare($default_query);
1467     $sth->execute();
1468     if ($result = $sth->fetchrow_hashref()) {
1469         return $result;
1470     }
1471
1472     # built-in default circulation rule
1473     return {
1474         maxissueqty => undef,
1475     };
1476 }
1477
1478 =head2 GetBranchItemRule
1479
1480   my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1481
1482 Retrieves circulation rule attributes that apply to the given
1483 branch and item type, regardless of patron category.
1484
1485 The return value is a hashref containing the following keys:
1486
1487 holdallowed => Hold policy for this branch and itemtype. Possible values:
1488   0: No holds allowed.
1489   1: Holds allowed only by patrons that have the same homebranch as the item.
1490   2: Holds allowed from any patron.
1491
1492 returnbranch => branch to which to return item.  Possible values:
1493   noreturn: do not return, let item remain where checked in (floating collections)
1494   homebranch: return to item's home branch
1495
1496 This searches branchitemrules in the following order:
1497
1498   * Same branchcode and itemtype
1499   * Same branchcode, itemtype '*'
1500   * branchcode '*', same itemtype
1501   * branchcode and itemtype '*'
1502
1503 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1504
1505 =cut
1506
1507 sub GetBranchItemRule {
1508     my ( $branchcode, $itemtype ) = @_;
1509     my $dbh = C4::Context->dbh();
1510     my $result = {};
1511
1512     my @attempts = (
1513         ['SELECT holdallowed, returnbranch
1514             FROM branch_item_rules
1515             WHERE branchcode = ?
1516               AND itemtype = ?', $branchcode, $itemtype],
1517         ['SELECT holdallowed, returnbranch
1518             FROM default_branch_circ_rules
1519             WHERE branchcode = ?', $branchcode],
1520         ['SELECT holdallowed, returnbranch
1521             FROM default_branch_item_rules
1522             WHERE itemtype = ?', $itemtype],
1523         ['SELECT holdallowed, returnbranch
1524             FROM default_circ_rules'],
1525     );
1526
1527     foreach my $attempt (@attempts) {
1528         my ($query, @bind_params) = @{$attempt};
1529         my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1530           or next;
1531
1532         # Since branch/category and branch/itemtype use the same per-branch
1533         # defaults tables, we have to check that the key we want is set, not
1534         # just that a row was returned
1535         $result->{'holdallowed'}  = $search_result->{'holdallowed'}  unless ( defined $result->{'holdallowed'} );
1536         $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1537     }
1538
1539     # built-in default circulation rule
1540     $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1541     $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1542
1543     return $result;
1544 }
1545
1546 =head2 AddReturn
1547
1548   ($doreturn, $messages, $iteminformation, $borrower) =
1549       &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1550
1551 Returns a book.
1552
1553 =over 4
1554
1555 =item C<$barcode> is the bar code of the book being returned.
1556
1557 =item C<$branch> is the code of the branch where the book is being returned.
1558
1559 =item C<$exemptfine> indicates that overdue charges for the item will be
1560 removed.
1561
1562 =item C<$dropbox> indicates that the check-in date is assumed to be
1563 yesterday, or the last non-holiday as defined in C4::Calendar .  If
1564 overdue charges are applied and C<$dropbox> is true, the last charge
1565 will be removed.  This assumes that the fines accrual script has run
1566 for _today_.
1567
1568 =back
1569
1570 C<&AddReturn> returns a list of four items:
1571
1572 C<$doreturn> is true iff the return succeeded.
1573
1574 C<$messages> is a reference-to-hash giving feedback on the operation.
1575 The keys of the hash are:
1576
1577 =over 4
1578
1579 =item C<BadBarcode>
1580
1581 No item with this barcode exists. The value is C<$barcode>.
1582
1583 =item C<NotIssued>
1584
1585 The book is not currently on loan. The value is C<$barcode>.
1586
1587 =item C<IsPermanent>
1588
1589 The book's home branch is a permanent collection. If you have borrowed
1590 this book, you are not allowed to return it. The value is the code for
1591 the book's home branch.
1592
1593 =item C<wthdrawn>
1594
1595 This book has been withdrawn/cancelled. The value should be ignored.
1596
1597 =item C<Wrongbranch>
1598
1599 This book has was returned to the wrong branch.  The value is a hashref
1600 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1601 contain the branchcode of the incorrect and correct return library, respectively.
1602
1603 =item C<ResFound>
1604
1605 The item was reserved. The value is a reference-to-hash whose keys are
1606 fields from the reserves table of the Koha database, and
1607 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1608 either C<Waiting>, C<Reserved>, or 0.
1609
1610 =back
1611
1612 C<$iteminformation> is a reference-to-hash, giving information about the
1613 returned item from the issues table.
1614
1615 C<$borrower> is a reference-to-hash, giving information about the
1616 patron who last borrowed the book.
1617
1618 =cut
1619
1620 sub AddReturn {
1621     my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1622
1623     if ($branch and not GetBranchDetail($branch)) {
1624         warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
1625         undef $branch;
1626     }
1627     $branch = C4::Context->userenv->{'branch'} unless $branch;  # we trust userenv to be a safe fallback/default
1628     my $messages;
1629     my $borrower;
1630     my $biblio;
1631     my $doreturn       = 1;
1632     my $validTransfert = 0;
1633     my $stat_type = 'return';
1634
1635     # get information on item
1636     my $itemnumber = GetItemnumberFromBarcode( $barcode );
1637     unless ($itemnumber) {
1638         return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower.  bail out.
1639     }
1640     my $issue  = GetItemIssue($itemnumber);
1641 #   warn Dumper($iteminformation);
1642     if ($issue and $issue->{borrowernumber}) {
1643         $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1644             or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existant borrowernumber '$issue->{borrowernumber}'\n"
1645                 . Dumper($issue) . "\n";
1646     } else {
1647         $messages->{'NotIssued'} = $barcode;
1648         # even though item is not on loan, it may still be transferred;  therefore, get current branch info
1649         $doreturn = 0;
1650         # No issue, no borrowernumber.  ONLY if $doreturn, *might* you have a $borrower later.
1651         # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1652         if (C4::Context->preference("RecordLocalUseOnReturn")) {
1653            $messages->{'LocalUse'} = 1;
1654            $stat_type = 'localuse';
1655         }
1656     }
1657
1658     my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1659         # full item data, but no borrowernumber or checkout info (no issue)
1660         # we know GetItem should work because GetItemnumberFromBarcode worked
1661     my $hbr      = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1662         # get the proper branch to which to return the item
1663     $hbr = $item->{$hbr} || $branch ;
1664         # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1665
1666     my $borrowernumber = $borrower->{'borrowernumber'} || undef;    # we don't know if we had a borrower or not
1667
1668     # check if the book is in a permanent collection....
1669     # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
1670     if ( $hbr ) {
1671         my $branches = GetBranches();    # a potentially expensive call for a non-feature.
1672         $branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr;
1673     }
1674
1675     # check if the return is allowed at this branch
1676     my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1677     unless ($returnallowed){
1678         $messages->{'Wrongbranch'} = {
1679             Wrongbranch => $branch,
1680             Rightbranch => $message
1681         };
1682         $doreturn = 0;
1683         return ( $doreturn, $messages, $issue, $borrower );
1684     }
1685
1686     if ( $item->{'wthdrawn'} ) { # book has been cancelled
1687         $messages->{'wthdrawn'} = 1;
1688         $doreturn = 0;
1689     }
1690
1691     # case of a return of document (deal with issues and holdingbranch)
1692     my $today = DateTime->now( time_zone => C4::Context->tz() );
1693     if ($doreturn) {
1694     my $datedue = $issue->{date_due};
1695         $borrower or warn "AddReturn without current borrower";
1696                 my $circControlBranch;
1697         if ($dropbox) {
1698             # define circControlBranch only if dropbox mode is set
1699             # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1700             # FIXME: check issuedate > returndate, factoring in holidays
1701             #$circControlBranch = _GetCircControlBranch($item,$borrower) unless ( $item->{'issuedate'} eq C4::Dates->today('iso') );;
1702             $circControlBranch = _GetCircControlBranch($item,$borrower);
1703         $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $today ) == -1 ? 1 : 0;
1704         }
1705
1706         if ($borrowernumber) {
1707         if($issue->{'overdue'}){
1708                 my ( $amount, $type, $unitcounttotal ) = C4::Overdues::CalcFine( $item, $borrower->{categorycode},$branch, $datedue, $today );
1709                 $type ||= q{};
1710         if ( $amount > 0 && ( C4::Context->preference('finesMode') eq 'production' )) {
1711           C4::Overdues::UpdateFine(
1712               $issue->{itemnumber},
1713               $issue->{borrowernumber},
1714                       $amount, $type, output_pref($datedue)
1715               );
1716         }
1717             }
1718             MarkIssueReturned($borrowernumber, $item->{'itemnumber'}, $circControlBranch, '', $borrower->{'privacy'});
1719             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?  This could be the borrower hash.
1720         }
1721
1722         ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1723     }
1724
1725     # the holdingbranch is updated if the document is returned to another location.
1726     # this is always done regardless of whether the item was on loan or not
1727     if ($item->{'holdingbranch'} ne $branch) {
1728         UpdateHoldingbranch($branch, $item->{'itemnumber'});
1729         $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1730     }
1731     ModDateLastSeen( $item->{'itemnumber'} );
1732
1733     # check if we have a transfer for this document
1734     my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1735
1736     # if we have a transfer to do, we update the line of transfers with the datearrived
1737     if ($datesent) {
1738         if ( $tobranch eq $branch ) {
1739             my $sth = C4::Context->dbh->prepare(
1740                 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1741             );
1742             $sth->execute( $item->{'itemnumber'} );
1743             # if we have a reservation with valid transfer, we can set it's status to 'W'
1744             ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1745             C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1746         } else {
1747             $messages->{'WrongTransfer'}     = $tobranch;
1748             $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1749         }
1750         $validTransfert = 1;
1751     } else {
1752         ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1753     }
1754
1755     # fix up the accounts.....
1756     if ($item->{'itemlost'}) {
1757         _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode);    # can tolerate undef $borrowernumber
1758         $messages->{'WasLost'} = 1;
1759     }
1760
1761     # fix up the overdues in accounts...
1762     if ($borrowernumber) {
1763         my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1764         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!";  # zero is OK, check defined
1765
1766         if ( $issue->{overdue} && $issue->{date_due} ) {
1767 # fix fine days
1768             my $debardate =
1769               _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
1770             $messages->{Debarred} = $debardate if ($debardate);
1771         }
1772     }
1773
1774     # find reserves.....
1775     # if we don't have a reserve with the status W, we launch the Checkreserves routine
1776     my ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1777     if ($resfound) {
1778           $resrec->{'ResFound'} = $resfound;
1779         $messages->{'ResFound'} = $resrec;
1780     }
1781
1782     # update stats?
1783     # Record the fact that this book was returned.
1784     UpdateStats(
1785         $branch, $stat_type, '0', '',
1786         $item->{'itemnumber'},
1787         $biblio->{'itemtype'},
1788         $borrowernumber, undef, $item->{'ccode'}
1789     );
1790
1791     # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
1792     my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1793     my %conditions = (
1794         branchcode   => $branch,
1795         categorycode => $borrower->{categorycode},
1796         item_type    => $item->{itype},
1797         notification => 'CHECKIN',
1798     );
1799     if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
1800         SendCirculationAlert({
1801             type     => 'CHECKIN',
1802             item     => $item,
1803             borrower => $borrower,
1804             branch   => $branch,
1805         });
1806     }
1807
1808     logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'})
1809         if C4::Context->preference("ReturnLog");
1810
1811     # FIXME: make this comment intelligible.
1812     #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1813     #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1814
1815     if (($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $hbr) and not $messages->{'WrongTransfer'}){
1816         if ( C4::Context->preference("AutomaticItemReturn"    ) or
1817             (C4::Context->preference("UseBranchTransferLimits") and
1818              ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} )
1819            )) {
1820             $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
1821             $debug and warn "item: " . Dumper($item);
1822             ModItemTransfer($item->{'itemnumber'}, $branch, $hbr);
1823             $messages->{'WasTransfered'} = 1;
1824         } else {
1825             $messages->{'NeedsTransfer'} = 1;   # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
1826         }
1827     }
1828     return ( $doreturn, $messages, $issue, $borrower );
1829 }
1830
1831 =head2 MarkIssueReturned
1832
1833   MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
1834
1835 Unconditionally marks an issue as being returned by
1836 moving the C<issues> row to C<old_issues> and
1837 setting C<returndate> to the current date, or
1838 the last non-holiday date of the branccode specified in
1839 C<dropbox_branch> .  Assumes you've already checked that
1840 it's safe to do this, i.e. last non-holiday > issuedate.
1841
1842 if C<$returndate> is specified (in iso format), it is used as the date
1843 of the return. It is ignored when a dropbox_branch is passed in.
1844
1845 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
1846 the old_issue is immediately anonymised
1847
1848 Ideally, this function would be internal to C<C4::Circulation>,
1849 not exported, but it is currently needed by one
1850 routine in C<C4::Accounts>.
1851
1852 =cut
1853
1854 sub MarkIssueReturned {
1855     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
1856
1857     my $dbh   = C4::Context->dbh;
1858     my $query = 'UPDATE issues SET returndate=';
1859     my @bind;
1860     if ($dropbox_branch) {
1861         my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
1862         my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
1863         $query .= ' ? ';
1864         push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
1865     } elsif ($returndate) {
1866         $query .= ' ? ';
1867         push @bind, $returndate;
1868     } else {
1869         $query .= ' now() ';
1870     }
1871     $query .= ' WHERE  borrowernumber = ?  AND itemnumber = ?';
1872     push @bind, $borrowernumber, $itemnumber;
1873     # FIXME transaction
1874     my $sth_upd  = $dbh->prepare($query);
1875     $sth_upd->execute(@bind);
1876     my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
1877                                   WHERE borrowernumber = ?
1878                                   AND itemnumber = ?');
1879     $sth_copy->execute($borrowernumber, $itemnumber);
1880     # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
1881     if ( $privacy == 2) {
1882         # The default of 0 does not work due to foreign key constraints
1883         # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
1884         my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
1885         my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
1886                                   WHERE borrowernumber = ?
1887                                   AND itemnumber = ?");
1888        $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
1889     }
1890     my $sth_del  = $dbh->prepare("DELETE FROM issues
1891                                   WHERE borrowernumber = ?
1892                                   AND itemnumber = ?");
1893     $sth_del->execute($borrowernumber, $itemnumber);
1894 }
1895
1896 =head2 _debar_user_on_return
1897
1898     _debar_user_on_return($borrower, $item, $datedue, today);
1899
1900 C<$borrower> borrower hashref
1901
1902 C<$item> item hashref
1903
1904 C<$datedue> date due DateTime object
1905
1906 C<$today> DateTime object representing the return time
1907
1908 Internal function, called only by AddReturn that calculates and updates
1909  the user fine days, and debars him if necessary.
1910
1911 Should only be called for overdue returns
1912
1913 =cut
1914
1915 sub _debar_user_on_return {
1916     my ( $borrower, $item, $dt_due, $dt_today ) = @_;
1917
1918     my $branchcode = _GetCircControlBranch( $item, $borrower );
1919     my $calendar = Koha::Calendar->new( branchcode => $branchcode );
1920
1921     # $deltadays is a DateTime::Duration object
1922     my $deltadays = $calendar->days_between( $dt_due, $dt_today );
1923
1924     my $circcontrol = C4::Context::preference('CircControl');
1925     my $issuingrule =
1926       GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
1927     my $finedays = $issuingrule->{finedays};
1928     my $unit     = $issuingrule->{lengthunit};
1929
1930     if ($finedays) {
1931
1932         # finedays is in days, so hourly loans must multiply by 24
1933         # thus 1 hour late equals 1 day suspension * finedays rate
1934         $finedays = $finedays * 24 if ( $unit eq 'hours' );
1935
1936         # grace period is measured in the same units as the loan
1937         my $grace =
1938           DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
1939         if ( $deltadays->subtract($grace)->is_positive() ) {
1940
1941             my $new_debar_dt =
1942               $dt_today->clone()->add_duration( $deltadays * $finedays );
1943             if ( $borrower->{debarred} ) {
1944                 my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
1945
1946                 # Update patron only if new date > old
1947                 if ( DateTime->compare( $borrower_debar_dt, $new_debar_dt ) !=
1948                     -1 )
1949                 {
1950                     return;
1951                 }
1952
1953             }
1954             C4::Members::DebarMember( $borrower->{borrowernumber},
1955                 $new_debar_dt->ymd() );
1956             return $new_debar_dt->ymd();
1957         }
1958     }
1959     return;
1960 }
1961
1962 =head2 _FixOverduesOnReturn
1963
1964    &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1965
1966 C<$brn> borrowernumber
1967
1968 C<$itm> itemnumber
1969
1970 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1971 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1972
1973 Internal function, called only by AddReturn
1974
1975 =cut
1976
1977 sub _FixOverduesOnReturn {
1978     my ($borrowernumber, $item);
1979     unless ($borrowernumber = shift) {
1980         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
1981         return;
1982     }
1983     unless ($item = shift) {
1984         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
1985         return;
1986     }
1987     my ($exemptfine, $dropbox) = @_;
1988     my $dbh = C4::Context->dbh;
1989
1990     # check for overdue fine
1991     my $sth = $dbh->prepare(
1992 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1993     );
1994     $sth->execute( $borrowernumber, $item );
1995
1996     # alter fine to show that the book has been returned
1997     my $data = $sth->fetchrow_hashref;
1998     return 0 unless $data;    # no warning, there's just nothing to fix
1999
2000     my $uquery;
2001     my @bind = ($data->{'accountlines_id'});
2002     if ($exemptfine) {
2003         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2004         if (C4::Context->preference("FinesLog")) {
2005             &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2006         }
2007     } elsif ($dropbox && $data->{lastincrement}) {
2008         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2009         my $amt = $data->{amount} - $data->{lastincrement} ;
2010         if (C4::Context->preference("FinesLog")) {
2011             &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2012         }
2013          $uquery = "update accountlines set accounttype='F' ";
2014          if($outstanding  >= 0 && $amt >=0) {
2015             $uquery .= ", amount = ? , amountoutstanding=? ";
2016             unshift @bind, ($amt, $outstanding) ;
2017         }
2018     } else {
2019         $uquery = "update accountlines set accounttype='F' ";
2020     }
2021     $uquery .= " where (accountlines_id = ?)";
2022     my $usth = $dbh->prepare($uquery);
2023     return $usth->execute(@bind);
2024 }
2025
2026 =head2 _FixAccountForLostAndReturned
2027
2028   &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2029
2030 Calculates the charge for a book lost and returned.
2031
2032 Internal function, not exported, called only by AddReturn.
2033
2034 FIXME: This function reflects how inscrutable fines logic is.  Fix both.
2035 FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.
2036
2037 =cut
2038
2039 sub _FixAccountForLostAndReturned {
2040     my $itemnumber     = shift or return;
2041     my $borrowernumber = @_ ? shift : undef;
2042     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
2043     my $dbh = C4::Context->dbh;
2044     # check for charge made for lost book
2045     my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2046     $sth->execute($itemnumber);
2047     my $data = $sth->fetchrow_hashref;
2048     $data or return;    # bail if there is nothing to do
2049     $data->{accounttype} eq 'W' and return;    # Written off
2050
2051     # writeoff this amount
2052     my $offset;
2053     my $amount = $data->{'amount'};
2054     my $acctno = $data->{'accountno'};
2055     my $amountleft;                                             # Starts off undef/zero.
2056     if ($data->{'amountoutstanding'} == $amount) {
2057         $offset     = $data->{'amount'};
2058         $amountleft = 0;                                        # Hey, it's zero here, too.
2059     } else {
2060         $offset     = $amount - $data->{'amountoutstanding'};   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2061         $amountleft = $data->{'amountoutstanding'} - $amount;   # Um, isn't this the same as ZERO?  We just tested those two things are ==
2062     }
2063     my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2064         WHERE (accountlines_id = ?)");
2065     $usth->execute($data->{'accountlines_id'});      # We might be adjusting an account for some OTHER borrowernumber now.  Not the one we passed in.
2066     #check if any credit is left if so writeoff other accounts
2067     my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2068     $amountleft *= -1 if ($amountleft < 0);
2069     if ($amountleft > 0) {
2070         my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2071                             AND (amountoutstanding >0) ORDER BY date");     # might want to order by amountoustanding ASC (pay smallest first)
2072         $msth->execute($data->{'borrowernumber'});
2073         # offset transactions
2074         my $newamtos;
2075         my $accdata;
2076         while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2077             if ($accdata->{'amountoutstanding'} < $amountleft) {
2078                 $newamtos = 0;
2079                 $amountleft -= $accdata->{'amountoutstanding'};
2080             }  else {
2081                 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2082                 $amountleft = 0;
2083             }
2084             my $thisacct = $accdata->{'accountlines_id'};
2085             # FIXME: move prepares outside while loop!
2086             my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2087                     WHERE (accountlines_id = ?)");
2088             $usth->execute($newamtos,'$thisacct');    # FIXME: '$thisacct' is a string literal!
2089             $usth = $dbh->prepare("INSERT INTO accountoffsets
2090                 (borrowernumber, accountno, offsetaccount,  offsetamount)
2091                 VALUES
2092                 (?,?,?,?)");
2093             $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2094         }
2095         $msth->finish;  # $msth might actually have data left
2096     }
2097     $amountleft *= -1 if ($amountleft > 0);
2098     my $desc = "Item Returned " . $item_id;
2099     $usth = $dbh->prepare("INSERT INTO accountlines
2100         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2101         VALUES (?,?,now(),?,?,'CR',?)");
2102     $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2103     if ($borrowernumber) {
2104         # FIXME: same as query above.  use 1 sth for both
2105         $usth = $dbh->prepare("INSERT INTO accountoffsets
2106             (borrowernumber, accountno, offsetaccount,  offsetamount)
2107             VALUES (?,?,?,?)");
2108         $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2109     }
2110     ModItem({ paidfor => '' }, undef, $itemnumber);
2111     return;
2112 }
2113
2114 =head2 _GetCircControlBranch
2115
2116    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2117
2118 Internal function :
2119
2120 Return the library code to be used to determine which circulation
2121 policy applies to a transaction.  Looks up the CircControl and
2122 HomeOrHoldingBranch system preferences.
2123
2124 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2125
2126 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2127
2128 =cut
2129
2130 sub _GetCircControlBranch {
2131     my ($item, $borrower) = @_;
2132     my $circcontrol = C4::Context->preference('CircControl');
2133     my $branch;
2134
2135     if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2136         $branch= C4::Context->userenv->{'branch'};
2137     } elsif ($circcontrol eq 'PatronLibrary') {
2138         $branch=$borrower->{branchcode};
2139     } else {
2140         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2141         $branch = $item->{$branchfield};
2142         # default to item home branch if holdingbranch is used
2143         # and is not defined
2144         if (!defined($branch) && $branchfield eq 'holdingbranch') {
2145             $branch = $item->{homebranch};
2146         }
2147     }
2148     return $branch;
2149 }
2150
2151
2152
2153
2154
2155
2156 =head2 GetItemIssue
2157
2158   $issue = &GetItemIssue($itemnumber);
2159
2160 Returns patron currently having a book, or undef if not checked out.
2161
2162 C<$itemnumber> is the itemnumber.
2163
2164 C<$issue> is a hashref of the row from the issues table.
2165
2166 =cut
2167
2168 sub GetItemIssue {
2169     my ($itemnumber) = @_;
2170     return unless $itemnumber;
2171     my $sth = C4::Context->dbh->prepare(
2172         "SELECT *
2173         FROM issues
2174         LEFT JOIN items ON issues.itemnumber=items.itemnumber
2175         WHERE issues.itemnumber=?");
2176     $sth->execute($itemnumber);
2177     my $data = $sth->fetchrow_hashref;
2178     return unless $data;
2179     $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2180     $data->{issuedate}->truncate(to => 'minute');
2181     $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2182     $data->{date_due}->truncate(to => 'minute');
2183     my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2184     $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2185     return $data;
2186 }
2187
2188 =head2 GetOpenIssue
2189
2190   $issue = GetOpenIssue( $itemnumber );
2191
2192 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2193
2194 C<$itemnumber> is the item's itemnumber
2195
2196 Returns a hashref
2197
2198 =cut
2199
2200 sub GetOpenIssue {
2201   my ( $itemnumber ) = @_;
2202
2203   my $dbh = C4::Context->dbh;
2204   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2205   $sth->execute( $itemnumber );
2206   my $issue = $sth->fetchrow_hashref();
2207   return $issue;
2208 }
2209
2210 =head2 GetItemIssues
2211
2212   $issues = &GetItemIssues($itemnumber, $history);
2213
2214 Returns patrons that have issued a book
2215
2216 C<$itemnumber> is the itemnumber
2217 C<$history> is false if you just want the current "issuer" (if any)
2218 and true if you want issues history from old_issues also.
2219
2220 Returns reference to an array of hashes
2221
2222 =cut
2223
2224 sub GetItemIssues {
2225     my ( $itemnumber, $history ) = @_;
2226
2227     my $today = DateTime->now( time_zome => C4::Context->tz);  # get today date
2228     $today->truncate( to => 'minute' );
2229     my $sql = "SELECT * FROM issues
2230               JOIN borrowers USING (borrowernumber)
2231               JOIN items     USING (itemnumber)
2232               WHERE issues.itemnumber = ? ";
2233     if ($history) {
2234         $sql .= "UNION ALL
2235                  SELECT * FROM old_issues
2236                  LEFT JOIN borrowers USING (borrowernumber)
2237                  JOIN items USING (itemnumber)
2238                  WHERE old_issues.itemnumber = ? ";
2239     }
2240     $sql .= "ORDER BY date_due DESC";
2241     my $sth = C4::Context->dbh->prepare($sql);
2242     if ($history) {
2243         $sth->execute($itemnumber, $itemnumber);
2244     } else {
2245         $sth->execute($itemnumber);
2246     }
2247     my $results = $sth->fetchall_arrayref({});
2248     foreach (@$results) {
2249         my $date_due = dt_from_string($_->{date_due},'sql');
2250         $date_due->truncate( to => 'minute' );
2251
2252         $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2253     }
2254     return $results;
2255 }
2256
2257 =head2 GetBiblioIssues
2258
2259   $issues = GetBiblioIssues($biblionumber);
2260
2261 this function get all issues from a biblionumber.
2262
2263 Return:
2264 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2265 tables issues and the firstname,surname & cardnumber from borrowers.
2266
2267 =cut
2268
2269 sub GetBiblioIssues {
2270     my $biblionumber = shift;
2271     return undef unless $biblionumber;
2272     my $dbh   = C4::Context->dbh;
2273     my $query = "
2274         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2275         FROM issues
2276             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2277             LEFT JOIN items ON issues.itemnumber = items.itemnumber
2278             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2279             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2280         WHERE biblio.biblionumber = ?
2281         UNION ALL
2282         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2283         FROM old_issues
2284             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2285             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2286             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2287             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2288         WHERE biblio.biblionumber = ?
2289         ORDER BY timestamp
2290     ";
2291     my $sth = $dbh->prepare($query);
2292     $sth->execute($biblionumber, $biblionumber);
2293
2294     my @issues;
2295     while ( my $data = $sth->fetchrow_hashref ) {
2296         push @issues, $data;
2297     }
2298     return \@issues;
2299 }
2300
2301 =head2 GetUpcomingDueIssues
2302
2303   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2304
2305 =cut
2306
2307 sub GetUpcomingDueIssues {
2308     my $params = shift;
2309
2310     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2311     my $dbh = C4::Context->dbh;
2312
2313     my $statement = <<END_SQL;
2314 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2315 FROM issues
2316 LEFT JOIN items USING (itemnumber)
2317 LEFT OUTER JOIN branches USING (branchcode)
2318 WhERE returndate is NULL
2319 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
2320 END_SQL
2321
2322     my @bind_parameters = ( $params->{'days_in_advance'} );
2323
2324     my $sth = $dbh->prepare( $statement );
2325     $sth->execute( @bind_parameters );
2326     my $upcoming_dues = $sth->fetchall_arrayref({});
2327     $sth->finish;
2328
2329     return $upcoming_dues;
2330 }
2331
2332 =head2 CanBookBeRenewed
2333
2334   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2335
2336 Find out whether a borrowed item may be renewed.
2337
2338 C<$dbh> is a DBI handle to the Koha database.
2339
2340 C<$borrowernumber> is the borrower number of the patron who currently
2341 has the item on loan.
2342
2343 C<$itemnumber> is the number of the item to renew.
2344
2345 C<$override_limit>, if supplied with a true value, causes
2346 the limit on the number of times that the loan can be renewed
2347 (as controlled by the item type) to be ignored.
2348
2349 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
2350 item must currently be on loan to the specified borrower; renewals
2351 must be allowed for the item's type; and the borrower must not have
2352 already renewed the loan. $error will contain the reason the renewal can not proceed
2353
2354 =cut
2355
2356 sub CanBookBeRenewed {
2357
2358     # check renewal status
2359     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2360     my $dbh       = C4::Context->dbh;
2361     my $renews    = 1;
2362     my $renewokay = 0;
2363         my $error;
2364
2365     # Look in the issues table for this item, lent to this borrower,
2366     # and not yet returned.
2367
2368     # Look in the issues table for this item, lent to this borrower,
2369     # and not yet returned.
2370     my %branch = (
2371             'ItemHomeLibrary' => 'items.homebranch',
2372             'PickupLibrary'   => 'items.holdingbranch',
2373             'PatronLibrary'   => 'borrowers.branchcode'
2374             );
2375     my $controlbranch = $branch{C4::Context->preference('CircControl')};
2376     my $itype         = C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype';
2377
2378     my $sthcount = $dbh->prepare("
2379                    SELECT
2380                     borrowers.categorycode, biblioitems.itemtype, issues.renewals, renewalsallowed, $controlbranch
2381                    FROM  issuingrules,
2382                    issues
2383                    LEFT JOIN items USING (itemnumber)
2384                    LEFT JOIN borrowers USING (borrowernumber)
2385                    LEFT JOIN biblioitems USING (biblioitemnumber)
2386
2387                    WHERE
2388                     (issuingrules.categorycode = borrowers.categorycode OR issuingrules.categorycode = '*')
2389                    AND
2390                     (issuingrules.itemtype = $itype OR issuingrules.itemtype = '*')
2391                    AND
2392                     (issuingrules.branchcode = $controlbranch OR issuingrules.branchcode = '*')
2393                    AND
2394                     borrowernumber = ?
2395                    AND
2396                     itemnumber = ?
2397                    ORDER BY
2398                     issuingrules.categorycode desc,
2399                     issuingrules.itemtype desc,
2400                     issuingrules.branchcode desc
2401                    LIMIT 1;
2402                   ");
2403
2404     $sthcount->execute( $borrowernumber, $itemnumber );
2405     if ( my $data1 = $sthcount->fetchrow_hashref ) {
2406
2407         if ( ( $data1->{renewalsallowed} && $data1->{renewalsallowed} > $data1->{renewals} ) || $override_limit ) {
2408             $renewokay = 1;
2409         }
2410         else {
2411                         $error="too_many";
2412                 }
2413
2414         my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2415         if ($resfound) {
2416             $renewokay = 0;
2417                         $error="on_reserve"
2418         }
2419
2420     }
2421     return ($renewokay,$error);
2422 }
2423
2424 =head2 AddRenewal
2425
2426   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2427
2428 Renews a loan.
2429
2430 C<$borrowernumber> is the borrower number of the patron who currently
2431 has the item.
2432
2433 C<$itemnumber> is the number of the item to renew.
2434
2435 C<$branch> is the library where the renewal took place (if any).
2436            The library that controls the circ policies for the renewal is retrieved from the issues record.
2437
2438 C<$datedue> can be a C4::Dates object used to set the due date.
2439
2440 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2441 this parameter is not supplied, lastreneweddate is set to the current date.
2442
2443 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2444 from the book's item type.
2445
2446 =cut
2447
2448 sub AddRenewal {
2449     my $borrowernumber  = shift or return undef;
2450     my $itemnumber      = shift or return undef;
2451     my $branch          = shift;
2452     my $datedue         = shift;
2453     my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2454     my $item   = GetItem($itemnumber) or return undef;
2455     my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
2456
2457     my $dbh = C4::Context->dbh;
2458     # Find the issues record for this book
2459     my $sth =
2460       $dbh->prepare("SELECT * FROM issues
2461                         WHERE borrowernumber=?
2462                         AND itemnumber=?"
2463       );
2464     $sth->execute( $borrowernumber, $itemnumber );
2465     my $issuedata = $sth->fetchrow_hashref;
2466     $sth->finish;
2467     if(defined $datedue && ref $datedue ne 'DateTime' ) {
2468         carp 'Invalid date passed to AddRenewal.';
2469         return;
2470     }
2471     # If the due date wasn't specified, calculate it by adding the
2472     # book's loan length to today's date or the current due date
2473     # based on the value of the RenewalPeriodBase syspref.
2474     unless ($datedue) {
2475
2476         my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return undef;
2477         my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2478
2479         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2480                                         $issuedata->{date_due} :
2481                                         DateTime->now( time_zone => C4::Context->tz());
2482         $datedue =  CalcDateDue($datedue,$itemtype,$issuedata->{'branchcode'},$borrower);
2483     }
2484
2485     # Update the issues record to have the new due date, and a new count
2486     # of how many times it has been renewed.
2487     my $renews = $issuedata->{'renewals'} + 1;
2488     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2489                             WHERE borrowernumber=?
2490                             AND itemnumber=?"
2491     );
2492
2493     $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2494     $sth->finish;
2495
2496     # Update the renewal count on the item, and tell zebra to reindex
2497     $renews = $biblio->{'renewals'} + 1;
2498     ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2499
2500     # Charge a new rental fee, if applicable?
2501     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2502     if ( $charge > 0 ) {
2503         my $accountno = getnextacctno( $borrowernumber );
2504         my $item = GetBiblioFromItemNumber($itemnumber);
2505         my $manager_id = 0;
2506         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2507         $sth = $dbh->prepare(
2508                 "INSERT INTO accountlines
2509                     (date, borrowernumber, accountno, amount, manager_id,
2510                     description,accounttype, amountoutstanding, itemnumber)
2511                     VALUES (now(),?,?,?,?,?,?,?,?)"
2512         );
2513         $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2514             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2515             'Rent', $charge, $itemnumber );
2516     }
2517     # Log the renewal
2518     UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'});
2519         return $datedue;
2520 }
2521
2522 sub GetRenewCount {
2523     # check renewal status
2524     my ( $bornum, $itemno ) = @_;
2525     my $dbh           = C4::Context->dbh;
2526     my $renewcount    = 0;
2527     my $renewsallowed = 0;
2528     my $renewsleft    = 0;
2529
2530     my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
2531     my $item     = GetItem($itemno);
2532
2533     # Look in the issues table for this item, lent to this borrower,
2534     # and not yet returned.
2535
2536     # FIXME - I think this function could be redone to use only one SQL call.
2537     my $sth = $dbh->prepare(
2538         "select * from issues
2539                                 where (borrowernumber = ?)
2540                                 and (itemnumber = ?)"
2541     );
2542     $sth->execute( $bornum, $itemno );
2543     my $data = $sth->fetchrow_hashref;
2544     $renewcount = $data->{'renewals'} if $data->{'renewals'};
2545     $sth->finish;
2546     # $item and $borrower should be calculated
2547     my $branchcode = _GetCircControlBranch($item, $borrower);
2548
2549     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2550
2551     $renewsallowed = $issuingrule->{'renewalsallowed'};
2552     $renewsleft    = $renewsallowed - $renewcount;
2553     if($renewsleft < 0){ $renewsleft = 0; }
2554     return ( $renewcount, $renewsallowed, $renewsleft );
2555 }
2556
2557 =head2 GetIssuingCharges
2558
2559   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2560
2561 Calculate how much it would cost for a given patron to borrow a given
2562 item, including any applicable discounts.
2563
2564 C<$itemnumber> is the item number of item the patron wishes to borrow.
2565
2566 C<$borrowernumber> is the patron's borrower number.
2567
2568 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2569 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2570 if it's a video).
2571
2572 =cut
2573
2574 sub GetIssuingCharges {
2575
2576     # calculate charges due
2577     my ( $itemnumber, $borrowernumber ) = @_;
2578     my $charge = 0;
2579     my $dbh    = C4::Context->dbh;
2580     my $item_type;
2581
2582     # Get the book's item type and rental charge (via its biblioitem).
2583     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
2584         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
2585     $charge_query .= (C4::Context->preference('item-level_itypes'))
2586         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
2587         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
2588
2589     $charge_query .= ' WHERE items.itemnumber =?';
2590
2591     my $sth = $dbh->prepare($charge_query);
2592     $sth->execute($itemnumber);
2593     if ( my $item_data = $sth->fetchrow_hashref ) {
2594         $item_type = $item_data->{itemtype};
2595         $charge    = $item_data->{rentalcharge};
2596         my $branch = C4::Branch::mybranch();
2597         my $discount_query = q|SELECT rentaldiscount,
2598             issuingrules.itemtype, issuingrules.branchcode
2599             FROM borrowers
2600             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2601             WHERE borrowers.borrowernumber = ?
2602             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
2603             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
2604         my $discount_sth = $dbh->prepare($discount_query);
2605         $discount_sth->execute( $borrowernumber, $item_type, $branch );
2606         my $discount_rules = $discount_sth->fetchall_arrayref({});
2607         if (@{$discount_rules}) {
2608             # We may have multiple rules so get the most specific
2609             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
2610             $charge = ( $charge * ( 100 - $discount ) ) / 100;
2611         }
2612     }
2613
2614     $sth->finish; # we havent _explicitly_ fetched all rows
2615     return ( $charge, $item_type );
2616 }
2617
2618 # Select most appropriate discount rule from those returned
2619 sub _get_discount_from_rule {
2620     my ($rules_ref, $branch, $itemtype) = @_;
2621     my $discount;
2622
2623     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
2624         $discount = $rules_ref->[0]->{rentaldiscount};
2625         return (defined $discount) ? $discount : 0;
2626     }
2627     # could have up to 4 does one match $branch and $itemtype
2628     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
2629     if (@d) {
2630         $discount = $d[0]->{rentaldiscount};
2631         return (defined $discount) ? $discount : 0;
2632     }
2633     # do we have item type + all branches
2634     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
2635     if (@d) {
2636         $discount = $d[0]->{rentaldiscount};
2637         return (defined $discount) ? $discount : 0;
2638     }
2639     # do we all item types + this branch
2640     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
2641     if (@d) {
2642         $discount = $d[0]->{rentaldiscount};
2643         return (defined $discount) ? $discount : 0;
2644     }
2645     # so all and all (surely we wont get here)
2646     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
2647     if (@d) {
2648         $discount = $d[0]->{rentaldiscount};
2649         return (defined $discount) ? $discount : 0;
2650     }
2651     # none of the above
2652     return 0;
2653 }
2654
2655 =head2 AddIssuingCharge
2656
2657   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2658
2659 =cut
2660
2661 sub AddIssuingCharge {
2662     my ( $itemnumber, $borrowernumber, $charge ) = @_;
2663     my $dbh = C4::Context->dbh;
2664     my $nextaccntno = getnextacctno( $borrowernumber );
2665     my $manager_id = 0;
2666     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2667     my $query ="
2668         INSERT INTO accountlines
2669             (borrowernumber, itemnumber, accountno,
2670             date, amount, description, accounttype,
2671             amountoutstanding, manager_id)
2672         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
2673     ";
2674     my $sth = $dbh->prepare($query);
2675     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
2676     $sth->finish;
2677 }
2678
2679 =head2 GetTransfers
2680
2681   GetTransfers($itemnumber);
2682
2683 =cut
2684
2685 sub GetTransfers {
2686     my ($itemnumber) = @_;
2687
2688     my $dbh = C4::Context->dbh;
2689
2690     my $query = '
2691         SELECT datesent,
2692                frombranch,
2693                tobranch
2694         FROM branchtransfers
2695         WHERE itemnumber = ?
2696           AND datearrived IS NULL
2697         ';
2698     my $sth = $dbh->prepare($query);
2699     $sth->execute($itemnumber);
2700     my @row = $sth->fetchrow_array();
2701     $sth->finish;
2702     return @row;
2703 }
2704
2705 =head2 GetTransfersFromTo
2706
2707   @results = GetTransfersFromTo($frombranch,$tobranch);
2708
2709 Returns the list of pending transfers between $from and $to branch
2710
2711 =cut
2712
2713 sub GetTransfersFromTo {
2714     my ( $frombranch, $tobranch ) = @_;
2715     return unless ( $frombranch && $tobranch );
2716     my $dbh   = C4::Context->dbh;
2717     my $query = "
2718         SELECT itemnumber,datesent,frombranch
2719         FROM   branchtransfers
2720         WHERE  frombranch=?
2721           AND  tobranch=?
2722           AND datearrived IS NULL
2723     ";
2724     my $sth = $dbh->prepare($query);
2725     $sth->execute( $frombranch, $tobranch );
2726     my @gettransfers;
2727
2728     while ( my $data = $sth->fetchrow_hashref ) {
2729         push @gettransfers, $data;
2730     }
2731     $sth->finish;
2732     return (@gettransfers);
2733 }
2734
2735 =head2 DeleteTransfer
2736
2737   &DeleteTransfer($itemnumber);
2738
2739 =cut
2740
2741 sub DeleteTransfer {
2742     my ($itemnumber) = @_;
2743     my $dbh          = C4::Context->dbh;
2744     my $sth          = $dbh->prepare(
2745         "DELETE FROM branchtransfers
2746          WHERE itemnumber=?
2747          AND datearrived IS NULL "
2748     );
2749     $sth->execute($itemnumber);
2750     $sth->finish;
2751 }
2752
2753 =head2 AnonymiseIssueHistory
2754
2755   $rows = AnonymiseIssueHistory($date,$borrowernumber)
2756
2757 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2758 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2759
2760 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
2761 setting (force delete).
2762
2763 return the number of affected rows.
2764
2765 =cut
2766
2767 sub AnonymiseIssueHistory {
2768     my $date           = shift;
2769     my $borrowernumber = shift;
2770     my $dbh            = C4::Context->dbh;
2771     my $query          = "
2772         UPDATE old_issues
2773         SET    borrowernumber = ?
2774         WHERE  returndate < ?
2775           AND borrowernumber IS NOT NULL
2776     ";
2777
2778     # The default of 0 does not work due to foreign key constraints
2779     # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
2780     my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
2781     my @bind_params = ($anonymouspatron, $date);
2782     if (defined $borrowernumber) {
2783        $query .= " AND borrowernumber = ?";
2784        push @bind_params, $borrowernumber;
2785     } else {
2786        $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
2787     }
2788     my $sth = $dbh->prepare($query);
2789     $sth->execute(@bind_params);
2790     my $rows_affected = $sth->rows;  ### doublecheck row count return function
2791     return $rows_affected;
2792 }
2793
2794 =head2 SendCirculationAlert
2795
2796 Send out a C<check-in> or C<checkout> alert using the messaging system.
2797
2798 B<Parameters>:
2799
2800 =over 4
2801
2802 =item type
2803
2804 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
2805
2806 =item item
2807
2808 Hashref of information about the item being checked in or out.
2809
2810 =item borrower
2811
2812 Hashref of information about the borrower of the item.
2813
2814 =item branch
2815
2816 The branchcode from where the checkout or check-in took place.
2817
2818 =back
2819
2820 B<Example>:
2821
2822     SendCirculationAlert({
2823         type     => 'CHECKOUT',
2824         item     => $item,
2825         borrower => $borrower,
2826         branch   => $branch,
2827     });
2828
2829 =cut
2830
2831 sub SendCirculationAlert {
2832     my ($opts) = @_;
2833     my ($type, $item, $borrower, $branch) =
2834         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
2835     my %message_name = (
2836         CHECKIN  => 'Item_Check_in',
2837         CHECKOUT => 'Item_Checkout',
2838     );
2839     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
2840         borrowernumber => $borrower->{borrowernumber},
2841         message_name   => $message_name{$type},
2842     });
2843     my $issues_table = ( $type eq 'CHECKOUT' ) ? 'issues' : 'old_issues';
2844     my $letter =  C4::Letters::GetPreparedLetter (
2845         module => 'circulation',
2846         letter_code => $type,
2847         branchcode => $branch,
2848         tables => {
2849             $issues_table => $item->{itemnumber},
2850             'items'       => $item->{itemnumber},
2851             'biblio'      => $item->{biblionumber},
2852             'biblioitems' => $item->{biblionumber},
2853             'borrowers'   => $borrower,
2854             'branches'    => $branch,
2855         }
2856     ) or return;
2857
2858     my @transports = keys %{ $borrower_preferences->{transports} };
2859     # warn "no transports" unless @transports;
2860     for (@transports) {
2861         # warn "transport: $_";
2862         my $message = C4::Message->find_last_message($borrower, $type, $_);
2863         if (!$message) {
2864             #warn "create new message";
2865             C4::Message->enqueue($letter, $borrower, $_);
2866         } else {
2867             #warn "append to old message";
2868             $message->append($letter);
2869             $message->update;
2870         }
2871     }
2872
2873     return $letter;
2874 }
2875
2876 =head2 updateWrongTransfer
2877
2878   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2879
2880 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
2881
2882 =cut
2883
2884 sub updateWrongTransfer {
2885         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2886         my $dbh = C4::Context->dbh;
2887 # first step validate the actual line of transfert .
2888         my $sth =
2889                 $dbh->prepare(
2890                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2891                 );
2892                 $sth->execute($FromLibrary,$itemNumber);
2893                 $sth->finish;
2894
2895 # second step create a new line of branchtransfer to the right location .
2896         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2897
2898 #third step changing holdingbranch of item
2899         UpdateHoldingbranch($FromLibrary,$itemNumber);
2900 }
2901
2902 =head2 UpdateHoldingbranch
2903
2904   $items = UpdateHoldingbranch($branch,$itmenumber);
2905
2906 Simple methode for updating hodlingbranch in items BDD line
2907
2908 =cut
2909
2910 sub UpdateHoldingbranch {
2911         my ( $branch,$itemnumber ) = @_;
2912     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2913 }
2914
2915 =head2 CalcDateDue
2916
2917 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
2918
2919 this function calculates the due date given the start date and configured circulation rules,
2920 checking against the holidays calendar as per the 'useDaysMode' syspref.
2921 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2922 C<$itemtype>  = itemtype code of item in question
2923 C<$branch>  = location whose calendar to use
2924 C<$borrower> = Borrower object
2925
2926 =cut
2927
2928 sub CalcDateDue {
2929     my ( $startdate, $itemtype, $branch, $borrower ) = @_;
2930
2931     # loanlength now a href
2932     my $loanlength =
2933       GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
2934
2935     my $datedue;
2936
2937     # if globalDueDate ON the datedue is set to that date
2938     if (C4::Context->preference('globalDueDate')
2939         && ( C4::Context->preference('globalDueDate') =~
2940             C4::Dates->regexp('syspref') )
2941       ) {
2942         $datedue = dt_from_string(
2943             C4::Context->preference('globalDueDate'),
2944             C4::Context->preference('dateformat')
2945         );
2946     } else {
2947
2948         # otherwise, calculate the datedue as normal
2949         if ( C4::Context->preference('useDaysMode') eq 'Days' )
2950         {    # ignoring calendar
2951             my $dt =
2952               DateTime->now( time_zone => C4::Context->tz() )
2953               ->truncate( to => 'minute' );
2954             if ( $loanlength->{lengthunit} eq 'hours' ) {
2955                 $dt->add( hours => $loanlength->{issuelength} );
2956                 return $dt;
2957             } else {    # days
2958                 $dt->add( days => $loanlength->{issuelength} );
2959                 $dt->set_hour(23);
2960                 $dt->set_minute(59);
2961                 return $dt;
2962             }
2963         } else {
2964             my $dur;
2965             if ($loanlength->{lengthunit} eq 'hours') {
2966                 $dur = DateTime::Duration->new( hours => $loanlength->{issuelength});
2967             }
2968             else { # days
2969                 $dur = DateTime::Duration->new( days => $loanlength->{issuelength});
2970             }
2971             if (ref $startdate ne 'DateTime' ) {
2972                 $startdate = dt_from_string($startdate);
2973             }
2974             my $calendar = Koha::Calendar->new( branchcode => $branch );
2975             $datedue = $calendar->addDate( $startdate, $dur, $loanlength->{lengthunit} );
2976             if ($loanlength->{lengthunit} eq 'days') {
2977                 $datedue->set_hour(23);
2978                 $datedue->set_minute(59);
2979             }
2980         }
2981     }
2982
2983     # if Hard Due Dates are used, retreive them and apply as necessary
2984     my ( $hardduedate, $hardduedatecompare ) =
2985       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
2986     if ($hardduedate) {    # hardduedates are currently dates
2987         $hardduedate->truncate( to => 'minute' );
2988         $hardduedate->set_hour(23);
2989         $hardduedate->set_minute(59);
2990         my $cmp = DateTime->compare( $hardduedate, $datedue );
2991
2992 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
2993 # if the calculated date is before the 'after' Hard Due Date (floor), override
2994 # if the hard due date is set to 'exactly', overrride
2995         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
2996             $datedue = $hardduedate->clone;
2997         }
2998
2999         # in all other cases, keep the date due as it is
3000     }
3001
3002     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3003     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3004         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso' );
3005         if ( DateTime->compare( $datedue, $expiry_dt ) == 1 ) {
3006             $datedue = $expiry_dt->clone;
3007         }
3008     }
3009
3010     return $datedue;
3011 }
3012
3013
3014 =head2 CheckRepeatableHolidays
3015
3016   $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
3017
3018 This function checks if the date due is a repeatable holiday
3019
3020 C<$date_due>   = returndate calculate with no day check
3021 C<$itemnumber>  = itemnumber
3022 C<$branchcode>  = localisation of issue
3023
3024 =cut
3025
3026 sub CheckRepeatableHolidays{
3027 my($itemnumber,$week_day,$branchcode)=@_;
3028 my $dbh = C4::Context->dbh;
3029 my $query = qq|SELECT count(*)
3030         FROM repeatable_holidays
3031         WHERE branchcode=?
3032         AND weekday=?|;
3033 my $sth = $dbh->prepare($query);
3034 $sth->execute($branchcode,$week_day);
3035 my $result=$sth->fetchrow;
3036 $sth->finish;
3037 return $result;
3038 }
3039
3040
3041 =head2 CheckSpecialHolidays
3042
3043   $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
3044
3045 This function check if the date is a special holiday
3046
3047 C<$years>   = the years of datedue
3048 C<$month>   = the month of datedue
3049 C<$day>     = the day of datedue
3050 C<$itemnumber>  = itemnumber
3051 C<$branchcode>  = localisation of issue
3052
3053 =cut
3054
3055 sub CheckSpecialHolidays{
3056 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
3057 my $dbh = C4::Context->dbh;
3058 my $query=qq|SELECT count(*)
3059              FROM `special_holidays`
3060              WHERE year=?
3061              AND month=?
3062              AND day=?
3063              AND branchcode=?
3064             |;
3065 my $sth = $dbh->prepare($query);
3066 $sth->execute($years,$month,$day,$branchcode);
3067 my $countspecial=$sth->fetchrow ;
3068 $sth->finish;
3069 return $countspecial;
3070 }
3071
3072 =head2 CheckRepeatableSpecialHolidays
3073
3074   $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
3075
3076 This function check if the date is a repeatble special holidays
3077
3078 C<$month>   = the month of datedue
3079 C<$day>     = the day of datedue
3080 C<$itemnumber>  = itemnumber
3081 C<$branchcode>  = localisation of issue
3082
3083 =cut
3084
3085 sub CheckRepeatableSpecialHolidays{
3086 my ($month,$day,$itemnumber,$branchcode) = @_;
3087 my $dbh = C4::Context->dbh;
3088 my $query=qq|SELECT count(*)
3089              FROM `repeatable_holidays`
3090              WHERE month=?
3091              AND day=?
3092              AND branchcode=?
3093             |;
3094 my $sth = $dbh->prepare($query);
3095 $sth->execute($month,$day,$branchcode);
3096 my $countspecial=$sth->fetchrow ;
3097 $sth->finish;
3098 return $countspecial;
3099 }
3100
3101
3102
3103 sub CheckValidBarcode{
3104 my ($barcode) = @_;
3105 my $dbh = C4::Context->dbh;
3106 my $query=qq|SELECT count(*)
3107              FROM items
3108              WHERE barcode=?
3109             |;
3110 my $sth = $dbh->prepare($query);
3111 $sth->execute($barcode);
3112 my $exist=$sth->fetchrow ;
3113 $sth->finish;
3114 return $exist;
3115 }
3116
3117 =head2 IsBranchTransferAllowed
3118
3119   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3120
3121 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3122
3123 =cut
3124
3125 sub IsBranchTransferAllowed {
3126         my ( $toBranch, $fromBranch, $code ) = @_;
3127
3128         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3129
3130         my $limitType = C4::Context->preference("BranchTransferLimitsType");
3131         my $dbh = C4::Context->dbh;
3132
3133         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3134         $sth->execute( $toBranch, $fromBranch, $code );
3135         my $limit = $sth->fetchrow_hashref();
3136
3137         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3138         if ( $limit->{'limitId'} ) {
3139                 return 0;
3140         } else {
3141                 return 1;
3142         }
3143 }
3144
3145 =head2 CreateBranchTransferLimit
3146
3147   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3148
3149 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3150
3151 =cut
3152
3153 sub CreateBranchTransferLimit {
3154    my ( $toBranch, $fromBranch, $code ) = @_;
3155
3156    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3157
3158    my $dbh = C4::Context->dbh;
3159
3160    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3161    $sth->execute( $code, $toBranch, $fromBranch );
3162 }
3163
3164 =head2 DeleteBranchTransferLimits
3165
3166 DeleteBranchTransferLimits($frombranch);
3167
3168 Deletes all the branch transfer limits for one branch
3169
3170 =cut
3171
3172 sub DeleteBranchTransferLimits {
3173     my $branch = shift;
3174     my $dbh    = C4::Context->dbh;
3175     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3176     $sth->execute($branch);
3177 }
3178
3179 sub ReturnLostItem{
3180     my ( $borrowernumber, $itemnum ) = @_;
3181
3182     MarkIssueReturned( $borrowernumber, $itemnum );
3183     my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3184     my $item = C4::Items::GetItem( $itemnum );
3185     my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3186     my @datearr = localtime(time);
3187     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3188     my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3189     ModItem({ paidfor =>  $old_note."Paid for by $bor $date" }, undef, $itemnum);
3190 }
3191
3192
3193 sub LostItem{
3194     my ($itemnumber, $mark_returned, $charge_fee) = @_;
3195
3196     my $dbh = C4::Context->dbh();
3197     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3198                            FROM issues
3199                            JOIN items USING (itemnumber)
3200                            JOIN biblio USING (biblionumber)
3201                            WHERE issues.itemnumber=?");
3202     $sth->execute($itemnumber);
3203     my $issues=$sth->fetchrow_hashref();
3204     $sth->finish;
3205
3206     # if a borrower lost the item, add a replacement cost to the their record
3207     if ( my $borrowernumber = $issues->{borrowernumber} ){
3208         my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3209
3210         C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}")
3211           if $charge_fee;
3212         #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3213         #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3214         MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3215     }
3216 }
3217
3218 sub GetOfflineOperations {
3219     my $dbh = C4::Context->dbh;
3220     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3221     $sth->execute(C4::Context->userenv->{'branch'});
3222     my $results = $sth->fetchall_arrayref({});
3223     $sth->finish;
3224     return $results;
3225 }
3226
3227 sub GetOfflineOperation {
3228     my $dbh = C4::Context->dbh;
3229     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3230     $sth->execute( shift );
3231     my $result = $sth->fetchrow_hashref;
3232     $sth->finish;
3233     return $result;
3234 }
3235
3236 sub AddOfflineOperation {
3237     my $dbh = C4::Context->dbh;
3238     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber) VALUES(?,?,?,?,?,?)");
3239     $sth->execute( @_ );
3240     return "Added.";
3241 }
3242
3243 sub DeleteOfflineOperation {
3244     my $dbh = C4::Context->dbh;
3245     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3246     $sth->execute( shift );
3247     return "Deleted.";
3248 }
3249
3250 sub ProcessOfflineOperation {
3251     my $operation = shift;
3252
3253     my $report;
3254     if ( $operation->{action} eq 'return' ) {
3255         $report = ProcessOfflineReturn( $operation );
3256     } elsif ( $operation->{action} eq 'issue' ) {
3257         $report = ProcessOfflineIssue( $operation );
3258     }
3259
3260     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3261
3262     return $report;
3263 }
3264
3265 sub ProcessOfflineReturn {
3266     my $operation = shift;
3267
3268     my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3269
3270     if ( $itemnumber ) {
3271         my $issue = GetOpenIssue( $itemnumber );
3272         if ( $issue ) {
3273             MarkIssueReturned(
3274                 $issue->{borrowernumber},
3275                 $itemnumber,
3276                 undef,
3277                 $operation->{timestamp},
3278             );
3279             ModItem(
3280                 { renewals => 0, onloan => undef },
3281                 $issue->{'biblionumber'},
3282                 $itemnumber
3283             );
3284             return "Success.";
3285         } else {
3286             return "Item not issued.";
3287         }
3288     } else {
3289         return "Item not found.";
3290     }
3291 }
3292
3293 sub ProcessOfflineIssue {
3294     my $operation = shift;
3295
3296     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3297
3298     if ( $borrower->{borrowernumber} ) {
3299         my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3300         unless ($itemnumber) {
3301             return "Barcode not found.";
3302         }
3303         my $issue = GetOpenIssue( $itemnumber );
3304
3305         if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3306             MarkIssueReturned(
3307                 $issue->{borrowernumber},
3308                 $itemnumber,
3309                 undef,
3310                 $operation->{timestamp},
3311             );
3312         }
3313         AddIssue(
3314             $borrower,
3315             $operation->{'barcode'},
3316             undef,
3317             1,
3318             $operation->{timestamp},
3319             undef,
3320         );
3321         return "Success.";
3322     } else {
3323         return "Borrower not found.";
3324     }
3325 }
3326
3327
3328
3329 =head2 TransferSlip
3330
3331   TransferSlip($user_branch, $itemnumber, $to_branch)
3332
3333   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3334
3335 =cut
3336
3337 sub TransferSlip {
3338     my ($branch, $itemnumber, $to_branch) = @_;
3339
3340     my $item =  GetItem( $itemnumber )
3341       or return;
3342
3343     my $pulldate = C4::Dates->new();
3344
3345     return C4::Letters::GetPreparedLetter (
3346         module => 'circulation',
3347         letter_code => 'TRANSFERSLIP',
3348         branchcode => $branch,
3349         tables => {
3350             'branches'    => $to_branch,
3351             'biblio'      => $item->{biblionumber},
3352             'items'       => $item,
3353         },
3354     );
3355 }
3356
3357
3358 1;
3359
3360 __END__
3361
3362 =head1 AUTHOR
3363
3364 Koha Development Team <http://koha-community.org/>
3365
3366 =cut
3367