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