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