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