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