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