C4/Overdues.pm

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