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