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