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.01;
  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         &CheckAccountLineLevelInfo
  45         &CheckAccountLineItemInfo
  46         &CheckExistantNotifyid
  47         &GetNextIdNotify
  48         &GetNotifyId
  49         &NumberNotifyId
  50         &AmountNotify
  51         &UpdateAccountLines
  52         &UpdateFine
  53         &GetOverdueDelays
  54         &GetOverduerules
  55         &GetFine
  56         &CreateItemAccountLine
  57         &ReplacementCost2
  58
  59         &CheckItemNotify
  60         &GetOverduesForBranch
  61         &RemoveNotifyLine
  62         &AddNotifyLine
  63         );
  64         # subs to remove
  65         push @EXPORT, qw(
  66         &BorType
  67         );
  68
  69         # check that an equivalent don't exist already before moving
  70
  71         # subs to move to Circulation.pm
  72         push @EXPORT, qw(
  73         &GetIssuesIteminfo
  74         );
  75     #
  76         # &GetIssuingRules - delete.
  77         # use C4::Circulation::GetIssuingRule instead.
  78
  79         # subs to move to Members.pm
  80         push @EXPORT, qw(
  81         &CheckBorrowerDebarred
  82         );
  83         # subs to move to Biblio.pm
  84         push @EXPORT, qw(
  85         &GetItems
  86         &ReplacementCost
  87         );
  88 }
  89
  90 =head1 NAME
  91
  92 C4::Circulation::Fines - Koha module dealing with fines
  93
  94 =head1 SYNOPSIS
  95
  96   use C4::Overdues;
  97
  98 =head1 DESCRIPTION
  99
 100 This module contains several functions for dealing with fines for
 101 overdue items. It is primarily used by the 'misc/fines2.pl' script.
 102
 103 =head1 FUNCTIONS
 104
 105 =head2 Getoverdues
 106
 107   $overdues = Getoverdues( { minimumdays => 1, maximumdays => 30 } );
 108
 109 Returns the list of all overdue books, with their itemtype.
 110
 111 C<$overdues> is a reference-to-array. Each element is a
 112 reference-to-hash whose keys are the fields of the issues table in the
 113 Koha database.
 114
 115 =cut
 116
 117 #'
 118 sub Getoverdues {
 119     my $params = shift;
 120     my $dbh = C4::Context->dbh;
 121     my $statement;
 122     if ( C4::Context->preference('item-level_itypes') ) {
 123         $statement = "
 124    SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode
 125      FROM issues
 126 LEFT JOIN items       USING (itemnumber)
 127     WHERE date_due < NOW()
 128 ";
 129     } else {
 130         $statement = "
 131    SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode
 132      FROM issues
 133 LEFT JOIN items       USING (itemnumber)
 134 LEFT JOIN biblioitems USING (biblioitemnumber)
 135     WHERE date_due < NOW()
 136 ";
 137     }
 138
 139     my @bind_parameters;
 140     if ( exists $params->{'minimumdays'} and exists $params->{'maximumdays'} ) {
 141         $statement .= ' AND TO_DAYS( NOW() )-TO_DAYS( date_due ) BETWEEN ? and ? ';
 142         push @bind_parameters, $params->{'minimumdays'}, $params->{'maximumdays'};
 143     } elsif ( exists $params->{'minimumdays'} ) {
 144         $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) > ? ';
 145         push @bind_parameters, $params->{'minimumdays'};
 146     } elsif ( exists $params->{'maximumdays'} ) {
 147         $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ? ';
 148         push @bind_parameters, $params->{'maximumdays'};
 149     }
 150     $statement .= 'ORDER BY borrowernumber';
 151     my $sth = $dbh->prepare( $statement );
 152     $sth->execute( @bind_parameters );
 153     return $sth->fetchall_arrayref({});
 154 }
 155
 156
 157 =head2 checkoverdues
 158
 159     ($count, $overdueitems) = checkoverdues($borrowernumber);
 160
 161 Returns a count and a list of overdueitems for a given borrowernumber
 162
 163 =cut
 164
 165 sub checkoverdues {
 166     my $borrowernumber = shift or return;
 167     # don't select biblioitems.marc or biblioitems.marcxml... too slow on large systems
 168     my $sth = C4::Context->dbh->prepare(
 169         "SELECT biblio.*, items.*, issues.*,
 170                 biblioitems.volume,
 171                 biblioitems.number,
 172                 biblioitems.itemtype,
 173                 biblioitems.isbn,
 174                 biblioitems.issn,
 175                 biblioitems.publicationyear,
 176                 biblioitems.publishercode,
 177                 biblioitems.volumedate,
 178                 biblioitems.volumedesc,
 179                 biblioitems.collectiontitle,
 180                 biblioitems.collectionissn,
 181                 biblioitems.collectionvolume,
 182                 biblioitems.editionstatement,
 183                 biblioitems.editionresponsibility,
 184                 biblioitems.illus,
 185                 biblioitems.pages,
 186                 biblioitems.notes,
 187                 biblioitems.size,
 188                 biblioitems.place,
 189                 biblioitems.lccn,
 190                 biblioitems.url,
 191                 biblioitems.cn_source,
 192                 biblioitems.cn_class,
 193                 biblioitems.cn_item,
 194                 biblioitems.cn_suffix,
 195                 biblioitems.cn_sort,
 196                 biblioitems.totalissues
 197          FROM issues
 198          LEFT JOIN items       ON issues.itemnumber      = items.itemnumber
 199          LEFT JOIN biblio      ON items.biblionumber     = biblio.biblionumber
 200          LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 201             WHERE issues.borrowernumber  = ?
 202             AND   issues.date_due < NOW()"
 203     );
 204     # FIXME: SELECT * across 4 tables?  do we really need the marc AND marcxml blobs??
 205     $sth->execute($borrowernumber);
 206     my $results = $sth->fetchall_arrayref({});
 207     return ( scalar(@$results), $results);  # returning the count and the results is silly
 208 }
 209
 210 =head2 CalcFine
 211
 212     ($amount, $chargename,  $daycounttotal) = &CalcFine($item,
 213                                   $categorycode, $branch,
 214                                   $start_dt, $end_dt );
 215
 216 Calculates the fine for a book.
 217
 218 The issuingrules table in the Koha database is a fine matrix, listing
 219 the penalties for each type of patron for each type of item and each branch (e.g., the
 220 standard fine for books might be $0.50, but $1.50 for DVDs, or staff
 221 members might get a longer grace period between the first and second
 222 reminders that a book is overdue).
 223
 224
 225 C<$item> is an item object (hashref).
 226
 227 C<$categorycode> is the category code (string) of the patron who currently has
 228 the book.
 229
 230 C<$branchcode> is the library (string) whose issuingrules govern this transaction.
 231
 232 C<$start_date> & C<$end_date> are DateTime objects
 233 defining the date range over which to determine the fine.
 234
 235 Fines scripts should just supply the date range over which to calculate the fine.
 236
 237 C<&CalcFine> returns four values:
 238
 239 C<$amount> is the fine owed by the patron (see above).
 240
 241 C<$chargename> is the chargename field from the applicable record in
 242 the categoryitem table, whatever that is.
 243
 244 C<$daycount> is the number of days between start and end dates, Calendar adjusted (where needed),
 245 minus any applicable grace period.
 246
 247 FIXME - What is chargename supposed to be ?
 248
 249 FIXME: previously attempted to return C<$message> as a text message, either "First Notice", "Second Notice",
 250 or "Final Notice".  But CalcFine never defined any value.
 251
 252 =cut
 253
 254 sub CalcFine {
 255     my ( $item, $bortype, $branchcode, $due_dt, $end_date  ) = @_;
 256     my $start_date = $due_dt->clone();
 257     # get issuingrules (fines part will be used)
 258     my $itemtype = $item->{itemtype} || $item->{itype};
 259     my $data = C4::Circulation::GetIssuingRule($bortype, $itemtype, $branchcode);
 260     my $fine_unit = $data->{lengthunit};
 261     $fine_unit ||= 'days';
 262
 263     my $chargeable_units = _get_chargeable_units($fine_unit, $start_date, $end_date, $branchcode);
 264     my $units_minus_grace = $chargeable_units - $data->{firstremind};
 265     my $amount = 0;
 266     if ($data->{'chargeperiod'}  && $units_minus_grace  ) {
 267         $amount = int($chargeable_units / $data->{'chargeperiod'}) * $data->{'fine'};# TODO fine calc should be in cents
 268     } else {
 269         # a zero (or null)  chargeperiod means no charge.
 270     }
 271     if(C4::Context->preference('maxFine') && ( $amount > C4::Context->preference('maxFine'))) {
 272         $amount = C4::Context->preference('maxFine');
 273     }
 274     return ($amount, $data->{chargename}, $units_minus_grace);
 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, $dt1, $dt2, $branchcode) = @_;
 295     my $charge_units = 0;
 296     my $charge_duration;
 297     if ($unit eq 'hours') {
 298         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
 299             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
 300             $charge_duration = $calendar->hours_between( $dt1, $dt2 );
 301         } else {
 302             $charge_duration = $dt2->delta_ms( $dt1 );
 303         }
 304         if($charge_duration->in_units('hours') == 0 && $charge_duration->in_units('seconds') > 0){
 305             return 1;
 306         }
 307         return $charge_duration->in_units('hours');
 308     }
 309     else { # days
 310         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
 311             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
 312             $charge_duration = $calendar->days_between( $dt1, $dt2 );
 313         } else {
 314             $charge_duration = $dt2->delta_days( $dt1 );
 315         }
 316         return $charge_duration->in_units('days');
 317     }
 318 }
 319
 320
 321 =head2 GetSpecialHolidays
 322
 323     &GetSpecialHolidays($date_dues,$itemnumber);
 324
 325 return number of special days  between date of the day and date due
 326
 327 C<$date_dues> is the envisaged date of book return.
 328
 329 C<$itemnumber> is the book's item number.
 330
 331 =cut
 332
 333 sub GetSpecialHolidays {
 334     my ( $date_dues, $itemnumber ) = @_;
 335
 336     # calcul the today date
 337     my $today = join "-", &Today();
 338
 339     # return the holdingbranch
 340     my $iteminfo = GetIssuesIteminfo($itemnumber);
 341
 342     # use sql request to find all date between date_due and today
 343     my $dbh = C4::Context->dbh;
 344     my $query =
 345       qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') as date
 346 FROM `special_holidays`
 347 WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
 348 AND   DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
 349 AND branchcode=?
 350 |;
 351     my @result = GetWdayFromItemnumber($itemnumber);
 352     my @result_date;
 353     my $wday;
 354     my $dateinsec;
 355     my $sth = $dbh->prepare($query);
 356     $sth->execute( $date_dues, $today, $iteminfo->{'branchcode'} )
 357       ;    # FIXME: just use NOW() in SQL instead of passing in $today
 358
 359     while ( my $special_date = $sth->fetchrow_hashref ) {
 360         push( @result_date, $special_date );
 361     }
 362
 363     my $specialdaycount = scalar(@result_date);
 364
 365     for ( my $i = 0 ; $i < scalar(@result_date) ; $i++ ) {
 366         $dateinsec = UnixDate( $result_date[$i]->{'date'}, "%o" );
 367         ( undef, undef, undef, undef, undef, undef, $wday, undef, undef ) =
 368           localtime($dateinsec);
 369         for ( my $j = 0 ; $j < scalar(@result) ; $j++ ) {
 370             if ( $wday == ( $result[$j]->{'weekday'} ) ) {
 371                 $specialdaycount--;
 372             }
 373         }
 374     }
 375
 376     return $specialdaycount;
 377 }
 378
 379 =head2 GetRepeatableHolidays
 380
 381     &GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
 382
 383 return number of day closed between date of the day and date due
 384
 385 C<$date_dues> is the envisaged date of book return.
 386
 387 C<$itemnumber> is item number.
 388
 389 C<$difference> numbers of between day date of the day and date due
 390
 391 =cut
 392
 393 sub GetRepeatableHolidays {
 394     my ( $date_dues, $itemnumber, $difference ) = @_;
 395     my $dateinsec = UnixDate( $date_dues, "%o" );
 396     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
 397       localtime($dateinsec);
 398     my @result = GetWdayFromItemnumber($itemnumber);
 399     my @dayclosedcount;
 400     my $j;
 401
 402     for ( my $i = 0 ; $i < scalar(@result) ; $i++ ) {
 403         my $k = $wday;
 404
 405         for ( $j = 0 ; $j < $difference ; $j++ ) {
 406             if ( $result[$i]->{'weekday'} == $k ) {
 407                 push( @dayclosedcount, $k );
 408             }
 409             $k++;
 410             ( $k = 0 ) if ( $k eq 7 );
 411         }
 412     }
 413     return scalar(@dayclosedcount);
 414 }
 415
 416
 417 =head2 GetWayFromItemnumber
 418
 419     &Getwdayfromitemnumber($itemnumber);
 420
 421 return the different week day from repeatable_holidays table
 422
 423 C<$itemnumber> is  item number.
 424
 425 =cut
 426
 427 sub GetWdayFromItemnumber {
 428     my ($itemnumber) = @_;
 429     my $iteminfo = GetIssuesIteminfo($itemnumber);
 430     my @result;
 431     my $query = qq|SELECT weekday
 432     FROM repeatable_holidays
 433     WHERE branchcode=?
 434 |;
 435     my $sth = C4::Context->dbh->prepare($query);
 436
 437     $sth->execute( $iteminfo->{'branchcode'} );
 438     while ( my $weekday = $sth->fetchrow_hashref ) {
 439         push( @result, $weekday );
 440     }
 441     return @result;
 442 }
 443
 444
 445 =head2 GetIssuesIteminfo
 446
 447     &GetIssuesIteminfo($itemnumber);
 448
 449 return all data from issues about item
 450
 451 C<$itemnumber> is  item number.
 452
 453 =cut
 454
 455 sub GetIssuesIteminfo {
 456     my ($itemnumber) = @_;
 457     my $dbh          = C4::Context->dbh;
 458     my $query        = qq|SELECT *
 459     FROM issues
 460     WHERE itemnumber=?
 461     |;
 462     my $sth = $dbh->prepare($query);
 463     $sth->execute($itemnumber);
 464     my ($issuesinfo) = $sth->fetchrow_hashref;
 465     return $issuesinfo;
 466 }
 467
 468
 469 =head2 UpdateFine
 470
 471     &UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description);
 472
 473 (Note: the following is mostly conjecture and guesswork.)
 474
 475 Updates the fine owed on an overdue book.
 476
 477 C<$itemnumber> is the book's item number.
 478
 479 C<$borrowernumber> is the borrower number of the patron who currently
 480 has the book on loan.
 481
 482 C<$amount> is the current amount owed by the patron.
 483
 484 C<$type> will be used in the description of the fine.
 485
 486 C<$description> is a string that must be present in the description of
 487 the fine. I think this is expected to be a date in DD/MM/YYYY format.
 488
 489 C<&UpdateFine> looks up the amount currently owed on the given item
 490 and sets it to C<$amount>, creating, if necessary, a new entry in the
 491 accountlines table of the Koha database.
 492
 493 =cut
 494
 495 #
 496 # Question: Why should the caller have to
 497 # specify both the item number and the borrower number? A book can't
 498 # be on loan to two different people, so the item number should be
 499 # sufficient.
 500 #
 501 # Possible Answer: You might update a fine for a damaged item, *after* it is returned.
 502 #
 503 sub UpdateFine {
 504     my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_;
 505         $debug and warn "UpdateFine($itemnum, $borrowernumber, $amount, " . ($type||'""') . ", $due) called";
 506     my $dbh = C4::Context->dbh;
 507     # FIXME - What exactly is this query supposed to do? It looks up an
 508     # entry in accountlines that matches the given item and borrower
 509     # numbers, where the description contains $due, and where the
 510     # account type has one of several values, but what does this _mean_?
 511     # Does it look up existing fines for this item?
 512     # FIXME - What are these various account types? ("FU", "O", "F", "M")
 513         #       "L"   is LOST item
 514         #   "A"   is Account Management Fee
 515         #   "N"   is New Card
 516         #   "M"   is Sundry
 517         #   "O"   is Overdue ??
 518         #   "F"   is Fine ??
 519         #   "FU"  is Fine UPDATE??
 520         #       "Pay" is Payment
 521         #   "REF" is Cash Refund
 522     my $sth = $dbh->prepare(
 523         "SELECT * FROM accountlines
 524                 WHERE itemnumber=?
 525                 AND   borrowernumber=?
 526                 AND   accounttype IN ('FU','O','F','M')
 527                 AND   description like ? "
 528     );
 529     $sth->execute( $itemnum, $borrowernumber, "%$due%" );
 530
 531     if ( my $data = $sth->fetchrow_hashref ) {
 532
 533                 # we're updating an existing fine.  Only modify if amount changed
 534         # Note that in the current implementation, you cannot pay against an accruing fine
 535         # (i.e. , of accounttype 'FU').  Doing so will break accrual.
 536         if ( $data->{'amount'} != $amount ) {
 537             my $diff = $amount - $data->{'amount'};
 538             #3341: diff could be positive or negative!
 539             my $out  = $data->{'amountoutstanding'} + $diff;
 540             my $query = "
 541                 UPDATE accountlines
 542                                 SET date=now(), amount=?, amountoutstanding=?,
 543                                         lastincrement=?, accounttype='FU'
 544                                 WHERE borrowernumber=?
 545                                 AND   itemnumber=?
 546                                 AND   accounttype IN ('FU','O')
 547                                 AND   description LIKE ?
 548                                 LIMIT 1 ";
 549             my $sth2 = $dbh->prepare($query);
 550                         # FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!!
 551                         #               LIMIT 1 added to prevent multiple affected lines
 552                         # FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline.
 553                         #               But actually, we should just have a regular autoincrementing PK and forget accountline,
 554                         #               including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops).
 555                         # FIXME: Why only 2 account types here?
 556                         $debug and print STDERR "UpdateFine query: $query\n" .
 557                                 "w/ args: $amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, \"\%$due\%\"\n";
 558             $sth2->execute($amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, "%$due%");
 559         } else {
 560             #      print "no update needed $data->{'amount'}"
 561         }
 562     } else {
 563         my $sth4 = $dbh->prepare(
 564             "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?"
 565         );
 566         $sth4->execute($itemnum);
 567         my $title = $sth4->fetchrow;
 568
 569 #         #   print "not in account";
 570 #         my $sth3 = $dbh->prepare("Select max(accountno) from accountlines");
 571 #         $sth3->execute;
 572 #
 573 #         # FIXME - Make $accountno a scalar.
 574 #         my @accountno = $sth3->fetchrow_array;
 575 #         $sth3->finish;
 576 #         $accountno[0]++;
 577 # begin transaction
 578                 my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
 579                 my $desc = ($type ? "$type " : '') . "$title $due";     # FIXEDME, avoid whitespace prefix on empty $type
 580                 my $query = "INSERT INTO accountlines
 581                     (borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno)
 582                             VALUES (?,?,now(),?,?,'FU',?,?,?)";
 583                 my $sth2 = $dbh->prepare($query);
 584                 $debug and print STDERR "UpdateFine query: $query\nw/ args: $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno\n";
 585         $sth2->execute($borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno);
 586     }
 587     # logging action
 588     &logaction(
 589         "FINES",
 590         $type,
 591         $borrowernumber,
 592         "due=".$due."  amount=".$amount." itemnumber=".$itemnum
 593         ) if C4::Context->preference("FinesLog");
 594 }
 595
 596 =head2 BorType
 597
 598     $borrower = &BorType($borrowernumber);
 599
 600 Looks up a patron by borrower number.
 601
 602 C<$borrower> is a reference-to-hash whose keys are all of the fields
 603 from the borrowers and categories tables of the Koha database. Thus,
 604 C<$borrower> contains all information about both the borrower and
 605 category he or she belongs to.
 606
 607 =cut
 608
 609 #'
 610 sub BorType {
 611     my ($borrowernumber) = @_;
 612     my $dbh              = C4::Context->dbh;
 613     my $sth              = $dbh->prepare(
 614         "SELECT * from borrowers
 615       LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
 616       WHERE borrowernumber=?"
 617     );
 618     $sth->execute($borrowernumber);
 619     return $sth->fetchrow_hashref;
 620 }
 621
 622 =head2 ReplacementCost
 623
 624     $cost = &ReplacementCost($itemnumber);
 625
 626 Returns the replacement cost of the item with the given item number.
 627
 628 =cut
 629
 630 #'
 631 sub ReplacementCost {
 632     my ($itemnum) = @_;
 633     my $dbh       = C4::Context->dbh;
 634     my $sth       =
 635       $dbh->prepare("Select replacementprice from items where itemnumber=?");
 636     $sth->execute($itemnum);
 637
 638     # FIXME - Use fetchrow_array or a slice.
 639     my $data = $sth->fetchrow_hashref;
 640     return ( $data->{'replacementprice'} );
 641 }
 642
 643 =head2 GetFine
 644
 645     $data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
 646
 647 return the total of fine
 648
 649 C<$itemnum> is item number
 650
 651 C<$borrowernumber> is the borrowernumber
 652
 653 =cut
 654
 655
 656 sub GetFine {
 657     my ( $itemnum, $borrowernumber ) = @_;
 658     my $dbh   = C4::Context->dbh();
 659     my $query = q|SELECT sum(amountoutstanding) as fineamount FROM accountlines
 660     where accounttype like 'F%'
 661   AND amountoutstanding > 0 AND itemnumber = ? AND borrowernumber=?|;
 662     my $sth = $dbh->prepare($query);
 663     $sth->execute( $itemnum, $borrowernumber );
 664     my $fine = $sth->fetchrow_hashref();
 665     if ($fine->{fineamount}) {
 666         return $fine->{fineamount};
 667     }
 668     return 0;
 669 }
 670
 671
 672 =head2 GetIssuingRules
 673
 674 FIXME - This sub should be deprecated and removed.
 675 It ignores branch and defaults.
 676
 677     $data = &GetIssuingRules($itemtype,$categorycode);
 678
 679 Looks up for all issuingrules an item info
 680
 681 C<$itemnumber> is a reference-to-hash whose keys are all of the fields
 682 from the borrowers and categories tables of the Koha database. Thus,
 683
 684 C<$categorycode> contains  information about borrowers category
 685
 686 C<$data> contains all information about both the borrower and
 687 category he or she belongs to.
 688 =cut
 689
 690 sub GetIssuingRules {
 691         warn "GetIssuingRules is deprecated: use GetIssuingRule from C4::Circulation instead.";
 692    my ($itemtype,$categorycode)=@_;
 693    my $dbh   = C4::Context->dbh();
 694    my $query=qq|SELECT *
 695         FROM issuingrules
 696         WHERE issuingrules.itemtype=?
 697             AND issuingrules.categorycode=?
 698         |;
 699     my $sth = $dbh->prepare($query);
 700     #  print $query;
 701     $sth->execute($itemtype,$categorycode);
 702     return $sth->fetchrow_hashref;
 703 }
 704
 705
 706 sub ReplacementCost2 {
 707     my ( $itemnum, $borrowernumber ) = @_;
 708     my $dbh   = C4::Context->dbh();
 709     my $query = "SELECT amountoutstanding
 710          FROM accountlines
 711              WHERE accounttype like 'L'
 712          AND amountoutstanding > 0
 713          AND itemnumber = ?
 714          AND borrowernumber= ?";
 715     my $sth = $dbh->prepare($query);
 716     $sth->execute( $itemnum, $borrowernumber );
 717     my $data = $sth->fetchrow_hashref();
 718     return ( $data->{'amountoutstanding'} );
 719 }
 720
 721
 722 =head2 GetNextIdNotify
 723
 724     ($result) = &GetNextIdNotify($reference);
 725
 726 Returns the new file number
 727
 728 C<$result> contains the next file number
 729
 730 C<$reference> contains the beggining of file number
 731
 732 =cut
 733
 734 sub GetNextIdNotify {
 735     my ($reference) = @_;
 736     my $query = qq|SELECT max(notify_id)
 737          FROM accountlines
 738          WHERE notify_id  like \"$reference%\"
 739          |;
 740
 741     # AND borrowernumber=?|;
 742     my $dbh = C4::Context->dbh;
 743     my $sth = $dbh->prepare($query);
 744     $sth->execute();
 745     my $result = $sth->fetchrow;
 746     my $count;
 747     if ( $result eq '' ) {
 748         ( $result = $reference . "01" );
 749     }
 750     else {
 751         $count = substr( $result, 6 ) + 1;
 752
 753         if ( $count < 10 ) {
 754             ( $count = "0" . $count );
 755         }
 756         $result = $reference . $count;
 757     }
 758     return $result;
 759 }
 760
 761 =head2 NumberNotifyId
 762
 763     (@notify) = &NumberNotifyId($borrowernumber);
 764
 765 Returns amount for all file per borrowers
 766 C<@notify> array contains all file per borrowers
 767
 768 C<$notify_id> contains the file number for the borrower number nad item number
 769
 770 =cut
 771
 772 sub NumberNotifyId{
 773     my ($borrowernumber)=@_;
 774     my $dbh = C4::Context->dbh;
 775     my $query=qq|    SELECT distinct(notify_id)
 776             FROM accountlines
 777             WHERE borrowernumber=?|;
 778     my @notify;
 779     my $sth = $dbh->prepare($query);
 780     $sth->execute($borrowernumber);
 781     while ( my ($numberofnotify) = $sth->fetchrow ) {
 782         push( @notify, $numberofnotify );
 783     }
 784     return (@notify);
 785 }
 786
 787 =head2 AmountNotify
 788
 789     ($totalnotify) = &AmountNotify($notifyid);
 790
 791 Returns amount for all file per borrowers
 792 C<$notifyid> is the file number
 793
 794 C<$totalnotify> contains amount of a file
 795
 796 C<$notify_id> contains the file number for the borrower number and item number
 797
 798 =cut
 799
 800 sub AmountNotify{
 801     my ($notifyid,$borrowernumber)=@_;
 802     my $dbh = C4::Context->dbh;
 803     my $query=qq|    SELECT sum(amountoutstanding)
 804             FROM accountlines
 805             WHERE notify_id=? AND borrowernumber = ?|;
 806     my $sth=$dbh->prepare($query);
 807         $sth->execute($notifyid,$borrowernumber);
 808         my $totalnotify=$sth->fetchrow;
 809     $sth->finish;
 810     return ($totalnotify);
 811 }
 812
 813
 814 =head2 GetNotifyId
 815
 816     ($notify_id) = &GetNotifyId($borrowernumber,$itemnumber);
 817
 818 Returns the file number per borrower and itemnumber
 819
 820 C<$borrowernumber> is a reference-to-hash whose keys are all of the fields
 821 from the items tables of the Koha database. Thus,
 822
 823 C<$itemnumber> contains the borrower categorycode
 824
 825 C<$notify_id> contains the file number for the borrower number nad item number
 826
 827 =cut
 828
 829 sub GetNotifyId {
 830     my ( $borrowernumber, $itemnumber ) = @_;
 831     my $query = qq|SELECT notify_id
 832            FROM accountlines
 833            WHERE borrowernumber=?
 834           AND itemnumber=?
 835            AND (accounttype='FU' or accounttype='O')|;
 836     my $dbh = C4::Context->dbh;
 837     my $sth = $dbh->prepare($query);
 838     $sth->execute( $borrowernumber, $itemnumber );
 839     my ($notify_id) = $sth->fetchrow;
 840     $sth->finish;
 841     return ($notify_id);
 842 }
 843
 844 =head2 CreateItemAccountLine
 845
 846     () = &CreateItemAccountLine($borrowernumber, $itemnumber, $date, $amount,
 847                                $description, $accounttype, $amountoutstanding,
 848                                $timestamp, $notify_id, $level);
 849
 850 update the account lines with file number or with file level
 851
 852 C<$items> is a reference-to-hash whose keys are all of the fields
 853 from the items tables of the Koha database. Thus,
 854
 855 C<$itemnumber> contains the item number
 856
 857 C<$borrowernumber> contains the borrower number
 858
 859 C<$date> contains the date of the day
 860
 861 C<$amount> contains item price
 862
 863 C<$description> contains the descritpion of accounttype
 864
 865 C<$accounttype> contains the account type
 866
 867 C<$amountoutstanding> contains the $amountoutstanding
 868
 869 C<$timestamp> contains the timestamp with time and the date of the day
 870
 871 C<$notify_id> contains the file number
 872
 873 C<$level> contains the file level
 874
 875 =cut
 876
 877 sub CreateItemAccountLine {
 878     my (
 879         $borrowernumber, $itemnumber,  $date,              $amount,
 880         $description,    $accounttype, $amountoutstanding, $timestamp,
 881         $notify_id,      $level
 882     ) = @_;
 883     my $dbh         = C4::Context->dbh;
 884     my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
 885     my $query       = "INSERT into accountlines
 886          (borrowernumber,accountno,itemnumber,date,amount,description,accounttype,amountoutstanding,timestamp,notify_id,notify_level)
 887           VALUES
 888              (?,?,?,?,?,?,?,?,?,?,?)";
 889
 890     my $sth = $dbh->prepare($query);
 891     $sth->execute(
 892         $borrowernumber, $nextaccntno,       $itemnumber,
 893         $date,           $amount,            $description,
 894         $accounttype,    $amountoutstanding, $timestamp,
 895         $notify_id,      $level
 896     );
 897 }
 898
 899 =head2 UpdateAccountLines
 900
 901     () = &UpdateAccountLines($notify_id,$notify_level,$borrowernumber,$itemnumber);
 902
 903 update the account lines with file number or with file level
 904
 905 C<$items> is a reference-to-hash whose keys are all of the fields
 906 from the items tables of the Koha database. Thus,
 907
 908 C<$itemnumber> contains the item number
 909
 910 C<$notify_id> contains the file number
 911
 912 C<$notify_level> contains the file level
 913
 914 C<$borrowernumber> contains the borrowernumber
 915
 916 =cut
 917
 918 sub UpdateAccountLines {
 919     my ( $notify_id, $notify_level, $borrowernumber, $itemnumber ) = @_;
 920     my $query;
 921     if ( $notify_id eq '' ) {
 922         $query = qq|UPDATE accountlines
 923     SET  notify_level=?
 924     WHERE borrowernumber=? AND itemnumber=?
 925     AND (accounttype='FU' or accounttype='O')|;
 926     } else {
 927         $query = qq|UPDATE accountlines
 928      SET notify_id=?, notify_level=?
 929    WHERE borrowernumber=?
 930     AND itemnumber=?
 931     AND (accounttype='FU' or accounttype='O')|;
 932     }
 933
 934     my $sth = C4::Context->dbh->prepare($query);
 935     if ( $notify_id eq '' ) {
 936         $sth->execute( $notify_level, $borrowernumber, $itemnumber );
 937     } else {
 938         $sth->execute( $notify_id, $notify_level, $borrowernumber, $itemnumber );
 939     }
 940 }
 941
 942 =head2 GetItems
 943
 944     ($items) = &GetItems($itemnumber);
 945
 946 Returns the list of all delays from overduerules.
 947
 948 C<$items> is a reference-to-hash whose keys are all of the fields
 949 from the items tables of the Koha database. Thus,
 950
 951 C<$itemnumber> contains the borrower categorycode
 952
 953 =cut
 954
 955 # FIXME: This is a bad function to have here.
 956 # Shouldn't it be in C4::Items?
 957 # Shouldn't it be called GetItem since you only get 1 row?
 958 # Shouldn't it be called GetItem since you give it only 1 itemnumber?
 959
 960 sub GetItems {
 961     my $itemnumber = shift or return;
 962     my $query = qq|SELECT *
 963              FROM items
 964               WHERE itemnumber=?|;
 965     my $sth = C4::Context->dbh->prepare($query);
 966     $sth->execute($itemnumber);
 967     my ($items) = $sth->fetchrow_hashref;
 968     return ($items);
 969 }
 970
 971 =head2 GetOverdueDelays
 972
 973     (@delays) = &GetOverdueDelays($categorycode);
 974
 975 Returns the list of all delays from overduerules.
 976
 977 C<@delays> it's an array contains the three delays from overduerules table
 978
 979 C<$categorycode> contains the borrower categorycode
 980
 981 =cut
 982
 983 sub GetOverdueDelays {
 984     my ($category) = @_;
 985     my $query      = qq|SELECT delay1,delay2,delay3
 986                 FROM overduerules
 987                 WHERE categorycode=?|;
 988     my $sth = C4::Context->dbh->prepare($query);
 989     $sth->execute($category);
 990     my (@delays) = $sth->fetchrow_array;
 991     return (@delays);
 992 }
 993
 994 =head2 GetBranchcodesWithOverdueRules
 995
 996     my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules()
 997
 998 returns a list of branch codes for branches with overdue rules defined.
 999
