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
  10 # under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  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 List::MoreUtils qw( uniq );
  27 use POSIX qw( floor ceil );
  28 use Locale::Currency::Format 1.28;
  29
  30 use C4::Circulation;
  31 use C4::Context;
  32 use C4::Accounts;
  33 use C4::Log; # logaction
  34 use C4::Debug;
  35 use C4::Budgets qw(GetCurrency);
  36 use Koha::DateUtils;
  37
  38 use vars qw($VERSION @ISA @EXPORT);
  39
  40 BEGIN {
  41     # set the version for version checking
  42     $VERSION = 3.07.00.049;
  43     require Exporter;
  44     @ISA = qw(Exporter);
  45
  46     # subs to rename (and maybe merge some...)
  47     push @EXPORT, qw(
  48       &CalcFine
  49       &Getoverdues
  50       &checkoverdues
  51       &NumberNotifyId
  52       &AmountNotify
  53       &UpdateFine
  54       &GetFine
  55       &get_chargeable_units
  56       &CheckItemNotify
  57       &GetOverduesForBranch
  58       &RemoveNotifyLine
  59       &AddNotifyLine
  60       &GetOverdueMessageTransportTypes
  61       &parse_overdues_letter
  62     );
  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 Biblio.pm
  80     push @EXPORT, qw(
  81       &GetItems
  82     );
  83 }
  84
  85 =head1 NAME
  86
  87 C4::Circulation::Fines - Koha module dealing with fines
  88
  89 =head1 SYNOPSIS
  90
  91   use C4::Overdues;
  92
  93 =head1 DESCRIPTION
  94
  95 This module contains several functions for dealing with fines for
  96 overdue items. It is primarily used by the 'misc/fines2.pl' script.
  97
  98 =head1 FUNCTIONS
  99
 100 =head2 Getoverdues
 101
 102   $overdues = Getoverdues( { minimumdays => 1, maximumdays => 30 } );
 103
 104 Returns the list of all overdue books, with their itemtype.
 105
 106 C<$overdues> is a reference-to-array. Each element is a
 107 reference-to-hash whose keys are the fields of the issues table in the
 108 Koha database.
 109
 110 =cut
 111
 112 #'
 113 sub Getoverdues {
 114     my $params = shift;
 115     my $dbh = C4::Context->dbh;
 116     my $statement;
 117     if ( C4::Context->preference('item-level_itypes') ) {
 118         $statement = "
 119    SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode, items.itemlost, items.replacementprice
 120      FROM issues
 121 LEFT JOIN items       USING (itemnumber)
 122     WHERE date_due < NOW()
 123 ";
 124     } else {
 125         $statement = "
 126    SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode, items.itemlost, replacementprice
 127      FROM issues
 128 LEFT JOIN items       USING (itemnumber)
 129 LEFT JOIN biblioitems USING (biblioitemnumber)
 130     WHERE date_due < NOW()
 131 ";
 132     }
 133
 134     my @bind_parameters;
 135     if ( exists $params->{'minimumdays'} and exists $params->{'maximumdays'} ) {
 136         $statement .= ' AND TO_DAYS( NOW() )-TO_DAYS( date_due ) BETWEEN ? and ? ';
 137         push @bind_parameters, $params->{'minimumdays'}, $params->{'maximumdays'};
 138     } elsif ( exists $params->{'minimumdays'} ) {
 139         $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) > ? ';
 140         push @bind_parameters, $params->{'minimumdays'};
 141     } elsif ( exists $params->{'maximumdays'} ) {
 142         $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ? ';
 143         push @bind_parameters, $params->{'maximumdays'};
 144     }
 145     $statement .= 'ORDER BY borrowernumber';
 146     my $sth = $dbh->prepare( $statement );
 147     $sth->execute( @bind_parameters );
 148     return $sth->fetchall_arrayref({});
 149 }
 150
 151
 152 =head2 checkoverdues
 153
 154     ($count, $overdueitems) = checkoverdues($borrowernumber);
 155
 156 Returns a count and a list of overdueitems for a given borrowernumber
 157
 158 =cut
 159
 160 sub checkoverdues {
 161     my $borrowernumber = shift or return;
 162     # don't select biblioitems.marc or biblioitems.marcxml... too slow on large systems
 163     my $sth = C4::Context->dbh->prepare(
 164         "SELECT biblio.*, items.*, issues.*,
 165                 biblioitems.volume,
 166                 biblioitems.number,
 167                 biblioitems.itemtype,
 168                 biblioitems.isbn,
 169                 biblioitems.issn,
 170                 biblioitems.publicationyear,
 171                 biblioitems.publishercode,
 172                 biblioitems.volumedate,
 173                 biblioitems.volumedesc,
 174                 biblioitems.collectiontitle,
 175                 biblioitems.collectionissn,
 176                 biblioitems.collectionvolume,
 177                 biblioitems.editionstatement,
 178                 biblioitems.editionresponsibility,
 179                 biblioitems.illus,
 180                 biblioitems.pages,
 181                 biblioitems.notes,
 182                 biblioitems.size,
 183                 biblioitems.place,
 184                 biblioitems.lccn,
 185                 biblioitems.url,
 186                 biblioitems.cn_source,
 187                 biblioitems.cn_class,
 188                 biblioitems.cn_item,
 189                 biblioitems.cn_suffix,
 190                 biblioitems.cn_sort,
 191                 biblioitems.totalissues
 192          FROM issues
 193          LEFT JOIN items       ON issues.itemnumber      = items.itemnumber
 194          LEFT JOIN biblio      ON items.biblionumber     = biblio.biblionumber
 195          LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 196             WHERE issues.borrowernumber  = ?
 197             AND   issues.date_due < NOW()"
 198     );
 199     # FIXME: SELECT * across 4 tables?  do we really need the marc AND marcxml blobs??
 200     $sth->execute($borrowernumber);
 201     my $results = $sth->fetchall_arrayref({});
 202     return ( scalar(@$results), $results);  # returning the count and the results is silly
 203 }
 204
 205 =head2 CalcFine
 206
 207     ($amount, $chargename,  $daycounttotal) = &CalcFine($item,
 208                                   $categorycode, $branch,
 209                                   $start_dt, $end_dt );
 210
 211 Calculates the fine for a book.
 212
 213 The issuingrules table in the Koha database is a fine matrix, listing
 214 the penalties for each type of patron for each type of item and each branch (e.g., the
 215 standard fine for books might be $0.50, but $1.50 for DVDs, or staff
 216 members might get a longer grace period between the first and second
 217 reminders that a book is overdue).
 218
 219
 220 C<$item> is an item object (hashref).
 221
 222 C<$categorycode> is the category code (string) of the patron who currently has
 223 the book.
 224
 225 C<$branchcode> is the library (string) whose issuingrules govern this transaction.
 226
 227 C<$start_date> & C<$end_date> are DateTime objects
 228 defining the date range over which to determine the fine.
 229
 230 Fines scripts should just supply the date range over which to calculate the fine.
 231
 232 C<&CalcFine> returns four values:
 233
 234 C<$amount> is the fine owed by the patron (see above).
 235
 236 C<$chargename> is the chargename field from the applicable record in
 237 the categoryitem table, whatever that is.
 238
 239 C<$unitcount> is the number of chargeable units (days between start and end dates, Calendar adjusted where needed,
 240 minus any applicable grace period, or hours)
 241
 242 FIXME - What is chargename supposed to be ?
 243
 244 FIXME: previously attempted to return C<$message> as a text message, either "First Notice", "Second Notice",
 245 or "Final Notice".  But CalcFine never defined any value.
 246
 247 =cut
 248
 249 sub CalcFine {
 250     my ( $item, $bortype, $branchcode, $due_dt, $end_date  ) = @_;
 251     my $start_date = $due_dt->clone();
 252     # get issuingrules (fines part will be used)
 253     my $itemtype = $item->{itemtype} || $item->{itype};
 254     my $data = C4::Circulation::GetIssuingRule($bortype, $itemtype, $branchcode);
 255     my $fine_unit = $data->{lengthunit};
 256     $fine_unit ||= 'days';
 257
 258     my $chargeable_units = get_chargeable_units($fine_unit, $start_date, $end_date, $branchcode);
 259     my $units_minus_grace = $chargeable_units - $data->{firstremind};
 260     my $amount = 0;
 261     if ( $data->{'chargeperiod'} && ( $units_minus_grace > 0 ) ) {
 262         my $units = C4::Context->preference('FinesIncludeGracePeriod') ? $chargeable_units : $units_minus_grace;
 263         my $charge_periods = $units / $data->{'chargeperiod'};
 264         # If chargeperiod_charge_at = 1, we charge a fine at the start of each charge period
 265         # if chargeperiod_charge_at = 0, we charge at the end of each charge period
 266         $charge_periods = $data->{'chargeperiod_charge_at'} == 1 ? ceil($charge_periods) : floor($charge_periods);
 267         $amount = $charge_periods * $data->{'fine'};
 268     } # else { # a zero (or null) chargeperiod or negative units_minus_grace value means no charge. }
 269
 270     $amount = $data->{overduefinescap} if $data->{overduefinescap} && $amount > $data->{overduefinescap};
 271     $amount = $item->{replacementprice} if ( $data->{cap_fine_to_replacement_price} && $item->{replacementprice} && $amount > $item->{replacementprice} );
 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, $date_due, $date_returned, $branchcode) = @_;
 294
 295     # If the due date is later than the return date
 296     return 0 unless ( $date_returned > $date_due );
 297
 298     my $charge_units = 0;
 299     my $charge_duration;
 300     if ($unit eq 'hours') {
 301         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
 302             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
 303             $charge_duration = $calendar->hours_between( $date_due, $date_returned );
 304         } else {
 305             $charge_duration = $date_returned->delta_ms( $date_due );
 306         }
 307         if($charge_duration->in_units('hours') == 0 && $charge_duration->in_units('seconds') > 0){
 308             return 1;
 309         }
 310         return $charge_duration->in_units('hours');
 311     }
 312     else { # days
 313         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
 314             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
 315             $charge_duration = $calendar->days_between( $date_due, $date_returned );
 316         } else {
 317             $charge_duration = $date_returned->delta_days( $date_due );
 318         }
 319         return $charge_duration->in_units('days');
 320     }
 321 }
 322
 323
 324 =head2 GetSpecialHolidays
 325
 326     &GetSpecialHolidays($date_dues,$itemnumber);
 327
 328 return number of special days  between date of the day and date due
 329
 330 C<$date_dues> is the envisaged date of book return.
 331
 332 C<$itemnumber> is the book's item number.
 333
 334 =cut
 335
 336 sub GetSpecialHolidays {
 337     my ( $date_dues, $itemnumber ) = @_;
 338
 339     # calcul the today date
 340     my $today = join "-", &Today();
 341
 342     # return the holdingbranch
 343     my $iteminfo = GetIssuesIteminfo($itemnumber);
 344
 345     # use sql request to find all date between date_due and today
 346     my $dbh = C4::Context->dbh;
 347     my $query =
 348       qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') as date
 349 FROM `special_holidays`
 350 WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
 351 AND   DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
 352 AND branchcode=?
 353 |;
 354     my @result = GetWdayFromItemnumber($itemnumber);
 355     my @result_date;
 356     my $wday;
 357     my $dateinsec;
 358     my $sth = $dbh->prepare($query);
 359     $sth->execute( $date_dues, $today, $iteminfo->{'branchcode'} )
 360       ;    # FIXME: just use NOW() in SQL instead of passing in $today
 361
 362     while ( my $special_date = $sth->fetchrow_hashref ) {
 363         push( @result_date, $special_date );
 364     }
 365
 366     my $specialdaycount = scalar(@result_date);
 367
 368     for ( my $i = 0 ; $i < scalar(@result_date) ; $i++ ) {
 369         $dateinsec = UnixDate( $result_date[$i]->{'date'}, "%o" );
 370         ( undef, undef, undef, undef, undef, undef, $wday, undef, undef ) =
 371           localtime($dateinsec);
 372         for ( my $j = 0 ; $j < scalar(@result) ; $j++ ) {
 373             if ( $wday == ( $result[$j]->{'weekday'} ) ) {
 374                 $specialdaycount--;
 375             }
 376         }
 377     }
 378
 379     return $specialdaycount;
 380 }
 381
 382 =head2 GetRepeatableHolidays
 383
 384     &GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
 385
 386 return number of day closed between date of the day and date due
 387
 388 C<$date_dues> is the envisaged date of book return.
 389
 390 C<$itemnumber> is item number.
 391
 392 C<$difference> numbers of between day date of the day and date due
 393
 394 =cut
 395
 396 sub GetRepeatableHolidays {
 397     my ( $date_dues, $itemnumber, $difference ) = @_;
 398     my $dateinsec = UnixDate( $date_dues, "%o" );
 399     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
 400       localtime($dateinsec);
 401     my @result = GetWdayFromItemnumber($itemnumber);
 402     my @dayclosedcount;
 403     my $j;
 404
 405     for ( my $i = 0 ; $i < scalar(@result) ; $i++ ) {
 406         my $k = $wday;
 407
 408         for ( $j = 0 ; $j < $difference ; $j++ ) {
 409             if ( $result[$i]->{'weekday'} == $k ) {
 410                 push( @dayclosedcount, $k );
 411             }
 412             $k++;
 413             ( $k = 0 ) if ( $k eq 7 );
 414         }
 415     }
 416     return scalar(@dayclosedcount);
 417 }
 418
 419
 420 =head2 GetWayFromItemnumber
 421
 422     &Getwdayfromitemnumber($itemnumber);
 423
 424 return the different week day from repeatable_holidays table
 425
 426 C<$itemnumber> is  item number.
 427
 428 =cut
 429
 430 sub GetWdayFromItemnumber {
 431     my ($itemnumber) = @_;
 432     my $iteminfo = GetIssuesIteminfo($itemnumber);
 433     my @result;
 434     my $query = qq|SELECT weekday
 435     FROM repeatable_holidays
 436     WHERE branchcode=?
 437 |;
 438     my $sth = C4::Context->dbh->prepare($query);
 439
 440     $sth->execute( $iteminfo->{'branchcode'} );
 441     while ( my $weekday = $sth->fetchrow_hashref ) {
 442         push( @result, $weekday );
 443     }
 444     return @result;
 445 }
 446
 447
 448 =head2 GetIssuesIteminfo
 449
 450     &GetIssuesIteminfo($itemnumber);
 451
 452 return all data from issues about item
 453
 454 C<$itemnumber> is  item number.
 455
 456 =cut
 457
 458 sub GetIssuesIteminfo {
 459     my ($itemnumber) = @_;
 460     my $dbh          = C4::Context->dbh;
 461     my $query        = qq|SELECT *
 462     FROM issues
 463     WHERE itemnumber=?
 464     |;
 465     my $sth = $dbh->prepare($query);
 466     $sth->execute($itemnumber);
 467     my ($issuesinfo) = $sth->fetchrow_hashref;
 468     return $issuesinfo;
 469 }
 470
 471
 472 =head2 UpdateFine
 473
 474     &UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description);
 475
 476 (Note: the following is mostly conjecture and guesswork.)
 477
 478 Updates the fine owed on an overdue book.
 479
 480 C<$itemnumber> is the book's item number.
 481
 482 C<$borrowernumber> is the borrower number of the patron who currently
 483 has the book on loan.
 484
 485 C<$amount> is the current amount owed by the patron.
 486
 487 C<$type> will be used in the description of the fine.
 488
 489 C<$description> is a string that must be present in the description of
 490 the fine. I think this is expected to be a date in DD/MM/YYYY format.
 491
 492 C<&UpdateFine> looks up the amount currently owed on the given item
 493 and sets it to C<$amount>, creating, if necessary, a new entry in the
 494 accountlines table of the Koha database.
 495
 496 =cut
 497
 498 #
 499 # Question: Why should the caller have to
 500 # specify both the item number and the borrower number? A book can't
 501 # be on loan to two different people, so the item number should be
 502 # sufficient.
 503 #
 504 # Possible Answer: You might update a fine for a damaged item, *after* it is returned.
 505 #
 506 sub UpdateFine {
 507     my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_;
 508         $debug and warn "UpdateFine($itemnum, $borrowernumber, $amount, " . ($type||'""') . ", $due) called";
 509     my $dbh = C4::Context->dbh;
 510     # FIXME - What exactly is this query supposed to do? It looks up an
 511     # entry in accountlines that matches the given item and borrower
 512     # numbers, where the description contains $due, and where the
 513     # account type has one of several values, but what does this _mean_?
 514     # Does it look up existing fines for this item?
 515     # FIXME - What are these various account types? ("FU", "O", "F", "M")
 516         #       "L"   is LOST item
 517         #   "A"   is Account Management Fee
 518         #   "N"   is New Card
 519         #   "M"   is Sundry
 520         #   "O"   is Overdue ??
 521         #   "F"   is Fine ??
 522         #   "FU"  is Fine UPDATE??
 523         #       "Pay" is Payment
 524         #   "REF" is Cash Refund
 525     my $sth = $dbh->prepare(
 526         "SELECT * FROM accountlines
 527         WHERE borrowernumber=?
 528         AND   accounttype IN ('FU','O','F','M')"
 529     );
 530     $sth->execute( $borrowernumber );
 531     my $data;
 532     my $total_amount_other = 0.00;
 533     my $due_qr = qr/$due/;
 534     # Cycle through the fines and
 535     # - find line that relates to the requested $itemnum
 536     # - accumulate fines for other items
 537     # so we can update $itemnum fine taking in account fine caps
 538     while (my $rec = $sth->fetchrow_hashref) {
 539         if ($rec->{itemnumber} == $itemnum && $rec->{description} =~ /$due_qr/) {
 540             if ($data) {
 541                 warn "Not a unique accountlines record for item $itemnum borrower $borrowernumber";
 542             } else {
 543                 $data = $rec;
 544                 next;
 545             }
 546         }
 547         $total_amount_other += $rec->{'amountoutstanding'};
 548     }
 549
 550     if (my $maxfine = C4::Context->preference('MaxFine')) {
 551         if ($total_amount_other + $amount > $maxfine) {
 552             my $new_amount = $maxfine - $total_amount_other;
 553             return if $new_amount <= 0.00;
 554             warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached";
 555             $amount = $new_amount;
 556         }
 557     }
 558
 559     if ( $data ) {
 560
 561                 # we're updating an existing fine.  Only modify if amount changed
 562         # Note that in the current implementation, you cannot pay against an accruing fine
 563         # (i.e. , of accounttype 'FU').  Doing so will break accrual.
 564         if ( $data->{'amount'} != $amount ) {
 565             my $diff = $amount - $data->{'amount'};
 566             #3341: diff could be positive or negative!
 567             my $out  = $data->{'amountoutstanding'} + $diff;
 568             my $query = "
 569                 UPDATE accountlines
 570                                 SET date=now(), amount=?, amountoutstanding=?,
 571                                         lastincrement=?, accounttype='FU'
 572                                 WHERE borrowernumber=?
 573                                 AND   itemnumber=?
 574                                 AND   accounttype IN ('FU','O')
 575                                 AND   description LIKE ?
 576                                 LIMIT 1 ";
 577             my $sth2 = $dbh->prepare($query);
 578                         # FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!!
 579                         #               LIMIT 1 added to prevent multiple affected lines
 580                         # FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline.
 581                         #               But actually, we should just have a regular autoincrementing PK and forget accountline,
 582                         #               including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops).
 583                         # FIXME: Why only 2 account types here?
 584                         $debug and print STDERR "UpdateFine query: $query\n" .
 585                                 "w/ args: $amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, \"\%$due\%\"\n";
 586             $sth2->execute($amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, "%$due%");
 587         } else {
 588             #      print "no update needed $data->{'amount'}"
 589         }
 590     } else {
 591         if ( $amount ) { # Don't add new fines with an amount of 0
 592             my $sth4 = $dbh->prepare(
 593                 "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?"
 594             );
 595             $sth4->execute($itemnum);
 596             my $title = $sth4->fetchrow;
 597
 598             my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
 599
 600             my $desc = ( $type ? "$type " : '' ) . "$title $due";    # FIXEDME, avoid whitespace prefix on empty $type
 601
 602             my $query = "INSERT INTO accountlines
 603                          (borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno)
 604                          VALUES (?,?,now(),?,?,'FU',?,?,?)";
 605             my $sth2 = $dbh->prepare($query);
 606             $debug and print STDERR "UpdateFine query: $query\nw/ args: $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno\n";
 607             $sth2->execute( $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno );
 608         }
 609     }
 610     # logging action
 611     &logaction(
 612         "FINES",
 613         $type,
 614         $borrowernumber,
 615         "due=".$due."  amount=".$amount." itemnumber=".$itemnum
 616         ) if C4::Context->preference("FinesLog");
 617 }
 618
 619 =head2 BorType
 620
 621     $borrower = &BorType($borrowernumber);
 622
 623 Looks up a patron by borrower number.
 624
 625 C<$borrower> is a reference-to-hash whose keys are all of the fields
 626 from the borrowers and categories tables of the Koha database. Thus,
 627 C<$borrower> contains all information about both the borrower and
 628 category he or she belongs to.
 629
 630 =cut
 631
 632 sub BorType {
 633     my ($borrowernumber) = @_;
 634     my $dbh              = C4::Context->dbh;
 635     my $sth              = $dbh->prepare(
 636         "SELECT * from borrowers
 637       LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
 638       WHERE borrowernumber=?"
 639     );
 640     $sth->execute($borrowernumber);
 641     return $sth->fetchrow_hashref;
 642 }
 643
 644 =head2 GetFine
 645
 646     $data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
 647
 648 return the total of fine
 649
 650 C<$itemnum> is item number
 651
 652 C<$borrowernumber> is the borrowernumber
 653
 654 =cut
 655
 656 sub GetFine {
 657     my ( $itemnum, $borrowernumber ) = @_;
 658     my $dbh   = C4::Context->dbh();
 659     my $query = q|SELECT sum(amountoutstanding) as fineamount FROM accountlines
 660     where accounttype like 'F%'
 661   AND amountoutstanding > 0 AND borrowernumber=?|;
 662     my @query_param;
 663     push @query_param, $borrowernumber;
 664     if (defined $itemnum )
 665     {
 666         $query .= " AND itemnumber=?";
 667         push @query_param, $itemnum;
 668     }
 669     my $sth = $dbh->prepare($query);
 670     $sth->execute( @query_param );
 671     my $fine = $sth->fetchrow_hashref();
 672     if ($fine->{fineamount}) {
 673         return $fine->{fineamount};
 674     }
 675     return 0;
 676 }
 677
 678 =head2 NumberNotifyId
 679
 680     (@notify) = &NumberNotifyId($borrowernumber);
 681
 682 Returns amount for all file per borrowers
 683 C<@notify> array contains all file per borrowers
 684
 685 C<$notify_id> contains the file number for the borrower number nad item number
 686
 687 =cut
 688
 689 sub NumberNotifyId{
 690     my ($borrowernumber)=@_;
 691     my $dbh = C4::Context->dbh;
 692     my $query=qq|    SELECT distinct(notify_id)
 693             FROM accountlines
 694             WHERE borrowernumber=?|;
 695     my @notify;
 696     my $sth = $dbh->prepare($query);
 697     $sth->execute($borrowernumber);
 698     while ( my ($numberofnotify) = $sth->fetchrow ) {
 699         push( @notify, $numberofnotify );
 700     }
 701     return (@notify);
 702 }
 703
 704 =head2 AmountNotify
 705
 706     ($totalnotify) = &AmountNotify($notifyid);
 707
 708 Returns amount for all file per borrowers
 709 C<$notifyid> is the file number
 710
 711 C<$totalnotify> contains amount of a file
 712
 713 C<$notify_id> contains the file number for the borrower number and item number
 714
 715 =cut
 716
 717 sub AmountNotify{
 718     my ($notifyid,$borrowernumber)=@_;
 719     my $dbh = C4::Context->dbh;
 720     my $query=qq|    SELECT sum(amountoutstanding)
 721             FROM accountlines
 722             WHERE notify_id=? AND borrowernumber = ?|;
 723     my $sth=$dbh->prepare($query);
 724         $sth->execute($notifyid,$borrowernumber);
 725         my $totalnotify=$sth->fetchrow;
 726     $sth->finish;
 727     return ($totalnotify);
 728 }
 729
 730 =head2 GetItems
 731
 732     ($items) = &GetItems($itemnumber);
 733
 734 Returns the list of all delays from overduerules.
 735
 736 C<$items> is a reference-to-hash whose keys are all of the fields
 737 from the items tables of the Koha database. Thus,
 738
 739 C<$itemnumber> contains the borrower categorycode
 740
 741 =cut
 742
 743 # FIXME: This is a bad function to have here.
 744 # Shouldn't it be in C4::Items?
 745 # Shouldn't it be called GetItem since you only get 1 row?
 746 # Shouldn't it be called GetItem since you give it only 1 itemnumber?
 747
 748 sub GetItems {
 749     my $itemnumber = shift or return;
 750     my $query = qq|SELECT *
 751              FROM items
 752               WHERE itemnumber=?|;
 753     my $sth = C4::Context->dbh->prepare($query);
 754     $sth->execute($itemnumber);
 755     my ($items) = $sth->fetchrow_hashref;
 756     return ($items);
 757 }
 758
 759 =head2 GetBranchcodesWithOverdueRules
 760
 761     my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules()
 762
 763 returns a list of branch codes for branches with overdue rules defined.
 764
 765 =cut
 766
 767 sub GetBranchcodesWithOverdueRules {
 768     my $dbh               = C4::Context->dbh;
 769     my $branchcodes = $dbh->selectcol_arrayref(q|
 770         SELECT DISTINCT(branchcode)
 771         FROM overduerules
 772         WHERE delay1 IS NOT NULL
 773         ORDER BY branchcode
 774     |);
 775     if ( $branchcodes->[0] eq '' ) {
 776         # If a default rule exists, all branches should be returned
 777         my $availbranches = C4::Branch::GetBranches();
 778         return keys %$availbranches;
 779     }
 780     return @$branchcodes;
 781 }
 782
 783 =head2 CheckItemNotify
 784
 785 Sql request to check if the document has alreday been notified
 786 this function is not exported, only used with GetOverduesForBranch
 787
 788 =cut
 789
 790 sub CheckItemNotify {
 791     my ($notify_id,$notify_level,$itemnumber) = @_;
 792     my $dbh = C4::Context->dbh;
 793     my $sth = $dbh->prepare("
 794     SELECT COUNT(*)
 795      FROM notifys
 796     WHERE notify_id    = ?
 797      AND  notify_level = ?
 798      AND  itemnumber   = ? ");
 799     $sth->execute($notify_id,$notify_level,$itemnumber);
 800     my $notified = $sth->fetchrow;
 801     return ($notified);
 802 }
 803
 804 =head2 GetOverduesForBranch
 805
 806 Sql request for display all information for branchoverdues.pl
 807 2 possibilities : with or without location .
 808 display is filtered by branch
 809
 810 FIXME: This function should be renamed.
 811
 812 =cut
 813
 814 sub GetOverduesForBranch {
 815     my ( $branch, $location) = @_;
 816         my $itype_link =  (C4::Context->preference('item-level_itypes')) ?  " items.itype " :  " biblioitems.itemtype ";
 817     my $dbh = C4::Context->dbh;
 818     my $select = "
 819     SELECT
 820             borrowers.cardnumber,
 821             borrowers.borrowernumber,
 822             borrowers.surname,
 823             borrowers.firstname,
 824             borrowers.phone,
 825             borrowers.email,
 826                biblio.title,
 827                biblio.author,
 828                biblio.biblionumber,
 829                issues.date_due,
 830                issues.returndate,
 831                issues.branchcode,
 832              branches.branchname,
 833                 items.barcode,
 834                 items.homebranch,
 835                 items.itemcallnumber,
 836                 items.location,
 837                 items.itemnumber,
 838             itemtypes.description,
 839          accountlines.notify_id,
 840          accountlines.notify_level,
 841          accountlines.amountoutstanding
 842     FROM  accountlines
 843     LEFT JOIN issues      ON    issues.itemnumber     = accountlines.itemnumber
 844                           AND   issues.borrowernumber = accountlines.borrowernumber
 845     LEFT JOIN borrowers   ON borrowers.borrowernumber = accountlines.borrowernumber
 846     LEFT JOIN items       ON     items.itemnumber     = issues.itemnumber
 847     LEFT JOIN biblio      ON      biblio.biblionumber =  items.biblionumber
 848     LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
 849     LEFT JOIN itemtypes   ON itemtypes.itemtype       = $itype_link
 850     LEFT JOIN branches    ON  branches.branchcode     = issues.branchcode
 851     WHERE (accountlines.amountoutstanding  != '0.000000')
 852       AND (accountlines.accounttype         = 'FU'      )
 853       AND (issues.branchcode =  ?   )
 854       AND (issues.date_due  < NOW())
 855     ";
 856     my @getoverdues;
 857     my $i = 0;
 858     my $sth;
 859     if ($location) {
 860         $sth = $dbh->prepare("$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname");
 861         $sth->execute($branch, $location);
 862     } else {
 863         $sth = $dbh->prepare("$select ORDER BY borrowers.surname, borrowers.firstname");
 864         $sth->execute($branch);
 865     }
 866     while ( my $data = $sth->fetchrow_hashref ) {
 867     #check if the document has already been notified
 868         my $countnotify = CheckItemNotify($data->{'notify_id'}, $data->{'notify_level'}, $data->{'itemnumber'});
 869         if ($countnotify eq '0') {
 870             $getoverdues[$i] = $data;
 871             $i++;
 872         }
 873     }
 874     return (@getoverdues);
 875 }
 876
 877
 878 =head2 AddNotifyLine
 879
 880     &AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
 881
 882 Create a line into notify, if the method is phone, the notification_send_date is implemented to
 883
 884 =cut
 885
 886 sub AddNotifyLine {
 887     my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_;
 888     my $dbh = C4::Context->dbh;
 889     if ( $method eq "phone" ) {
 890         my $sth = $dbh->prepare(
 891             "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
 892         VALUES (?,?,now(),now(),?,?,?)"
 893         );
 894         $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
 895             $notifyId );
 896     }
 897     else {
 898         my $sth = $dbh->prepare(
 899             "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
 900         VALUES (?,?,now(),?,?,?)"
 901         );
 902         $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
 903             $notifyId );
 904     }
 905     return 1;
 906 }
 907
 908 =head2 RemoveNotifyLine
 909
 910     &RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
 911
 912 Cancel a notification
 913
 914 =cut
 915
 916 sub RemoveNotifyLine {
 917     my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
 918     my $dbh = C4::Context->dbh;
 919     my $sth = $dbh->prepare(
 920         "DELETE FROM notifys
 921             WHERE
 922             borrowernumber=?
 923             AND itemnumber=?
 924             AND notify_date=?"
 925     );
 926     $sth->execute( $borrowernumber, $itemnumber, $notify_date );
 927     return 1;
 928 }
 929
 930 =head2 GetOverdueMessageTransportTypes
 931
 932     my $message_transport_types = GetOverdueMessageTransportTypes( $branchcode, $categorycode, $letternumber);
 933
 934     return a arrayref with all message_transport_type for given branchcode, categorycode and letternumber(1,2 or 3)
 935
 936 =cut
 937
 938 sub GetOverdueMessageTransportTypes {
 939     my ( $branchcode, $categorycode, $letternumber ) = @_;
 940     return unless $categorycode and $letternumber;
 941     my $dbh = C4::Context->dbh;
 942     my $sth = $dbh->prepare("
 943         SELECT message_transport_type
 944         FROM overduerules odr LEFT JOIN overduerules_transport_types ott USING (overduerules_id)
 945         WHERE branchcode = ?
 946           AND categorycode = ?
 947           AND letternumber = ?
 948     ");
 949     $sth->execute( $branchcode, $categorycode, $letternumber );
 950     my @mtts;
 951     while ( my $mtt = $sth->fetchrow ) {
 952         push @mtts, $mtt;
 953     }
 954
 955     # Put 'print' in first if exists
 956     # It avoid to sent a print notice with an email or sms template is no email or sms is defined
 957     @mtts = uniq( 'print', @mtts )
 958         if grep {/^print$/} @mtts;
 959
 960     return \@mtts;
 961 }
 962
 963 =head2 parse_overdues_letter
 964
 965 parses the letter template, replacing the placeholders with data
 966 specific to this patron, biblio, or item for overdues
 967
 968 named parameters:
 969   letter - required hashref
 970   borrowernumber - required integer
 971   substitute - optional hashref of other key/value pairs that should
 972     be substituted in the letter content
 973
 974 returns the C<letter> hashref, with the content updated to reflect the
 975 substituted keys and values.
 976
 977 =cut
 978
 979 sub parse_overdues_letter {
 980     my $params = shift;
 981     foreach my $required (qw( letter_code borrowernumber )) {
 982         return unless ( exists $params->{$required} && $params->{$required} );
 983     }
 984
 985     my $substitute = $params->{'substitute'} || {};
 986     $substitute->{today} ||= output_pref( { dt => dt_from_string, dateonly => 1} );
 987
 988     my %tables = ( 'borrowers' => $params->{'borrowernumber'} );
 989     if ( my $p = $params->{'branchcode'} ) {
 990         $tables{'branches'} = $p;
 991     }
 992
 993     my $currencies = GetCurrency();
 994     my $currency_format;
 995     $currency_format = $currencies->{currency} if defined($currencies);
 996
 997     my @item_tables;
 998     if ( my $i = $params->{'items'} ) {
 999         my $item_format = '';
1000         foreach my $item (@$i) {
1001             my $fine = GetFine($item->{'itemnumber'}, $params->{'borrowernumber'});
1002             if ( !$item_format and defined $params->{'letter'}->{'content'} ) {
1003                 $params->{'letter'}->{'content'} =~ m/(<item>.*<\/item>)/;
1004                 $item_format = $1;
1005             }
1006
1007             $item->{'fine'} = currency_format($currency_format, "$fine", FMT_SYMBOL);
1008             # if active currency isn't correct ISO code fallback to sprintf
1009             $item->{'fine'} = sprintf('%.2f', $fine) unless $item->{'fine'};
1010
1011             push @item_tables, {
1012                 'biblio' => $item->{'biblionumber'},
1013                 'biblioitems' => $item->{'biblionumber'},
1014                 'items' => $item,
1015                 'issues' => $item->{'itemnumber'},
1016             };
1017         }
1018     }
1019
1020     return C4::Letters::GetPreparedLetter (
1021         module => 'circulation',
1022         letter_code => $params->{'letter_code'},
1023         branchcode => $params->{'branchcode'},
1024         tables => \%tables,
1025         substitute => $substitute,
1026         repeat => { item => \@item_tables },
1027         message_transport_type => $params->{message_transport_type},
1028     );
1029 }
1030
1031 1;
1032 __END__
1033
1034 =head1 AUTHOR
1035
1036 Koha Development Team <http://koha-community.org/>
1037
1038 =cut