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       &UpdateFine
  54       &GetFine
  55       &get_chargeable_units
  56       &GetOverduesForBranch
  57       &GetOverdueMessageTransportTypes
  58       &parse_overdues_letter
  59     );
  60
  61     # subs to remove
  62     push @EXPORT, qw(
  63       &BorType
  64     );
  65
  66     # check that an equivalent don't exist already before moving
  67
  68     # subs to move to Circulation.pm
  69     push @EXPORT, qw(
  70       &GetIssuesIteminfo
  71     );
  72 }
  73
  74 =head1 NAME
  75
  76 C4::Circulation::Fines - Koha module dealing with fines
  77
  78 =head1 SYNOPSIS
  79
  80   use C4::Overdues;
  81
  82 =head1 DESCRIPTION
  83
  84 This module contains several functions for dealing with fines for
  85 overdue items. It is primarily used by the 'misc/fines2.pl' script.
  86
  87 =head1 FUNCTIONS
  88
  89 =head2 Getoverdues
  90
  91   $overdues = Getoverdues( { minimumdays => 1, maximumdays => 30 } );
  92
  93 Returns the list of all overdue books, with their itemtype.
  94
  95 C<$overdues> is a reference-to-array. Each element is a
  96 reference-to-hash whose keys are the fields of the issues table in the
  97 Koha database.
  98
  99 =cut
 100
 101 #'
 102 sub Getoverdues {
 103     my $params = shift;
 104     my $dbh = C4::Context->dbh;
 105     my $statement;
 106     if ( C4::Context->preference('item-level_itypes') ) {
 107         $statement = "
 108    SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode, items.itemlost, items.replacementprice
 109      FROM issues
 110 LEFT JOIN items       USING (itemnumber)
 111     WHERE date_due < NOW()
 112 ";
 113     } else {
 114         $statement = "
 115    SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode, items.itemlost, replacementprice
 116      FROM issues
 117 LEFT JOIN items       USING (itemnumber)
 118 LEFT JOIN biblioitems USING (biblioitemnumber)
 119     WHERE date_due < NOW()
 120 ";
 121     }
 122
 123     my @bind_parameters;
 124     if ( exists $params->{'minimumdays'} and exists $params->{'maximumdays'} ) {
 125         $statement .= ' AND TO_DAYS( NOW() )-TO_DAYS( date_due ) BETWEEN ? and ? ';
 126         push @bind_parameters, $params->{'minimumdays'}, $params->{'maximumdays'};
 127     } elsif ( exists $params->{'minimumdays'} ) {
 128         $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) > ? ';
 129         push @bind_parameters, $params->{'minimumdays'};
 130     } elsif ( exists $params->{'maximumdays'} ) {
 131         $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ? ';
 132         push @bind_parameters, $params->{'maximumdays'};
 133     }
 134     $statement .= 'ORDER BY borrowernumber';
 135     my $sth = $dbh->prepare( $statement );
 136     $sth->execute( @bind_parameters );
 137     return $sth->fetchall_arrayref({});
 138 }
 139
 140
 141 =head2 checkoverdues
 142
 143     ($count, $overdueitems) = checkoverdues($borrowernumber);
 144
 145 Returns a count and a list of overdueitems for a given borrowernumber
 146
 147 =cut
 148
 149 sub checkoverdues {
 150     my $borrowernumber = shift or return;
 151     my $sth = C4::Context->dbh->prepare(
 152         "SELECT biblio.*, items.*, issues.*,
 153                 biblioitems.volume,
 154                 biblioitems.number,
 155                 biblioitems.itemtype,
 156                 biblioitems.isbn,
 157                 biblioitems.issn,
 158                 biblioitems.publicationyear,
 159                 biblioitems.publishercode,
 160                 biblioitems.volumedate,
 161                 biblioitems.volumedesc,
 162                 biblioitems.collectiontitle,
 163                 biblioitems.collectionissn,
 164                 biblioitems.collectionvolume,
 165                 biblioitems.editionstatement,
 166                 biblioitems.editionresponsibility,
 167                 biblioitems.illus,
 168                 biblioitems.pages,
 169                 biblioitems.notes,
 170                 biblioitems.size,
 171                 biblioitems.place,
 172                 biblioitems.lccn,
 173                 biblioitems.url,
 174                 biblioitems.cn_source,
 175                 biblioitems.cn_class,
 176                 biblioitems.cn_item,
 177                 biblioitems.cn_suffix,
 178                 biblioitems.cn_sort,
 179                 biblioitems.totalissues
 180          FROM issues
 181          LEFT JOIN items       ON issues.itemnumber      = items.itemnumber
 182          LEFT JOIN biblio      ON items.biblionumber     = biblio.biblionumber
 183          LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 184             WHERE issues.borrowernumber  = ?
 185             AND   issues.date_due < NOW()"
 186     );
 187     $sth->execute($borrowernumber);
 188     my $results = $sth->fetchall_arrayref({});
 189     return ( scalar(@$results), $results);  # returning the count and the results is silly
 190 }
 191
 192 =head2 CalcFine
 193
 194     ($amount, $chargename,  $units_minus_grace, $chargeable_units) = &CalcFine($item,
 195                                   $categorycode, $branch,
 196                                   $start_dt, $end_dt );
 197
 198 Calculates the fine for a book.
 199
 200 The issuingrules table in the Koha database is a fine matrix, listing
 201 the penalties for each type of patron for each type of item and each branch (e.g., the
 202 standard fine for books might be $0.50, but $1.50 for DVDs, or staff
 203 members might get a longer grace period between the first and second
 204 reminders that a book is overdue).
 205
 206
 207 C<$item> is an item object (hashref).
 208
 209 C<$categorycode> is the category code (string) of the patron who currently has
 210 the book.
 211
 212 C<$branchcode> is the library (string) whose issuingrules govern this transaction.
 213
 214 C<$start_date> & C<$end_date> are DateTime objects
 215 defining the date range over which to determine the fine.
 216
 217 Fines scripts should just supply the date range over which to calculate the fine.
 218
 219 C<&CalcFine> returns four values:
 220
 221 C<$amount> is the fine owed by the patron (see above).
 222
 223 C<$chargename> is the chargename field from the applicable record in
 224 the categoryitem table, whatever that is.
 225
 226 C<$units_minus_grace> is the number of chargeable units minus the grace period
 227
 228 C<$chargeable_units> is the number of chargeable units (days between start and end dates, Calendar adjusted where needed,
 229 minus any applicable grace period, or hours)
 230
 231 FIXME: previously attempted to return C<$message> as a text message, either "First Notice", "Second Notice",
 232 or "Final Notice".  But CalcFine never defined any value.
 233
 234 =cut
 235
 236 sub CalcFine {
 237     my ( $item, $bortype, $branchcode, $due_dt, $end_date  ) = @_;
 238     my $start_date = $due_dt->clone();
 239     # get issuingrules (fines part will be used)
 240     my $itemtype = $item->{itemtype} || $item->{itype};
 241     my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule({ categorycode => $bortype, itemtype => $itemtype, branchcode => $branchcode });
 242
 243     $itemtype = Koha::ItemTypes->find($itemtype);
 244
 245     return unless $issuing_rule; # If not rule exist, there is no fine
 246
 247     my $fine_unit = $issuing_rule->lengthunit || 'days';
 248
 249     my $chargeable_units = get_chargeable_units($fine_unit, $start_date, $end_date, $branchcode);
 250     my $units_minus_grace = $chargeable_units - $issuing_rule->firstremind;
 251     my $amount = 0;
 252     if ( $issuing_rule->chargeperiod && ( $units_minus_grace > 0 ) ) {
 253         my $units = C4::Context->preference('FinesIncludeGracePeriod') ? $chargeable_units : $units_minus_grace;
 254         my $charge_periods = $units / $issuing_rule->chargeperiod;
 255         # If chargeperiod_charge_at = 1, we charge a fine at the start of each charge period
 256         # if chargeperiod_charge_at = 0, we charge at the end of each charge period
 257         $charge_periods = $issuing_rule->chargeperiod_charge_at == 1 ? ceil($charge_periods) : floor($charge_periods);
 258         $amount = $charge_periods * $issuing_rule->fine;
 259     } # else { # a zero (or null) chargeperiod or negative units_minus_grace value means no charge. }
 260
 261     $amount = $issuing_rule->overduefinescap if $issuing_rule->overduefinescap && $amount > $issuing_rule->overduefinescap;
 262
 263     # This must be moved to Koha::Item (see also similar code in C4::Accounts::chargelostitem
 264     $item->{replacementprice} ||= $itemtype->defaultreplacecost
 265       if $itemtype
 266       && $item->{replacementprice} == 0
 267       && C4::Context->preference("useDefaultReplacementCost");
 268
 269     $amount = $item->{replacementprice} if ( $issuing_rule->cap_fine_to_replacement_price && $item->{replacementprice} && $amount > $item->{replacementprice} );
 270
 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 GetBranchcodesWithOverdueRules
 708
 709     my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules()
 710
 711 returns a list of branch codes for branches with overdue rules defined.
 712
 713 =cut
 714
 715 sub GetBranchcodesWithOverdueRules {
 716     my $dbh               = C4::Context->dbh;
 717     my $branchcodes = $dbh->selectcol_arrayref(q|
 718         SELECT DISTINCT(branchcode)
 719         FROM overduerules
 720         WHERE delay1 IS NOT NULL
 721         ORDER BY branchcode
 722     |);
 723     if ( $branchcodes->[0] eq '' ) {
 724         # If a default rule exists, all branches should be returned
 725         return map { $_->branchcode } Koha::Libraries->search({}, { order_by => 'branchname' });
 726     }
 727     return @$branchcodes;
 728 }
 729
 730 =head2 GetOverduesForBranch
 731
 732 Sql request for display all information for branchoverdues.pl
 733 2 possibilities : with or without location .
 734 display is filtered by branch
 735
 736 FIXME: This function should be renamed.
 737
 738 =cut
 739
 740 sub GetOverduesForBranch {
 741     my ( $branch, $location) = @_;
 742         my $itype_link =  (C4::Context->preference('item-level_itypes')) ?  " items.itype " :  " biblioitems.itemtype ";
 743     my $dbh = C4::Context->dbh;
 744     my $select = "
 745     SELECT
 746             borrowers.cardnumber,
 747             borrowers.borrowernumber,
 748             borrowers.surname,
 749             borrowers.firstname,
 750             borrowers.phone,
 751             borrowers.email,
 752                biblio.title,
 753                biblio.author,
 754                biblio.biblionumber,
 755                issues.date_due,
 756                issues.returndate,
 757                issues.branchcode,
 758              branches.branchname,
 759                 items.barcode,
 760                 items.homebranch,
 761                 items.itemcallnumber,
 762                 items.location,
 763                 items.itemnumber,
 764             itemtypes.description,
 765          accountlines.amountoutstanding
 766     FROM  accountlines
 767     LEFT JOIN issues      ON    issues.itemnumber     = accountlines.itemnumber
 768                           AND   issues.borrowernumber = accountlines.borrowernumber
 769     LEFT JOIN borrowers   ON borrowers.borrowernumber = accountlines.borrowernumber
 770     LEFT JOIN items       ON     items.itemnumber     = issues.itemnumber
 771     LEFT JOIN biblio      ON      biblio.biblionumber =  items.biblionumber
 772     LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
 773     LEFT JOIN itemtypes   ON itemtypes.itemtype       = $itype_link
 774     LEFT JOIN branches    ON  branches.branchcode     = issues.branchcode
 775     WHERE (accountlines.amountoutstanding  != '0.000000')
 776       AND (accountlines.accounttype         = 'FU'      )
 777       AND (issues.branchcode =  ?   )
 778       AND (issues.date_due  < NOW())
 779     ";
 780     if ($location) {
 781         my $q = "$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname";
 782         return @{ $dbh->selectall_arrayref($q, { Slice => {} }, $branch, $location ) };
 783     } else {
 784         my $q = "$select ORDER BY borrowers.surname, borrowers.firstname";
 785         return @{ $dbh->selectall_arrayref($q, { Slice => {} }, $branch ) };
 786     }
 787 }
 788
 789 =head2 GetOverdueMessageTransportTypes
 790
 791     my $message_transport_types = GetOverdueMessageTransportTypes( $branchcode, $categorycode, $letternumber);
 792
 793     return a arrayref with all message_transport_type for given branchcode, categorycode and letternumber(1,2 or 3)
 794
 795 =cut
 796
 797 sub GetOverdueMessageTransportTypes {
 798     my ( $branchcode, $categorycode, $letternumber ) = @_;
 799     return unless $categorycode and $letternumber;
 800     my $dbh = C4::Context->dbh;
 801     my $sth = $dbh->prepare("
 802         SELECT message_transport_type
 803         FROM overduerules odr LEFT JOIN overduerules_transport_types ott USING (overduerules_id)
 804         WHERE branchcode = ?
 805           AND categorycode = ?
 806           AND letternumber = ?
 807     ");
 808     $sth->execute( $branchcode, $categorycode, $letternumber );
 809     my @mtts;
 810     while ( my $mtt = $sth->fetchrow ) {
 811         push @mtts, $mtt;
 812     }
 813
 814     # Put 'print' in first if exists
 815     # It avoid to sent a print notice with an email or sms template is no email or sms is defined
 816     @mtts = uniq( 'print', @mtts )
 817         if grep {/^print$/} @mtts;
 818
 819     return \@mtts;
 820 }
 821
 822 =head2 parse_overdues_letter
 823
 824 parses the letter template, replacing the placeholders with data
 825 specific to this patron, biblio, or item for overdues
 826
 827 named parameters:
 828   letter - required hashref
 829   borrowernumber - required integer
 830   substitute - optional hashref of other key/value pairs that should
 831     be substituted in the letter content
 832
 833 returns the C<letter> hashref, with the content updated to reflect the
 834 substituted keys and values.
 835
 836 =cut
 837
 838 sub parse_overdues_letter {
 839     my $params = shift;
 840     foreach my $required (qw( letter_code borrowernumber )) {
 841         return unless ( exists $params->{$required} && $params->{$required} );
 842     }
 843
 844     my $patron = Koha::Patrons->find( $params->{borrowernumber} );
 845
 846     my $substitute = $params->{'substitute'} || {};
 847
 848     my %tables = ( 'borrowers' => $params->{'borrowernumber'} );
 849     if ( my $p = $params->{'branchcode'} ) {
 850         $tables{'branches'} = $p;
 851     }
 852
 853     my $active_currency = Koha::Acquisition::Currencies->get_active;
 854
 855     my $currency_format;
 856     $currency_format = $active_currency->currency if defined($active_currency);
 857
 858     my @item_tables;
 859     if ( my $i = $params->{'items'} ) {
 860         foreach my $item (@$i) {
 861             my $fine = GetFine($item->{'itemnumber'}, $params->{'borrowernumber'});
 862             $item->{'fine'} = currency_format($currency_format, "$fine", FMT_SYMBOL);
 863             # if active currency isn't correct ISO code fallback to sprintf
 864             $item->{'fine'} = sprintf('%.2f', $fine) unless $item->{'fine'};
 865
 866             push @item_tables, {
 867                 'biblio' => $item->{'biblionumber'},
 868                 'biblioitems' => $item->{'biblionumber'},
 869                 'items' => $item,
 870                 'issues' => $item->{'itemnumber'},
 871             };
 872         }
 873     }
 874
 875     return C4::Letters::GetPreparedLetter (
 876         module => 'circulation',
 877         letter_code => $params->{'letter_code'},
 878         branchcode => $params->{'branchcode'},
 879         lang => $patron->lang,
 880         tables => \%tables,
 881         loops => {
 882             overdues => [ map { $_->{items}->{itemnumber} } @item_tables ],
 883         },
 884         substitute => $substitute,
 885         repeat => { item => \@item_tables },
 886         message_transport_type => $params->{message_transport_type},
 887     );
 888 }
 889
 890 1;
 891 __END__
 892
 893 =head1 AUTHOR
 894
 895 Koha Development Team <http://koha-community.org/>
 896
 897 =cut