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