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 use Carp;
  30
  31 use C4::Circulation;
  32 use C4::Context;
  33 use C4::Accounts;
  34 use C4::Log; # logaction
  35 use C4::Debug;
  36 use Koha::DateUtils;
  37 use Koha::Account::Lines;
  38 use Koha::Account::Offsets;
  39 use Koha::IssuingRules;
  40 use Koha::Libraries;
  41
  42 use vars qw(@ISA @EXPORT);
  43
  44 BEGIN {
  45     require Exporter;
  46     @ISA = qw(Exporter);
  47
  48     # subs to rename (and maybe merge some...)
  49     push @EXPORT, qw(
  50       &CalcFine
  51       &Getoverdues
  52       &checkoverdues
  53       &NumberNotifyId
  54       &AmountNotify
  55       &UpdateFine
  56       &GetFine
  57       &get_chargeable_units
  58       &CheckItemNotify
  59       &GetOverduesForBranch
  60       &RemoveNotifyLine
  61       &AddNotifyLine
  62       &GetOverdueMessageTransportTypes
  63       &parse_overdues_letter
  64     );
  65
  66     # subs to remove
  67     push @EXPORT, qw(
  68       &BorType
  69     );
  70
  71     # check that an equivalent don't exist already before moving
  72
  73     # subs to move to Circulation.pm
  74     push @EXPORT, qw(
  75       &GetIssuesIteminfo
  76     );
  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, items.replacementprice
 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, replacementprice
 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     my $sth = C4::Context->dbh->prepare(
 162         "SELECT biblio.*, items.*, issues.*,
 163                 biblioitems.volume,
 164                 biblioitems.number,
 165                 biblioitems.itemtype,
 166                 biblioitems.isbn,
 167                 biblioitems.issn,
 168                 biblioitems.publicationyear,
 169                 biblioitems.publishercode,
 170                 biblioitems.volumedate,
 171                 biblioitems.volumedesc,
 172                 biblioitems.collectiontitle,
 173                 biblioitems.collectionissn,
 174                 biblioitems.collectionvolume,
 175                 biblioitems.editionstatement,
 176                 biblioitems.editionresponsibility,
 177                 biblioitems.illus,
 178                 biblioitems.pages,
 179                 biblioitems.notes,
 180                 biblioitems.size,
 181                 biblioitems.place,
 182                 biblioitems.lccn,
 183                 biblioitems.url,
 184                 biblioitems.cn_source,
 185                 biblioitems.cn_class,
 186                 biblioitems.cn_item,
 187                 biblioitems.cn_suffix,
 188                 biblioitems.cn_sort,
 189                 biblioitems.totalissues
 190          FROM issues
 191          LEFT JOIN items       ON issues.itemnumber      = items.itemnumber
 192          LEFT JOIN biblio      ON items.biblionumber     = biblio.biblionumber
 193          LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 194             WHERE issues.borrowernumber  = ?
 195             AND   issues.date_due < NOW()"
 196     );
 197     $sth->execute($borrowernumber);
 198     my $results = $sth->fetchall_arrayref({});
 199     return ( scalar(@$results), $results);  # returning the count and the results is silly
 200 }
 201
 202 =head2 CalcFine
 203
 204     ($amount, $chargename,  $units_minus_grace, $chargeable_units) = &CalcFine($item,
 205                                   $categorycode, $branch,
 206                                   $start_dt, $end_dt );
 207
 208 Calculates the fine for a book.
 209
 210 The issuingrules table in the Koha database is a fine matrix, listing
 211 the penalties for each type of patron for each type of item and each branch (e.g., the
 212 standard fine for books might be $0.50, but $1.50 for DVDs, or staff
 213 members might get a longer grace period between the first and second
 214 reminders that a book is overdue).
 215
 216
 217 C<$item> is an item object (hashref).
 218
 219 C<$categorycode> is the category code (string) of the patron who currently has
 220 the book.
 221
 222 C<$branchcode> is the library (string) whose issuingrules govern this transaction.
 223
 224 C<$start_date> & C<$end_date> are DateTime objects
 225 defining the date range over which to determine the fine.
 226
 227 Fines scripts should just supply the date range over which to calculate the fine.
 228
 229 C<&CalcFine> returns four values:
 230
 231 C<$amount> is the fine owed by the patron (see above).
 232
 233 C<$chargename> is the chargename field from the applicable record in
 234 the categoryitem table, whatever that is.
 235
 236 C<$units_minus_grace> is the number of chargeable units minus the grace period
 237
 238 C<$chargeable_units> 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: previously attempted to return C<$message> as a text message, either "First Notice", "Second Notice",
 242 or "Final Notice".  But CalcFine never defined any value.
 243
 244 =cut
 245
 246 sub CalcFine {
 247     my ( $item, $bortype, $branchcode, $due_dt, $end_date  ) = @_;
 248     my $start_date = $due_dt->clone();
 249     # get issuingrules (fines part will be used)
 250     my $itemtype = $item->{itemtype} || $item->{itype};
 251     my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule({ categorycode => $bortype, itemtype => $itemtype, branchcode => $branchcode });
 252
 253     return unless $issuing_rule; # If not rule exist, there is no fine
 254
 255     my $fine_unit = $issuing_rule->lengthunit || 'days';
 256
 257     my $chargeable_units = get_chargeable_units($fine_unit, $start_date, $end_date, $branchcode);
 258     my $units_minus_grace = $chargeable_units - $issuing_rule->firstremind;
 259     my $amount = 0;
 260     if ( $issuing_rule->chargeperiod && ( $units_minus_grace > 0 ) ) {
 261         my $units = C4::Context->preference('FinesIncludeGracePeriod') ? $chargeable_units : $units_minus_grace;
 262         my $charge_periods = $units / $issuing_rule->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 = $issuing_rule->chargeperiod_charge_at == 1 ? ceil($charge_periods) : floor($charge_periods);
 266         $amount = $charge_periods * $issuing_rule->fine;
 267     } # else { # a zero (or null) chargeperiod or negative units_minus_grace value means no charge. }
 268
 269     $amount = $issuing_rule->overduefinescap if $issuing_rule->overduefinescap && $amount > $issuing_rule->overduefinescap;
 270     $amount = $item->{replacementprice} if ( $issuing_rule->cap_fine_to_replacement_price && $item->{replacementprice} && $amount > $item->{replacementprice} );
 271     $debug and warn sprintf("CalcFine returning (%s, %s, %s, %s)", $amount, $issuing_rule->chargename, $units_minus_grace, $chargeable_units);
 272     return ($amount, $issuing_rule->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({ issue_id => $issue_id, itemnumber => $itemnumber, borrwernumber => $borrowernumber, amount => $amount, type => $type, $due => $date_due });
 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<$due> is the due date formatted to the currently specified date 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 ($params) = @_;
 506
 507     my $issue_id       = $params->{issue_id};
 508     my $itemnum        = $params->{itemnumber};
 509     my $borrowernumber = $params->{borrowernumber};
 510     my $amount         = $params->{amount};
 511     my $type           = $params->{type};
 512     my $due            = $params->{due};
 513
 514     $debug and warn "UpdateFine({ itemnumber => $itemnum, borrowernumber => $borrowernumber, type => $type, due => $due, issue_id => $issue_id})";
 515
 516     unless ( $issue_id ) {
 517         carp("No issue_id passed in!");
 518         return;
 519     }
 520
 521     my $dbh = C4::Context->dbh;
 522     # FIXME - What exactly is this query supposed to do? It looks up an
 523     # entry in accountlines that matches the given item and borrower
 524     # numbers, where the description contains $due, and where the
 525     # account type has one of several values, but what does this _mean_?
 526     # Does it look up existing fines for this item?
 527     # FIXME - What are these various account types? ("FU", "O", "F", "M")
 528     #   "L"   is LOST item
 529     #   "A"   is Account Management Fee
 530     #   "N"   is New Card
 531     #   "M"   is Sundry
 532     #   "O"   is Overdue ??
 533     #   "F"   is Fine ??
 534     #   "FU"  is Fine UPDATE??
 535     #   "Pay" is Payment
 536     #   "REF" is Cash Refund
 537     my $sth = $dbh->prepare(
 538         "SELECT * FROM accountlines
 539         WHERE borrowernumber=? AND
 540         (( accounttype IN ('O','F','M') AND amountoutstanding<>0 ) OR
 541            accounttype = 'FU' )"
 542     );
 543     $sth->execute( $borrowernumber );
 544     my $data;
 545     my $total_amount_other = 0.00;
 546     my $due_qr = qr/$due/;
 547     # Cycle through the fines and
 548     # - find line that relates to the requested $itemnum
 549     # - accumulate fines for other items
 550     # so we can update $itemnum fine taking in account fine caps
 551     while (my $rec = $sth->fetchrow_hashref) {
 552         if ( $rec->{issue_id} == $issue_id && $rec->{accounttype} eq 'FU' ) {
 553             if ($data) {
 554                 warn "Not a unique accountlines record for issue_id $issue_id";
 555                 #FIXME Should we still count this one in total_amount ??
 556             }
 557             else {
 558                 $data = $rec;
 559                 next;
 560             }
 561         }
 562         $total_amount_other += $rec->{'amountoutstanding'};
 563     }
 564
 565     if (my $maxfine = C4::Context->preference('MaxFine')) {
 566         if ($total_amount_other + $amount > $maxfine) {
 567             my $new_amount = $maxfine - $total_amount_other;
 568             return if $new_amount <= 0.00;
 569             warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached";
 570             $amount = $new_amount;
 571         }
 572     }
 573
 574     if ( $data ) {
 575         # we're updating an existing fine.  Only modify if amount changed
 576         # Note that in the current implementation, you cannot pay against an accruing fine
 577         # (i.e. , of accounttype 'FU').  Doing so will break accrual.
 578         if ( $data->{'amount'} != $amount ) {
 579             my $accountline = Koha::Account::Lines->find( $data->{accountlines_id} );
 580             my $diff = $amount - $data->{'amount'};
 581
 582             #3341: diff could be positive or negative!
 583             my $out   = $data->{'amountoutstanding'} + $diff;
 584
 585             $accountline->set(
 586                 {
 587                     date          => dt_from_string(),
 588                     amount        => $amount,
 589                     amountoutstanding   => $out,
 590                     lastincrement => $diff,
 591                     accounttype   => 'FU',
 592                 }
 593             )->store();
 594
 595             Koha::Account::Offset->new(
 596                 {
 597                     debit_id => $accountline->id,
 598                     type     => 'Fine Update',
 599                     amount   => $diff,
 600                 }
 601             )->store();
 602         }
 603     } else {
 604         if ( $amount ) { # Don't add new fines with an amount of 0
 605             my $sth4 = $dbh->prepare(
 606                 "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?"
 607             );
 608             $sth4->execute($itemnum);
 609             my $title = $sth4->fetchrow;
 610
 611             my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
 612
 613             my $desc = ( $type ? "$type " : '' ) . "$title $due";    # FIXEDME, avoid whitespace prefix on empty $type
 614
 615             my $accountline = Koha::Account::Line->new(
 616                 {
 617                     borrowernumber    => $borrowernumber,
 618                     itemnumber        => $itemnum,
 619                     date              => dt_from_string(),
 620                     amount            => $amount,
 621                     description       => $desc,
 622                     accounttype       => 'FU',
 623                     amountoutstanding => $amount,
 624                     lastincrement     => $amount,
 625                     accountno         => $nextaccntno,
 626                     issue_id          => $issue_id,
 627                 }
 628             )->store();
 629
 630             Koha::Account::Offset->new(
 631                 {
 632                     debit_id => $accountline->id,
 633                     type     => 'Fine',
 634                     amount   => $amount,
 635                 }
 636             )->store();
 637         }
 638     }
 639     # logging action
 640     &logaction(
 641         "FINES",
 642         $type,
 643         $borrowernumber,
 644         "due=".$due."  amount=".$amount." itemnumber=".$itemnum
 645         ) if C4::Context->preference("FinesLog");
 646 }
 647
 648 =head2 BorType
 649
 650     $borrower = &BorType($borrowernumber);
 651
 652 Looks up a patron by borrower number.
 653
 654 C<$borrower> is a reference-to-hash whose keys are all of the fields
 655 from the borrowers and categories tables of the Koha database. Thus,
 656 C<$borrower> contains all information about both the borrower and
 657 category they belong to.
 658
 659 =cut
 660
 661 sub BorType {
 662     my ($borrowernumber) = @_;
 663     my $dbh              = C4::Context->dbh;
 664     my $sth              = $dbh->prepare(
 665         "SELECT * from borrowers
 666       LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
 667       WHERE borrowernumber=?"
 668     );
 669     $sth->execute($borrowernumber);
 670     return $sth->fetchrow_hashref;
 671 }
 672
 673 =head2 GetFine
 674
 675     $data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
 676
 677 return the total of fine
 678
 679 C<$itemnum> is item number
 680
 681 C<$borrowernumber> is the borrowernumber
 682
 683 =cut
 684
 685 sub GetFine {
 686     my ( $itemnum, $borrowernumber ) = @_;
 687     my $dbh   = C4::Context->dbh();
 688     my $query = q|SELECT sum(amountoutstanding) as fineamount FROM accountlines
 689     where accounttype like 'F%'
 690   AND amountoutstanding > 0 AND borrowernumber=?|;
 691     my @query_param;
 692     push @query_param, $borrowernumber;
 693     if (defined $itemnum )
 694     {
 695         $query .= " AND itemnumber=?";
 696         push @query_param, $itemnum;
 697     }
 698     my $sth = $dbh->prepare($query);
 699     $sth->execute( @query_param );
 700     my $fine = $sth->fetchrow_hashref();
 701     if ($fine->{fineamount}) {
 702         return $fine->{fineamount};
 703     }
 704     return 0;
 705 }
 706
 707 =head2 NumberNotifyId
 708
 709     (@notify) = &NumberNotifyId($borrowernumber);
 710
 711 Returns amount for all file per borrowers
 712 C<@notify> array contains all file per borrowers
 713
 714 C<$notify_id> contains the file number for the borrower number nad item number
 715
 716 =cut
 717
 718 sub NumberNotifyId{
 719     my ($borrowernumber)=@_;
 720     my $dbh = C4::Context->dbh;
 721     my $query=qq|    SELECT distinct(notify_id)
 722             FROM accountlines
 723             WHERE borrowernumber=?|;
 724     my @notify;
 725     my $sth = $dbh->prepare($query);
 726     $sth->execute($borrowernumber);
 727     while ( my ($numberofnotify) = $sth->fetchrow ) {
 728         push( @notify, $numberofnotify );
 729     }
 730     return (@notify);
 731 }
 732
 733 =head2 AmountNotify
 734
 735     ($totalnotify) = &AmountNotify($notifyid);
 736
 737 Returns amount for all file per borrowers
 738 C<$notifyid> is the file number
 739
 740 C<$totalnotify> contains amount of a file
 741
 742 C<$notify_id> contains the file number for the borrower number and item number
 743
 744 =cut
 745
 746 sub AmountNotify{
 747     my ($notifyid,$borrowernumber)=@_;
 748     my $dbh = C4::Context->dbh;
 749     my $query=qq|    SELECT sum(amountoutstanding)
 750             FROM accountlines
 751             WHERE notify_id=? AND borrowernumber = ?|;
 752     my $sth=$dbh->prepare($query);
 753         $sth->execute($notifyid,$borrowernumber);
 754         my $totalnotify=$sth->fetchrow;
 755     $sth->finish;
 756     return ($totalnotify);
 757 }
 758
 759 =head2 GetItems
 760
 761     ($items) = &GetItems($itemnumber);
 762
 763 Returns the list of all delays from overduerules.
 764
 765 C<$items> is a reference-to-hash whose keys are all of the fields
 766 from the items tables of the Koha database. Thus,
 767
 768 C<$itemnumber> contains the borrower categorycode
 769
 770 =cut
 771
 772 # FIXME: This is a bad function to have here.
 773 # Shouldn't it be in C4::Items?
 774 # Shouldn't it be called GetItem since you only get 1 row?
 775 # Shouldn't it be called GetItem since you give it only 1 itemnumber?
 776
 777 sub GetItems {
 778     my $itemnumber = shift or return;
 779     my $query = qq|SELECT *
 780              FROM items
 781               WHERE itemnumber=?|;
 782     my $sth = C4::Context->dbh->prepare($query);
 783     $sth->execute($itemnumber);
 784     my ($items) = $sth->fetchrow_hashref;
 785     return ($items);
 786 }
 787
 788 =head2 GetBranchcodesWithOverdueRules
 789
 790     my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules()
 791
 792 returns a list of branch codes for branches with overdue rules defined.
 793
 794 =cut
 795
 796 sub GetBranchcodesWithOverdueRules {
 797     my $dbh               = C4::Context->dbh;
 798     my $branchcodes = $dbh->selectcol_arrayref(q|
 799         SELECT DISTINCT(branchcode)
 800         FROM overduerules
 801         WHERE delay1 IS NOT NULL
 802         ORDER BY branchcode
 803     |);
 804     if ( $branchcodes->[0] eq '' ) {
 805         # If a default rule exists, all branches should be returned
 806         return map { $_->branchcode } Koha::Libraries->search({}, { order_by => 'branchname' });
 807     }
 808     return @$branchcodes;
 809 }
 810
 811 =head2 CheckItemNotify
 812
 813 Sql request to check if the document has alreday been notified
 814 this function is not exported, only used with GetOverduesForBranch
 815
 816 =cut
 817
 818 sub CheckItemNotify {
 819     my ($notify_id,$notify_level,$itemnumber) = @_;
 820     my $dbh = C4::Context->dbh;
 821     my $sth = $dbh->prepare("
 822     SELECT COUNT(*)
 823      FROM notifys
 824     WHERE notify_id    = ?
 825      AND  notify_level = ?
 826      AND  itemnumber   = ? ");
 827     $sth->execute($notify_id,$notify_level,$itemnumber);
 828     my $notified = $sth->fetchrow;
 829     return ($notified);
 830 }
 831
 832 =head2 GetOverduesForBranch
 833
 834 Sql request for display all information for branchoverdues.pl
 835 2 possibilities : with or without location .
 836 display is filtered by branch
 837
 838 FIXME: This function should be renamed.
 839
 840 =cut
 841
 842 sub GetOverduesForBranch {
 843     my ( $branch, $location) = @_;
 844         my $itype_link =  (C4::Context->preference('item-level_itypes')) ?  " items.itype " :  " biblioitems.itemtype ";
 845     my $dbh = C4::Context->dbh;
 846     my $select = "
 847     SELECT
 848             borrowers.cardnumber,
 849             borrowers.borrowernumber,
 850             borrowers.surname,
 851             borrowers.firstname,
 852             borrowers.phone,
 853             borrowers.email,
 854                biblio.title,
 855                biblio.author,
 856                biblio.biblionumber,
 857                issues.date_due,
 858                issues.returndate,
 859                issues.branchcode,
 860              branches.branchname,
 861                 items.barcode,
 862                 items.homebranch,
 863                 items.itemcallnumber,
 864                 items.location,
 865                 items.itemnumber,
 866             itemtypes.description,
 867          accountlines.notify_id,
 868          accountlines.notify_level,
 869          accountlines.amountoutstanding
 870     FROM  accountlines
 871     LEFT JOIN issues      ON    issues.itemnumber     = accountlines.itemnumber
 872                           AND   issues.borrowernumber = accountlines.borrowernumber
 873     LEFT JOIN borrowers   ON borrowers.borrowernumber = accountlines.borrowernumber
 874     LEFT JOIN items       ON     items.itemnumber     = issues.itemnumber
 875     LEFT JOIN biblio      ON      biblio.biblionumber =  items.biblionumber
 876     LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
 877     LEFT JOIN itemtypes   ON itemtypes.itemtype       = $itype_link
 878     LEFT JOIN branches    ON  branches.branchcode     = issues.branchcode
 879     WHERE (accountlines.amountoutstanding  != '0.000000')
 880       AND (accountlines.accounttype         = 'FU'      )
 881       AND (issues.branchcode =  ?   )
 882       AND (issues.date_due  < NOW())
 883     ";
 884     my @getoverdues;
 885     my $i = 0;
 886     my $sth;
 887     if ($location) {
 888         $sth = $dbh->prepare("$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname");
 889         $sth->execute($branch, $location);
 890     } else {
 891         $sth = $dbh->prepare("$select ORDER BY borrowers.surname, borrowers.firstname");
 892         $sth->execute($branch);
 893     }
 894     while ( my $data = $sth->fetchrow_hashref ) {
 895     #check if the document has already been notified
 896         my $countnotify = CheckItemNotify($data->{'notify_id'}, $data->{'notify_level'}, $data->{'itemnumber'});
 897         if ($countnotify eq '0') {
 898             $getoverdues[$i] = $data;
 899             $i++;
 900         }
 901     }
 902     return (@getoverdues);
 903 }
 904
 905
 906 =head2 AddNotifyLine
 907
 908     &AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
 909
 910 Create a line into notify, if the method is phone, the notification_send_date is implemented to
 911
 912 =cut
 913
 914 sub AddNotifyLine {
 915     my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_;
 916     my $dbh = C4::Context->dbh;
 917     if ( $method eq "phone" ) {
 918         my $sth = $dbh->prepare(
 919             "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
 920         VALUES (?,?,now(),now(),?,?,?)"
 921         );
 922         $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
 923             $notifyId );
 924     }
 925     else {
 926         my $sth = $dbh->prepare(
 927             "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
 928         VALUES (?,?,now(),?,?,?)"
 929         );
 930         $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
 931             $notifyId );
 932     }
 933     return 1;
 934 }
 935
 936 =head2 RemoveNotifyLine
 937
 938     &RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
 939
 940 Cancel a notification
 941
 942 =cut
 943
 944 sub RemoveNotifyLine {
 945     my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
 946     my $dbh = C4::Context->dbh;
 947     my $sth = $dbh->prepare(
 948         "DELETE FROM notifys
 949             WHERE
 950             borrowernumber=?
 951             AND itemnumber=?
 952             AND notify_date=?"
 953     );
 954     $sth->execute( $borrowernumber, $itemnumber, $notify_date );
 955     return 1;
 956 }
 957
 958 =head2 GetOverdueMessageTransportTypes
 959
 960     my $message_transport_types = GetOverdueMessageTransportTypes( $branchcode, $categorycode, $letternumber);
 961
 962     return a arrayref with all message_transport_type for given branchcode, categorycode and letternumber(1,2 or 3)
 963
 964 =cut
 965
 966 sub GetOverdueMessageTransportTypes {
 967     my ( $branchcode, $categorycode, $letternumber ) = @_;
 968     return unless $categorycode and $letternumber;
 969     my $dbh = C4::Context->dbh;
 970     my $sth = $dbh->prepare("
 971         SELECT message_transport_type
 972         FROM overduerules odr LEFT JOIN overduerules_transport_types ott USING (overduerules_id)
 973         WHERE branchcode = ?
 974           AND categorycode = ?
 975           AND letternumber = ?
 976     ");
 977     $sth->execute( $branchcode, $categorycode, $letternumber );
 978     my @mtts;
 979     while ( my $mtt = $sth->fetchrow ) {
 980         push @mtts, $mtt;
 981     }
 982
 983     # Put 'print' in first if exists
 984     # It avoid to sent a print notice with an email or sms template is no email or sms is defined
 985     @mtts = uniq( 'print', @mtts )
 986         if grep {/^print$/} @mtts;
 987
 988     return \@mtts;
 989 }
 990
 991 =head2 parse_overdues_letter
 992
 993 parses the letter template, replacing the placeholders with data
 994 specific to this patron, biblio, or item for overdues
 995
 996 named parameters:
 997   letter - required hashref
 998   borrowernumber - required integer
 999   substitute - optional hashref of other key/value pairs that should
1000     be substituted in the letter content
1001
1002 returns the C<letter> hashref, with the content updated to reflect the
1003 substituted keys and values.
1004
1005 =cut
1006
1007 sub parse_overdues_letter {
1008     my $params = shift;
1009     foreach my $required (qw( letter_code borrowernumber )) {
1010         return unless ( exists $params->{$required} && $params->{$required} );
1011     }
1012
1013     my $patron = Koha::Patrons->find( $params->{borrowernumber} );
1014
1015     my $substitute = $params->{'substitute'} || {};
1016
1017     my %tables = ( 'borrowers' => $params->{'borrowernumber'} );
1018     if ( my $p = $params->{'branchcode'} ) {
1019         $tables{'branches'} = $p;
1020     }
1021
1022     my $active_currency = Koha::Acquisition::Currencies->get_active;
1023
1024     my $currency_format;
1025     $currency_format = $active_currency->currency if defined($active_currency);
1026
1027     my @item_tables;
1028     if ( my $i = $params->{'items'} ) {
1029         foreach my $item (@$i) {
1030             my $fine = GetFine($item->{'itemnumber'}, $params->{'borrowernumber'});
1031             $item->{'fine'} = currency_format($currency_format, "$fine", FMT_SYMBOL);
1032             # if active currency isn't correct ISO code fallback to sprintf
1033             $item->{'fine'} = sprintf('%.2f', $fine) unless $item->{'fine'};
1034
1035             push @item_tables, {
1036                 'biblio' => $item->{'biblionumber'},
1037                 'biblioitems' => $item->{'biblionumber'},
1038                 'items' => $item,
1039                 'issues' => $item->{'itemnumber'},
1040             };
1041         }
1042     }
1043
1044     return C4::Letters::GetPreparedLetter (
1045         module => 'circulation',
1046         letter_code => $params->{'letter_code'},
1047         branchcode => $params->{'branchcode'},
1048         lang => $patron->lang,
1049         tables => \%tables,
1050         loops => {
1051             overdues => [ map { $_->{items}->{itemnumber} } @item_tables ],
1052         },
1053         substitute => $substitute,
1054         repeat => { item => \@item_tables },
1055         message_transport_type => $params->{message_transport_type},
1056     );
1057 }
1058
1059 1;
1060 __END__
1061
1062 =head1 AUTHOR
1063
1064 Koha Development Team <http://koha-community.org/>
1065
1066 =cut