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 Modern::Perl;
  23 use Date::Calc qw( Today );
  24 use Date::Manip qw( UnixDate );
  25 use List::MoreUtils qw( uniq );
  26 use POSIX qw( ceil floor );
  27 use Locale::Currency::Format 1.28 qw( currency_format FMT_SYMBOL );
  28 use Carp qw( carp );
  29
  30 use C4::Context;
  31 use C4::Accounts;
  32 use Koha::Logger;
  33 use Koha::Account::Lines;
  34 use Koha::Account::Offsets;
  35 use Koha::Libraries;
  36 use Koha::Recalls;
  37
  38 our (@ISA, @EXPORT_OK);
  39 BEGIN {
  40     require Exporter;
  41     @ISA = qw(Exporter);
  42
  43     # subs to rename (and maybe merge some...)
  44     @EXPORT_OK = qw(
  45       CalcFine
  46       Getoverdues
  47       checkoverdues
  48       UpdateFine
  49       GetFine
  50       GetBranchcodesWithOverdueRules
  51       get_chargeable_units
  52       GetOverduesForBranch
  53       GetOverdueMessageTransportTypes
  54       parse_overdues_letter
  55       GetIssuesIteminfo
  56     );
  57 }
  58
  59 =head1 NAME
  60
  61 C4::Circulation::Fines - Koha module dealing with fines
  62
  63 =head1 SYNOPSIS
  64
  65   use C4::Overdues;
  66
  67 =head1 DESCRIPTION
  68
  69 This module contains several functions for dealing with fines for
  70 overdue items. It is primarily used by the 'misc/fines2.pl' script.
  71
  72 =head1 FUNCTIONS
  73
  74 =head2 Getoverdues
  75
  76   $overdues = Getoverdues( { minimumdays => 1, maximumdays => 30 } );
  77
  78 Returns the list of all overdue books, with their itemtype.
  79
  80 C<$overdues> is a reference-to-array. Each element is a
  81 reference-to-hash whose keys are the fields of the issues table in the
  82 Koha database.
  83
  84 =cut
  85
  86 #'
  87 sub Getoverdues {
  88     my $params = shift;
  89     my $dbh = C4::Context->dbh;
  90     my $statement;
  91     if ( C4::Context->preference('item-level_itypes') ) {
  92         $statement = "
  93    SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode, items.itemlost, items.replacementprice, items.biblionumber
  94      FROM issues
  95 LEFT JOIN items       USING (itemnumber)
  96     WHERE date_due < NOW()
  97 ";
  98     } else {
  99         $statement = "
 100    SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode, items.itemlost, replacementprice, items.biblionumber
 101      FROM issues
 102 LEFT JOIN items       USING (itemnumber)
 103 LEFT JOIN biblioitems USING (biblioitemnumber)
 104     WHERE date_due < NOW()
 105 ";
 106     }
 107
 108     my @bind_parameters;
 109     if ( exists $params->{'minimumdays'} and exists $params->{'maximumdays'} ) {
 110         $statement .= ' AND TO_DAYS( NOW() )-TO_DAYS( date_due ) BETWEEN ? and ? ';
 111         push @bind_parameters, $params->{'minimumdays'}, $params->{'maximumdays'};
 112     } elsif ( exists $params->{'minimumdays'} ) {
 113         $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) > ? ';
 114         push @bind_parameters, $params->{'minimumdays'};
 115     } elsif ( exists $params->{'maximumdays'} ) {
 116         $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ? ';
 117         push @bind_parameters, $params->{'maximumdays'};
 118     }
 119     $statement .= 'ORDER BY borrowernumber';
 120     my $sth = $dbh->prepare( $statement );
 121     $sth->execute( @bind_parameters );
 122     return $sth->fetchall_arrayref({});
 123 }
 124
 125
 126 =head2 checkoverdues
 127
 128     ($count, $overdueitems) = checkoverdues($borrowernumber);
 129
 130 Returns a count and a list of overdueitems for a given borrowernumber
 131
 132 =cut
 133
 134 sub checkoverdues {
 135     my $borrowernumber = shift or return;
 136     my $sth = C4::Context->dbh->prepare(
 137         "SELECT biblio.*, items.*, issues.*,
 138                 biblioitems.volume,
 139                 biblioitems.number,
 140                 biblioitems.itemtype,
 141                 biblioitems.isbn,
 142                 biblioitems.issn,
 143                 biblioitems.publicationyear,
 144                 biblioitems.publishercode,
 145                 biblioitems.volumedate,
 146                 biblioitems.volumedesc,
 147                 biblioitems.collectiontitle,
 148                 biblioitems.collectionissn,
 149                 biblioitems.collectionvolume,
 150                 biblioitems.editionstatement,
 151                 biblioitems.editionresponsibility,
 152                 biblioitems.illus,
 153                 biblioitems.pages,
 154                 biblioitems.notes,
 155                 biblioitems.size,
 156                 biblioitems.place,
 157                 biblioitems.lccn,
 158                 biblioitems.url,
 159                 biblioitems.cn_source,
 160                 biblioitems.cn_class,
 161                 biblioitems.cn_item,
 162                 biblioitems.cn_suffix,
 163                 biblioitems.cn_sort,
 164                 biblioitems.totalissues
 165          FROM issues
 166          LEFT JOIN items       ON issues.itemnumber      = items.itemnumber
 167          LEFT JOIN biblio      ON items.biblionumber     = biblio.biblionumber
 168          LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 169             WHERE issues.borrowernumber  = ?
 170             AND   issues.date_due < NOW()"
 171     );
 172     $sth->execute($borrowernumber);
 173     my $results = $sth->fetchall_arrayref({});
 174     return ( scalar(@$results), $results);  # returning the count and the results is silly
 175 }
 176
 177 =head2 CalcFine
 178
 179     ($amount, $units_minus_grace, $chargeable_units) = &CalcFine($item,
 180                                   $categorycode, $branch,
 181                                   $start_dt, $end_dt );
 182
 183 Calculates the fine for a book.
 184
 185 The issuingrules table in the Koha database is a fine matrix, listing
 186 the penalties for each type of patron for each type of item and each branch (e.g., the
 187 standard fine for books might be $0.50, but $1.50 for DVDs, or staff
 188 members might get a longer grace period between the first and second
 189 reminders that a book is overdue).
 190
 191
 192 C<$item> is an item object (hashref).
 193
 194 C<$categorycode> is the category code (string) of the patron who currently has
 195 the book.
 196
 197 C<$branchcode> is the library (string) whose issuingrules govern this transaction.
 198
 199 C<$start_date> & C<$end_date> are DateTime objects
 200 defining the date range over which to determine the fine.
 201
 202 Fines scripts should just supply the date range over which to calculate the fine.
 203
 204 C<&CalcFine> returns three values:
 205
 206 C<$amount> is the fine owed by the patron (see above).
 207
 208 C<$units_minus_grace> is the number of chargeable units minus the grace period
 209
 210 C<$chargeable_units> is the number of chargeable units (days between start and end dates, Calendar adjusted where needed,
 211 minus any applicable grace period, or hours)
 212
 213 FIXME: previously attempted to return C<$message> as a text message, either "First Notice", "Second Notice",
 214 or "Final Notice".  But CalcFine never defined any value.
 215
 216 =cut
 217
 218 sub CalcFine {
 219     my ( $item, $bortype, $branchcode, $due_dt, $end_date  ) = @_;
 220
 221     # Skip calculations if item is not overdue
 222     return ( 0, 0, 0 ) unless (DateTime->compare( $due_dt, $end_date ) == -1);
 223
 224     my $start_date = $due_dt->clone();
 225     # get issuingrules (fines part will be used)
 226     my $itemtype = $item->{itemtype} || $item->{itype};
 227     my $issuing_rule = Koha::CirculationRules->get_effective_rules(
 228         {
 229             categorycode => $bortype,
 230             itemtype     => $itemtype,
 231             branchcode   => $branchcode,
 232             rules => [
 233                 'lengthunit',
 234                 'firstremind',
 235                 'chargeperiod',
 236                 'chargeperiod_charge_at',
 237                 'fine',
 238                 'overduefinescap',
 239                 'cap_fine_to_replacement_price',
 240                 'recall_overdue_fine',
 241             ]
 242         }
 243     );
 244
 245     $itemtype = Koha::ItemTypes->find($itemtype);
 246
 247     return unless $issuing_rule; # If not rule exist, there is no fine
 248
 249     my $fine_unit = $issuing_rule->{lengthunit} || 'days';
 250
 251     my $chargeable_units = get_chargeable_units($fine_unit, $start_date, $end_date, $branchcode);
 252     my $units_minus_grace = $chargeable_units - ($issuing_rule->{firstremind} || 0);
 253     my $amount = 0;
 254     if ( $issuing_rule->{chargeperiod} && ( $units_minus_grace > 0 ) ) {
 255         my $units = C4::Context->preference('FinesIncludeGracePeriod') ? $chargeable_units : $units_minus_grace;
 256         my $charge_periods = $units / $issuing_rule->{chargeperiod};
 257         # If chargeperiod_charge_at = 1, we charge a fine at the start of each charge period
 258         # if chargeperiod_charge_at = 0, we charge at the end of each charge period
 259         $charge_periods = defined $issuing_rule->{chargeperiod_charge_at} && $issuing_rule->{chargeperiod_charge_at} == 1 ? ceil($charge_periods) : floor($charge_periods);
 260
 261         # check if item has been recalled. recall should have been marked Overdue by cronjob, so only look at overdue recalls
 262         # only charge using recall_overdue_fine if there is an item-level recall for this particular item, OR a biblio-level recall
 263         my @recalls = Koha::Recalls->search({ biblio_id => $item->{biblionumber}, status => 'overdue' })->as_list;
 264         my $bib_level_recall = 0;
 265         $bib_level_recall = 1 if scalar @recalls > 0;
 266         foreach my $recall ( @recalls ) {
 267             if ( $recall->item_level and $recall->item_id == $item->{itemnumber} and $issuing_rule->{recall_overdue_fine} ) {
 268                 $bib_level_recall = 0;
 269                 $amount = $charge_periods * $issuing_rule->{recall_overdue_fine};
 270                 last;
 271             }
 272         }
 273         if ( $bib_level_recall and $issuing_rule->{recall_overdue_fine} ) {
 274             # biblio-level recall
 275             $amount = $charge_periods * $issuing_rule->{recall_overdue_fine};
 276         }
 277         if ( scalar @recalls == 0 && $issuing_rule->{fine}) {
 278             # no recall, use normal fine amount
 279             $amount = $charge_periods * $issuing_rule->{fine};
 280         }
 281     } # else { # a zero (or null) chargeperiod or negative units_minus_grace value means no charge. }
 282
 283     $amount = $issuing_rule->{overduefinescap}
 284         if $issuing_rule->{overduefinescap}
 285         && $issuing_rule->{overduefinescap} > 0
 286         && $amount > $issuing_rule->{overduefinescap};
 287
 288     # This must be moved to Koha::Item (see also similar code in C4::Accounts::chargelostitem
 289     $item->{replacementprice} ||= $itemtype->defaultreplacecost
 290       if $itemtype
 291       && ( ! defined $item->{replacementprice} || $item->{replacementprice} == 0 )
 292       && C4::Context->preference("useDefaultReplacementCost");
 293
 294     $amount = $item->{replacementprice} if ( $issuing_rule->{cap_fine_to_replacement_price} && $item->{replacementprice} && $amount > $item->{replacementprice} );
 295
 296     return ($amount, $units_minus_grace, $chargeable_units);
 297 }
 298
 299
 300 =head2 get_chargeable_units
 301
 302     get_chargeable_units($unit, $start_date_ $end_date, $branchcode);
 303
 304 return integer value of units between C<$start_date> and C<$end_date>, factoring in holidays for C<$branchcode>.
 305
 306 C<$unit> is 'days' or 'hours' (default is 'days').
 307
 308 C<$start_date> and C<$end_date> are the two DateTimes to get the number of units between.
 309
 310 C<$branchcode> is the branch whose calendar to use for finding holidays.
 311
 312 =cut
 313
 314 sub get_chargeable_units {
 315     my ($unit, $date_due, $date_returned, $branchcode) = @_;
 316
 317     # If the due date is later than the return date
 318     return 0 unless ( $date_returned > $date_due );
 319
 320     my $charge_units = 0;
 321     my $charge_duration;
 322     if ($unit eq 'hours') {
 323         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
 324             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
 325             $charge_duration = $calendar->hours_between( $date_due, $date_returned );
 326         } else {
 327             $charge_duration = $date_returned->delta_ms( $date_due );
 328         }
 329         if($charge_duration->in_units('hours') == 0 && $charge_duration->in_units('seconds') > 0){
 330             return 1;
 331         }
 332         return $charge_duration->in_units('hours');
 333     }
 334     else { # days
 335         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
 336             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
 337             $charge_duration = $calendar->days_between( $date_due, $date_returned );
 338         } else {
 339             $charge_duration = $date_returned->delta_days( $date_due );
 340         }
 341         return $charge_duration->in_units('days');
 342     }
 343 }
 344
 345
 346 =head2 GetSpecialHolidays
 347
 348     &GetSpecialHolidays($date_dues,$itemnumber);
 349
 350 return number of special days  between date of the day and date due
 351
 352 C<$date_dues> is the envisaged date of book return.
 353
 354 C<$itemnumber> is the book's item number.
 355
 356 =cut
 357
 358 sub GetSpecialHolidays {
 359     my ( $date_dues, $itemnumber ) = @_;
 360
 361     # calcul the today date
 362     my $today = join "-", &Today();
 363
 364     # return the holdingbranch
 365     my $iteminfo = GetIssuesIteminfo($itemnumber);
 366
 367     # use sql request to find all date between date_due and today
 368     my $dbh = C4::Context->dbh;
 369     my $query =
 370       qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') as date
 371 FROM `special_holidays`
 372 WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
 373 AND   DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
 374 AND branchcode=?
 375 |;
 376     my @result = GetWdayFromItemnumber($itemnumber);
 377     my @result_date;
 378     my $wday;
 379     my $dateinsec;
 380     my $sth = $dbh->prepare($query);
 381     $sth->execute( $date_dues, $today, $iteminfo->{'branchcode'} )
 382       ;    # FIXME: just use NOW() in SQL instead of passing in $today
 383
 384     while ( my $special_date = $sth->fetchrow_hashref ) {
 385         push( @result_date, $special_date );
 386     }
 387
 388     my $specialdaycount = scalar(@result_date);
 389
 390     for ( my $i = 0 ; $i < scalar(@result_date) ; $i++ ) {
 391         $dateinsec = UnixDate( $result_date[$i]->{'date'}, "%o" );
 392         ( undef, undef, undef, undef, undef, undef, $wday, undef, undef ) =
 393           localtime($dateinsec);
 394         for ( my $j = 0 ; $j < scalar(@result) ; $j++ ) {
 395             if ( $wday == ( $result[$j]->{'weekday'} ) ) {
 396                 $specialdaycount--;
 397             }
 398         }
 399     }
 400
 401     return $specialdaycount;
 402 }
 403
 404 =head2 GetRepeatableHolidays
 405
 406     &GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
 407
 408 return number of day closed between date of the day and date due
 409
 410 C<$date_dues> is the envisaged date of book return.
 411
 412 C<$itemnumber> is item number.
 413
 414 C<$difference> numbers of between day date of the day and date due
 415
 416 =cut
 417
 418 sub GetRepeatableHolidays {
 419     my ( $date_dues, $itemnumber, $difference ) = @_;
 420     my $dateinsec = UnixDate( $date_dues, "%o" );
 421     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
 422       localtime($dateinsec);
 423     my @result = GetWdayFromItemnumber($itemnumber);
 424     my @dayclosedcount;
 425     my $j;
 426
 427     for ( my $i = 0 ; $i < scalar(@result) ; $i++ ) {
 428         my $k = $wday;
 429
 430         for ( $j = 0 ; $j < $difference ; $j++ ) {
 431             if ( $result[$i]->{'weekday'} == $k ) {
 432                 push( @dayclosedcount, $k );
 433             }
 434             $k++;
 435             ( $k = 0 ) if ( $k eq 7 );
 436         }
 437     }
 438     return scalar(@dayclosedcount);
 439 }
 440
 441
 442 =head2 GetWayFromItemnumber
 443
 444     &Getwdayfromitemnumber($itemnumber);
 445
 446 return the different week day from repeatable_holidays table
 447
 448 C<$itemnumber> is  item number.
 449
 450 =cut
 451
 452 sub GetWdayFromItemnumber {
 453     my ($itemnumber) = @_;
 454     my $iteminfo = GetIssuesIteminfo($itemnumber);
 455     my @result;
 456     my $query = qq|SELECT weekday
 457     FROM repeatable_holidays
 458     WHERE branchcode=?
 459 |;
 460     my $sth = C4::Context->dbh->prepare($query);
 461
 462     $sth->execute( $iteminfo->{'branchcode'} );
 463     while ( my $weekday = $sth->fetchrow_hashref ) {
 464         push( @result, $weekday );
 465     }
 466     return @result;
 467 }
 468
 469
 470 =head2 GetIssuesIteminfo
 471
 472     &GetIssuesIteminfo($itemnumber);
 473
 474 return all data from issues about item
 475
 476 C<$itemnumber> is  item number.
 477
 478 =cut
 479
 480 sub GetIssuesIteminfo {
 481     my ($itemnumber) = @_;
 482     my $dbh          = C4::Context->dbh;
 483     my $query        = qq|SELECT *
 484     FROM issues
 485     WHERE itemnumber=?
 486     |;
 487     my $sth = $dbh->prepare($query);
 488     $sth->execute($itemnumber);
 489     my ($issuesinfo) = $sth->fetchrow_hashref;
 490     return $issuesinfo;
 491 }
 492
 493
 494 =head2 UpdateFine
 495
 496     &UpdateFine(
 497         {
 498             issue_id       => $issue_id,
 499             itemnumber     => $itemnumber,
 500             borrowernumber => $borrowernumber,
 501             amount         => $amount,
 502             due            => $date_due
 503         }
 504     );
 505
 506 (Note: the following is mostly conjecture and guesswork.)
 507
 508 Updates the fine owed on an overdue book.
 509
 510 C<$itemnumber> is the book's item number.
 511
 512 C<$borrowernumber> is the borrower number of the patron who currently
 513 has the book on loan.
 514
 515 C<$amount> is the current amount owed by the patron.
 516
 517 C<$due> is the due date formatted to the currently specified date format
 518
 519 C<&UpdateFine> looks up the amount currently owed on the given item
 520 and sets it to C<$amount>, creating, if necessary, a new entry in the
 521 accountlines table of the Koha database.
 522
 523 =cut
 524
 525 #
 526 # Question: Why should the caller have to
 527 # specify both the item number and the borrower number? A book can't
 528 # be on loan to two different people, so the item number should be
 529 # sufficient.
 530 #
 531 # Possible Answer: You might update a fine for a damaged item, *after* it is returned.
 532 #
 533 sub UpdateFine {
 534     my ($params) = @_;
 535
 536     my $issue_id       = $params->{issue_id};
 537     my $itemnum        = $params->{itemnumber};
 538     my $borrowernumber = $params->{borrowernumber};
 539     my $amount         = $params->{amount};
 540     my $due            = $params->{due} // q{};
 541
 542     unless ( $issue_id ) {
 543         carp("No issue_id passed in!");
 544         return;
 545     }
 546
 547     my $dbh = C4::Context->dbh;
 548     my $overdues = Koha::Account::Lines->search(
 549         {
 550             borrowernumber    => $borrowernumber,
 551             debit_type_code   => 'OVERDUE'
 552         }
 553     );
 554
 555     my $accountline;
 556     my $total_amount_other = 0.00;
 557     my $due_qr = qr/$due/;
 558     # Cycle through the fines and
 559     # - find line that relates to the requested $itemnum
 560     # - accumulate fines for other items
 561     # so we can update $itemnum fine taking in account fine caps
 562     while (my $overdue = $overdues->next) {
 563         if ( defined $overdue->issue_id && $overdue->issue_id == $issue_id && $overdue->status eq 'UNRETURNED' ) {
 564             if ($accountline) {
 565                 Koha::Logger->get->debug("Not a unique accountlines record for issue_id $issue_id"); # FIXME Do we really need to log that?
 566                 #FIXME Should we still count this one in total_amount ??
 567             }
 568             else {
 569                 $accountline = $overdue;
 570             }
 571         }
 572         $total_amount_other += $overdue->amountoutstanding;
 573     }
 574
 575     if ( my $maxfine = C4::Context->preference('MaxFine') ) {
 576         my $maxIncrease = $maxfine - $total_amount_other;
 577         return if Koha::Number::Price->new($maxIncrease)->round <= 0.00;
 578         if ($accountline) {
 579             if ( ( $amount - $accountline->amount ) > $maxIncrease ) {
 580                 my $new_amount = $accountline->amount + $maxIncrease;
 581                 Koha::Logger->get->debug("Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached");
 582                 $amount = $new_amount;
 583             }
 584         }
 585         elsif ( $amount > $maxIncrease ) {
 586             Koha::Logger->get->debug("Reducing fine for item $itemnum borrower $borrowernumber from $amount to $maxIncrease - MaxFine reached");
 587             $amount = $maxIncrease;
 588         }
 589     }
 590
 591     if ( $accountline ) {
 592         if ( Koha::Number::Price->new($accountline->amount)->round != Koha::Number::Price->new($amount)->round ) {
 593             $accountline->adjust(
 594                 {
 595                     amount    => $amount,
 596                     type      => 'overdue_update',
 597                     interface => C4::Context->interface
 598                 }
 599             );
 600         }
 601     } else {
 602         if ( $amount ) { # Don't add new fines with an amount of 0
 603             my $sth4 = $dbh->prepare(
 604                 "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?"
 605             );
 606             $sth4->execute($itemnum);
 607             my $title = $sth4->fetchrow;
 608             my $desc = "$title $due";
 609
 610             my $account = Koha::Account->new({ patron_id => $borrowernumber });
 611             $accountline = $account->add_debit(
 612                 {
 613                     amount      => $amount,
 614                     description => $desc,
 615                     note        => undef,
 616                     user_id     => undef,
 617                     interface   => C4::Context->interface,
 618                     library_id  => undef, #FIXME: Should we grab the checkout or circ-control branch here perhaps?
 619                     type        => 'OVERDUE',
 620                     item_id     => $itemnum,
 621                     issue_id    => $issue_id,
 622                 }
 623             );
 624         }
 625     }
 626 }
 627
 628 =head2 GetFine
 629
 630     $data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
 631
 632 return the total of fine
 633
 634 C<$itemnum> is item number
 635
 636 C<$borrowernumber> is the borrowernumber
 637
 638 =cut
 639
 640 sub GetFine {
 641     my ( $itemnum, $borrowernumber ) = @_;
 642     my $dbh   = C4::Context->dbh();
 643     my $query = q|SELECT sum(amountoutstanding) as fineamount FROM accountlines
 644     WHERE debit_type_code = 'OVERDUE'
 645   AND amountoutstanding > 0 AND borrowernumber=?|;
 646     my @query_param;
 647     push @query_param, $borrowernumber;
 648     if (defined $itemnum )
 649     {
 650         $query .= " AND itemnumber=?";
 651         push @query_param, $itemnum;
 652     }
 653     my $sth = $dbh->prepare($query);
 654     $sth->execute( @query_param );
 655     my $fine = $sth->fetchrow_hashref();
 656     if ($fine->{fineamount}) {
 657         return $fine->{fineamount};
 658     }
 659     return 0;
 660 }
 661
 662 =head2 GetBranchcodesWithOverdueRules
 663
 664     my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules()
 665
 666 returns a list of branch codes for branches with overdue rules defined.
 667
 668 =cut
 669
 670 sub GetBranchcodesWithOverdueRules {
 671     my $dbh               = C4::Context->dbh;
 672     my $branchcodes = $dbh->selectcol_arrayref(q|
 673         SELECT DISTINCT(branchcode)
 674         FROM overduerules
 675         WHERE delay1 IS NOT NULL
 676         ORDER BY branchcode
 677     |);
 678     if ( $branchcodes->[0] eq '' ) {
 679         # If a default rule exists, all branches should be returned
 680         return Koha::Libraries->search({}, { order_by => 'branchname' })->get_column('branchcode');
 681     }
 682     return @$branchcodes;
 683 }
 684
 685 =head2 GetOverduesForBranch
 686
 687 Sql request for display all information for branchoverdues.pl
 688 2 possibilities : with or without location .
 689 display is filtered by branch
 690
 691 FIXME: This function should be renamed.
 692
 693 =cut
 694
 695 sub GetOverduesForBranch {
 696     my ( $branch, $location) = @_;
 697         my $itype_link =  (C4::Context->preference('item-level_itypes')) ?  " items.itype " :  " biblioitems.itemtype ";
 698     my $dbh = C4::Context->dbh;
 699     my $select = "
 700     SELECT
 701             borrowers.cardnumber,
 702             borrowers.borrowernumber,
 703             borrowers.surname,
 704             borrowers.firstname,
 705             borrowers.phone,
 706             borrowers.email,
 707                biblio.title,
 708                biblio.subtitle,
 709                biblio.medium,
 710                biblio.part_number,
 711                biblio.part_name,
 712                biblio.author,
 713                biblio.biblionumber,
 714                issues.date_due,
 715                issues.returndate,
 716                issues.branchcode,
 717              branches.branchname,
 718                 items.barcode,
 719                 items.homebranch,
 720                 items.itemcallnumber,
 721                 items.location,
 722                 items.itemnumber,
 723             itemtypes.description,
 724          accountlines.amountoutstanding
 725     FROM  accountlines
 726     LEFT JOIN issues      ON    issues.itemnumber     = accountlines.itemnumber
 727                           AND   issues.borrowernumber = accountlines.borrowernumber
 728     LEFT JOIN borrowers   ON borrowers.borrowernumber = accountlines.borrowernumber
 729     LEFT JOIN items       ON     items.itemnumber     = issues.itemnumber
 730     LEFT JOIN biblio      ON      biblio.biblionumber =  items.biblionumber
 731     LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
 732     LEFT JOIN itemtypes   ON itemtypes.itemtype       = $itype_link
 733     LEFT JOIN branches    ON  branches.branchcode     = issues.branchcode
 734     WHERE (accountlines.amountoutstanding  != '0.000000')
 735       AND (accountlines.debit_type_code     = 'OVERDUE' )
 736       AND (accountlines.status              = 'UNRETURNED' )
 737       AND (issues.branchcode =  ?   )
 738       AND (issues.date_due  < NOW())
 739     ";
 740     if ($location) {
 741         my $q = "$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname";
 742         return @{ $dbh->selectall_arrayref($q, { Slice => {} }, $branch, $location ) };
 743     } else {
 744         my $q = "$select ORDER BY borrowers.surname, borrowers.firstname";
 745         return @{ $dbh->selectall_arrayref($q, { Slice => {} }, $branch ) };
 746     }
 747 }
 748
 749 =head2 GetOverdueMessageTransportTypes
 750
 751     my $message_transport_types = GetOverdueMessageTransportTypes( $branchcode, $categorycode, $letternumber);
 752
 753     return a arrayref with all message_transport_type for given branchcode, categorycode and letternumber(1,2 or 3)
 754
 755 =cut
 756
 757 sub GetOverdueMessageTransportTypes {
 758     my ( $branchcode, $categorycode, $letternumber ) = @_;
 759     return unless $categorycode and $letternumber;
 760     my $dbh = C4::Context->dbh;
 761     my $sth = $dbh->prepare("
 762         SELECT message_transport_type
 763         FROM overduerules odr LEFT JOIN overduerules_transport_types ott USING (overduerules_id)
 764         WHERE branchcode = ?
 765           AND categorycode = ?
 766           AND letternumber = ?
 767     ");
 768     $sth->execute( $branchcode, $categorycode, $letternumber );
 769     my @mtts;
 770     while ( my $mtt = $sth->fetchrow ) {
 771         push @mtts, $mtt;
 772     }
 773
 774     # Put 'print' in first if exists
 775     # It avoid to sent a print notice with an email or sms template is no email or sms is defined
 776     @mtts = uniq( 'print', @mtts )
 777         if grep { $_ eq 'print' } @mtts;
 778
 779     return \@mtts;
 780 }
 781
 782 =head2 parse_overdues_letter
 783
 784 parses the letter template, replacing the placeholders with data
 785 specific to this patron, biblio, or item for overdues
 786
 787 named parameters:
 788   letter - required hashref
 789   borrowernumber - required integer
 790   substitute - optional hashref of other key/value pairs that should
 791     be substituted in the letter content
 792
 793 returns the C<letter> hashref, with the content updated to reflect the
 794 substituted keys and values.
 795
 796 =cut
 797
 798 sub parse_overdues_letter {
 799     my $params = shift;
 800     foreach my $required (qw( letter_code borrowernumber )) {
 801         return unless ( exists $params->{$required} && $params->{$required} );
 802     }
 803
 804     my $patron = Koha::Patrons->find( $params->{borrowernumber} );
 805
 806     my $substitute = $params->{'substitute'} || {};
 807
 808     my %tables = ( 'borrowers' => $params->{'borrowernumber'} );
 809     if ( my $p = $params->{'branchcode'} ) {
 810         $tables{'branches'} = $p;
 811     }
 812
 813     my $active_currency = Koha::Acquisition::Currencies->get_active;
 814
 815     my $currency_format;
 816     $currency_format = $active_currency->currency if defined($active_currency);
 817
 818     my @item_tables;
 819     if ( my $i = $params->{'items'} ) {
 820         foreach my $item (@$i) {
 821             my $fine = GetFine($item->{'itemnumber'}, $params->{'borrowernumber'});
 822             $item->{'fine'} = currency_format($currency_format, "$fine", FMT_SYMBOL);
 823             # if active currency isn't correct ISO code fallback to sprintf
 824             $item->{'fine'} = sprintf('%.2f', $fine) unless $item->{'fine'};
 825
 826             push @item_tables, {
 827                 'biblio' => $item->{'biblionumber'},
 828                 'biblioitems' => $item->{'biblionumber'},
 829                 'items' => $item,
 830                 'issues' => $item->{'itemnumber'},
 831             };
 832         }
 833     }
 834
 835     return C4::Letters::GetPreparedLetter (
 836         module => 'circulation',
 837         letter_code => $params->{'letter_code'},
 838         branchcode => $params->{'branchcode'},
 839         lang => $patron->lang,
 840         tables => \%tables,
 841         loops => {
 842             overdues => [ map { $_->{items}->{itemnumber} } @item_tables ],
 843         },
 844         substitute => $substitute,
 845         repeat => { item => \@item_tables },
 846         message_transport_type => $params->{message_transport_type},
 847     );
 848 }
 849
 850 1;
 851 __END__
 852
 853 =head1 AUTHOR
 854
 855 Koha Development Team <http://koha-community.org/>
 856
 857 =cut