C4/Overdues.pm

   1 package C4::Overdues;
   2
   3
   4 # Copyright 2000-2002 Katipo Communications
   5 # copyright 2010 BibLibre
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it under the
  10 # terms of the GNU General Public License as published by the Free Software
  11 # Foundation; either version 2 of the License, or (at your option) any later
  12 # version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along
  19 # with Koha; if not, write to the Free Software Foundation, Inc.,
  20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  21
  22 use strict;
  23 #use warnings; FIXME - Bug 2505
  24 use Date::Calc qw/Today Date_to_Days/;
  25 use Date::Manip qw/UnixDate/;
  26 use C4::Circulation;
  27 use C4::Context;
  28 use C4::Accounts;
  29 use C4::Log; # logaction
  30 use C4::Debug;
  31
  32 use vars qw($VERSION @ISA @EXPORT);
  33
  34 BEGIN {
  35         # set the version for version checking
  36         $VERSION = 3.01;
  37         require Exporter;
  38         @ISA    = qw(Exporter);
  39         # subs to rename (and maybe merge some...)
  40         push @EXPORT, qw(
  41         &CalcFine
  42         &Getoverdues
  43         &checkoverdues
  44         &CheckAccountLineLevelInfo
  45         &CheckAccountLineItemInfo
  46         &CheckExistantNotifyid
  47         &GetNextIdNotify
  48         &GetNotifyId
  49         &NumberNotifyId
  50         &AmountNotify
  51         &UpdateAccountLines
  52         &UpdateFine
  53         &GetOverdueDelays
  54         &GetOverduerules
  55         &GetFine
  56         &CreateItemAccountLine
  57         &ReplacementCost2
  58
  59         &CheckItemNotify
  60         &GetOverduesForBranch
  61         &RemoveNotifyLine
  62         &AddNotifyLine
  63         );
  64         # subs to remove
  65         push @EXPORT, qw(
  66         &BorType
  67         );
  68
  69         # check that an equivalent don't exist already before moving
  70
  71         # subs to move to Circulation.pm
  72         push @EXPORT, qw(
  73         &GetIssuesIteminfo
  74         );
  75     #
  76         # &GetIssuingRules - delete.
  77         # use C4::Circulation::GetIssuingRule instead.
  78
  79         # subs to move to Members.pm
  80         push @EXPORT, qw(
  81         &CheckBorrowerDebarred
  82         );
  83         # subs to move to Biblio.pm
  84         push @EXPORT, qw(
  85         &GetItems
  86         &ReplacementCost
  87         );
  88 }
  89
  90 =head1 NAME
  91
  92 C4::Circulation::Fines - Koha module dealing with fines
  93
  94 =head1 SYNOPSIS
  95
  96   use C4::Overdues;
  97
  98 =head1 DESCRIPTION
  99
 100 This module contains several functions for dealing with fines for
 101 overdue items. It is primarily used by the 'misc/fines2.pl' script.
 102
 103 =head1 FUNCTIONS
 104
 105 =head2 Getoverdues
 106
 107   $overdues = Getoverdues( { minimumdays => 1, maximumdays => 30 } );
 108
 109 Returns the list of all overdue books, with their itemtype.
 110
 111 C<$overdues> is a reference-to-array. Each element is a
 112 reference-to-hash whose keys are the fields of the issues table in the
 113 Koha database.
 114
 115 =cut
 116
 117 #'
 118 sub Getoverdues {
 119     my $params = shift;
 120     my $dbh = C4::Context->dbh;
 121     my $statement;
 122     if ( C4::Context->preference('item-level_itypes') ) {
 123         $statement = "
 124    SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode
 125      FROM issues
 126 LEFT JOIN items       USING (itemnumber)
 127     WHERE date_due < NOW()
 128 ";
 129     } else {
 130         $statement = "
 131    SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode
 132      FROM issues
 133 LEFT JOIN items       USING (itemnumber)
 134 LEFT JOIN biblioitems USING (biblioitemnumber)
 135     WHERE date_due < NOW()
 136 ";
 137     }
 138
 139     my @bind_parameters;
 140     if ( exists $params->{'minimumdays'} and exists $params->{'maximumdays'} ) {
 141         $statement .= ' AND TO_DAYS( NOW() )-TO_DAYS( date_due ) BETWEEN ? and ? ';
 142         push @bind_parameters, $params->{'minimumdays'}, $params->{'maximumdays'};
 143     } elsif ( exists $params->{'minimumdays'} ) {
 144         $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) > ? ';
 145         push @bind_parameters, $params->{'minimumdays'};
 146     } elsif ( exists $params->{'maximumdays'} ) {
 147         $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ? ';
 148         push @bind_parameters, $params->{'maximumdays'};
 149     }
 150     $statement .= 'ORDER BY borrowernumber';
 151     my $sth = $dbh->prepare( $statement );
 152     $sth->execute( @bind_parameters );
 153     return $sth->fetchall_arrayref({});
 154 }
 155
 156
 157 =head2 checkoverdues
 158
 159     ($count, $overdueitems) = checkoverdues($borrowernumber);
 160
 161 Returns a count and a list of overdueitems for a given borrowernumber
 162
 163 =cut
 164
 165 sub checkoverdues {
 166     my $borrowernumber = shift or return;
 167     # don't select biblioitems.marc or biblioitems.marcxml... too slow on large systems
 168     my $sth = C4::Context->dbh->prepare(
 169         "SELECT biblio.*, items.*, issues.*,
 170                 biblioitems.volume,
 171                 biblioitems.number,
 172                 biblioitems.itemtype,
 173                 biblioitems.isbn,
 174                 biblioitems.issn,
 175                 biblioitems.publicationyear,
 176                 biblioitems.publishercode,
 177                 biblioitems.volumedate,
 178                 biblioitems.volumedesc,
 179                 biblioitems.collectiontitle,
 180                 biblioitems.collectionissn,
 181                 biblioitems.collectionvolume,
 182                 biblioitems.editionstatement,
 183                 biblioitems.editionresponsibility,
 184                 biblioitems.illus,
 185                 biblioitems.pages,
 186                 biblioitems.notes,
 187                 biblioitems.size,
 188                 biblioitems.place,
 189                 biblioitems.lccn,
 190                 biblioitems.url,
 191                 biblioitems.cn_source,
 192                 biblioitems.cn_class,
 193                 biblioitems.cn_item,
 194                 biblioitems.cn_suffix,
 195                 biblioitems.cn_sort,
 196                 biblioitems.totalissues
 197          FROM issues
 198          LEFT JOIN items       ON issues.itemnumber      = items.itemnumber
 199          LEFT JOIN biblio      ON items.biblionumber     = biblio.biblionumber
 200          LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 201             WHERE issues.borrowernumber  = ?
 202             AND   issues.date_due < NOW()"
 203     );
 204     # FIXME: SELECT * across 4 tables?  do we really need the marc AND marcxml blobs??
 205     $sth->execute($borrowernumber);
 206     my $results = $sth->fetchall_arrayref({});
 207     return ( scalar(@$results), $results);  # returning the count and the results is silly
 208 }
 209
 210 =head2 CalcFine
 211
 212     ($amount, $chargename,  $daycounttotal) = &CalcFine($item,
 213                                   $categorycode, $branch,
 214                                   $start_dt, $end_dt );
 215
 216 Calculates the fine for a book.
 217
 218 The issuingrules table in the Koha database is a fine matrix, listing
 219 the penalties for each type of patron for each type of item and each branch (e.g., the
 220 standard fine for books might be $0.50, but $1.50 for DVDs, or staff
 221 members might get a longer grace period between the first and second
 222 reminders that a book is overdue).
 223
 224
 225 C<$item> is an item object (hashref).
 226
 227 C<$categorycode> is the category code (string) of the patron who currently has
 228 the book.
 229
 230 C<$branchcode> is the library (string) whose issuingrules govern this transaction.
 231
 232 C<$start_date> & C<$end_date> are DateTime objects
 233 defining the date range over which to determine the fine.
 234
 235 Fines scripts should just supply the date range over which to calculate the fine.
 236
 237 C<&CalcFine> returns four values:
 238
 239 C<$amount> is the fine owed by the patron (see above).
 240
 241 C<$chargename> is the chargename field from the applicable record in
 242 the categoryitem table, whatever that is.
 243
 244 C<$daycount> is the number of days between start and end dates, Calendar adjusted (where needed),
 245 minus any applicable grace period.
 246
 247 FIXME - What is chargename supposed to be ?
 248
 249 FIXME: previously attempted to return C<$message> as a text message, either "First Notice", "Second Notice",
 250 or "Final Notice".  But CalcFine never defined any value.
 251
 252 =cut
 253
 254 sub CalcFine {
 255     my ( $item, $bortype, $branchcode, $due_dt, $end_date  ) = @_;
 256     my $start_date = $due_dt->clone();
 257     # get issuingrules (fines part will be used)
 258     my $data = C4::Circulation::GetIssuingRule($bortype, $item->{itemtype}, $branchcode);
 259     my $fine_unit = $data->{lengthunit};
 260     $fine_unit ||= 'days';
 261
 262     my $chargeable_units = _get_chargeable_units($fine_unit, $start_date, $end_date, $branchcode);
 263     my $units_minus_grace = $chargeable_units - $data->{firstremind};
 264     my $amount = 0;
 265     if ($data->{'chargeperiod'}  && $units_minus_grace  ) {
 266         $amount = int($chargeable_units / $data->{'chargeperiod'}) * $data->{'fine'};# TODO fine calc should be in cents
 267     } else {
 268         # a zero (or null)  chargeperiod means no charge.
 269     }
 270     if(C4::Context->preference('maxFine') && ( $amount > C4::Context->preference('maxFine'))) {
 271         $amount = C4::Context->preference('maxFine');
 272     }
 273     return ($amount, $data->{chargename}, $units_minus_grace);
 274     # FIXME: chargename is NEVER populated anywhere.
 275 }
 276
 277
 278 =head2 _get_chargeable_units
 279
 280     _get_chargeable_units($unit, $start_date_ $end_date, $branchcode);
 281
 282 return integer value of units between C<$start_date> and C<$end_date>, factoring in holidays for C<$branchcode>.
 283
 284 C<$unit> is 'days' or 'hours' (default is 'days').
 285
 286 C<$start_date> and C<$end_date> are the two DateTimes to get the number of units between.
 287
 288 C<$branchcode> is the branch whose calendar to use for finding holidays.
 289
 290 =cut
 291
 292 sub _get_chargeable_units {
 293     my ($unit, $dt1, $dt2, $branchcode) = @_;
 294     my $charge_units = 0;
 295     my $charge_duration;
 296     if ($unit eq 'hours') {
 297         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
 298             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
 299             $charge_duration = $calendar->hours_between( $dt1, $dt2 );
 300         } else {
 301             $charge_duration = $dt2->delta_ms( $dt1 );
 302         }
 303         return $charge_duration->in_units('hours');
 304     }
 305     else { # days
 306         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
 307             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
 308             $charge_duration = $calendar->days_between( $dt1, $dt2 );
 309         } else {
 310             $charge_duration = $dt2->delta_days( $dt1 );
 311         }
 312         return $charge_duration->in_units('days');
 313     }
 314 }
 315
 316
 317 =head2 GetSpecialHolidays
 318
 319     &GetSpecialHolidays($date_dues,$itemnumber);
 320
 321 return number of special days  between date of the day and date due
 322
 323 C<$date_dues> is the envisaged date of book return.
 324
 325 C<$itemnumber> is the book's item number.
 326
 327 =cut
 328
 329 sub GetSpecialHolidays {
 330     my ( $date_dues, $itemnumber ) = @_;
 331
 332     # calcul the today date
 333     my $today = join "-", &Today();
 334
 335     # return the holdingbranch
 336     my $iteminfo = GetIssuesIteminfo($itemnumber);
 337
 338     # use sql request to find all date between date_due and today
 339     my $dbh = C4::Context->dbh;
 340     my $query =
 341       qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') as date
 342 FROM `special_holidays`
 343 WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
 344 AND   DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
 345 AND branchcode=?
 346 |;
 347     my @result = GetWdayFromItemnumber($itemnumber);
 348     my @result_date;
 349     my $wday;
 350     my $dateinsec;
 351     my $sth = $dbh->prepare($query);
 352     $sth->execute( $date_dues, $today, $iteminfo->{'branchcode'} )
 353       ;    # FIXME: just use NOW() in SQL instead of passing in $today
 354
 355     while ( my $special_date = $sth->fetchrow_hashref ) {
 356         push( @result_date, $special_date );
 357     }
 358
 359     my $specialdaycount = scalar(@result_date);
 360
 361     for ( my $i = 0 ; $i < scalar(@result_date) ; $i++ ) {
 362         $dateinsec = UnixDate( $result_date[$i]->{'date'}, "%o" );
 363         ( undef, undef, undef, undef, undef, undef, $wday, undef, undef ) =
 364           localtime($dateinsec);
 365         for ( my $j = 0 ; $j < scalar(@result) ; $j++ ) {
 366             if ( $wday == ( $result[$j]->{'weekday'} ) ) {
 367                 $specialdaycount--;
 368             }
 369         }
 370     }
 371
 372     return $specialdaycount;
 373 }
 374
 375 =head2 GetRepeatableHolidays
 376
 377     &GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
 378
 379 return number of day closed between date of the day and date due
 380
 381 C<$date_dues> is the envisaged date of book return.
 382
 383 C<$itemnumber> is item number.
 384
 385 C<$difference> numbers of between day date of the day and date due
 386
 387 =cut
 388
 389 sub GetRepeatableHolidays {
 390     my ( $date_dues, $itemnumber, $difference ) = @_;
 391     my $dateinsec = UnixDate( $date_dues, "%o" );
 392     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
 393       localtime($dateinsec);
 394     my @result = GetWdayFromItemnumber($itemnumber);
 395     my @dayclosedcount;
 396     my $j;
 397
 398     for ( my $i = 0 ; $i < scalar(@result) ; $i++ ) {
 399         my $k = $wday;
 400
 401         for ( $j = 0 ; $j < $difference ; $j++ ) {
 402             if ( $result[$i]->{'weekday'} == $k ) {
 403                 push( @dayclosedcount, $k );
 404             }
 405             $k++;
 406             ( $k = 0 ) if ( $k eq 7 );
 407         }
 408     }
 409     return scalar(@dayclosedcount);
 410 }
 411
 412
 413 =head2 GetWayFromItemnumber
 414
 415     &Getwdayfromitemnumber($itemnumber);
 416
 417 return the different week day from repeatable_holidays table
 418
 419 C<$itemnumber> is  item number.
 420
 421 =cut
 422
 423 sub GetWdayFromItemnumber {
 424     my ($itemnumber) = @_;
 425     my $iteminfo = GetIssuesIteminfo($itemnumber);
 426     my @result;
 427     my $query = qq|SELECT weekday
 428     FROM repeatable_holidays
 429     WHERE branchcode=?
 430 |;
 431     my $sth = C4::Context->dbh->prepare($query);
 432
 433     $sth->execute( $iteminfo->{'branchcode'} );
 434     while ( my $weekday = $sth->fetchrow_hashref ) {
 435         push( @result, $weekday );
 436     }
 437     return @result;
 438 }
 439
 440
 441 =head2 GetIssuesIteminfo
 442
 443     &GetIssuesIteminfo($itemnumber);
 444
 445 return all data from issues about item
 446
 447 C<$itemnumber> is  item number.
 448
 449 =cut
 450
 451 sub GetIssuesIteminfo {
 452     my ($itemnumber) = @_;
 453     my $dbh          = C4::Context->dbh;
 454     my $query        = qq|SELECT *
 455     FROM issues
 456     WHERE itemnumber=?
 457     |;
 458     my $sth = $dbh->prepare($query);
 459     $sth->execute($itemnumber);
 460     my ($issuesinfo) = $sth->fetchrow_hashref;
 461     return $issuesinfo;
 462 }
 463
 464
 465 =head2 UpdateFine
 466
 467     &UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description);
 468
 469 (Note: the following is mostly conjecture and guesswork.)
 470
 471 Updates the fine owed on an overdue book.
 472
 473 C<$itemnumber> is the book's item number.
 474
 475 C<$borrowernumber> is the borrower number of the patron who currently
 476 has the book on loan.
 477
 478 C<$amount> is the current amount owed by the patron.
 479
 480 C<$type> will be used in the description of the fine.
 481
 482 C<$description> is a string that must be present in the description of
 483 the fine. I think this is expected to be a date in DD/MM/YYYY format.
 484
 485 C<&UpdateFine> looks up the amount currently owed on the given item
 486 and sets it to C<$amount>, creating, if necessary, a new entry in the
 487 accountlines table of the Koha database.
 488
 489 =cut
 490
 491 #
 492 # Question: Why should the caller have to
 493 # specify both the item number and the borrower number? A book can't
 494 # be on loan to two different people, so the item number should be
 495 # sufficient.
 496 #
 497 # Possible Answer: You might update a fine for a damaged item, *after* it is returned.
 498 #
 499 sub UpdateFine {
 500     my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_;
 501         $debug and warn "UpdateFine($itemnum, $borrowernumber, $amount, " . ($type||'""') . ", $due) called";
 502     my $dbh = C4::Context->dbh;
 503     # FIXME - What exactly is this query supposed to do? It looks up an
 504     # entry in accountlines that matches the given item and borrower
 505     # numbers, where the description contains $due, and where the
 506     # account type has one of several values, but what does this _mean_?
 507     # Does it look up existing fines for this item?
 508     # FIXME - What are these various account types? ("FU", "O", "F", "M")
 509         #       "L"   is LOST item
 510         #   "A"   is Account Management Fee
 511         #   "N"   is New Card
 512         #   "M"   is Sundry
 513         #   "O"   is Overdue ??
 514         #   "F"   is Fine ??
 515         #   "FU"  is Fine UPDATE??
 516         #       "Pay" is Payment
 517         #   "REF" is Cash Refund
 518     my $sth = $dbh->prepare(
 519         "SELECT * FROM accountlines
 520                 WHERE itemnumber=?
 521                 AND   borrowernumber=?
 522                 AND   accounttype IN ('FU','O','F','M')
 523                 AND   description like ? "
 524     );
 525     $sth->execute( $itemnum, $borrowernumber, "%$due%" );
 526
 527     if ( my $data = $sth->fetchrow_hashref ) {
 528
 529                 # we're updating an existing fine.  Only modify if amount changed
 530         # Note that in the current implementation, you cannot pay against an accruing fine
 531         # (i.e. , of accounttype 'FU').  Doing so will break accrual.
 532         if ( $data->{'amount'} != $amount ) {
 533             my $diff = $amount - $data->{'amount'};
 534             #3341: diff could be positive or negative!
 535             my $out  = $data->{'amountoutstanding'} + $diff;
 536             my $query = "
 537                 UPDATE accountlines
 538                                 SET date=now(), amount=?, amountoutstanding=?,
 539                                         lastincrement=?, accounttype='FU'
 540                                 WHERE borrowernumber=?
 541                                 AND   itemnumber=?
 542                                 AND   accounttype IN ('FU','O')
 543                                 AND   description LIKE ?
 544                                 LIMIT 1 ";
 545             my $sth2 = $dbh->prepare($query);
 546                         # FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!!
 547                         #               LIMIT 1 added to prevent multiple affected lines
 548                         # FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline.
 549                         #               But actually, we should just have a regular autoincrementing PK and forget accountline,
 550                         #               including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops).
 551                         # FIXME: Why only 2 account types here?
 552                         $debug and print STDERR "UpdateFine query: $query\n" .
 553                                 "w/ args: $amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, \"\%$due\%\"\n";
 554             $sth2->execute($amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, "%$due%");
 555         } else {
 556             #      print "no update needed $data->{'amount'}"
 557         }
 558     } else {
 559         my $sth4 = $dbh->prepare(
 560             "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?"
 561         );
 562         $sth4->execute($itemnum);
 563         my $title = $sth4->fetchrow;
 564
 565 #         #   print "not in account";
 566 #         my $sth3 = $dbh->prepare("Select max(accountno) from accountlines");
 567 #         $sth3->execute;
 568 #
 569 #         # FIXME - Make $accountno a scalar.
 570 #         my @accountno = $sth3->fetchrow_array;
 571 #         $sth3->finish;
 572 #         $accountno[0]++;
 573 # begin transaction
 574                 my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
 575                 my $desc = ($type ? "$type " : '') . "$title $due";     # FIXEDME, avoid whitespace prefix on empty $type
 576                 my $query = "INSERT INTO accountlines
 577                     (borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno)
 578                             VALUES (?,?,now(),?,?,'FU',?,?,?)";
 579                 my $sth2 = $dbh->prepare($query);
 580                 $debug and print STDERR "UpdateFine query: $query\nw/ args: $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno\n";
 581         $sth2->execute($borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno);
 582     }
 583     # logging action
 584     &logaction(
 585         "FINES",
 586         $type,
 587         $borrowernumber,
 588         "due=".$due."  amount=".$amount." itemnumber=".$itemnum
 589         ) if C4::Context->preference("FinesLog");
 590 }
 591
 592 =head2 BorType
 593
 594     $borrower = &BorType($borrowernumber);
 595
 596 Looks up a patron by borrower number.
 597
 598 C<$borrower> is a reference-to-hash whose keys are all of the fields
 599 from the borrowers and categories tables of the Koha database. Thus,
 600 C<$borrower> contains all information about both the borrower and
 601 category he or she belongs to.
 602
 603 =cut
 604
 605 #'
 606 sub BorType {
 607     my ($borrowernumber) = @_;
 608     my $dbh              = C4::Context->dbh;
 609     my $sth              = $dbh->prepare(
 610         "SELECT * from borrowers
 611       LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
 612       WHERE borrowernumber=?"
 613     );
 614     $sth->execute($borrowernumber);
 615     return $sth->fetchrow_hashref;
 616 }
 617
 618 =head2 ReplacementCost
 619
 620     $cost = &ReplacementCost($itemnumber);
 621
 622 Returns the replacement cost of the item with the given item number.
 623
 624 =cut
 625
 626 #'
 627 sub ReplacementCost {
 628     my ($itemnum) = @_;
 629     my $dbh       = C4::Context->dbh;
 630     my $sth       =
 631       $dbh->prepare("Select replacementprice from items where itemnumber=?");
 632     $sth->execute($itemnum);
 633
 634     # FIXME - Use fetchrow_array or a slice.
 635     my $data = $sth->fetchrow_hashref;
 636     return ( $data->{'replacementprice'} );
 637 }
 638
 639 =head2 GetFine
 640
 641     $data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
 642
 643 return the total of fine
 644
 645 C<$itemnum> is item number
 646
 647 C<$borrowernumber> is the borrowernumber
 648
 649 =cut
 650
 651
 652 sub GetFine {
 653     my ( $itemnum, $borrowernumber ) = @_;
 654     my $dbh   = C4::Context->dbh();
 655     my $query = q|SELECT sum(amountoutstanding) as fineamount FROM accountlines
 656     where accounttype like 'F%'
 657   AND amountoutstanding > 0 AND itemnumber = ? AND borrowernumber=?|;
 658     my $sth = $dbh->prepare($query);
 659     $sth->execute( $itemnum, $borrowernumber );
 660     my $fine = $sth->fetchrow_hashref();
 661     if ($fine->{fineamount}) {
 662         return $fine->{fineamount};
 663     }
 664     return 0;
 665 }
 666
 667
 668 =head2 GetIssuingRules
 669
 670 FIXME - This sub should be deprecated and removed.
 671 It ignores branch and defaults.
 672
 673     $data = &GetIssuingRules($itemtype,$categorycode);
 674
 675 Looks up for all issuingrules an item info
 676
 677 C<$itemnumber> is a reference-to-hash whose keys are all of the fields
 678 from the borrowers and categories tables of the Koha database. Thus,
 679
 680 C<$categorycode> contains  information about borrowers category
 681
 682 C<$data> contains all information about both the borrower and
 683 category he or she belongs to.
 684 =cut
 685
 686 sub GetIssuingRules {
 687         warn "GetIssuingRules is deprecated: use GetIssuingRule from C4::Circulation instead.";
 688    my ($itemtype,$categorycode)=@_;
 689    my $dbh   = C4::Context->dbh();
 690    my $query=qq|SELECT *
 691         FROM issuingrules
 692         WHERE issuingrules.itemtype=?
 693             AND issuingrules.categorycode=?
 694         |;
 695     my $sth = $dbh->prepare($query);
 696     #  print $query;
 697     $sth->execute($itemtype,$categorycode);
 698     return $sth->fetchrow_hashref;
 699 }
 700
 701
 702 sub ReplacementCost2 {
 703     my ( $itemnum, $borrowernumber ) = @_;
 704     my $dbh   = C4::Context->dbh();
 705     my $query = "SELECT amountoutstanding
 706          FROM accountlines
 707              WHERE accounttype like 'L'
 708          AND amountoutstanding > 0
 709          AND itemnumber = ?
 710          AND borrowernumber= ?";
 711     my $sth = $dbh->prepare($query);
 712     $sth->execute( $itemnum, $borrowernumber );
 713     my $data = $sth->fetchrow_hashref();
 714     return ( $data->{'amountoutstanding'} );
 715 }
 716
 717
 718 =head2 GetNextIdNotify
 719
 720     ($result) = &GetNextIdNotify($reference);
 721
 722 Returns the new file number
 723
 724 C<$result> contains the next file number
 725
 726 C<$reference> contains the beggining of file number
 727
 728 =cut
 729
 730 sub GetNextIdNotify {
 731     my ($reference) = @_;
 732     my $query = qq|SELECT max(notify_id)
 733          FROM accountlines
 734          WHERE notify_id  like \"$reference%\"
 735          |;
 736
 737     # AND borrowernumber=?|;
 738     my $dbh = C4::Context->dbh;
 739     my $sth = $dbh->prepare($query);
 740     $sth->execute();
 741     my $result = $sth->fetchrow;
 742     my $count;
 743     if ( $result eq '' ) {
 744         ( $result = $reference . "01" );
 745     }
 746     else {
 747         $count = substr( $result, 6 ) + 1;
 748
 749         if ( $count < 10 ) {
 750             ( $count = "0" . $count );
 751         }
 752         $result = $reference . $count;
 753     }
 754     return $result;
 755 }
 756
 757 =head2 NumberNotifyId
 758
 759     (@notify) = &NumberNotifyId($borrowernumber);
 760
 761 Returns amount for all file per borrowers
 762 C<@notify> array contains all file per borrowers
 763
 764 C<$notify_id> contains the file number for the borrower number nad item number
 765
 766 =cut
 767
 768 sub NumberNotifyId{
 769     my ($borrowernumber)=@_;
 770     my $dbh = C4::Context->dbh;
 771     my $query=qq|    SELECT distinct(notify_id)
 772             FROM accountlines
 773             WHERE borrowernumber=?|;
 774     my @notify;
 775     my $sth = $dbh->prepare($query);
 776     $sth->execute($borrowernumber);
 777     while ( my ($numberofnotify) = $sth->fetchrow ) {
 778         push( @notify, $numberofnotify );
 779     }
 780     return (@notify);
 781 }
 782
 783 =head2 AmountNotify
 784
 785     ($totalnotify) = &AmountNotify($notifyid);
 786
 787 Returns amount for all file per borrowers
 788 C<$notifyid> is the file number
 789
 790 C<$totalnotify> contains amount of a file
 791
 792 C<$notify_id> contains the file number for the borrower number and item number
 793
 794 =cut
 795
 796 sub AmountNotify{
 797     my ($notifyid,$borrowernumber)=@_;
 798     my $dbh = C4::Context->dbh;
 799     my $query=qq|    SELECT sum(amountoutstanding)
 800             FROM accountlines
 801             WHERE notify_id=? AND borrowernumber = ?|;
 802     my $sth=$dbh->prepare($query);
 803         $sth->execute($notifyid,$borrowernumber);
 804         my $totalnotify=$sth->fetchrow;
 805     $sth->finish;
 806     return ($totalnotify);
 807 }
 808
 809
 810 =head2 GetNotifyId
 811
 812     ($notify_id) = &GetNotifyId($borrowernumber,$itemnumber);
 813
 814 Returns the file number per borrower and itemnumber
 815
 816 C<$borrowernumber> is a reference-to-hash whose keys are all of the fields
 817 from the items tables of the Koha database. Thus,
 818
 819 C<$itemnumber> contains the borrower categorycode
 820
 821 C<$notify_id> contains the file number for the borrower number nad item number
 822
 823 =cut
 824
 825 sub GetNotifyId {
 826     my ( $borrowernumber, $itemnumber ) = @_;
 827     my $query = qq|SELECT notify_id
 828            FROM accountlines
 829            WHERE borrowernumber=?
 830           AND itemnumber=?
 831            AND (accounttype='FU' or accounttype='O')|;
 832     my $dbh = C4::Context->dbh;
 833     my $sth = $dbh->prepare($query);
 834     $sth->execute( $borrowernumber, $itemnumber );
 835     my ($notify_id) = $sth->fetchrow;
 836     $sth->finish;
 837     return ($notify_id);
 838 }
 839
 840 =head2 CreateItemAccountLine
 841
 842     () = &CreateItemAccountLine($borrowernumber, $itemnumber, $date, $amount,
 843                                $description, $accounttype, $amountoutstanding,
 844                                $timestamp, $notify_id, $level);
 845
 846 update the account lines with file number or with file level
 847
 848 C<$items> is a reference-to-hash whose keys are all of the fields
 849 from the items tables of the Koha database. Thus,
 850
 851 C<$itemnumber> contains the item number
 852
 853 C<$borrowernumber> contains the borrower number
 854
 855 C<$date> contains the date of the day
 856
 857 C<$amount> contains item price
 858
 859 C<$description> contains the descritpion of accounttype
 860
 861 C<$accounttype> contains the account type
 862
 863 C<$amountoutstanding> contains the $amountoutstanding
 864
 865 C<$timestamp> contains the timestamp with time and the date of the day
 866
 867 C<$notify_id> contains the file number
 868
 869 C<$level> contains the file level
 870
 871 =cut
 872
 873 sub CreateItemAccountLine {
 874     my (
 875         $borrowernumber, $itemnumber,  $date,              $amount,
 876         $description,    $accounttype, $amountoutstanding, $timestamp,
 877         $notify_id,      $level
 878     ) = @_;
 879     my $dbh         = C4::Context->dbh;
 880     my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
 881     my $query       = "INSERT into accountlines
 882          (borrowernumber,accountno,itemnumber,date,amount,description,accounttype,amountoutstanding,timestamp,notify_id,notify_level)
 883           VALUES
 884              (?,?,?,?,?,?,?,?,?,?,?)";
 885
 886     my $sth = $dbh->prepare($query);
 887     $sth->execute(
 888         $borrowernumber, $nextaccntno,       $itemnumber,
 889         $date,           $amount,            $description,
 890         $accounttype,    $amountoutstanding, $timestamp,
 891         $notify_id,      $level
 892     );
 893 }
 894
 895 =head2 UpdateAccountLines
 896
 897     () = &UpdateAccountLines($notify_id,$notify_level,$borrowernumber,$itemnumber);
 898
 899 update the account lines with file number or with file level
 900
 901 C<$items> is a reference-to-hash whose keys are all of the fields
 902 from the items tables of the Koha database. Thus,
 903
 904 C<$itemnumber> contains the item number
 905
 906 C<$notify_id> contains the file number
 907
 908 C<$notify_level> contains the file level
 909
 910 C<$borrowernumber> contains the borrowernumber
 911
 912 =cut
 913
 914 sub UpdateAccountLines {
 915     my ( $notify_id, $notify_level, $borrowernumber, $itemnumber ) = @_;
 916     my $query;
 917     if ( $notify_id eq '' ) {
 918         $query = qq|UPDATE accountlines
 919     SET  notify_level=?
 920     WHERE borrowernumber=? AND itemnumber=?
 921     AND (accounttype='FU' or accounttype='O')|;
 922     } else {
 923         $query = qq|UPDATE accountlines
 924      SET notify_id=?, notify_level=?
 925    WHERE borrowernumber=?
 926     AND itemnumber=?
 927     AND (accounttype='FU' or accounttype='O')|;
 928     }
 929
 930     my $sth = C4::Context->dbh->prepare($query);
 931     if ( $notify_id eq '' ) {
 932         $sth->execute( $notify_level, $borrowernumber, $itemnumber );
 933     } else {
 934         $sth->execute( $notify_id, $notify_level, $borrowernumber, $itemnumber );
 935     }
 936 }
 937
 938 =head2 GetItems
 939
 940     ($items) = &GetItems($itemnumber);
 941
 942 Returns the list of all delays from overduerules.
 943
 944 C<$items> is a reference-to-hash whose keys are all of the fields
 945 from the items tables of the Koha database. Thus,
 946
 947 C<$itemnumber> contains the borrower categorycode
 948
 949 =cut
 950
 951 # FIXME: This is a bad function to have here.
 952 # Shouldn't it be in C4::Items?
 953 # Shouldn't it be called GetItem since you only get 1 row?
 954 # Shouldn't it be called GetItem since you give it only 1 itemnumber?
 955
 956 sub GetItems {
 957     my $itemnumber = shift or return;
 958     my $query = qq|SELECT *
 959              FROM items
 960               WHERE itemnumber=?|;
 961     my $sth = C4::Context->dbh->prepare($query);
 962     $sth->execute($itemnumber);
 963     my ($items) = $sth->fetchrow_hashref;
 964     return ($items);
 965 }
 966
 967 =head2 GetOverdueDelays
 968
 969     (@delays) = &GetOverdueDelays($categorycode);
 970
 971 Returns the list of all delays from overduerules.
 972
 973 C<@delays> it's an array contains the three delays from overduerules table
 974
 975 C<$categorycode> contains the borrower categorycode
 976
 977 =cut
 978
 979 sub GetOverdueDelays {
 980     my ($category) = @_;
 981     my $query      = qq|SELECT delay1,delay2,delay3
 982                 FROM overduerules
 983                 WHERE categorycode=?|;
 984     my $sth = C4::Context->dbh->prepare($query);
 985     $sth->execute($category);
 986     my (@delays) = $sth->fetchrow_array;
 987     return (@delays);
 988 }
 989
 990 =head2 GetBranchcodesWithOverdueRules
 991
 992     my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules()
 993
 994 returns a list of branch codes for branches with overdue rules defined.
 995
 996 =cut
 997
 998 sub GetBranchcodesWithOverdueRules {
 999     my $dbh               = C4::Context->dbh;
1000     my $rqoverduebranches = $dbh->prepare("SELECT DISTINCT branchcode FROM overduerules WHERE delay1 IS NOT NULL AND branchcode <> '' ORDER BY branchcode");
1001     $rqoverduebranches->execute;
1002     my @branches = map { shift @$_ } @{ $rqoverduebranches->fetchall_arrayref };
1003     if (!$branches[0]) {
1004        my $availbranches = C4::Branch::GetBranches();
1005        @branches = keys %$availbranches;
1006     }
1007     return @branches;
1008 }
1009
1010 =head2 CheckAccountLineLevelInfo
1011
1012     ($exist) = &CheckAccountLineLevelInfo($borrowernumber,$itemnumber,$accounttype,notify_level);
1013
1014 Check and Returns the list of all overdue books.
1015
1016 C<$exist> contains number of line in accounlines
1017 with the same .biblionumber,itemnumber,accounttype,and notify_level
1018
1019 C<$borrowernumber> contains the borrower number
1020
1021 C<$itemnumber> contains item number
1022
1023 C<$accounttype> contains account type
1024
1025 C<$notify_level> contains the accountline level
1026
1027
1028 =cut
1029
1030 sub CheckAccountLineLevelInfo {
1031     my ( $borrowernumber, $itemnumber, $level ) = @_;
1032     my $dbh   = C4::Context->dbh;
1033     my $query = qq|SELECT count(*)
1034             FROM accountlines
1035             WHERE borrowernumber =?
1036             AND itemnumber = ?
1037             AND notify_level=?|;
1038     my $sth = $dbh->prepare($query);
1039     $sth->execute( $borrowernumber, $itemnumber, $level );
1040     my ($exist) = $sth->fetchrow;
1041     return ($exist);
1042 }
1043
1044 =head2 GetOverduerules
1045
1046     ($overduerules) = &GetOverduerules($categorycode);
1047
1048 Returns the value of borrowers (debarred or not) with notify level
1049
1050 C<$overduerules> return value of debbraed field in overduerules table
1051
1052 C<$category> contains the borrower categorycode
1053
1054 C<$notify_level> contains the notify level
1055
1056 =cut
1057
1058 sub GetOverduerules {
1059     my ( $category, $notify_level ) = @_;
1060     my $dbh   = C4::Context->dbh;
1061     my $query = qq|SELECT debarred$notify_level
1062                      FROM overduerules
1063                     WHERE categorycode=?|;
1064     my $sth = $dbh->prepare($query);
1065     $sth->execute($category);
1066     my ($overduerules) = $sth->fetchrow;
1067     return ($overduerules);
1068 }
1069
1070
1071 =head2 CheckBorrowerDebarred
1072
1073     ($debarredstatus) = &CheckBorrowerDebarred($borrowernumber);
1074
1075 Check if the borrowers is already debarred
1076
1077 C<$debarredstatus> return 0 for not debarred and return 1 for debarred
1078
1079 C<$borrowernumber> contains the borrower number
1080
1081 =cut
1082
1083 # FIXME: Shouldn't this be in C4::Members?
1084 sub CheckBorrowerDebarred {
1085     my ($borrowernumber) = @_;
1086     my $dbh   = C4::Context->dbh;
1087     my $query = qq|
1088         SELECT debarred
1089         FROM borrowers
1090         WHERE borrowernumber=?
1091         AND debarred > NOW()
1092     |;
1093     my $sth = $dbh->prepare($query);
1094     $sth->execute($borrowernumber);
1095     my $debarredstatus = $sth->fetchrow;
1096     return $debarredstatus;
1097 }
1098
1099
1100 =head2 CheckExistantNotifyid
1101
1102     ($exist) = &CheckExistantNotifyid($borrowernumber,$itemnumber,$accounttype,$notify_id);
1103
1104 Check and Returns the notify id if exist else return 0.
1105
1106 C<$exist> contains a notify_id
1107
1108 C<$borrowernumber> contains the borrower number
1109
1110 C<$date_due> contains the date of item return
1111
1112
1113 =cut
1114
1115 sub CheckExistantNotifyid {
1116     my ( $borrowernumber, $date_due ) = @_;
1117     my $dbh   = C4::Context->dbh;
1118     my $query = qq|SELECT notify_id FROM accountlines
1119              LEFT JOIN issues ON issues.itemnumber= accountlines.itemnumber
1120              WHERE accountlines.borrowernumber =?
1121               AND date_due = ?|;
1122     my $sth = $dbh->prepare($query);
1123     $sth->execute( $borrowernumber, $date_due );
1124     return $sth->fetchrow || 0;
1125 }
1126
1127 =head2 CheckAccountLineItemInfo
1128
1129     ($exist) = &CheckAccountLineItemInfo($borrowernumber,$itemnumber,$accounttype,$notify_id);
1130
1131 Check and Returns the list of all overdue items from the same file number(notify_id).
1132
1133 C<$exist> contains number of line in accounlines
1134 with the same .biblionumber,itemnumber,accounttype,notify_id
1135
1136 C<$borrowernumber> contains the borrower number
1137
1138 C<$itemnumber> contains item number
1139
1140 C<$accounttype> contains account type
1141
1142 C<$notify_id> contains the file number
1143
1144 =cut
1145
1146 sub CheckAccountLineItemInfo {
1147     my ( $borrowernumber, $itemnumber, $accounttype, $notify_id ) = @_;
1148     my $dbh   = C4::Context->dbh;
1149     my $query = qq|SELECT count(*) FROM accountlines
1150              WHERE borrowernumber =?
1151              AND itemnumber = ?
1152               AND accounttype= ?
1153             AND notify_id = ?|;
1154     my $sth = $dbh->prepare($query);
1155     $sth->execute( $borrowernumber, $itemnumber, $accounttype, $notify_id );
1156     my ($exist) = $sth->fetchrow;
1157     return ($exist);
1158 }
1159
1160 =head2 CheckItemNotify
1161
1162 Sql request to check if the document has alreday been notified
1163 this function is not exported, only used with GetOverduesForBranch
1164
1165 =cut
1166
1167 sub CheckItemNotify {
1168     my ($notify_id,$notify_level,$itemnumber) = @_;
1169     my $dbh = C4::Context->dbh;
1170     my $sth = $dbh->prepare("
1171     SELECT COUNT(*)
1172      FROM notifys
1173     WHERE notify_id    = ?
1174      AND  notify_level = ?
1175      AND  itemnumber   = ? ");
1176     $sth->execute($notify_id,$notify_level,$itemnumber);
1177     my $notified = $sth->fetchrow;
1178     return ($notified);
1179 }
1180
1181 =head2 GetOverduesForBranch
1182
1183 Sql request for display all information for branchoverdues.pl
1184 2 possibilities : with or without location .
1185 display is filtered by branch
1186
1187 FIXME: This function should be renamed.
1188
1189 =cut
1190
1191 sub GetOverduesForBranch {
1192     my ( $branch, $location) = @_;
1193         my $itype_link =  (C4::Context->preference('item-level_itypes')) ?  " items.itype " :  " biblioitems.itemtype ";
1194     my $dbh = C4::Context->dbh;
1195     my $select = "
1196     SELECT
1197             borrowers.borrowernumber,
1198             borrowers.surname,
1199             borrowers.firstname,
1200             borrowers.phone,
1201             borrowers.email,
1202                biblio.title,
1203                biblio.author,
1204                biblio.biblionumber,
1205                issues.date_due,
1206                issues.returndate,
1207                issues.branchcode,
1208              branches.branchname,
1209                 items.barcode,
1210                 items.homebranch,
1211                 items.itemcallnumber,
1212                 items.location,
1213                 items.itemnumber,
1214             itemtypes.description,
1215          accountlines.notify_id,
1216          accountlines.notify_level,
1217          accountlines.amountoutstanding
1218     FROM  accountlines
1219     LEFT JOIN issues      ON    issues.itemnumber     = accountlines.itemnumber
1220                           AND   issues.borrowernumber = accountlines.borrowernumber
1221     LEFT JOIN borrowers   ON borrowers.borrowernumber = accountlines.borrowernumber
1222     LEFT JOIN items       ON     items.itemnumber     = issues.itemnumber
1223     LEFT JOIN biblio      ON      biblio.biblionumber =  items.biblionumber
1224     LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1225     LEFT JOIN itemtypes   ON itemtypes.itemtype       = $itype_link
1226     LEFT JOIN branches    ON  branches.branchcode     = issues.branchcode
1227     WHERE (accountlines.amountoutstanding  != '0.000000')
1228       AND (accountlines.accounttype         = 'FU'      )
1229       AND (issues.branchcode =  ?   )
1230       AND (issues.date_due  < NOW())
1231     ";
1232     my @getoverdues;
1233     my $i = 0;
1234     my $sth;
1235     if ($location) {
1236         $sth = $dbh->prepare("$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname");
1237         $sth->execute($branch, $location);
1238     } else {
1239         $sth = $dbh->prepare("$select ORDER BY borrowers.surname, borrowers.firstname");
1240         $sth->execute($branch);
1241     }
1242     while ( my $data = $sth->fetchrow_hashref ) {
1243     #check if the document has already been notified
1244         my $countnotify = CheckItemNotify($data->{'notify_id'}, $data->{'notify_level'}, $data->{'itemnumber'});
1245         if ($countnotify eq '0') {
1246             $getoverdues[$i] = $data;
1247             $i++;
1248         }
1249     }
1250     return (@getoverdues);
1251 }
1252
1253
1254 =head2 AddNotifyLine
1255
1256     &AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
1257
1258 Create a line into notify, if the method is phone, the notification_send_date is implemented to
1259
1260 =cut
1261
1262 sub AddNotifyLine {
1263     my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_;
1264     my $dbh = C4::Context->dbh;
1265     if ( $method eq "phone" ) {
1266         my $sth = $dbh->prepare(
1267             "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
1268         VALUES (?,?,now(),now(),?,?,?)"
1269         );
1270         $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
1271             $notifyId );
1272     }
1273     else {
1274         my $sth = $dbh->prepare(
1275             "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
1276         VALUES (?,?,now(),?,?,?)"
1277         );
1278         $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
1279             $notifyId );
1280     }
1281     return 1;
1282 }
1283
1284 =head2 RemoveNotifyLine
1285
1286     &RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
1287
1288 Cancel a notification
1289
1290 =cut
1291
1292 sub RemoveNotifyLine {
1293     my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
1294     my $dbh = C4::Context->dbh;
1295     my $sth = $dbh->prepare(
1296         "DELETE FROM notifys
1297             WHERE
1298             borrowernumber=?
1299             AND itemnumber=?
1300             AND notify_date=?"
1301     );
1302     $sth->execute( $borrowernumber, $itemnumber, $notify_date );
1303     return 1;
1304 }
1305
1306 1;
1307 __END__
1308
1309 =head1 AUTHOR
1310
1311 Koha Development Team <http://koha-community.org/>
1312
1313 =cut