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