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