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