C4/Circulation.pm

   1 package C4::Circulation;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 # $Id$
  21
  22 use strict;
  23 require Exporter;
  24 use C4::Context;
  25 use C4::Stats;
  26 use C4::Reserves2;
  27 use C4::Koha;
  28 use C4::Biblio;
  29 use C4::Accounts;
  30 use C4::Reserves2;
  31 use C4::Members;
  32 use C4::Date;
  33 use Date::Calc qw(
  34   Today
  35   Today_and_Now
  36   Add_Delta_YM
  37   Add_Delta_DHMS
  38   Date_to_Days
  39 );
  40 use POSIX qw(strftime);
  41 use C4::Branch; # GetBranches
  42 use C4::Log; # logaction
  43
  44 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  45
  46 # set the version for version checking
  47 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
  48
  49 =head1 NAME
  50
  51 C4::Circulation::Circ2 - Koha circulation module
  52
  53 =head1 SYNOPSIS
  54
  55 use C4::Circulation;
  56
  57 =head1 DESCRIPTION
  58
  59 The functions in this module deal with circulation, issues, and
  60 returns, as well as general information about the library.
  61 Also deals with stocktaking.
  62
  63 =head1 FUNCTIONS
  64
  65 =cut
  66
  67 @ISA    = qw(Exporter);
  68
  69 # FIXME subs that should probably be elsewhere
  70 push @EXPORT, qw(
  71   &fixoverduesonreturn
  72 );
  73
  74 # subs to deal with issuing a book
  75 push @EXPORT, qw(
  76   &CanBookBeIssued
  77   &CanBookBeRenewed
  78   &AddIssue
  79   &AddRenewal
  80   &GetItemIssue
  81   &GetItemIssues
  82   &GetBorrowerIssues
  83   &GetIssuingCharges
  84   &GetBiblioIssues
  85   &AnonymiseIssueHistory
  86 );
  87 # subs to deal with returns
  88 push @EXPORT, qw(
  89   &AddReturn
  90 );
  91
  92 # subs to deal with transfers
  93 push @EXPORT, qw(
  94   &transferbook
  95   &GetTransfers
  96   &GetTransfersFromTo
  97   &updateWrongTransfer
  98   &DeleteTransfer
  99 );
 100
 101 # subs to remove
 102 push @EXPORT, qw(
 103   &decode
 104   &dotransfer
 105 );
 106
 107 =head2 decode
 108
 109 =head3 $str = &decode($chunk);
 110
 111 =over 4
 112
 113 =item Decodes a segment of a string emitted by a CueCat barcode scanner and
 114 returns it.
 115
 116 =back
 117
 118 =cut
 119
 120 # FIXME - At least, I'm pretty sure this is for decoding CueCat stuff.
 121
 122 # FIXME From Paul : i don't understand what this sub does & why it has to be called on every circ. Speak of this with chris maybe ?
 123 sub decode {
 124     my ($encoded) = @_;
 125     my $seq =
 126       'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
 127     my @s = map { index( $seq, $_ ); } split( //, $encoded );
 128     my $l = ( $#s + 1 ) % 4;
 129     if ($l) {
 130         if ( $l == 1 ) {
 131             warn "Error!";
 132             return;
 133         }
 134         $l = 4 - $l;
 135         $#s += $l;
 136     }
 137     my $r = '';
 138     while ( $#s >= 0 ) {
 139         my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
 140         $r .=
 141             chr( ( $n >> 16 ) ^ 67 )
 142          .chr( ( $n >> 8 & 255 ) ^ 67 )
 143          .chr( ( $n & 255 ) ^ 67 );
 144         @s = @s[ 4 .. $#s ];
 145     }
 146     $r = substr( $r, 0, length($r) - $l );
 147     return $r;
 148 }
 149
 150 =head2 transferbook
 151
 152 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves);
 153
 154 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
 155
 156 C<$newbranch> is the code for the branch to which the item should be transferred.
 157
 158 C<$barcode> is the barcode of the item to be transferred.
 159
 160 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
 161 Otherwise, if an item is reserved, the transfer fails.
 162
 163 Returns three values:
 164
 165 =head3 $dotransfer
 166
 167 is true if the transfer was successful.
 168
 169 =head3 $messages
 170
 171 is a reference-to-hash which may have any of the following keys:
 172
 173 =over 4
 174
 175 =item C<BadBarcode>
 176
 177 There is no item in the catalog with the given barcode. The value is C<$barcode>.
 178
 179 =item C<IsPermanent>
 180
 181 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.
 182
 183 =item C<DestinationEqualsHolding>
 184
 185 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.
 186
 187 =item C<WasReturned>
 188
 189 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.
 190
 191 =item C<ResFound>
 192
 193 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>.
 194
 195 =item C<WasTransferred>
 196
 197 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
 198
 199 =back
 200
 201 =cut
 202
 203 #'
 204 # FIXME - This function tries to do too much, and its API is clumsy.
 205 # If it didn't also return books, it could be used to change the home
 206 # branch of a book while the book is on loan.
 207 #
 208 # Is there any point in returning the item information? The caller can
 209 # look that up elsewhere if ve cares.
 210 #
 211 # This leaves the ($dotransfer, $messages) tuple. This seems clumsy.
 212 # If the transfer succeeds, that's all the caller should need to know.
 213 # Thus, this function could simply return 1 or 0 to indicate success
 214 # or failure, and set $C4::Circulation::Circ2::errmsg in case of
 215 # failure. Or this function could return undef if successful, and an
 216 # error message in case of failure (this would feel more like C than
 217 # Perl, though).
 218 sub transferbook {
 219     my ( $tbr, $barcode, $ignoreRs ) = @_;
 220     my $messages;
 221     my %env;
 222     my $dotransfer      = 1;
 223     my $branches        = GetBranches();
 224     my $item = GetItemFromBarcode( $barcode );
 225     my $issue      = GetItemIssues($item->{itemnumber});
 226
 227     # bad barcode..
 228     if ( not $item ) {
 229         $messages->{'BadBarcode'} = $barcode;
 230         $dotransfer = 0;
 231     }
 232
 233     # get branches of book...
 234     my $hbr = $item->{'homebranch'};
 235     my $fbr = $item->{'holdingbranch'};
 236
 237     # if is permanent...
 238     if ( $hbr && $branches->{$hbr}->{'PE'} ) {
 239         $messages->{'IsPermanent'} = $hbr;
 240     }
 241
 242     # can't transfer book if is already there....
 243     # FIXME - Why not? Shouldn't it trivially succeed?
 244     if ( $fbr eq $tbr ) {
 245         $messages->{'DestinationEqualsHolding'} = 1;
 246         $dotransfer = 0;
 247     }
 248
 249     # check if it is still issued to someone, return it...
 250     if ($issue->{borrowernumber}) {
 251         AddReturn( $barcode, $fbr );
 252         $messages->{'WasReturned'} = $issue->{borrowernumber};
 253     }
 254
 255     # find reserves.....
 256     # FIXME - Don't call &CheckReserves unless $ignoreRs is true.
 257     # That'll save a database query.
 258     my ( $resfound, $resrec ) =
 259       CheckReserves( $item->{'itemnumber'} );
 260     if ( $resfound and not $ignoreRs ) {
 261         $resrec->{'ResFound'} = $resfound;
 262
 263         #         $messages->{'ResFound'} = $resrec;
 264         $dotransfer = 1;
 265     }
 266
 267     #actually do the transfer....
 268     if ($dotransfer) {
 269         dotransfer( $item->{'itemnumber'}, $fbr, $tbr );
 270
 271         # don't need to update MARC anymore, we do it in batch now
 272         $messages->{'WasTransfered'} = 1;
 273     }
 274     return ( $dotransfer, $messages, $item );
 275 }
 276
 277 # Not exported
 278 # FIXME - This is only used in &transferbook. Why bother making it a
 279 # separate function?
 280 sub dotransfer {
 281     my ( $itm, $fbr, $tbr ) = @_;
 282
 283     my $dbh = C4::Context->dbh;
 284     $itm = $dbh->quote($itm);
 285     $fbr = $dbh->quote($fbr);
 286     $tbr = $dbh->quote($tbr);
 287
 288     #new entry in branchtransfers....
 289     $dbh->do(
 290 "INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
 291                     VALUES ($itm, $fbr, now(), $tbr)"
 292     );
 293
 294     #update holdingbranch in items .....
 295       $dbh->do(
 296           "UPDATE items set holdingbranch = $tbr WHERE items.itemnumber = $itm");
 297     &ModDateLastSeen($itm);
 298     &domarctransfer( $dbh, $itm );
 299     return;
 300 }
 301
 302 ##New sub to dotransfer in marc tables as well. Not exported -TG 10/04/2006
 303 sub domarctransfer {
 304     my ( $dbh, $itemnumber ) = @_;
 305     $itemnumber =~ s /\'//g;    ##itemnumber seems to come with quotes-TG
 306     my $sth =
 307       $dbh->prepare(
 308         "select biblionumber,holdingbranch from items where itemnumber=$itemnumber"
 309       );
 310     $sth->execute();
 311     while ( my ( $biblionumber, $holdingbranch ) = $sth->fetchrow ) {
 312         &ModItemInMarconefield( $biblionumber, $itemnumber,
 313             'items.holdingbranch', $holdingbranch );
 314     }
 315     return;
 316 }
 317
 318 =head2 CanBookBeIssued
 319
 320 Check if a book can be issued.
 321
 322 my ($issuingimpossible,$needsconfirmation) = CanBookBeIssued($env,$borrower,$barcode,$year,$month,$day);
 323
 324 =over 4
 325
 326 =item C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it.
 327
 328 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
 329
 330 =item C<$barcode> is the bar code of the book being issued.
 331
 332 =item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
 333
 334 =back
 335
 336 Returns :
 337
 338 =over 4
 339
 340 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
 341 Possible values are :
 342
 343 =back
 344
 345 =head3 INVALID_DATE
 346
 347 sticky due date is invalid
 348
 349 =head3 GNA
 350
 351 borrower gone with no address
 352
 353 =head3 CARD_LOST
 354
 355 borrower declared it's card lost
 356
 357 =head3 DEBARRED
 358
 359 borrower debarred
 360
 361 =head3 UNKNOWN_BARCODE
 362
 363 barcode unknown
 364
 365 =head3 NOT_FOR_LOAN
 366
 367 item is not for loan
 368
 369 =head3 WTHDRAWN
 370
 371 item withdrawn.
 372
 373 =head3 RESTRICTED
 374
 375 item is restricted (set by ??)
 376
 377 C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
 378 Possible values are :
 379
 380 =head3 DEBT
 381
 382 borrower has debts.
 383
 384 =head3 RENEW_ISSUE
 385
 386 renewing, not issuing
 387
 388 =head3 ISSUED_TO_ANOTHER
 389
 390 issued to someone else.
 391
 392 =head3 RESERVED
 393
 394 reserved for someone else.
 395
 396 =head3 INVALID_DATE
 397
 398 sticky due date is invalid
 399
 400 =head3 TOO_MANY
 401
 402 if the borrower borrows to much things
 403
 404 =cut
 405
 406 # check if a book can be issued.
 407 # returns an array with errors if any
 408
 409 sub TooMany ($$) {
 410     my $borrower        = shift;
 411     my $biblionumber = shift;
 412     my $cat_borrower    = $borrower->{'categorycode'};
 413     my $branch_borrower = $borrower->{'branchcode'};
 414     my $dbh             = C4::Context->dbh;
 415
 416     my $sth =
 417       $dbh->prepare('select itemtype from biblioitems where biblionumber = ?');
 418     $sth->execute($biblionumber);
 419     my $type = $sth->fetchrow;
 420     $sth =
 421       $dbh->prepare(
 422 'select * from issuingrules where categorycode = ? and itemtype = ? and branchcode = ?'
 423       );
 424
 425 #     my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s.biblioitemnumber and s.itemtype like ?");
 426     my $sth2 =
 427       $dbh->prepare(
 428 "select COUNT(*) from issues i, biblioitems s1, items s2 where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s2.itemnumber and s1.itemtype like ? and s1.biblioitemnumber = s2.biblioitemnumber"
 429       );
 430     my $sth3 =
 431       $dbh->prepare(
 432 'select COUNT(*) from issues where borrowernumber = ? and returndate is null'
 433       );
 434     my $alreadyissued;
 435
 436     # check the 3 parameters
 437     $sth->execute( $cat_borrower, $type, $branch_borrower );
 438     my $result = $sth->fetchrow_hashref;
 439
 440     #    warn "==>".$result->{maxissueqty};
 441
 442 # Currently, using defined($result) ie on an entire hash reports whether memory
 443 # for that aggregate has ever been allocated. As $result is used all over the place
 444 # it would rarely return as undefined.
 445     if ( defined( $result->{maxissueqty} ) ) {
 446         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
 447         my $alreadyissued = $sth2->fetchrow;
 448         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 449             return ( "a $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
 450         }
 451         else {
 452             return;
 453         }
 454     }
 455
 456     # check for branch=*
 457     $sth->execute( $cat_borrower, $type, "" );
 458     $result = $sth->fetchrow_hashref;
 459     if ( defined( $result->{maxissueqty} ) ) {
 460         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
 461         my $alreadyissued = $sth2->fetchrow;
 462         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 463             return ( "b $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
 464         }
 465         else {
 466             return;
 467         }
 468     }
 469
 470     # check for itemtype=*
 471     $sth->execute( $cat_borrower, "*", $branch_borrower );
 472     $result = $sth->fetchrow_hashref;
 473     if ( defined( $result->{maxissueqty} ) ) {
 474         $sth3->execute( $borrower->{'borrowernumber'} );
 475         my ($alreadyissued) = $sth3->fetchrow;
 476         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 477
 478 #        warn "HERE : $alreadyissued / ($result->{maxissueqty} for $borrower->{'borrowernumber'}";
 479             return ( "c $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
 480         }
 481         else {
 482             return;
 483         }
 484     }
 485
 486     # check for borrowertype=*
 487     $sth->execute( "*", $type, $branch_borrower );
 488     $result = $sth->fetchrow_hashref;
 489     if ( defined( $result->{maxissueqty} ) ) {
 490         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
 491         my $alreadyissued = $sth2->fetchrow;
 492         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 493             return ( "d $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
 494         }
 495         else {
 496             return;
 497         }
 498     }
 499
 500     $sth->execute( "*", "*", $branch_borrower );
 501     $result = $sth->fetchrow_hashref;
 502     if ( defined( $result->{maxissueqty} ) ) {
 503         $sth3->execute( $borrower->{'borrowernumber'} );
 504         my $alreadyissued = $sth3->fetchrow;
 505         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 506             return ( "e $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
 507         }
 508         else {
 509             return;
 510         }
 511     }
 512
 513     $sth->execute( "*", $type, "" );
 514     $result = $sth->fetchrow_hashref;
 515     if ( defined( $result->{maxissueqty} ) && $result->{maxissueqty} >= 0 ) {
 516         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
 517         my $alreadyissued = $sth2->fetchrow;
 518         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 519             return ( "f $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
 520         }
 521         else {
 522             return;
 523         }
 524     }
 525
 526     $sth->execute( $cat_borrower, "*", "" );
 527     $result = $sth->fetchrow_hashref;
 528     if ( defined( $result->{maxissueqty} ) ) {
 529         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
 530         my $alreadyissued = $sth2->fetchrow;
 531         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 532             return ( "g $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
 533         }
 534         else {
 535             return;
 536         }
 537     }
 538
 539     $sth->execute( "*", "*", "" );
 540     $result = $sth->fetchrow_hashref;
 541     if ( defined( $result->{maxissueqty} ) ) {
 542         $sth3->execute( $borrower->{'borrowernumber'} );
 543         my $alreadyissued = $sth3->fetchrow;
 544         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
 545             return ( "h $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
 546         }
 547         else {
 548             return;
 549         }
 550     }
 551     return;
 552 }
 553
 554 =head2 itemissues
 555
 556   @issues = &itemissues($biblioitemnumber, $biblio);
 557
 558 Looks up information about who has borrowed the bookZ<>(s) with the
 559 given biblioitemnumber.
 560
 561 C<$biblio> is ignored.
 562
 563 C<&itemissues> returns an array of references-to-hash. The keys
 564 include the fields from the C<items> table in the Koha database.
 565 Additional keys include:
 566
 567 =over 4
 568
 569 =item C<date_due>
 570
 571 If the item is currently on loan, this gives the due date.
 572
 573 If the item is not on loan, then this is either "Available" or
 574 "Cancelled", if the item has been withdrawn.
 575
 576 =item C<card>
 577
 578 If the item is currently on loan, this gives the card number of the
 579 patron who currently has the item.
 580
 581 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
 582
 583 These give the timestamp for the last three times the item was
 584 borrowed.
 585
 586 =item C<card0>, C<card1>, C<card2>
 587
 588 The card number of the last three patrons who borrowed this item.
 589
 590 =item C<borrower0>, C<borrower1>, C<borrower2>
 591
 592 The borrower number of the last three patrons who borrowed this item.
 593
 594 =back
 595
 596 =cut
 597
 598 #'
 599 sub itemissues {
 600     my ( $bibitem, $biblio ) = @_;
 601     my $dbh = C4::Context->dbh;
 602
 603     # FIXME - If this function die()s, the script will abort, and the
 604     # user won't get anything; depending on how far the script has
 605     # gotten, the user might get a blank page. It would be much better
 606     # to at least print an error message. The easiest way to do this
 607     # is to set $SIG{__DIE__}.
 608     my $sth =
 609       $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
 610       || die $dbh->errstr;
 611     my $i = 0;
 612     my @results;
 613
 614     $sth->execute($bibitem) || die $sth->errstr;
 615
 616     while ( my $data = $sth->fetchrow_hashref ) {
 617
 618         # Find out who currently has this item.
 619         # FIXME - Wouldn't it be better to do this as a left join of
 620         # some sort? Currently, this code assumes that if
 621         # fetchrow_hashref() fails, then the book is on the shelf.
 622         # fetchrow_hashref() can fail for any number of reasons (e.g.,
 623         # database server crash), not just because no items match the
 624         # search criteria.
 625         my $sth2 = $dbh->prepare(
 626             "SELECT * FROM issues
 627                 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 628                 WHERE itemnumber = ?
 629                     AND returndate IS NULL
 630             "
 631         );
 632
 633         $sth2->execute( $data->{'itemnumber'} );
 634         if ( my $data2 = $sth2->fetchrow_hashref ) {
 635             $data->{'date_due'} = $data2->{'date_due'};
 636             $data->{'card'}     = $data2->{'cardnumber'};
 637             $data->{'borrower'} = $data2->{'borrowernumber'};
 638         }
 639         else {
 640             if ( $data->{'wthdrawn'} eq '1' ) {
 641                 $data->{'date_due'} = 'Cancelled';
 642             }
 643             else {
 644                 $data->{'date_due'} = 'Available';
 645             }    # else
 646         }    # else
 647
 648         $sth2->finish;
 649
 650         # Find the last 3 people who borrowed this item.
 651         $sth2 = $dbh->prepare(
 652             "SELECT * FROM issues, borrowers
 653                 LEFT JOIN borrowers ON  issues.borrowernumber = borrowers.borrowernumber
 654                 WHERE itemnumber = ?
 655                 AND returndate IS NOT NULL
 656                 ORDER BY returndate DESC,timestamp DESC"
 657         );
 658
 659 #        $sth2 = $dbh->prepare("
 660 #            SELECT *
 661 #            FROM issues
 662 #                LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 663 #            WHERE   itemnumber = ?
 664 #                AND returndate is not NULL
 665 #            ORDER BY returndate DESC,timestamp DESC
 666 #        ");
 667
 668         $sth2->execute( $data->{'itemnumber'} );
 669         for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
 670         {    # FIXME : error if there is less than 3 pple borrowing this item
 671             if ( my $data2 = $sth2->fetchrow_hashref ) {
 672                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
 673                 $data->{"card$i2"}      = $data2->{'cardnumber'};
 674                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
 675             }    # if
 676         }    # for
 677
 678         $sth2->finish;
 679         $results[$i] = $data;
 680         $i++;
 681     }
 682
 683     $sth->finish;
 684     return (@results);
 685 }
 686
 687 =head2 CanBookBeIssued
 688
 689 $issuingimpossible, $needsconfirmation =
 690         CanBookBeIssued( $env, $borrower, $barcode, $year, $month, $day, $inprocess );
 691
 692 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
 693
 694 =cut
 695
 696 sub CanBookBeIssued {
 697     my ( $env, $borrower, $barcode, $year, $month, $day, $inprocess ) = @_;
 698     my %needsconfirmation;    # filled with problems that needs confirmations
 699     my %issuingimpossible;    # filled with problems that causes the issue to be IMPOSSIBLE
 700     my $item = GetItem(GetItemFromBarcode( $barcode ));
 701     my $issue = GetItemIssue($item->{itemnumber});
 702     my $dbh             = C4::Context->dbh;
 703
 704     #
 705     # DUE DATE is OK ?
 706     #
 707     my ( $duedate, $invalidduedate ) = fixdate( $year, $month, $day );
 708     $issuingimpossible{INVALID_DATE} = 1 if ($invalidduedate);
 709
 710     #
 711     # BORROWER STATUS
 712     #
 713     if ( $borrower->{flags}->{GNA} ) {
 714         $issuingimpossible{GNA} = 1;
 715     }
 716     if ( $borrower->{flags}->{'LOST'} ) {
 717         $issuingimpossible{CARD_LOST} = 1;
 718     }
 719     if ( $borrower->{flags}->{'DBARRED'} ) {
 720         $issuingimpossible{DEBARRED} = 1;
 721     }
 722     if ( Date_to_Days(Today) >
 723         Date_to_Days( split "-", $borrower->{'dateexpiry'} ) )
 724     {
 725
 726         #
 727         #if (&Date_Cmp(&ParseDate($borrower->{expiry}),&ParseDate("today"))<0) {
 728         $issuingimpossible{EXPIRED} = 1;
 729     }
 730
 731     #
 732     # BORROWER STATUS
 733     #
 734
 735     # DEBTS
 736     my $amount =
 737       checkaccount( $borrower->{'borrowernumber'}, $dbh, $duedate );
 738     if ( C4::Context->preference("IssuingInProcess") ) {
 739         my $amountlimit = C4::Context->preference("noissuescharge");
 740         if ( $amount > $amountlimit && !$inprocess ) {
 741             $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
 742         }
 743         elsif ( $amount <= $amountlimit && !$inprocess ) {
 744             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
 745         }
 746     }
 747     else {
 748         if ( $amount > 0 ) {
 749             $needsconfirmation{DEBT} = $amount;
 750         }
 751     }
 752
 753     #
 754     # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
 755     #
 756     my $toomany = TooMany( $borrower, $item->{biblionumber} );
 757     $needsconfirmation{TOO_MANY} = $toomany if $toomany;
 758
 759     #
 760     # ITEM CHECKING
 761     #
 762     unless ( $item->{barcode} ) {
 763         $issuingimpossible{UNKNOWN_BARCODE} = 1;
 764     }
 765     if (   $item->{'notforloan'}
 766         && $item->{'notforloan'} > 0 )
 767     {
 768         $issuingimpossible{NOT_FOR_LOAN} = 1;
 769     }
 770     if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
 771     {
 772         $issuingimpossible{WTHDRAWN} = 1;
 773     }
 774     if (   $item->{'restricted'}
 775         && $item->{'restricted'} == 1 )
 776     {
 777         $issuingimpossible{RESTRICTED} = 1;
 778     }
 779     if ( C4::Context->preference("IndependantBranches") ) {
 780         my $userenv = C4::Context->userenv;
 781         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 782             $issuingimpossible{NOTSAMEBRANCH} = 1
 783               if ( $item->{'holdingbranch'} ne $userenv->{branch} );
 784         }
 785     }
 786
 787     #
 788     # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
 789     #
 790     if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
 791     {
 792
 793         # Already issued to current borrower. Ask whether the loan should
 794         # be renewed.
 795         my ($CanBookBeRenewed) = CanBookBeRenewed(
 796             $borrower->{'borrowernumber'},
 797             $item->{'itemnumber'}
 798         );
 799         if ( $CanBookBeRenewed == 0 ) {    # no more renewals allowed
 800             $issuingimpossible{NO_MORE_RENEWALS} = 1;
 801         }
 802         else {
 803
 804             #        $needsconfirmation{RENEW_ISSUE} = 1;
 805         }
 806     }
 807     elsif ($issue->{borrowernumber}) {
 808
 809         # issued to someone else
 810         my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
 811
 812 #        warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
 813         $needsconfirmation{ISSUED_TO_ANOTHER} =
 814 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
 815     }
 816
 817     # See if the item is on reserve.
 818     my ( $restype, $res ) = CheckReserves( $item->{'itemnumber'} );
 819     if ($restype) {
 820         my $resbor = $res->{'borrowernumber'};
 821         if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
 822         {
 823
 824             # The item is on reserve and waiting, but has been
 825             # reserved by some other patron.
 826             my ( $resborrower, $flags ) =
 827               GetMemberDetails( $resbor, 0 );
 828             my $branches   = GetBranches();
 829             my $branchname =
 830               $branches->{ $res->{'branchcode'} }->{'branchname'};
 831             $needsconfirmation{RESERVE_WAITING} =
 832 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
 833
 834 # CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine.
 835         }
 836         elsif ( $restype eq "Reserved" ) {
 837
 838             # The item is on reserve for someone else.
 839             my ( $resborrower, $flags ) =
 840               GetMemberDetails( $resbor, 0 );
 841             my $branches   = GetBranches();
 842             my $branchname =
 843               $branches->{ $res->{'branchcode'} }->{'branchname'};
 844             $needsconfirmation{RESERVED} =
 845 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
 846         }
 847     }
 848     if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" )
 849     {
 850         if ( $borrower->{'categorycode'} eq 'W' ) {
 851             my %issuingimpossible;
 852             return ( \%issuingimpossible, \%needsconfirmation );
 853         }
 854         else {
 855             return ( \%issuingimpossible, \%needsconfirmation );
 856         }
 857     }
 858     else {
 859         return ( \%issuingimpossible, \%needsconfirmation );
 860     }
 861 }
 862
 863 =head2 AddIssue
 864
 865 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
 866
 867 &AddIssue($env,$borrower,$barcode,$date)
 868
 869 =over 4
 870
 871 =item C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it.
 872
 873 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
 874
 875 =item C<$barcode> is the bar code of the book being issued.
 876
 877 =item C<$date> contains the max date of return. calculated if empty.
 878
 879 AddIssue does the following things :
 880 - step 0°: check that there is a borrowernumber & a barcode provided
 881 - check for RENEWAL (book issued & being issued to the same patron)
 882     - renewal YES = Calculate Charge & renew
 883     - renewal NO  =
 884         * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
 885         * RESERVE PLACED ?
 886             - fill reserve if reserve to this patron
 887             - cancel reserve or not, otherwise
 888         * TRANSFERT PENDING ?
 889             - complete the transfert
 890         * ISSUE THE BOOK
 891
 892 =back
 893
 894 =cut
 895
 896 sub AddIssue {
 897     my ( $env, $borrower, $barcode, $date, $cancelreserve ) = @_;
 898
 899     my $dbh = C4::Context->dbh;
 900 if ($borrower and $barcode){
 901 #   my ($borrower, $flags) = &GetMemberDetails($borrowernumber, 0);
 902     # find which item we issue
 903     my $item = GetItem('', $barcode);
 904
 905     # get actual issuing if there is one
 906     my $actualissue = GetItemIssue( $item->{itemnumber});
 907
 908     # get biblioinformation for this item
 909     my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
 910
 911 #
 912 # check if we just renew the issue.
 913 #
 914     if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
 915         # we renew, do we need to add some charge ?
 916         my ( $charge, $itemtype ) = GetIssuingCharges(
 917             $item->{'itemnumber'},
 918             $borrower->{'borrowernumber'}
 919         );
 920         if ( $charge > 0 ) {
 921             AddIssuingCharge(
 922                 $item->{'itemnumber'},
 923                 $borrower->{'borrowernumber'}, $charge
 924             );
 925             $item->{'charge'} = $charge;
 926         }
 927         &UpdateStats(
 928             $env,                           $env->{'branchcode'},
 929             'renew',                        $charge,
 930             '',                             $item->{'itemnumber'},
 931             $biblio->{'itemtype'}, $borrower->{'borrowernumber'}
 932         );
 933         AddRenewal(
 934             $borrower->{'borrowernumber'},
 935             $item->{'itemnumber'}
 936         );
 937     }
 938     else {# it's NOT a renewal
 939         if ( $actualissue->{borrowernumber}) {
 940             # This book is currently on loan, but not to the person
 941             # who wants to borrow it now. mark it returned before issuing to the new borrower
 942             AddReturn(
 943                 $item->{'barcode'},
 944                 C4::Context->userenv->{'branch'}
 945             );
 946         }
 947
 948         # See if the item is on reserve.
 949         my ( $restype, $res ) =
 950           CheckReserves( $item->{'itemnumber'} );
 951         if ($restype) {
 952             my $resbor = $res->{'borrowernumber'};
 953             if ( $resbor eq $borrower->{'borrowernumber'} ) {
 954
 955                 # The item is reserved by the current patron
 956                 FillReserve($res);
 957             }
 958             elsif ( $restype eq "Waiting" ) {
 959
 960                 # warn "Waiting";
 961                 # The item is on reserve and waiting, but has been
 962                 # reserved by some other patron.
 963                 my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
 964                 my $branches   = GetBranches();
 965                 my $branchname =
 966                   $branches->{ $res->{'branchcode'} }->{'branchname'};
 967                 if ($cancelreserve) {
 968                     CancelReserve( 0, $res->{'itemnumber'},
 969                         $res->{'borrowernumber'} );
 970                 }
 971                 else {
 972
 973        # set waiting reserve to first in reserve queue as book isn't waiting now
 974                     UpdateReserve(
 975                         1,
 976                         $res->{'biblionumber'},
 977                         $res->{'borrowernumber'},
 978                         $res->{'branchcode'}
 979                     );
 980                 }
 981             }
 982             elsif ( $restype eq "Reserved" ) {
 983
 984                 # warn "Reserved";
 985                 # The item is reserved by someone else.
 986                 my ( $resborrower, $flags ) =
 987                   GetMemberDetails( $resbor, 0 );
 988                 my $branches   = GetBranches();
 989                 my $branchname =
 990                   $branches->{ $res->{'branchcode'} }->{'branchname'};
 991                 if ($cancelreserve) { # cancel reserves on this item
 992                     CancelReserve( 0, $res->{'itemnumber'},
 993                         $res->{'borrowernumber'} );
 994                 }
 995             }
 996         }
 997
 998         # Starting process for transfer job (checking transfert and validate it if we have one)
 999             my ($datesent) = GetTransfers($item->{'itemnumber'});
1000             if ($datesent) {
1001         #       updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
1002             my $sth =
1003                     $dbh->prepare(
1004                     "UPDATE branchtransfers
1005                         SET datearrived = now(),
1006                         tobranch = ?,
1007                         comments = 'Forced branchtransfert'
1008                     WHERE itemnumber= ? AND datearrived IS NULL"
1009                     );
1010                     $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
1011                     $sth->finish;
1012             }
1013
1014         # Record in the database the fact that the book was issued.
1015         my $sth =
1016           $dbh->prepare(
1017                 "INSERT INTO issues
1018                     (borrowernumber, itemnumber,issuedate, date_due, branchcode)
1019                 VALUES (?,?,?,?,?)"
1020           );
1021         my $loanlength = GetLoanLength(
1022             $borrower->{'categorycode'},
1023             $biblio->{'itemtype'},
1024             $borrower->{'branchcode'}
1025         );
1026         my $datedue  = time + ($loanlength) * 86400;
1027         my @datearr  = localtime($datedue);
1028         my $dateduef =
1029             ( 1900 + $datearr[5] ) . "-"
1030           . ( $datearr[4] + 1 ) . "-"
1031           . $datearr[3];
1032         if ($date) {
1033             $dateduef = $date;
1034         }
1035
1036        # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
1037         if ( C4::Context->preference('ReturnBeforeExpiry')
1038             && $dateduef gt $borrower->{dateexpiry} )
1039         {
1040             $dateduef = $borrower->{dateexpiry};
1041         }
1042         $sth->execute(
1043             $borrower->{'borrowernumber'},
1044             $item->{'itemnumber'},
1045             strftime( "%Y-%m-%d", localtime ),$dateduef, $env->{'branchcode'}
1046         );
1047         $sth->finish;
1048         $item->{'issues'}++;
1049         $sth =
1050           $dbh->prepare(
1051             "UPDATE items SET issues=?, holdingbranch=?, itemlost=0, datelastborrowed  = now() WHERE itemnumber=?");
1052         $sth->execute(
1053             $item->{'issues'},
1054             C4::Context->userenv->{'branch'},
1055             $item->{'itemnumber'}
1056         );
1057         $sth->finish;
1058         &ModDateLastSeen( $item->{'itemnumber'} );
1059         # If it costs to borrow this book, charge it to the patron's account.
1060         my ( $charge, $itemtype ) = GetIssuingCharges(
1061             $item->{'itemnumber'},
1062             $borrower->{'borrowernumber'}
1063         );
1064         if ( $charge > 0 ) {
1065             AddIssuingCharge(
1066                 $item->{'itemnumber'},
1067                 $borrower->{'borrowernumber'}, $charge
1068             );
1069             $item->{'charge'} = $charge;
1070         }
1071
1072         # Record the fact that this book was issued.
1073         &UpdateStats(
1074             $env,                           $env->{'branchcode'},
1075             'issue',                        $charge,
1076             '',                             $item->{'itemnumber'},
1077             $item->{'itemtype'}, $borrower->{'borrowernumber'}
1078         );
1079     }
1080
1081     &logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$biblio->{'biblionumber'})
1082         if C4::Context->preference("IssueLog");
1083   }
1084 }
1085
1086 =head2 GetLoanLength
1087
1088 Get loan length for an itemtype, a borrower type and a branch
1089
1090 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1091
1092 =cut
1093
1094 sub GetLoanLength {
1095     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1096     my $dbh = C4::Context->dbh;
1097     my $sth =
1098       $dbh->prepare(
1099 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=?"
1100       );
1101
1102 # try to find issuelength & return the 1st available.
1103 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1104     $sth->execute( $borrowertype, $itemtype, $branchcode );
1105     my $loanlength = $sth->fetchrow_hashref;
1106     return $loanlength->{issuelength}
1107       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1108
1109     $sth->execute( $borrowertype, $itemtype, "" );
1110     $loanlength = $sth->fetchrow_hashref;
1111     return $loanlength->{issuelength}
1112       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1113
1114     $sth->execute( $borrowertype, "*", $branchcode );
1115     $loanlength = $sth->fetchrow_hashref;
1116     return $loanlength->{issuelength}
1117       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1118
1119     $sth->execute( "*", $itemtype, $branchcode );
1120     $loanlength = $sth->fetchrow_hashref;
1121     return $loanlength->{issuelength}
1122       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1123
1124     $sth->execute( $borrowertype, "*", "" );
1125     $loanlength = $sth->fetchrow_hashref;
1126     return $loanlength->{issuelength}
1127       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1128
1129     $sth->execute( "*", "*", $branchcode );
1130     $loanlength = $sth->fetchrow_hashref;
1131     return $loanlength->{issuelength}
1132       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1133
1134     $sth->execute( "*", $itemtype, "" );
1135     $loanlength = $sth->fetchrow_hashref;
1136     return $loanlength->{issuelength}
1137       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1138
1139     $sth->execute( "*", "*", "" );
1140     $loanlength = $sth->fetchrow_hashref;
1141     return $loanlength->{issuelength}
1142       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1143
1144     # if no rule is set => 21 days (hardcoded)
1145     return 21;
1146 }
1147
1148 =head2 AddReturn
1149
1150 ($doreturn, $messages, $iteminformation, $borrower) =
1151     &AddReturn($barcode, $branch);
1152
1153 Returns a book.
1154
1155 C<$barcode> is the bar code of the book being returned. C<$branch> is
1156 the code of the branch where the book is being returned.
1157
1158 C<&AddReturn> returns a list of four items:
1159
1160 C<$doreturn> is true iff the return succeeded.
1161
1162 C<$messages> is a reference-to-hash giving the reason for failure:
1163
1164 =over 4
1165
1166 =item C<BadBarcode>
1167
1168 No item with this barcode exists. The value is C<$barcode>.
1169
1170 =item C<NotIssued>
1171
1172 The book is not currently on loan. The value is C<$barcode>.
1173
1174 =item C<IsPermanent>
1175
1176 The book's home branch is a permanent collection. If you have borrowed
1177 this book, you are not allowed to return it. The value is the code for
1178 the book's home branch.
1179
1180 =item C<wthdrawn>
1181
1182 This book has been withdrawn/cancelled. The value should be ignored.
1183
1184 =item C<ResFound>
1185
1186 The item was reserved. The value is a reference-to-hash whose keys are
1187 fields from the reserves table of the Koha database, and
1188 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1189 either C<Waiting>, C<Reserved>, or 0.
1190
1191 =back
1192
1193 C<$borrower> is a reference-to-hash, giving information about the
1194 patron who last borrowed the book.
1195
1196 =cut
1197
1198 # FIXME - This API is bogus. There's no need to return $borrower and
1199 # $iteminformation; the caller can ask about those separately, if it
1200 # cares (it'd be inefficient to make two database calls instead of
1201 # one, but &GetMemberDetails and &getiteminformation can be
1202 # memoized if this is an issue).
1203 #
1204 # The ($doreturn, $messages) tuple is redundant: if the return
1205 # succeeded, that's all the caller needs to know. So &AddReturn can
1206 # return 1 and 0 on success and failure, and set
1207 # $C4::Circulation::Circ2::errmsg to indicate the error. Or it can
1208 # return undef for success, and an error message on error (though this
1209 # is more C-ish than Perl-ish).
1210
1211 sub AddReturn {
1212     my ( $barcode, $branch ) = @_;
1213     my %env;
1214     my $messages;
1215     my $dbh      = C4::Context->dbh;
1216     my $doreturn = 1;
1217     my $validTransfert = 0;
1218     my $reserveDone = 0;
1219
1220     die '$branch not defined' unless defined $branch;  # just in case (bug 170)
1221     # get information on item
1222     my $iteminformation = GetItemIssue( GetItemFromBarcode($barcode));
1223     if ( not $iteminformation ) {
1224         $messages->{'BadBarcode'} = $barcode;
1225         $doreturn = 0;
1226     }
1227
1228     # find the borrower
1229     if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1230         $messages->{'NotIssued'} = $barcode;
1231         $doreturn = 0;
1232     }
1233
1234     # check if the book is in a permanent collection....
1235     my $hbr      = $iteminformation->{'homebranch'};
1236     my $branches = GetBranches();
1237     if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1238         $messages->{'IsPermanent'} = $hbr;
1239     }
1240
1241     # check that the book has been cancelled
1242     if ( $iteminformation->{'wthdrawn'} ) {
1243         $messages->{'wthdrawn'} = 1;itemnumber
1244         $doreturn = 0;
1245     }
1246
1247 #     new op dev : if the book returned in an other branch update the holding branch
1248
1249 # update issues, thereby returning book (should push this out into another subroutine
1250     my ($borrower) = GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1251
1252 # case of a return of document (deal with issues and holdingbranch)
1253
1254     if ($doreturn) {
1255         my $sth =
1256           $dbh->prepare(
1257 "update issues set returndate = now() where (borrowernumber = ?) and (itemnumber = ?) and (returndate is null)"
1258           );
1259         $sth->execute( $borrower->{'borrowernumber'},
1260             $iteminformation->{'itemnumber'} );
1261         $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?
1262     }
1263
1264 # continue to deal with returns cases, but not only if we have an issue
1265
1266 # the holdingbranch is updated if the document is returned in an other location .
1267 if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} )
1268         {
1269                 UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1270 #               reload iteminformation holdingbranch with the userenv value
1271                 $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1272         }
1273     ModDateLastSeen( $iteminformation->{'itemnumber'} );
1274     ($borrower) = GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1275
1276     # fix up the accounts.....
1277     if ( $iteminformation->{'itemlost'} ) {
1278         $messages->{'WasLost'} = 1;
1279     }
1280
1281    # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1282    #     check if we have a transfer for this document
1283     my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1284
1285  #     if we have a transfer to do, we update the line of transfers with the datearrived
1286     if ($datesent) {
1287         if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1288                 my $sth =
1289                 $dbh->prepare(
1290                         "update branchtransfers set datearrived = now() where itemnumber= ? AND datearrived IS NULL"
1291                 );
1292                 $sth->execute( $iteminformation->{'itemnumber'} );
1293                 $sth->finish;
1294 #         now we check if there is a reservation with the validate of transfer if we have one, we can         set it with the status 'W'
1295         SetWaitingStatus( $iteminformation->{'itemnumber'} );
1296         }
1297      else {
1298         $messages->{'WrongTransfer'} = $tobranch;
1299         $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1300      }
1301      $validTransfert = 1;
1302     }
1303
1304 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1305 # fix up the overdues in accounts...
1306     fixoverduesonreturn( $borrower->{'borrowernumber'},
1307         $iteminformation->{'itemnumber'} );
1308
1309 # find reserves.....
1310 #     if we don't have a reserve with the status W, we launch the Checkreserves routine
1311     my ( $resfound, $resrec ) =
1312       CheckReserves( $iteminformation->{'itemnumber'} );
1313     if ($resfound) {
1314
1315 #    my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'});
1316         $resrec->{'ResFound'}   = $resfound;
1317         $messages->{'ResFound'} = $resrec;
1318         $reserveDone = 1;
1319     }
1320
1321     # update stats?
1322     # Record the fact that this book was returned.
1323     UpdateStats(
1324         \%env, $branch, 'return', '0', '',
1325         $iteminformation->{'itemnumber'},
1326         $iteminformation->{'itemtype'},
1327         $borrower->{'borrowernumber'}
1328     );
1329
1330     &logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$iteminformation->{borrowernumber},$iteminformation->{'biblionumber'})
1331         if C4::Context->preference("ReturnLog");
1332
1333     #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1334     #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1335
1336     if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1337                 if (C4::Context->preference("AutomaticItemReturn") == 1) {
1338                 dotransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1339                 $messages->{'WasTransfered'} = 1;
1340                 warn "was transfered";
1341                 }
1342     }
1343
1344     return ( $doreturn, $messages, $iteminformation, $borrower );
1345 }
1346
1347 =head2 fixoverdueonreturn
1348
1349     &fixoverdueonreturn($brn,$itm);
1350
1351 C<$brn> borrowernumber
1352
1353 C<$itm> itemnumber
1354
1355 =cut
1356
1357 sub fixoverduesonreturn {
1358     my ( $borrowernumber, $item ) = @_;
1359     my $dbh = C4::Context->dbh;
1360
1361     # check for overdue fine
1362     my $sth =
1363       $dbh->prepare(
1364 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1365       );
1366     $sth->execute( $borrowernumber, $item );
1367
1368     # alter fine to show that the book has been returned
1369     if ( my $data = $sth->fetchrow_hashref ) {
1370         my $usth =
1371           $dbh->prepare(
1372 "UPDATE accountlines SET accounttype='F' WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accountno = ?)"
1373           );
1374         $usth->execute( $borrowernumber, $item, $data->{'accountno'} );
1375         $usth->finish();
1376     }
1377     $sth->finish();
1378     return;
1379 }
1380
1381 =head2 GetItemIssue
1382
1383 $issues = &GetBorrowerIssue($itemnumber);
1384
1385 Returns patrons currently having a book. nothing if item is not issued atm
1386
1387 C<$itemnumber> is the itemnumber
1388
1389 Returns an array of hashes
1390 =cut
1391
1392 sub GetItemIssue {
1393     my ( $itemnumber) = @_;
1394     my $dbh = C4::Context->dbh;
1395     my @GetItemIssues;
1396
1397     # get today date
1398     my $today = POSIX::strftime("%Y%m%d", localtime);
1399
1400     my $sth = $dbh->prepare(
1401         "SELECT * FROM issues
1402         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1403     WHERE
1404     issues.itemnumber=?  AND returndate IS NULL ");
1405     $sth->execute($itemnumber);
1406     my $data = $sth->fetchrow_hashref;
1407     my $datedue = $data->{'date_due'};
1408     $datedue =~ s/-//g;
1409     if ( $datedue < $today ) {
1410         $data->{'overdue'} = 1;
1411     }
1412     my $itemnumber = $data->{'itemnumber'};
1413     $sth->finish;
1414     return ($data);
1415 }
1416
1417 =head2 GetItemIssues
1418
1419 $issues = &GetBorrowerIssues($itemnumber, $history);
1420
1421 Returns patrons that have issued a book
1422
1423 C<$itemnumber> is the itemnumber
1424 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1425
1426 Returns an array of hashes
1427 =cut
1428
1429 sub GetItemIssues {
1430     my ( $itemnumber,$history ) = @_;
1431     my $dbh = C4::Context->dbh;
1432     my @GetItemIssues;
1433
1434     # get today date
1435     my $today = POSIX::strftime("%Y%m%d", localtime);
1436
1437     my $sth = $dbh->prepare(
1438         "SELECT * FROM issues
1439     WHERE
1440     itemnumber=?".($history?"":" AND returndate IS NULL ").
1441     "ORDER BY issues.date_due DESC"
1442     );
1443     $sth->execute($itemnumber);
1444     while ( my $data = $sth->fetchrow_hashref ) {
1445         my $datedue = $data->{'date_due'};
1446         $datedue =~ s/-//g;
1447         if ( $datedue < $today ) {
1448             $data->{'overdue'} = 1;
1449         }
1450         my $itemnumber = $data->{'itemnumber'};
1451
1452         push @GetItemIssues, $data;
1453     }
1454     $sth->finish;
1455     return ( \@GetItemIssues );
1456 }
1457
1458 =head2 GetBorrowerIssues
1459
1460 $issues = &GetBorrowerIssues($borrower);
1461
1462 Returns a list of books currently on loan to a patron.
1463
1464 C<$borrower->{borrowernumber}> is the borrower number of the patron
1465 whose issues we want to list.
1466
1467 C<&GetBorrowerIssues> returns a PHP-style array: C<$issues> is a
1468 reference-to-hash whose keys are integers in the range 1...I<n>, where
1469 I<n> is the number of items on issue (either today or before today).
1470 C<$issues-E<gt>{I<n>}> is a reference-to-hash whose keys are all of
1471 the fields of the biblio, biblioitems, items, and issues fields of the
1472 Koha database for that particular item.
1473
1474 =cut
1475
1476 sub GetBorrowerIssues {
1477     my ( $borrower ) = @_;
1478     my $dbh = C4::Context->dbh;
1479     my @GetBorrowerIssues;
1480     # get today date
1481     my $today = POSIX::strftime("%Y%m%d", localtime);
1482
1483     my $sth = $dbh->prepare(
1484         "SELECT * FROM issues
1485     LEFT JOIN items ON issues.itemnumber=items.itemnumber
1486     LEFT JOIN biblio ON     items.biblionumber=biblio.biblionumber
1487     LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1488     WHERE
1489     borrowernumber=? AND returndate IS NULL
1490     ORDER BY issues.date_due"
1491     );
1492     $sth->execute($borrower->{'borrowernumber'});
1493     while ( my $data = $sth->fetchrow_hashref ) {
1494         my $datedue = $data->{'date_due'};
1495         $datedue =~ s/-//g;
1496         if ( $datedue < $today ) {
1497             $data->{'overdue'} = 1;
1498         }
1499         my $itemnumber = $data->{'itemnumber'};
1500
1501         push @GetBorrowerIssues, $data;
1502     }
1503     $sth->finish;
1504     return ( \@GetBorrowerIssues );
1505 }
1506
1507 =head2 GetBiblioIssues
1508
1509 $issues = GetBiblioIssues($biblionumber);
1510
1511 this function get all issues from a biblionumber.
1512
1513 Return:
1514 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1515 tables issues and the firstname,surname & cardnumber from borrowers.
1516
1517 =cut
1518
1519 sub GetBiblioIssues {
1520     my $biblionumber = shift;
1521     return undef unless $biblionumber;
1522     my $dbh   = C4::Context->dbh;
1523     my $query = "
1524         SELECT issues.*,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1525         FROM issues
1526             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1527             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1528             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1529             LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1530         WHERE biblio.biblionumber = ?
1531         ORDER BY issues.timestamp
1532     ";
1533     my $sth = $dbh->prepare($query);
1534     $sth->execute($biblionumber);
1535
1536     my @issues;
1537     while ( my $data = $sth->fetchrow_hashref ) {
1538         push @issues, $data;
1539     }
1540     return \@issues;
1541 }
1542
1543 =head2 CanBookBeRenewed
1544
1545 $ok = &CanBookBeRenewed($borrowernumber, $itemnumber);
1546
1547 Find out whether a borrowed item may be renewed.
1548
1549 C<$env> is ignored.
1550
1551 C<$dbh> is a DBI handle to the Koha database.
1552
1553 C<$borrowernumber> is the borrower number of the patron who currently
1554 has the item on loan.
1555
1556 C<$itemnumber> is the number of the item to renew.
1557
1558 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1559 item must currently be on loan to the specified borrower; renewals
1560 must be allowed for the item's type; and the borrower must not have
1561 already renewed the loan.
1562
1563 =cut
1564
1565 sub CanBookBeRenewed {
1566
1567     # check renewal status
1568     my ( $borrowernumber, $itemnumber ) = @_;
1569     my $dbh       = C4::Context->dbh;
1570     my $renews    = 1;
1571     my $renewokay = 0;
1572
1573     # Look in the issues table for this item, lent to this borrower,
1574     # and not yet returned.
1575
1576     # FIXME - I think this function could be redone to use only one SQL call.
1577     my $sth1 = $dbh->prepare(
1578         "SELECT * FROM issues
1579             WHERE borrowernumber = ?
1580             AND itemnumber = ?
1581             AND returndate IS NULL"
1582     );
1583     $sth1->execute( $borrowernumber, $itemnumber );
1584     if ( my $data1 = $sth1->fetchrow_hashref ) {
1585
1586         # Found a matching item
1587
1588         # See if this item may be renewed. This query is convoluted
1589         # because it's a bit messy: given the item number, we need to find
1590         # the biblioitem, which gives us the itemtype, which tells us
1591         # whether it may be renewed.
1592         my $sth2 = $dbh->prepare(
1593             "SELECT renewalsallowed FROM items
1594                 LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1595                 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1596                 WHERE items.itemnumber = ?
1597                 "
1598         );
1599         $sth2->execute($itemnumber);
1600         if ( my $data2 = $sth2->fetchrow_hashref ) {
1601             $renews = $data2->{'renewalsallowed'};
1602         }
1603         if ( $renews && $renews > $data1->{'renewals'} ) {
1604             $renewokay = 1;
1605         }
1606         $sth2->finish;
1607         my ( $resfound, $resrec ) = C4::Reserves2::CheckReserves($itemnumber);
1608         if ($resfound) {
1609             $renewokay = 0;
1610         }
1611         ( $resfound, $resrec ) = C4::Reserves2::CheckReserves($itemnumber);
1612         if ($resfound) {
1613             $renewokay = 0;
1614         }
1615
1616     }
1617     $sth1->finish;
1618     return ($renewokay);
1619 }
1620
1621 =head2 AddRenewal
1622
1623 &AddRenewal($borrowernumber, $itemnumber, $datedue);
1624
1625 Renews a loan.
1626
1627 C<$env-E<gt>{branchcode}> is the code of the branch where the
1628 renewal is taking place.
1629
1630 C<$env-E<gt>{usercode}> is the value to log in C<statistics.usercode>
1631 in the Koha database.
1632
1633 C<$borrowernumber> is the borrower number of the patron who currently
1634 has the item.
1635
1636 C<$itemnumber> is the number of the item to renew.
1637
1638 C<$datedue> can be used to set the due date. If C<$datedue> is the
1639 empty string, C<&AddRenewal> will calculate the due date automatically
1640 from the book's item type. If you wish to set the due date manually,
1641 C<$datedue> should be in the form YYYY-MM-DD.
1642
1643 =cut
1644
1645 sub AddRenewal {
1646
1647     my ( $borrowernumber, $itemnumber, $datedue ) = @_;
1648     my $dbh = C4::Context->dbh;
1649
1650     # If the due date wasn't specified, calculate it by adding the
1651     # book's loan length to today's date.
1652     if ( $datedue eq "" ) {
1653
1654         my $biblio = GetBiblioFromItemNumber($itemnumber);
1655         my $borrower = GetMemberDetails( $borrowernumber, 0 );
1656         my $loanlength = GetLoanLength(
1657             $borrower->{'categorycode'},
1658             $biblio->{'itemtype'},
1659             $borrower->{'branchcode'}
1660         );
1661         my ( $due_year, $due_month, $due_day ) =
1662           Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
1663         $datedue = "$due_year-$due_month-$due_day";
1664
1665     }
1666
1667     # Find the issues record for this book
1668     my $sth =
1669       $dbh->prepare("SELECT * FROM issues
1670                         WHERE borrowernumber=?
1671                         AND itemnumber=?
1672                         AND returndate IS NULL"
1673       );
1674     $sth->execute( $borrowernumber, $itemnumber );
1675     my $issuedata = $sth->fetchrow_hashref;
1676     $sth->finish;
1677
1678     # Update the issues record to have the new due date, and a new count
1679     # of how many times it has been renewed.
1680     my $renews = $issuedata->{'renewals'} + 1;
1681     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1682                             WHERE borrowernumber=?
1683                             AND itemnumber=?
1684                             AND returndate IS NULL"
1685     );
1686     $sth->execute( $datedue, $renews, $borrowernumber, $itemnumber );
1687     $sth->finish;
1688
1689     # Log the renewal
1690     UpdateStats( C4::Context->userenv->{'branchcode'}, 'renew', '', '', $itemnumber );
1691
1692     # Charge a new rental fee, if applicable?
1693     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1694     if ( $charge > 0 ) {
1695         my $accountno = getnextacctno( $borrowernumber );
1696         my $item = GetBiblioFromItemNumbe(r$itemnumber);
1697         $sth = $dbh->prepare(
1698                 "INSERT INTO accountlines
1699                     (borrowernumber,accountno,date,amount,
1700                         description,accounttype,amountoutstanding,
1701                     itemnumber)
1702                     VALUES (?,?,now(),?,?,?,?,?)"
1703         );
1704         $sth->execute( $borrowernumber, $accountno, $charge,
1705             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1706             'Rent', $charge, $itemnumber );
1707         $sth->finish;
1708     }
1709 }
1710
1711 =head2 GetIssuingCharges
1712
1713 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
1714
1715 Calculate how much it would cost for a given patron to borrow a given
1716 item, including any applicable discounts.
1717
1718 C<$env> is ignored.
1719
1720 C<$itemnumber> is the item number of item the patron wishes to borrow.
1721
1722 C<$borrowernumber> is the patron's borrower number.
1723
1724 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
1725 and C<$item_type> is the code for the item's item type (e.g., C<VID>
1726 if it's a video).
1727
1728 =cut
1729
1730 sub GetIssuingCharges {
1731
1732     # calculate charges due
1733     my ( $itemnumber, $borrowernumber ) = @_;
1734     my $charge = 0;
1735     my $dbh    = C4::Context->dbh;
1736     my $item_type;
1737
1738     # Get the book's item type and rental charge (via its biblioitem).
1739     my $sth1 = $dbh->prepare(
1740         "SELECT itemtypes.itemtype,rentalcharge FROM items
1741             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1742             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1743             WHERE items.itemnumber =?
1744         "
1745     );
1746     $sth1->execute($itemnumber);
1747     if ( my $data1 = $sth1->fetchrow_hashref ) {
1748         $item_type = $data1->{'itemtype'};
1749         $charge    = $data1->{'rentalcharge'};
1750         my $q2 = "SELECT rentaldiscount FROM borrowers
1751             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
1752             WHERE borrowers.borrowernumber = ?
1753             AND issuingrules.itemtype = ?";
1754         my $sth2 = $dbh->prepare($q2);
1755         $sth2->execute( $borrowernumber, $item_type );
1756         if ( my $data2 = $sth2->fetchrow_hashref ) {
1757             my $discount = $data2->{'rentaldiscount'};
1758             if ( $discount eq 'NULL' ) {
1759                 $discount = 0;
1760             }
1761             $charge = ( $charge * ( 100 - $discount ) ) / 100;
1762         }
1763         $sth2->finish;
1764     }
1765
1766     $sth1->finish;
1767     return ( $charge, $item_type );
1768 }
1769
1770 =head2 AddIssuingCharge
1771
1772 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
1773
1774 =cut
1775
1776 sub AddIssuingCharge {
1777     my ( $itemnumber, $borrowernumber, $charge ) = @_;
1778     my $dbh = C4::Context->dbh;
1779     my $nextaccntno = getnextacctno( $borrowernumber );
1780     my $query ="
1781         INSERT INTO accountlines
1782             (borrowernumber, itemnumber, accountno,
1783             date, amount, description, accounttype,
1784             amountoutstanding)
1785         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
1786     ";
1787     my $sth = $dbh->prepare($query);
1788     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
1789     $sth->finish;
1790 }
1791
1792 =head2 GetTransfers
1793
1794 GetTransfers($itemnumber);
1795
1796 =cut
1797
1798 sub GetTransfers {
1799     my ($itemnumber) = @_;
1800
1801     my $dbh = C4::Context->dbh;
1802
1803     my $query = '
1804         SELECT datesent,
1805                frombranch,
1806                tobranch
1807         FROM branchtransfers
1808         WHERE itemnumber = ?
1809           AND datearrived IS NULL
1810         ';
1811     my $sth = $dbh->prepare($query);
1812     $sth->execute($itemnumber);
1813     my @row = $sth->fetchrow_array();
1814     $sth->finish;
1815     return @row;
1816 }
1817
1818
1819 =head2 GetTransfersFromTo
1820
1821 @results = GetTransfersFromTo($frombranch,$tobranch);
1822
1823 Returns the list of pending transfers between $from and $to branch
1824
1825 =cut
1826
1827 sub GetTransfersFromTo {
1828     my ( $frombranch, $tobranch ) = @_;
1829     return unless ( $frombranch && $tobranch );
1830     my $dbh   = C4::Context->dbh;
1831     my $query = "
1832         SELECT itemnumber,datesent,frombranch
1833         FROM   branchtransfers
1834         WHERE  frombranch=?
1835           AND  tobranch=?
1836           AND datearrived IS NULL
1837     ";
1838     my $sth = $dbh->prepare($query);
1839     $sth->execute( $frombranch, $tobranch );
1840     my @gettransfers;
1841
1842     while ( my $data = $sth->fetchrow_hashref ) {
1843         push @gettransfers, $data;
1844     }
1845     $sth->finish;
1846     return (@gettransfers);
1847 }
1848
1849 =head2 DeleteTransfer
1850
1851 &DeleteTransfer($itemnumber);
1852
1853 =cut
1854
1855 sub DeleteTransfer {
1856     my ($itemnumber) = @_;
1857     my $dbh          = C4::Context->dbh;
1858     my $sth          = $dbh->prepare(
1859         "DELETE FROM branchtransfers
1860          WHERE itemnumber=?
1861          AND datearrived IS NULL "
1862     );
1863     $sth->execute($itemnumber);
1864     $sth->finish;
1865 }
1866
1867 =head2 AnonymiseIssueHistory
1868
1869 $rows = AnonymiseIssueHistory($borrowernumber,$date)
1870
1871 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
1872 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
1873
1874 return the number of affected rows.
1875
1876 =cut
1877
1878 sub AnonymiseIssueHistory {
1879     my $date           = shift;
1880     my $borrowernumber = shift;
1881     my $dbh            = C4::Context->dbh;
1882     my $query          = "
1883         UPDATE issues
1884         SET    borrowernumber = NULL
1885         WHERE  returndate < '".$date."'
1886           AND borrowernumber IS NOT NULL
1887     ";
1888     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
1889     my $rows_affected = $dbh->do($query);
1890     return $rows_affected;
1891 }
1892
1893 =head2 updateWrongTransfer
1894
1895 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
1896
1897 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
1898
1899 =cut
1900
1901 sub updateWrongTransfer {
1902         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
1903         my $dbh = C4::Context->dbh;
1904 # first step validate the actual line of transfert .
1905         my $sth =
1906                 $dbh->prepare(
1907                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
1908                 );
1909                 $sth->execute($FromLibrary,$itemNumber);
1910                 $sth->finish;
1911
1912 # second step create a new line of branchtransfer to the right location .
1913         dotransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
1914
1915 #third step changing holdingbranch of item
1916         UpdateHoldingbranch($FromLibrary,$itemNumber);
1917 }
1918
1919 =head2 UpdateHoldingbranch
1920
1921 $items = UpdateHoldingbranch($branch,$itmenumber);
1922 Simple methode for updating hodlingbranch in items BDD line
1923 =cut
1924
1925 sub UpdateHoldingbranch {
1926         my ( $branch,$itmenumber ) = @_;
1927         my $dbh = C4::Context->dbh;
1928 # first step validate the actual line of transfert .
1929         my $sth =
1930                 $dbh->prepare(
1931                         "update items set holdingbranch = ? where itemnumber= ?"
1932                 );
1933                 $sth->execute($branch,$itmenumber);
1934                 $sth->finish;
1935
1936
1937 }
1938
1939 1;
1940
1941 __END__
1942
1943 =head1 AUTHOR
1944
1945 Koha Developement team <info@koha.org>
1946
1947 =cut
1948