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