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