1000 =cut
1001
1002 sub GetBranchcodesWithOverdueRules {
1003     my $dbh               = C4::Context->dbh;
1004     my $rqoverduebranches = $dbh->prepare("SELECT DISTINCT branchcode FROM overduerules WHERE delay1 IS NOT NULL AND branchcode <> '' ORDER BY branchcode");
1005     $rqoverduebranches->execute;
1006     my @branches = map { shift @$_ } @{ $rqoverduebranches->fetchall_arrayref };
1007     if (!$branches[0]) {
1008        my $availbranches = C4::Branch::GetBranches();
1009        @branches = keys %$availbranches;
1010     }
1011     return @branches;
1012 }
1013
1014 =head2 CheckAccountLineLevelInfo
1015
1016     ($exist) = &CheckAccountLineLevelInfo($borrowernumber,$itemnumber,$accounttype,notify_level);
1017
1018 Check and Returns the list of all overdue books.
1019
1020 C<$exist> contains number of line in accounlines
1021 with the same .biblionumber,itemnumber,accounttype,and notify_level
1022
1023 C<$borrowernumber> contains the borrower number
1024
1025 C<$itemnumber> contains item number
1026
1027 C<$accounttype> contains account type
1028
1029 C<$notify_level> contains the accountline level
1030
1031
1032 =cut
1033
1034 sub CheckAccountLineLevelInfo {
1035     my ( $borrowernumber, $itemnumber, $level ) = @_;
1036     my $dbh   = C4::Context->dbh;
1037     my $query = qq|SELECT count(*)
1038             FROM accountlines
1039             WHERE borrowernumber =?
1040             AND itemnumber = ?
1041             AND notify_level=?|;
1042     my $sth = $dbh->prepare($query);
1043     $sth->execute( $borrowernumber, $itemnumber, $level );
1044     my ($exist) = $sth->fetchrow;
1045     return ($exist);
1046 }
1047
1048 =head2 GetOverduerules
1049
1050     ($overduerules) = &GetOverduerules($categorycode);
1051
1052 Returns the value of borrowers (debarred or not) with notify level
1053
1054 C<$overduerules> return value of debbraed field in overduerules table
1055
1056 C<$category> contains the borrower categorycode
1057
1058 C<$notify_level> contains the notify level
1059
1060 =cut
1061
1062 sub GetOverduerules {
1063     my ( $category, $notify_level ) = @_;
1064     my $dbh   = C4::Context->dbh;
1065     my $query = qq|SELECT debarred$notify_level
1066                      FROM overduerules
1067                     WHERE categorycode=?|;
1068     my $sth = $dbh->prepare($query);
1069     $sth->execute($category);
1070     my ($overduerules) = $sth->fetchrow;
1071     return ($overduerules);
1072 }
1073
1074
1075 =head2 CheckBorrowerDebarred
1076
1077     ($debarredstatus) = &CheckBorrowerDebarred($borrowernumber);
1078
1079 Check if the borrowers is already debarred
1080
1081 C<$debarredstatus> return 0 for not debarred and return 1 for debarred
1082
1083 C<$borrowernumber> contains the borrower number
1084
1085 =cut
1086
1087 # FIXME: Shouldn't this be in C4::Members?
1088 sub CheckBorrowerDebarred {
1089     my ($borrowernumber) = @_;
1090     my $dbh   = C4::Context->dbh;
1091     my $query = qq|
1092         SELECT debarred
1093         FROM borrowers
1094         WHERE borrowernumber=?
1095         AND debarred > NOW()
1096     |;
1097     my $sth = $dbh->prepare($query);
1098     $sth->execute($borrowernumber);
1099     my $debarredstatus = $sth->fetchrow;
1100     return $debarredstatus;
1101 }
1102
1103
1104 =head2 CheckExistantNotifyid
1105
1106     ($exist) = &CheckExistantNotifyid($borrowernumber,$itemnumber,$accounttype,$notify_id);
1107
1108 Check and Returns the notify id if exist else return 0.
1109
1110 C<$exist> contains a notify_id
1111
1112 C<$borrowernumber> contains the borrower number
1113
1114 C<$date_due> contains the date of item return
1115
1116
1117 =cut
1118
1119 sub CheckExistantNotifyid {
1120     my ( $borrowernumber, $date_due ) = @_;
1121     my $dbh   = C4::Context->dbh;
1122     my $query = qq|SELECT notify_id FROM accountlines
1123              LEFT JOIN issues ON issues.itemnumber= accountlines.itemnumber
1124              WHERE accountlines.borrowernumber =?
1125               AND date_due = ?|;
1126     my $sth = $dbh->prepare($query);
1127     $sth->execute( $borrowernumber, $date_due );
1128     return $sth->fetchrow || 0;
1129 }
1130
1131 =head2 CheckAccountLineItemInfo
1132
1133     ($exist) = &CheckAccountLineItemInfo($borrowernumber,$itemnumber,$accounttype,$notify_id);
1134
1135 Check and Returns the list of all overdue items from the same file number(notify_id).
1136
1137 C<$exist> contains number of line in accounlines
1138 with the same .biblionumber,itemnumber,accounttype,notify_id
1139
1140 C<$borrowernumber> contains the borrower number
1141
1142 C<$itemnumber> contains item number
1143
1144 C<$accounttype> contains account type
1145
1146 C<$notify_id> contains the file number
1147
1148 =cut
1149
1150 sub CheckAccountLineItemInfo {
1151     my ( $borrowernumber, $itemnumber, $accounttype, $notify_id ) = @_;
1152     my $dbh   = C4::Context->dbh;
1153     my $query = qq|SELECT count(*) FROM accountlines
1154              WHERE borrowernumber =?
1155              AND itemnumber = ?
1156               AND accounttype= ?
1157             AND notify_id = ?|;
1158     my $sth = $dbh->prepare($query);
1159     $sth->execute( $borrowernumber, $itemnumber, $accounttype, $notify_id );
1160     my ($exist) = $sth->fetchrow;
1161     return ($exist);
1162 }
1163
1164 =head2 CheckItemNotify
1165
1166 Sql request to check if the document has alreday been notified
1167 this function is not exported, only used with GetOverduesForBranch
1168
1169 =cut
1170
1171 sub CheckItemNotify {
1172     my ($notify_id,$notify_level,$itemnumber) = @_;
1173     my $dbh = C4::Context->dbh;
1174     my $sth = $dbh->prepare("
1175     SELECT COUNT(*)
1176      FROM notifys
1177     WHERE notify_id    = ?
1178      AND  notify_level = ?
1179      AND  itemnumber   = ? ");
1180     $sth->execute($notify_id,$notify_level,$itemnumber);
1181     my $notified = $sth->fetchrow;
1182     return ($notified);
1183 }
1184
1185 =head2 GetOverduesForBranch
1186
1187 Sql request for display all information for branchoverdues.pl
1188 2 possibilities : with or without location .
1189 display is filtered by branch
1190
1191 FIXME: This function should be renamed.
1192
1193 =cut
1194
1195 sub GetOverduesForBranch {
1196     my ( $branch, $location) = @_;
1197         my $itype_link =  (C4::Context->preference('item-level_itypes')) ?  " items.itype " :  " biblioitems.itemtype ";
1198     my $dbh = C4::Context->dbh;
1199     my $select = "
1200     SELECT
1201             borrowers.borrowernumber,
1202             borrowers.surname,
1203             borrowers.firstname,
1204             borrowers.phone,
1205             borrowers.email,
1206                biblio.title,
1207                biblio.author,
1208                biblio.biblionumber,
1209                issues.date_due,
1210                issues.returndate,
1211                issues.branchcode,
1212              branches.branchname,
1213                 items.barcode,
1214                 items.homebranch,
1215                 items.itemcallnumber,
1216                 items.location,
1217                 items.itemnumber,
1218             itemtypes.description,
1219          accountlines.notify_id,
1220          accountlines.notify_level,
1221          accountlines.amountoutstanding
1222     FROM  accountlines
1223     LEFT JOIN issues      ON    issues.itemnumber     = accountlines.itemnumber
1224                           AND   issues.borrowernumber = accountlines.borrowernumber
1225     LEFT JOIN borrowers   ON borrowers.borrowernumber = accountlines.borrowernumber
1226     LEFT JOIN items       ON     items.itemnumber     = issues.itemnumber
1227     LEFT JOIN biblio      ON      biblio.biblionumber =  items.biblionumber
1228     LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1229     LEFT JOIN itemtypes   ON itemtypes.itemtype       = $itype_link
1230     LEFT JOIN branches    ON  branches.branchcode     = issues.branchcode
1231     WHERE (accountlines.amountoutstanding  != '0.000000')
1232       AND (accountlines.accounttype         = 'FU'      )
1233       AND (issues.branchcode =  ?   )
1234       AND (issues.date_due  < NOW())
1235     ";
1236     my @getoverdues;
1237     my $i = 0;
1238     my $sth;
1239     if ($location) {
1240         $sth = $dbh->prepare("$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname");
1241         $sth->execute($branch, $location);
1242     } else {
1243         $sth = $dbh->prepare("$select ORDER BY borrowers.surname, borrowers.firstname");
1244         $sth->execute($branch);
1245     }
1246     while ( my $data = $sth->fetchrow_hashref ) {
1247     #check if the document has already been notified
1248         my $countnotify = CheckItemNotify($data->{'notify_id'}, $data->{'notify_level'}, $data->{'itemnumber'});
1249         if ($countnotify eq '0') {
1250             $getoverdues[$i] = $data;
1251             $i++;
1252         }
1253     }
1254     return (@getoverdues);
1255 }
1256
1257
1258 =head2 AddNotifyLine
1259
1260     &AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
1261
1262 Create a line into notify, if the method is phone, the notification_send_date is implemented to
1263
1264 =cut
1265
1266 sub AddNotifyLine {
1267     my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_;
1268     my $dbh = C4::Context->dbh;
1269     if ( $method eq "phone" ) {
1270         my $sth = $dbh->prepare(
1271             "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
1272         VALUES (?,?,now(),now(),?,?,?)"
1273         );
1274         $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
1275             $notifyId );
1276     }
1277     else {
1278         my $sth = $dbh->prepare(
1279             "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
1280         VALUES (?,?,now(),?,?,?)"
1281         );
1282         $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
1283             $notifyId );
1284     }
1285     return 1;
1286 }
1287
1288 =head2 RemoveNotifyLine
1289
1290     &RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
1291
1292 Cancel a notification
1293
1294 =cut
1295
1296 sub RemoveNotifyLine {
1297     my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
1298     my $dbh = C4::Context->dbh;
1299     my $sth = $dbh->prepare(
1300         "DELETE FROM notifys
1301             WHERE
1302             borrowernumber=?
1303             AND itemnumber=?
1304             AND notify_date=?"
1305     );
1306     $sth->execute( $borrowernumber, $itemnumber, $notify_date );
1307     return 1;
1308 }
1309
1310 1;
1311 __END__
1312
1313 =head1 AUTHOR
1314
1315 Koha Development Team <http://koha-community.org/>
1316
1317 =cut