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