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