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                 next;
 556             }
 557         }
 558         $total_amount_other += $overdue->amountoutstanding;
 559     }
 560
 561     if ( my $maxfine = C4::Context->preference('MaxFine') ) {
 562         my $maxIncrease = $maxfine - $total_amount_other;
 563         return if $maxIncrease <= 0.00;
 564         if ($accountline) {
 565             if ( ( $amount - $accountline->amount ) > $maxIncrease ) {
 566                 my $new_amount = $accountline->amount + $maxIncrease;
 567                 $debug and warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached";
 568                 $amount = $new_amount;
 569             }
 570         }
 571         elsif ( $amount > $maxIncrease ) {
 572             $debug and warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $maxIncrease - MaxFine reached";
 573             $amount = $maxIncrease;
 574         }
 575     }
 576
 577     if ( $accountline ) {
 578         if ( $accountline->amount != $amount ) {
 579             $accountline->adjust(
 580                 {
 581                     amount    => $amount,
 582                     type      => 'overdue_update',
 583                     interface => C4::Context->interface
 584                 }
 585             );
 586         }
 587     } else {
 588         if ( $amount ) { # Don't add new fines with an amount of 0
 589             my $sth4 = $dbh->prepare(
 590                 "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?"
 591             );
 592             $sth4->execute($itemnum);
 593             my $title = $sth4->fetchrow;
 594             my $desc = "$title $due";
 595
 596             my $account = Koha::Account->new({ patron_id => $borrowernumber });
 597             $accountline = $account->add_debit(
 598                 {
 599                     amount      => $amount,
 600                     description => $desc,
 601                     note        => undef,
 602                     user_id     => undef,
 603                     interface   => C4::Context->interface,
 604                     library_id  => undef, #FIXME: Should we grab the checkout or circ-control branch here perhaps?
 605                     type        => 'OVERDUE',
 606                     item_id     => $itemnum,
 607                     issue_id    => $issue_id,
 608                 }
 609             );
 610         }
 611     }
 612 }
 613
 614 =head2 GetFine
 615
 616     $data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
 617
 618 return the total of fine
 619
 620 C<$itemnum> is item number
 621
 622 C<$borrowernumber> is the borrowernumber
 623
 624 =cut
 625
 626 sub GetFine {
 627     my ( $itemnum, $borrowernumber ) = @_;
 628     my $dbh   = C4::Context->dbh();
 629     my $query = q|SELECT sum(amountoutstanding) as fineamount FROM accountlines
 630     WHERE debit_type_code = 'OVERDUE'
 631   AND amountoutstanding > 0 AND borrowernumber=?|;
 632     my @query_param;
 633     push @query_param, $borrowernumber;
 634     if (defined $itemnum )
 635     {
 636         $query .= " AND itemnumber=?";
 637         push @query_param, $itemnum;
 638     }
 639     my $sth = $dbh->prepare($query);
 640     $sth->execute( @query_param );
 641     my $fine = $sth->fetchrow_hashref();
 642     if ($fine->{fineamount}) {
 643         return $fine->{fineamount};
 644     }
 645     return 0;
 646 }
 647
 648 =head2 GetBranchcodesWithOverdueRules
 649
 650     my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules()
 651
 652 returns a list of branch codes for branches with overdue rules defined.
 653
 654 =cut
 655
 656 sub GetBranchcodesWithOverdueRules {
 657     my $dbh               = C4::Context->dbh;
 658     my $branchcodes = $dbh->selectcol_arrayref(q|
 659         SELECT DISTINCT(branchcode)
 660         FROM overduerules
 661         WHERE delay1 IS NOT NULL
 662         ORDER BY branchcode
 663     |);
 664     if ( $branchcodes->[0] eq '' ) {
 665         # If a default rule exists, all branches should be returned
 666         return map { $_->branchcode } Koha::Libraries->search({}, { order_by => 'branchname' });
 667     }
 668     return @$branchcodes;
 669 }
 670
 671 =head2 GetOverduesForBranch
 672
 673 Sql request for display all information for branchoverdues.pl
 674 2 possibilities : with or without location .
 675 display is filtered by branch
 676
 677 FIXME: This function should be renamed.
 678
 679 =cut
 680
 681 sub GetOverduesForBranch {
 682     my ( $branch, $location) = @_;
 683         my $itype_link =  (C4::Context->preference('item-level_itypes')) ?  " items.itype " :  " biblioitems.itemtype ";
 684     my $dbh = C4::Context->dbh;
 685     my $select = "
 686     SELECT
 687             borrowers.cardnumber,
 688             borrowers.borrowernumber,
 689             borrowers.surname,
 690             borrowers.firstname,
 691             borrowers.phone,
 692             borrowers.email,
 693                biblio.title,
 694                biblio.subtitle,
 695                biblio.medium,
 696                biblio.part_number,
 697                biblio.part_name,
 698                biblio.author,
 699                biblio.biblionumber,
 700                issues.date_due,
 701                issues.returndate,
 702                issues.branchcode,
 703              branches.branchname,
 704                 items.barcode,
 705                 items.homebranch,
 706                 items.itemcallnumber,
 707                 items.location,
 708                 items.itemnumber,
 709             itemtypes.description,
 710          accountlines.amountoutstanding
 711     FROM  accountlines
 712     LEFT JOIN issues      ON    issues.itemnumber     = accountlines.itemnumber
 713                           AND   issues.borrowernumber = accountlines.borrowernumber
 714     LEFT JOIN borrowers   ON borrowers.borrowernumber = accountlines.borrowernumber
 715     LEFT JOIN items       ON     items.itemnumber     = issues.itemnumber
 716     LEFT JOIN biblio      ON      biblio.biblionumber =  items.biblionumber
 717     LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
 718     LEFT JOIN itemtypes   ON itemtypes.itemtype       = $itype_link
 719     LEFT JOIN branches    ON  branches.branchcode     = issues.branchcode
 720     WHERE (accountlines.amountoutstanding  != '0.000000')
 721       AND (accountlines.debit_type_code     = 'OVERDUE' )
 722       AND (accountlines.status              = 'UNRETURNED' )
 723       AND (issues.branchcode =  ?   )
 724       AND (issues.date_due  < NOW())
 725     ";
 726     if ($location) {
 727         my $q = "$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname";
 728         return @{ $dbh->selectall_arrayref($q, { Slice => {} }, $branch, $location ) };
 729     } else {
 730         my $q = "$select ORDER BY borrowers.surname, borrowers.firstname";
 731         return @{ $dbh->selectall_arrayref($q, { Slice => {} }, $branch ) };
 732     }
 733 }
 734
 735 =head2 GetOverdueMessageTransportTypes
 736
 737     my $message_transport_types = GetOverdueMessageTransportTypes( $branchcode, $categorycode, $letternumber);
 738
 739     return a arrayref with all message_transport_type for given branchcode, categorycode and letternumber(1,2 or 3)
 740
 741 =cut
 742
 743 sub GetOverdueMessageTransportTypes {
 744     my ( $branchcode, $categorycode, $letternumber ) = @_;
 745     return unless $categorycode and $letternumber;
 746     my $dbh = C4::Context->dbh;
 747     my $sth = $dbh->prepare("
 748         SELECT message_transport_type
 749         FROM overduerules odr LEFT JOIN overduerules_transport_types ott USING (overduerules_id)
 750         WHERE branchcode = ?
 751           AND categorycode = ?
 752           AND letternumber = ?
 753     ");
 754     $sth->execute( $branchcode, $categorycode, $letternumber );
 755     my @mtts;
 756     while ( my $mtt = $sth->fetchrow ) {
 757         push @mtts, $mtt;
 758     }
 759
 760     # Put 'print' in first if exists
 761     # It avoid to sent a print notice with an email or sms template is no email or sms is defined
 762     @mtts = uniq( 'print', @mtts )
 763         if grep { $_ eq 'print' } @mtts;
 764
 765     return \@mtts;
 766 }
 767
 768 =head2 parse_overdues_letter
 769
 770 parses the letter template, replacing the placeholders with data
 771 specific to this patron, biblio, or item for overdues
 772
 773 named parameters:
 774   letter - required hashref
 775   borrowernumber - required integer
 776   substitute - optional hashref of other key/value pairs that should
 777     be substituted in the letter content
 778
 779 returns the C<letter> hashref, with the content updated to reflect the
 780 substituted keys and values.
 781
 782 =cut
 783
 784 sub parse_overdues_letter {
 785     my $params = shift;
 786     foreach my $required (qw( letter_code borrowernumber )) {
 787         return unless ( exists $params->{$required} && $params->{$required} );
 788     }
 789
 790     my $patron = Koha::Patrons->find( $params->{borrowernumber} );
 791
 792     my $substitute = $params->{'substitute'} || {};
 793
 794     my %tables = ( 'borrowers' => $params->{'borrowernumber'} );
 795     if ( my $p = $params->{'branchcode'} ) {
 796         $tables{'branches'} = $p;
 797     }
 798
 799     my $active_currency = Koha::Acquisition::Currencies->get_active;
 800
 801     my $currency_format;
 802     $currency_format = $active_currency->currency if defined($active_currency);
 803
 804     my @item_tables;
 805     if ( my $i = $params->{'items'} ) {
 806         foreach my $item (@$i) {
 807             my $fine = GetFine($item->{'itemnumber'}, $params->{'borrowernumber'});
 808             $item->{'fine'} = currency_format($currency_format, "$fine", FMT_SYMBOL);
 809             # if active currency isn't correct ISO code fallback to sprintf
 810             $item->{'fine'} = sprintf('%.2f', $fine) unless $item->{'fine'};
 811
 812             push @item_tables, {
 813                 'biblio' => $item->{'biblionumber'},
 814                 'biblioitems' => $item->{'biblionumber'},
 815                 'items' => $item,
 816                 'issues' => $item->{'itemnumber'},
 817             };
 818         }
 819     }
 820
 821     return C4::Letters::GetPreparedLetter (
 822         module => 'circulation',
 823         letter_code => $params->{'letter_code'},
 824         branchcode => $params->{'branchcode'},
 825         lang => $patron->lang,
 826         tables => \%tables,
 827         loops => {
 828             overdues => [ map { $_->{items}->{itemnumber} } @item_tables ],
 829         },
 830         substitute => $substitute,
 831         repeat => { item => \@item_tables },
 832         message_transport_type => $params->{message_transport_type},
 833     );
 834 }
 835
 836 1;
 837 __END__
 838
 839 =head1 AUTHOR
 840
 841 Koha Development Team <http://koha-community.org/>
 842
 843 =cut