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
 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
 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     $debug and warn sprintf("CalcFine returning (%s, %s, %s, %s)", $amount, $data->{'chargename'}, $units_minus_grace, $chargeable_units);
 272     return ($amount, $data->{'chargename'}, $units_minus_grace, $chargeable_units);
 273     # FIXME: chargename is NEVER populated anywhere.
 274 }
 275
 276
 277 =head2 get_chargeable_units
 278
 279     get_chargeable_units($unit, $start_date_ $end_date, $branchcode);
 280
 281 return integer value of units between C<$start_date> and C<$end_date>, factoring in holidays for C<$branchcode>.
 282
 283 C<$unit> is 'days' or 'hours' (default is 'days').
 284
 285 C<$start_date> and C<$end_date> are the two DateTimes to get the number of units between.
 286
 287 C<$branchcode> is the branch whose calendar to use for finding holidays.
 288
 289 =cut
 290
 291 sub get_chargeable_units {
 292     my ($unit, $date_due, $date_returned, $branchcode) = @_;
 293
 294     # If the due date is later than the return date
 295     return 0 unless ( $date_returned > $date_due );
 296
 297     my $charge_units = 0;
 298     my $charge_duration;
 299     if ($unit eq 'hours') {
 300         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
 301             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
 302             $charge_duration = $calendar->hours_between( $date_due, $date_returned );
 303         } else {
 304             $charge_duration = $date_returned->delta_ms( $date_due );
 305         }
 306         if($charge_duration->in_units('hours') == 0 && $charge_duration->in_units('seconds') > 0){
 307             return 1;
 308         }
 309         return $charge_duration->in_units('hours');
 310     }
 311     else { # days
 312         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
 313             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
 314             $charge_duration = $calendar->days_between( $date_due, $date_returned );
 315         } else {
 316             $charge_duration = $date_returned->delta_days( $date_due );
 317         }
 318         return $charge_duration->in_units('days');
 319     }
 320 }
 321
 322
 323 =head2 GetSpecialHolidays
 324
 325     &GetSpecialHolidays($date_dues,$itemnumber);
 326
 327 return number of special days  between date of the day and date due
 328
 329 C<$date_dues> is the envisaged date of book return.
 330
 331 C<$itemnumber> is the book's item number.
 332
 333 =cut
 334
 335 sub GetSpecialHolidays {
 336     my ( $date_dues, $itemnumber ) = @_;
 337
 338     # calcul the today date
 339     my $today = join "-", &Today();
 340
 341     # return the holdingbranch
 342     my $iteminfo = GetIssuesIteminfo($itemnumber);
 343
 344     # use sql request to find all date between date_due and today
 345     my $dbh = C4::Context->dbh;
 346     my $query =
 347       qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') as date
 348 FROM `special_holidays`
 349 WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
 350 AND   DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
 351 AND branchcode=?
 352 |;
 353     my @result = GetWdayFromItemnumber($itemnumber);
 354     my @result_date;
 355     my $wday;
 356     my $dateinsec;
 357     my $sth = $dbh->prepare($query);
 358     $sth->execute( $date_dues, $today, $iteminfo->{'branchcode'} )
 359       ;    # FIXME: just use NOW() in SQL instead of passing in $today
 360
 361     while ( my $special_date = $sth->fetchrow_hashref ) {
 362         push( @result_date, $special_date );
 363     }
 364
 365     my $specialdaycount = scalar(@result_date);
 366
 367     for ( my $i = 0 ; $i < scalar(@result_date) ; $i++ ) {
 368         $dateinsec = UnixDate( $result_date[$i]->{'date'}, "%o" );
 369         ( undef, undef, undef, undef, undef, undef, $wday, undef, undef ) =
 370           localtime($dateinsec);
 371         for ( my $j = 0 ; $j < scalar(@result) ; $j++ ) {
 372             if ( $wday == ( $result[$j]->{'weekday'} ) ) {
 373                 $specialdaycount--;
 374             }
 375         }
 376     }
 377
 378     return $specialdaycount;
 379 }
 380
 381 =head2 GetRepeatableHolidays
 382
 383     &GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
 384
 385 return number of day closed between date of the day and date due
 386
 387 C<$date_dues> is the envisaged date of book return.
 388
 389 C<$itemnumber> is item number.
 390
 391 C<$difference> numbers of between day date of the day and date due
 392
 393 =cut
 394
 395 sub GetRepeatableHolidays {
 396     my ( $date_dues, $itemnumber, $difference ) = @_;
 397     my $dateinsec = UnixDate( $date_dues, "%o" );
 398     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
 399       localtime($dateinsec);
 400     my @result = GetWdayFromItemnumber($itemnumber);
 401     my @dayclosedcount;
 402     my $j;
 403
 404     for ( my $i = 0 ; $i < scalar(@result) ; $i++ ) {
 405         my $k = $wday;
 406
 407         for ( $j = 0 ; $j < $difference ; $j++ ) {
 408             if ( $result[$i]->{'weekday'} == $k ) {
 409                 push( @dayclosedcount, $k );
 410             }
 411             $k++;
 412             ( $k = 0 ) if ( $k eq 7 );
 413         }
 414     }
 415     return scalar(@dayclosedcount);
 416 }
 417
 418
 419 =head2 GetWayFromItemnumber
 420
 421     &Getwdayfromitemnumber($itemnumber);
 422
 423 return the different week day from repeatable_holidays table
 424
 425 C<$itemnumber> is  item number.
 426
 427 =cut
 428
 429 sub GetWdayFromItemnumber {
 430     my ($itemnumber) = @_;
 431     my $iteminfo = GetIssuesIteminfo($itemnumber);
 432     my @result;
 433     my $query = qq|SELECT weekday
 434     FROM repeatable_holidays
 435     WHERE branchcode=?
 436 |;
 437     my $sth = C4::Context->dbh->prepare($query);
 438
 439     $sth->execute( $iteminfo->{'branchcode'} );
 440     while ( my $weekday = $sth->fetchrow_hashref ) {
 441         push( @result, $weekday );
 442     }
 443     return @result;
 444 }
 445
 446
 447 =head2 GetIssuesIteminfo
 448
 449     &GetIssuesIteminfo($itemnumber);
 450
 451 return all data from issues about item
 452
 453 C<$itemnumber> is  item number.
 454
 455 =cut
 456
 457 sub GetIssuesIteminfo {
 458     my ($itemnumber) = @_;
 459     my $dbh          = C4::Context->dbh;
 460     my $query        = qq|SELECT *
 461     FROM issues
 462     WHERE itemnumber=?
 463     |;
 464     my $sth = $dbh->prepare($query);
 465     $sth->execute($itemnumber);
 466     my ($issuesinfo) = $sth->fetchrow_hashref;
 467     return $issuesinfo;
 468 }
 469
 470
 471 =head2 UpdateFine
 472
 473     &UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description);
 474
 475 (Note: the following is mostly conjecture and guesswork.)
 476
 477 Updates the fine owed on an overdue book.
 478
 479 C<$itemnumber> is the book's item number.
 480
 481 C<$borrowernumber> is the borrower number of the patron who currently
 482 has the book on loan.
 483
 484 C<$amount> is the current amount owed by the patron.
 485
 486 C<$type> will be used in the description of the fine.
 487
 488 C<$description> is a string that must be present in the description of
 489 the fine. I think this is expected to be a date in DD/MM/YYYY format.
 490
 491 C<&UpdateFine> looks up the amount currently owed on the given item
 492 and sets it to C<$amount>, creating, if necessary, a new entry in the
 493 accountlines table of the Koha database.
 494
 495 =cut
 496
 497 #
 498 # Question: Why should the caller have to
 499 # specify both the item number and the borrower number? A book can't
 500 # be on loan to two different people, so the item number should be
 501 # sufficient.
 502 #
 503 # Possible Answer: You might update a fine for a damaged item, *after* it is returned.
 504 #
 505 sub UpdateFine {
 506     my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_;
 507         $debug and warn "UpdateFine($itemnum, $borrowernumber, $amount, " . ($type||'""') . ", $due) called";
 508     my $dbh = C4::Context->dbh;
 509     # FIXME - What exactly is this query supposed to do? It looks up an
 510     # entry in accountlines that matches the given item and borrower
 511     # numbers, where the description contains $due, and where the
 512     # account type has one of several values, but what does this _mean_?
 513     # Does it look up existing fines for this item?
 514     # FIXME - What are these various account types? ("FU", "O", "F", "M")
 515         #       "L"   is LOST item
 516         #   "A"   is Account Management Fee
 517         #   "N"   is New Card
 518         #   "M"   is Sundry
 519         #   "O"   is Overdue ??
 520         #   "F"   is Fine ??
 521         #   "FU"  is Fine UPDATE??
 522         #       "Pay" is Payment
 523         #   "REF" is Cash Refund
 524     my $sth = $dbh->prepare(
 525         "SELECT * FROM accountlines
 526         WHERE borrowernumber=?
 527         AND   accounttype IN ('FU','O','F','M')"
 528     );
 529     $sth->execute( $borrowernumber );
 530     my $data;
 531     my $total_amount_other = 0.00;
 532     my $due_qr = qr/$due/;
 533     # Cycle through the fines and
 534     # - find line that relates to the requested $itemnum
 535     # - accumulate fines for other items
 536     # so we can update $itemnum fine taking in account fine caps
 537     while (my $rec = $sth->fetchrow_hashref) {
 538         if ($rec->{itemnumber} == $itemnum && $rec->{description} =~ /$due_qr/) {
 539             if ($data) {
 540                 warn "Not a unique accountlines record for item $itemnum borrower $borrowernumber";
 541             } else {
 542                 $data = $rec;
 543                 next;
 544             }
 545         }
 546         $total_amount_other += $rec->{'amountoutstanding'};
 547     }
 548
 549     if (my $maxfine = C4::Context->preference('MaxFine')) {
 550         if ($total_amount_other + $amount > $maxfine) {
 551             my $new_amount = $maxfine - $total_amount_other;
 552             return if $new_amount <= 0.00;
 553             warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached";
 554             $amount = $new_amount;
 555         }
 556     }
 557
 558     if ( $data ) {
 559
 560                 # we're updating an existing fine.  Only modify if amount changed
 561         # Note that in the current implementation, you cannot pay against an accruing fine
 562         # (i.e. , of accounttype 'FU').  Doing so will break accrual.
 563         if ( $data->{'amount'} != $amount ) {
 564             my $diff = $amount - $data->{'amount'};
 565             #3341: diff could be positive or negative!
 566             my $out  = $data->{'amountoutstanding'} + $diff;
 567             my $query = "
 568                 UPDATE accountlines
 569                                 SET date=now(), amount=?, amountoutstanding=?,
 570                                         lastincrement=?, accounttype='FU'
 571                                 WHERE borrowernumber=?
 572                                 AND   itemnumber=?
 573                                 AND   accounttype IN ('FU','O')
 574                                 AND   description LIKE ?
 575                                 LIMIT 1 ";
 576             my $sth2 = $dbh->prepare($query);
 577                         # FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!!
 578                         #               LIMIT 1 added to prevent multiple affected lines
 579                         # FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline.
 580                         #               But actually, we should just have a regular autoincrementing PK and forget accountline,
 581                         #               including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops).
 582                         # FIXME: Why only 2 account types here?
 583                         $debug and print STDERR "UpdateFine query: $query\n" .
 584                                 "w/ args: $amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, \"\%$due\%\"\n";
 585             $sth2->execute($amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, "%$due%");
 586         } else {
 587             #      print "no update needed $data->{'amount'}"
 588         }
 589     } else {
 590         if ( $amount ) { # Don't add new fines with an amount of 0
 591             my $sth4 = $dbh->prepare(
 592                 "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?"
 593             );
 594             $sth4->execute($itemnum);
 595             my $title = $sth4->fetchrow;
 596
 597             my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
 598
 599             my $desc = ( $type ? "$type " : '' ) . "$title $due";    # FIXEDME, avoid whitespace prefix on empty $type
 600
 601             my $query = "INSERT INTO accountlines
 602                          (borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno)
 603                          VALUES (?,?,now(),?,?,'FU',?,?,?)";
 604             my $sth2 = $dbh->prepare($query);
 605             $debug and print STDERR "UpdateFine query: $query\nw/ args: $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno\n";
 606             $sth2->execute( $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno );
 607         }
 608     }
 609     # logging action
 610     &logaction(
 611         "FINES",
 612         $type,
 613         $borrowernumber,
 614         "due=".$due."  amount=".$amount." itemnumber=".$itemnum
 615         ) if C4::Context->preference("FinesLog");
 616 }
 617
 618 =head2 BorType
 619
 620     $borrower = &BorType($borrowernumber);
 621
 622 Looks up a patron by borrower number.
 623
 624 C<$borrower> is a reference-to-hash whose keys are all of the fields
 625 from the borrowers and categories tables of the Koha database. Thus,
 626 C<$borrower> contains all information about both the borrower and
 627 category he or she belongs to.
 628
 629 =cut
 630
 631 sub BorType {
 632     my ($borrowernumber) = @_;
 633     my $dbh              = C4::Context->dbh;
 634     my $sth              = $dbh->prepare(
 635         "SELECT * from borrowers
 636       LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
 637       WHERE borrowernumber=?"
 638     );
 639     $sth->execute($borrowernumber);
 640     return $sth->fetchrow_hashref;
 641 }
 642
 643 =head2 GetFine
 644
 645     $data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
 646
 647 return the total of fine
 648
 649 C<$itemnum> is item number
 650
 651 C<$borrowernumber> is the borrowernumber
 652
 653 =cut
 654
 655 sub GetFine {
 656     my ( $itemnum, $borrowernumber ) = @_;
 657     my $dbh   = C4::Context->dbh();
 658     my $query = q|SELECT sum(amountoutstanding) as fineamount FROM accountlines
 659     where accounttype like 'F%'
 660   AND amountoutstanding > 0 AND borrowernumber=?|;
 661     my @query_param;
 662     push @query_param, $borrowernumber;
 663     if (defined $itemnum )
 664     {
 665         $query .= " AND itemnumber=?";
 666         push @query_param, $itemnum;
 667     }
 668     my $sth = $dbh->prepare($query);
 669     $sth->execute( @query_param );
 670     my $fine = $sth->fetchrow_hashref();
 671     if ($fine->{fineamount}) {
 672         return $fine->{fineamount};
 673     }
 674     return 0;
 675 }
 676
 677 =head2 NumberNotifyId
 678
 679     (@notify) = &NumberNotifyId($borrowernumber);
 680
 681 Returns amount for all file per borrowers
 682 C<@notify> array contains all file per borrowers
 683
 684 C<$notify_id> contains the file number for the borrower number nad item number
 685
 686 =cut
 687
 688 sub NumberNotifyId{
 689     my ($borrowernumber)=@_;
 690     my $dbh = C4::Context->dbh;
 691     my $query=qq|    SELECT distinct(notify_id)
 692             FROM accountlines
 693             WHERE borrowernumber=?|;
 694     my @notify;
 695     my $sth = $dbh->prepare($query);
 696     $sth->execute($borrowernumber);
 697     while ( my ($numberofnotify) = $sth->fetchrow ) {
 698         push( @notify, $numberofnotify );
 699     }
 700     return (@notify);
 701 }
 702
 703 =head2 AmountNotify
 704
 705     ($totalnotify) = &AmountNotify($notifyid);
 706
 707 Returns amount for all file per borrowers
 708 C<$notifyid> is the file number
 709
 710 C<$totalnotify> contains amount of a file
 711
 712 C<$notify_id> contains the file number for the borrower number and item number
 713
 714 =cut
 715
 716 sub AmountNotify{
 717     my ($notifyid,$borrowernumber)=@_;
 718     my $dbh = C4::Context->dbh;
 719     my $query=qq|    SELECT sum(amountoutstanding)
 720             FROM accountlines
 721             WHERE notify_id=? AND borrowernumber = ?|;
 722     my $sth=$dbh->prepare($query);
 723         $sth->execute($notifyid,$borrowernumber);
 724         my $totalnotify=$sth->fetchrow;
 725     $sth->finish;
 726     return ($totalnotify);
 727 }
 728
 729 =head2 GetItems
 730
 731     ($items) = &GetItems($itemnumber);
 732
 733 Returns the list of all delays from overduerules.
 734
 735 C<$items> is a reference-to-hash whose keys are all of the fields
 736 from the items tables of the Koha database. Thus,
 737
 738 C<$itemnumber> contains the borrower categorycode
 739
 740 =cut
 741
 742 # FIXME: This is a bad function to have here.
 743 # Shouldn't it be in C4::Items?
 744 # Shouldn't it be called GetItem since you only get 1 row?
 745 # Shouldn't it be called GetItem since you give it only 1 itemnumber?
 746
 747 sub GetItems {
 748     my $itemnumber = shift or return;
 749     my $query = qq|SELECT *
 750              FROM items
 751               WHERE itemnumber=?|;
 752     my $sth = C4::Context->dbh->prepare($query);
 753     $sth->execute($itemnumber);
 754     my ($items) = $sth->fetchrow_hashref;
 755     return ($items);
 756 }
 757
 758 =head2 GetBranchcodesWithOverdueRules
 759
 760     my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules()
 761
 762 returns a list of branch codes for branches with overdue rules defined.
 763
 764 =cut
 765
 766 sub GetBranchcodesWithOverdueRules {
 767     my $dbh               = C4::Context->dbh;
 768     my $branchcodes = $dbh->selectcol_arrayref(q|
 769         SELECT DISTINCT(branchcode)
 770         FROM overduerules
 771         WHERE delay1 IS NOT NULL
 772         ORDER BY branchcode
 773     |);
 774     if ( $branchcodes->[0] eq '' ) {
 775         # If a default rule exists, all branches should be returned
 776         my $availbranches = C4::Branch::GetBranches();
 777         return keys %$availbranches;
 778     }
 779     return @$branchcodes;
 780 }
 781
 782 =head2 CheckItemNotify
 783
 784 Sql request to check if the document has alreday been notified
 785 this function is not exported, only used with GetOverduesForBranch
 786
 787 =cut
 788
 789 sub CheckItemNotify {
 790     my ($notify_id,$notify_level,$itemnumber) = @_;
 791     my $dbh = C4::Context->dbh;
 792     my $sth = $dbh->prepare("
 793     SELECT COUNT(*)
 794      FROM notifys
 795     WHERE notify_id    = ?
 796      AND  notify_level = ?
 797      AND  itemnumber   = ? ");
 798     $sth->execute($notify_id,$notify_level,$itemnumber);
 799     my $notified = $sth->fetchrow;
 800     return ($notified);
 801 }
 802
 803 =head2 GetOverduesForBranch
 804
 805 Sql request for display all information for branchoverdues.pl
 806 2 possibilities : with or without location .
 807 display is filtered by branch
 808
 809 FIXME: This function should be renamed.
 810
 811 =cut
 812
 813 sub GetOverduesForBranch {
 814     my ( $branch, $location) = @_;
 815         my $itype_link =  (C4::Context->preference('item-level_itypes')) ?  " items.itype " :  " biblioitems.itemtype ";
 816     my $dbh = C4::Context->dbh;
 817     my $select = "
 818     SELECT
 819             borrowers.cardnumber,
 820             borrowers.borrowernumber,
 821             borrowers.surname,
 822             borrowers.firstname,
 823             borrowers.phone,
 824             borrowers.email,
 825                biblio.title,
 826                biblio.author,
 827                biblio.biblionumber,
 828                issues.date_due,
 829                issues.returndate,
 830                issues.branchcode,
 831              branches.branchname,
 832                 items.barcode,
 833                 items.homebranch,
 834                 items.itemcallnumber,
 835                 items.location,
 836                 items.itemnumber,
 837             itemtypes.description,
 838          accountlines.notify_id,
 839          accountlines.notify_level,
 840          accountlines.amountoutstanding
 841     FROM  accountlines
 842     LEFT JOIN issues      ON    issues.itemnumber     = accountlines.itemnumber
 843                           AND   issues.borrowernumber = accountlines.borrowernumber
 844     LEFT JOIN borrowers   ON borrowers.borrowernumber = accountlines.borrowernumber
 845     LEFT JOIN items       ON     items.itemnumber     = issues.itemnumber
 846     LEFT JOIN biblio      ON      biblio.biblionumber =  items.biblionumber
 847     LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
 848     LEFT JOIN itemtypes   ON itemtypes.itemtype       = $itype_link
 849     LEFT JOIN branches    ON  branches.branchcode     = issues.branchcode
 850     WHERE (accountlines.amountoutstanding  != '0.000000')
 851       AND (accountlines.accounttype         = 'FU'      )
 852       AND (issues.branchcode =  ?   )
 853       AND (issues.date_due  < NOW())
 854     ";
 855     my @getoverdues;
 856     my $i = 0;
 857     my $sth;
 858     if ($location) {
 859         $sth = $dbh->prepare("$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname");
 860         $sth->execute($branch, $location);
 861     } else {
 862         $sth = $dbh->prepare("$select ORDER BY borrowers.surname, borrowers.firstname");
 863         $sth->execute($branch);
 864     }
 865     while ( my $data = $sth->fetchrow_hashref ) {
 866     #check if the document has already been notified
 867         my $countnotify = CheckItemNotify($data->{'notify_id'}, $data->{'notify_level'}, $data->{'itemnumber'});
 868         if ($countnotify eq '0') {
 869             $getoverdues[$i] = $data;
 870             $i++;
 871         }
 872     }
 873     return (@getoverdues);
 874 }
 875
 876
 877 =head2 AddNotifyLine
 878
 879     &AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
 880
 881 Create a line into notify, if the method is phone, the notification_send_date is implemented to
 882
 883 =cut
 884
 885 sub AddNotifyLine {
 886     my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_;
 887     my $dbh = C4::Context->dbh;
 888     if ( $method eq "phone" ) {
 889         my $sth = $dbh->prepare(
 890             "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
 891         VALUES (?,?,now(),now(),?,?,?)"
 892         );
 893         $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
 894             $notifyId );
 895     }
 896     else {
 897         my $sth = $dbh->prepare(
 898             "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
 899         VALUES (?,?,now(),?,?,?)"
 900         );
 901         $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
 902             $notifyId );
 903     }
 904     return 1;
 905 }
 906
 907 =head2 RemoveNotifyLine
 908
 909     &RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
 910
 911 Cancel a notification
 912
 913 =cut
 914
 915 sub RemoveNotifyLine {
 916     my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
 917     my $dbh = C4::Context->dbh;
 918     my $sth = $dbh->prepare(
 919         "DELETE FROM notifys
 920             WHERE
 921             borrowernumber=?
 922             AND itemnumber=?
 923             AND notify_date=?"
 924     );
 925     $sth->execute( $borrowernumber, $itemnumber, $notify_date );
 926     return 1;
 927 }
 928
 929 =head2 GetOverdueMessageTransportTypes
 930
 931     my $message_transport_types = GetOverdueMessageTransportTypes( $branchcode, $categorycode, $letternumber);
 932
 933     return a arrayref with all message_transport_type for given branchcode, categorycode and letternumber(1,2 or 3)
 934
 935 =cut
 936
 937 sub GetOverdueMessageTransportTypes {
 938     my ( $branchcode, $categorycode, $letternumber ) = @_;
 939     return unless $categorycode and $letternumber;
 940     my $dbh = C4::Context->dbh;
 941     my $sth = $dbh->prepare("
 942         SELECT message_transport_type FROM overduerules_transport_types
 943         WHERE branchcode = ? AND categorycode = ? AND letternumber = ?
 944     ");
 945     $sth->execute( $branchcode, $categorycode, $letternumber );
 946     my @mtts;
 947     while ( my $mtt = $sth->fetchrow ) {
 948         push @mtts, $mtt;
 949     }
 950
 951     # Put 'print' in first if exists
 952     # It avoid to sent a print notice with an email or sms template is no email or sms is defined
 953     @mtts = uniq( 'print', @mtts )
 954         if grep {/^print$/} @mtts;
 955
 956     return \@mtts;
 957 }
 958
 959 =head2 parse_overdues_letter
 960
 961 parses the letter template, replacing the placeholders with data
 962 specific to this patron, biblio, or item for overdues
 963
 964 named parameters:
 965   letter - required hashref
 966   borrowernumber - required integer
 967   substitute - optional hashref of other key/value pairs that should
 968     be substituted in the letter content
 969
 970 returns the C<letter> hashref, with the content updated to reflect the
 971 substituted keys and values.
 972
 973 =cut
 974
 975 sub parse_overdues_letter {
 976     my $params = shift;
 977     foreach my $required (qw( letter_code borrowernumber )) {
 978         return unless ( exists $params->{$required} && $params->{$required} );
 979     }
 980
 981     my $substitute = $params->{'substitute'} || {};
 982     $substitute->{today} ||= output_pref( { dt => dt_from_string, dateonly => 1} );
 983
 984     my %tables = ( 'borrowers' => $params->{'borrowernumber'} );
 985     if ( my $p = $params->{'branchcode'} ) {
 986         $tables{'branches'} = $p;
 987     }
 988
 989     my $currencies = GetCurrency();
 990     my $currency_format;
 991     $currency_format = $currencies->{currency} if defined($currencies);
 992
 993     my @item_tables;
 994     if ( my $i = $params->{'items'} ) {
 995         my $item_format = '';
 996         foreach my $item (@$i) {
 997             my $fine = GetFine($item->{'itemnumber'}, $params->{'borrowernumber'});
 998             if ( !$item_format and defined $params->{'letter'}->{'content'} ) {
 999                 $params->{'letter'}->{'content'} =~ m/(<item>.*<\/item>)/;
1000                 $item_format = $1;
1001             }
1002
1003             $item->{'fine'} = currency_format($currency_format, "$fine", FMT_SYMBOL);
1004             # if active currency isn't correct ISO code fallback to sprintf
1005             $item->{'fine'} = sprintf('%.2f', $fine) unless $item->{'fine'};
1006
1007             push @item_tables, {
1008                 'biblio' => $item->{'biblionumber'},
1009                 'biblioitems' => $item->{'biblionumber'},
1010                 'items' => $item,
1011                 'issues' => $item->{'itemnumber'},
1012             };
1013         }
1014     }
1015
1016     return C4::Letters::GetPreparedLetter (
1017         module => 'circulation',
1018         letter_code => $params->{'letter_code'},
1019         branchcode => $params->{'branchcode'},
1020         tables => \%tables,
1021         substitute => $substitute,
1022         repeat => { item => \@item_tables },
1023         message_transport_type => $params->{message_transport_type},
1024     );
1025 }
1026
1027 1;
1028 __END__
1029
1030 =head1 AUTHOR
1031
1032 Koha Development Team <http://koha-community.org/>
1033
1034 =cut