Merge remote-tracking branch 'origin/new/bug_8233'
[koha.git] / 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         &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<$unitcount> is the number of chargeable units (days between start and end dates, Calendar adjusted where needed,
245 minus any applicable grace period, or hours)
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     $amount = $data->{overduefinescap} if $data->{overduefinescap} && $amount > $data->{overduefinescap};
272     $debug and warn sprintf("CalcFine returning (%s, %s, %s, %s)", $amount, $data->{'chargename'}, $units_minus_grace, $chargeable_units);
273     return ($amount, $data->{'chargename'}, $units_minus_grace, $chargeable_units);
274     # FIXME: chargename is NEVER populated anywhere.
275 }
276
277
278 =head2 _get_chargeable_units
279
280     _get_chargeable_units($unit, $start_date_ $end_date, $branchcode);
281
282 return integer value of units between C<$start_date> and C<$end_date>, factoring in holidays for C<$branchcode>.
283
284 C<$unit> is 'days' or 'hours' (default is 'days').
285
286 C<$start_date> and C<$end_date> are the two DateTimes to get the number of units between.
287
288 C<$branchcode> is the branch whose calendar to use for finding holidays.
289
290 =cut
291
292 sub _get_chargeable_units {
293     my ($unit, $dt1, $dt2, $branchcode) = @_;
294     my $charge_units = 0;
295     my $charge_duration;
296     if ($unit eq 'hours') {
297         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
298             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
299             $charge_duration = $calendar->hours_between( $dt1, $dt2 );
300         } else {
301             $charge_duration = $dt2->delta_ms( $dt1 );
302         }
303         if($charge_duration->in_units('hours') == 0 && $charge_duration->in_units('seconds') > 0){
304             return 1;
305         }
306         return $charge_duration->in_units('hours');
307     }
308     else { # days
309         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
310             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
311             $charge_duration = $calendar->days_between( $dt1, $dt2 );
312         } else {
313             $charge_duration = $dt2->delta_days( $dt1 );
314         }
315         return $charge_duration->in_units('days');
316     }
317 }
318
319
320 =head2 GetSpecialHolidays
321
322     &GetSpecialHolidays($date_dues,$itemnumber);
323
324 return number of special days  between date of the day and date due
325
326 C<$date_dues> is the envisaged date of book return.
327
328 C<$itemnumber> is the book's item number.
329
330 =cut
331
332 sub GetSpecialHolidays {
333     my ( $date_dues, $itemnumber ) = @_;
334
335     # calcul the today date
336     my $today = join "-", &Today();
337
338     # return the holdingbranch
339     my $iteminfo = GetIssuesIteminfo($itemnumber);
340
341     # use sql request to find all date between date_due and today
342     my $dbh = C4::Context->dbh;
343     my $query =
344       qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') as date
345 FROM `special_holidays`
346 WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
347 AND   DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
348 AND branchcode=?
349 |;
350     my @result = GetWdayFromItemnumber($itemnumber);
351     my @result_date;
352     my $wday;
353     my $dateinsec;
354     my $sth = $dbh->prepare($query);
355     $sth->execute( $date_dues, $today, $iteminfo->{'branchcode'} )
356       ;    # FIXME: just use NOW() in SQL instead of passing in $today
357
358     while ( my $special_date = $sth->fetchrow_hashref ) {
359         push( @result_date, $special_date );
360     }
361
362     my $specialdaycount = scalar(@result_date);
363
364     for ( my $i = 0 ; $i < scalar(@result_date) ; $i++ ) {
365         $dateinsec = UnixDate( $result_date[$i]->{'date'}, "%o" );
366         ( undef, undef, undef, undef, undef, undef, $wday, undef, undef ) =
367           localtime($dateinsec);
368         for ( my $j = 0 ; $j < scalar(@result) ; $j++ ) {
369             if ( $wday == ( $result[$j]->{'weekday'} ) ) {
370                 $specialdaycount--;
371             }
372         }
373     }
374
375     return $specialdaycount;
376 }
377
378 =head2 GetRepeatableHolidays
379
380     &GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
381
382 return number of day closed between date of the day and date due
383
384 C<$date_dues> is the envisaged date of book return.
385
386 C<$itemnumber> is item number.
387
388 C<$difference> numbers of between day date of the day and date due
389
390 =cut
391
392 sub GetRepeatableHolidays {
393     my ( $date_dues, $itemnumber, $difference ) = @_;
394     my $dateinsec = UnixDate( $date_dues, "%o" );
395     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
396       localtime($dateinsec);
397     my @result = GetWdayFromItemnumber($itemnumber);
398     my @dayclosedcount;
399     my $j;
400
401     for ( my $i = 0 ; $i < scalar(@result) ; $i++ ) {
402         my $k = $wday;
403
404         for ( $j = 0 ; $j < $difference ; $j++ ) {
405             if ( $result[$i]->{'weekday'} == $k ) {
406                 push( @dayclosedcount, $k );
407             }
408             $k++;
409             ( $k = 0 ) if ( $k eq 7 );
410         }
411     }
412     return scalar(@dayclosedcount);
413 }
414
415
416 =head2 GetWayFromItemnumber
417
418     &Getwdayfromitemnumber($itemnumber);
419
420 return the different week day from repeatable_holidays table
421
422 C<$itemnumber> is  item number.
423
424 =cut
425
426 sub GetWdayFromItemnumber {
427     my ($itemnumber) = @_;
428     my $iteminfo = GetIssuesIteminfo($itemnumber);
429     my @result;
430     my $query = qq|SELECT weekday
431     FROM repeatable_holidays
432     WHERE branchcode=?
433 |;
434     my $sth = C4::Context->dbh->prepare($query);
435
436     $sth->execute( $iteminfo->{'branchcode'} );
437     while ( my $weekday = $sth->fetchrow_hashref ) {
438         push( @result, $weekday );
439     }
440     return @result;
441 }
442
443
444 =head2 GetIssuesIteminfo
445
446     &GetIssuesIteminfo($itemnumber);
447
448 return all data from issues about item
449
450 C<$itemnumber> is  item number.
451
452 =cut
453
454 sub GetIssuesIteminfo {
455     my ($itemnumber) = @_;
456     my $dbh          = C4::Context->dbh;
457     my $query        = qq|SELECT *
458     FROM issues
459     WHERE itemnumber=?
460     |;
461     my $sth = $dbh->prepare($query);
462     $sth->execute($itemnumber);
463     my ($issuesinfo) = $sth->fetchrow_hashref;
464     return $issuesinfo;
465 }
466
467
468 =head2 UpdateFine
469
470     &UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description);
471
472 (Note: the following is mostly conjecture and guesswork.)
473
474 Updates the fine owed on an overdue book.
475
476 C<$itemnumber> is the book's item number.
477
478 C<$borrowernumber> is the borrower number of the patron who currently
479 has the book on loan.
480
481 C<$amount> is the current amount owed by the patron.
482
483 C<$type> will be used in the description of the fine.
484
485 C<$description> is a string that must be present in the description of
486 the fine. I think this is expected to be a date in DD/MM/YYYY format.
487
488 C<&UpdateFine> looks up the amount currently owed on the given item
489 and sets it to C<$amount>, creating, if necessary, a new entry in the
490 accountlines table of the Koha database.
491
492 =cut
493
494 #
495 # Question: Why should the caller have to
496 # specify both the item number and the borrower number? A book can't
497 # be on loan to two different people, so the item number should be
498 # sufficient.
499 #
500 # Possible Answer: You might update a fine for a damaged item, *after* it is returned.
501 #
502 sub UpdateFine {
503     my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_;
504         $debug and warn "UpdateFine($itemnum, $borrowernumber, $amount, " . ($type||'""') . ", $due) called";
505     my $dbh = C4::Context->dbh;
506     # FIXME - What exactly is this query supposed to do? It looks up an
507     # entry in accountlines that matches the given item and borrower
508     # numbers, where the description contains $due, and where the
509     # account type has one of several values, but what does this _mean_?
510     # Does it look up existing fines for this item?
511     # FIXME - What are these various account types? ("FU", "O", "F", "M")
512         #       "L"   is LOST item
513         #   "A"   is Account Management Fee
514         #   "N"   is New Card
515         #   "M"   is Sundry
516         #   "O"   is Overdue ??
517         #   "F"   is Fine ??
518         #   "FU"  is Fine UPDATE??
519         #       "Pay" is Payment
520         #   "REF" is Cash Refund
521     my $sth = $dbh->prepare(
522         "SELECT * FROM accountlines
523         WHERE borrowernumber=?
524         AND   accounttype IN ('FU','O','F','M')"
525     );
526     $sth->execute( $borrowernumber );
527     my $data;
528     my $total_amount_other = 0.00;
529     my $due_qr = qr/$due/;
530     # Cycle through the fines and
531     # - find line that relates to the requested $itemnum
532     # - accumulate fines for other items
533     # so we can update $itemnum fine taking in account fine caps
534     while (my $rec = $sth->fetchrow_hashref) {
535         if ($rec->{itemnumber} == $itemnum && $rec->{description} =~ /$due_qr/) {
536             if ($data) {
537                 warn "Not a unique accountlines record for item $itemnum borrower $borrowernumber";
538             } else {
539                 $data = $rec;
540                 next;
541             }
542         }
543         $total_amount_other += $rec->{'amount'};
544     }
545     if (my $maxfine = C4::Context->preference('MaxFine')) {
546         if ($total_amount_other + $amount > $maxfine) {
547             my $new_amount = $maxfine - $total_amount_other;
548             warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached";
549             return if $new_amount <= 0.00;
550
551             $amount = $new_amount;
552         }
553     }
554
555     if ( $data ) {
556
557                 # we're updating an existing fine.  Only modify if amount changed
558         # Note that in the current implementation, you cannot pay against an accruing fine
559         # (i.e. , of accounttype 'FU').  Doing so will break accrual.
560         if ( $data->{'amount'} != $amount ) {
561             my $diff = $amount - $data->{'amount'};
562             #3341: diff could be positive or negative!
563             my $out  = $data->{'amountoutstanding'} + $diff;
564             my $query = "
565                 UPDATE accountlines
566                                 SET date=now(), amount=?, amountoutstanding=?,
567                                         lastincrement=?, accounttype='FU'
568                                 WHERE borrowernumber=?
569                                 AND   itemnumber=?
570                                 AND   accounttype IN ('FU','O')
571                                 AND   description LIKE ?
572                                 LIMIT 1 ";
573             my $sth2 = $dbh->prepare($query);
574                         # FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!!
575                         #               LIMIT 1 added to prevent multiple affected lines
576                         # FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline.  
577                         #               But actually, we should just have a regular autoincrementing PK and forget accountline,
578                         #               including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops).
579                         # FIXME: Why only 2 account types here?
580                         $debug and print STDERR "UpdateFine query: $query\n" .
581                                 "w/ args: $amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, \"\%$due\%\"\n";
582             $sth2->execute($amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, "%$due%");
583         } else {
584             #      print "no update needed $data->{'amount'}"
585         }
586     } else {
587         my $sth4 = $dbh->prepare(
588             "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?"
589         );
590         $sth4->execute($itemnum);
591         my $title = $sth4->fetchrow;
592
593 #         #   print "not in account";
594 #         my $sth3 = $dbh->prepare("Select max(accountno) from accountlines");
595 #         $sth3->execute;
596
597 #         # FIXME - Make $accountno a scalar.
598 #         my @accountno = $sth3->fetchrow_array;
599 #         $sth3->finish;
600 #         $accountno[0]++;
601 # begin transaction
602                 my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
603                 my $desc = ($type ? "$type " : '') . "$title $due";     # FIXEDME, avoid whitespace prefix on empty $type
604                 my $query = "INSERT INTO accountlines
605                     (borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno)
606                             VALUES (?,?,now(),?,?,'FU',?,?,?)";
607                 my $sth2 = $dbh->prepare($query);
608                 $debug and print STDERR "UpdateFine query: $query\nw/ args: $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno\n";
609         $sth2->execute($borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno);
610     }
611     # logging action
612     &logaction(
613         "FINES",
614         $type,
615         $borrowernumber,
616         "due=".$due."  amount=".$amount." itemnumber=".$itemnum
617         ) if C4::Context->preference("FinesLog");
618 }
619
620 =head2 BorType
621
622     $borrower = &BorType($borrowernumber);
623
624 Looks up a patron by borrower number.
625
626 C<$borrower> is a reference-to-hash whose keys are all of the fields
627 from the borrowers and categories tables of the Koha database. Thus,
628 C<$borrower> contains all information about both the borrower and
629 category he or she belongs to.
630
631 =cut
632
633 #'
634 sub BorType {
635     my ($borrowernumber) = @_;
636     my $dbh              = C4::Context->dbh;
637     my $sth              = $dbh->prepare(
638         "SELECT * from borrowers
639       LEFT JOIN categories ON borrowers.categorycode=categories.categorycode 
640       WHERE borrowernumber=?"
641     );
642     $sth->execute($borrowernumber);
643     return $sth->fetchrow_hashref;
644 }
645
646 =head2 ReplacementCost
647
648     $cost = &ReplacementCost($itemnumber);
649
650 Returns the replacement cost of the item with the given item number.
651
652 =cut
653
654 #'
655 sub ReplacementCost {
656     my ($itemnum) = @_;
657     my $dbh       = C4::Context->dbh;
658     my $sth       =
659       $dbh->prepare("Select replacementprice from items where itemnumber=?");
660     $sth->execute($itemnum);
661
662     # FIXME - Use fetchrow_array or a slice.
663     my $data = $sth->fetchrow_hashref;
664     return ( $data->{'replacementprice'} );
665 }
666
667 =head2 GetFine
668
669     $data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
670
671 return the total of fine
672
673 C<$itemnum> is item number
674
675 C<$borrowernumber> is the borrowernumber
676
677 =cut 
678
679
680 sub GetFine {
681     my ( $itemnum, $borrowernumber ) = @_;
682     my $dbh   = C4::Context->dbh();
683     my $query = q|SELECT sum(amountoutstanding) as fineamount FROM accountlines
684     where accounttype like 'F%'
685   AND amountoutstanding > 0 AND itemnumber = ? AND borrowernumber=?|;
686     my $sth = $dbh->prepare($query);
687     $sth->execute( $itemnum, $borrowernumber );
688     my $fine = $sth->fetchrow_hashref();
689     if ($fine->{fineamount}) {
690         return $fine->{fineamount};
691     }
692     return 0;
693 }
694
695
696 =head2 GetIssuingRules
697
698 FIXME - This sub should be deprecated and removed.
699 It ignores branch and defaults.
700
701     $data = &GetIssuingRules($itemtype,$categorycode);
702
703 Looks up for all issuingrules an item info 
704
705 C<$itemnumber> is a reference-to-hash whose keys are all of the fields
706 from the borrowers and categories tables of the Koha database. Thus,
707
708 C<$categorycode> contains  information about borrowers category 
709
710 C<$data> contains all information about both the borrower and
711 category he or she belongs to.
712 =cut 
713
714 sub GetIssuingRules {
715         warn "GetIssuingRules is deprecated: use GetIssuingRule from C4::Circulation instead.";
716    my ($itemtype,$categorycode)=@_;
717    my $dbh   = C4::Context->dbh();    
718    my $query=qq|SELECT *
719         FROM issuingrules
720         WHERE issuingrules.itemtype=?
721             AND issuingrules.categorycode=?
722         |;
723     my $sth = $dbh->prepare($query);
724     #  print $query;
725     $sth->execute($itemtype,$categorycode);
726     return $sth->fetchrow_hashref;
727 }
728
729
730 sub ReplacementCost2 {
731     my ( $itemnum, $borrowernumber ) = @_;
732     my $dbh   = C4::Context->dbh();
733     my $query = "SELECT amountoutstanding
734          FROM accountlines
735              WHERE accounttype like 'L'
736          AND amountoutstanding > 0
737          AND itemnumber = ?
738          AND borrowernumber= ?";
739     my $sth = $dbh->prepare($query);
740     $sth->execute( $itemnum, $borrowernumber );
741     my $data = $sth->fetchrow_hashref();
742     return ( $data->{'amountoutstanding'} );
743 }
744
745
746 =head2 GetNextIdNotify
747
748     ($result) = &GetNextIdNotify($reference);
749
750 Returns the new file number
751
752 C<$result> contains the next file number
753
754 C<$reference> contains the beggining of file number
755
756 =cut
757
758 sub GetNextIdNotify {
759     my ($reference) = @_;
760     my $query = qq|SELECT max(notify_id)
761          FROM accountlines
762          WHERE notify_id  like \"$reference%\"
763          |;
764
765     # AND borrowernumber=?|;
766     my $dbh = C4::Context->dbh;
767     my $sth = $dbh->prepare($query);
768     $sth->execute();
769     my $result = $sth->fetchrow;
770     my $count;
771     if ( $result eq '' ) {
772         ( $result = $reference . "01" );
773     }
774     else {
775         $count = substr( $result, 6 ) + 1;
776
777         if ( $count < 10 ) {
778             ( $count = "0" . $count );
779         }
780         $result = $reference . $count;
781     }
782     return $result;
783 }
784
785 =head2 NumberNotifyId
786
787     (@notify) = &NumberNotifyId($borrowernumber);
788
789 Returns amount for all file per borrowers
790 C<@notify> array contains all file per borrowers
791
792 C<$notify_id> contains the file number for the borrower number nad item number
793
794 =cut
795
796 sub NumberNotifyId{
797     my ($borrowernumber)=@_;
798     my $dbh = C4::Context->dbh;
799     my $query=qq|    SELECT distinct(notify_id)
800             FROM accountlines
801             WHERE borrowernumber=?|;
802     my @notify;
803     my $sth = $dbh->prepare($query);
804     $sth->execute($borrowernumber);
805     while ( my ($numberofnotify) = $sth->fetchrow ) {
806         push( @notify, $numberofnotify );
807     }
808     return (@notify);
809 }
810
811 =head2 AmountNotify
812
813     ($totalnotify) = &AmountNotify($notifyid);
814
815 Returns amount for all file per borrowers
816 C<$notifyid> is the file number
817
818 C<$totalnotify> contains amount of a file
819
820 C<$notify_id> contains the file number for the borrower number and item number
821
822 =cut
823
824 sub AmountNotify{
825     my ($notifyid,$borrowernumber)=@_;
826     my $dbh = C4::Context->dbh;
827     my $query=qq|    SELECT sum(amountoutstanding)
828             FROM accountlines
829             WHERE notify_id=? AND borrowernumber = ?|;
830     my $sth=$dbh->prepare($query);
831         $sth->execute($notifyid,$borrowernumber);
832         my $totalnotify=$sth->fetchrow;
833     $sth->finish;
834     return ($totalnotify);
835 }
836
837
838 =head2 GetNotifyId
839
840     ($notify_id) = &GetNotifyId($borrowernumber,$itemnumber);
841
842 Returns the file number per borrower and itemnumber
843
844 C<$borrowernumber> is a reference-to-hash whose keys are all of the fields
845 from the items tables of the Koha database. Thus,
846
847 C<$itemnumber> contains the borrower categorycode
848
849 C<$notify_id> contains the file number for the borrower number nad item number
850
851 =cut
852
853 sub GetNotifyId {
854     my ( $borrowernumber, $itemnumber ) = @_;
855     my $query = qq|SELECT notify_id
856            FROM accountlines
857            WHERE borrowernumber=?
858           AND itemnumber=?
859            AND (accounttype='FU' or accounttype='O')|;
860     my $dbh = C4::Context->dbh;
861     my $sth = $dbh->prepare($query);
862     $sth->execute( $borrowernumber, $itemnumber );
863     my ($notify_id) = $sth->fetchrow;
864     $sth->finish;
865     return ($notify_id);
866 }
867
868 =head2 CreateItemAccountLine
869
870     () = &CreateItemAccountLine($borrowernumber, $itemnumber, $date, $amount,
871                                $description, $accounttype, $amountoutstanding, 
872                                $timestamp, $notify_id, $level);
873
874 update the account lines with file number or with file level
875
876 C<$items> is a reference-to-hash whose keys are all of the fields
877 from the items tables of the Koha database. Thus,
878
879 C<$itemnumber> contains the item number
880
881 C<$borrowernumber> contains the borrower number
882
883 C<$date> contains the date of the day
884
885 C<$amount> contains item price
886
887 C<$description> contains the descritpion of accounttype 
888
889 C<$accounttype> contains the account type
890
891 C<$amountoutstanding> contains the $amountoutstanding 
892
893 C<$timestamp> contains the timestamp with time and the date of the day
894
895 C<$notify_id> contains the file number
896
897 C<$level> contains the file level
898
899 =cut
900
901 sub CreateItemAccountLine {
902     my (
903         $borrowernumber, $itemnumber,  $date,              $amount,
904         $description,    $accounttype, $amountoutstanding, $timestamp,
905         $notify_id,      $level
906     ) = @_;
907     my $dbh         = C4::Context->dbh;
908     my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
909     my $query       = "INSERT into accountlines
910          (borrowernumber,accountno,itemnumber,date,amount,description,accounttype,amountoutstanding,timestamp,notify_id,notify_level)
911           VALUES
912              (?,?,?,?,?,?,?,?,?,?,?)";
913
914     my $sth = $dbh->prepare($query);
915     $sth->execute(
916         $borrowernumber, $nextaccntno,       $itemnumber,
917         $date,           $amount,            $description,
918         $accounttype,    $amountoutstanding, $timestamp,
919         $notify_id,      $level
920     );
921 }
922
923 =head2 UpdateAccountLines
924
925     () = &UpdateAccountLines($notify_id,$notify_level,$borrowernumber,$itemnumber);
926
927 update the account lines with file number or with file level
928
929 C<$items> is a reference-to-hash whose keys are all of the fields
930 from the items tables of the Koha database. Thus,
931
932 C<$itemnumber> contains the item number
933
934 C<$notify_id> contains the file number
935
936 C<$notify_level> contains the file level
937
938 C<$borrowernumber> contains the borrowernumber
939
940 =cut
941
942 sub UpdateAccountLines {
943     my ( $notify_id, $notify_level, $borrowernumber, $itemnumber ) = @_;
944     my $query;
945     if ( $notify_id eq '' ) {
946         $query = qq|UPDATE accountlines
947     SET  notify_level=?
948     WHERE borrowernumber=? AND itemnumber=?
949     AND (accounttype='FU' or accounttype='O')|;
950     } else {
951         $query = qq|UPDATE accountlines
952      SET notify_id=?, notify_level=?
953    WHERE borrowernumber=?
954     AND itemnumber=?
955     AND (accounttype='FU' or accounttype='O')|;
956     }
957
958     my $sth = C4::Context->dbh->prepare($query);
959     if ( $notify_id eq '' ) {
960         $sth->execute( $notify_level, $borrowernumber, $itemnumber );
961     } else {
962         $sth->execute( $notify_id, $notify_level, $borrowernumber, $itemnumber );
963     }
964 }
965
966 =head2 GetItems
967
968     ($items) = &GetItems($itemnumber);
969
970 Returns the list of all delays from overduerules.
971
972 C<$items> is a reference-to-hash whose keys are all of the fields
973 from the items tables of the Koha database. Thus,
974
975 C<$itemnumber> contains the borrower categorycode
976
977 =cut
978
979 # FIXME: This is a bad function to have here.
980 # Shouldn't it be in C4::Items?
981 # Shouldn't it be called GetItem since you only get 1 row?
982 # Shouldn't it be called GetItem since you give it only 1 itemnumber?
983
984 sub GetItems {
985     my $itemnumber = shift or return;
986     my $query = qq|SELECT *
987              FROM items
988               WHERE itemnumber=?|;
989     my $sth = C4::Context->dbh->prepare($query);
990     $sth->execute($itemnumber);
991     my ($items) = $sth->fetchrow_hashref;
992     return ($items);
993 }
994
995 =head2 GetOverdueDelays
996
997     (@delays) = &GetOverdueDelays($categorycode);
998
999 Returns the list of all delays from overduerules.
1000
1001 C<@delays> it's an array contains the three delays from overduerules table
1002
1003 C<$categorycode> contains the borrower categorycode
1004
1005 =cut
1006
1007 sub GetOverdueDelays {
1008     my ($category) = @_;
1009     my $query      = qq|SELECT delay1,delay2,delay3
1010                 FROM overduerules
1011                 WHERE categorycode=?|;
1012     my $sth = C4::Context->dbh->prepare($query);
1013     $sth->execute($category);
1014     my (@delays) = $sth->fetchrow_array;
1015     return (@delays);
1016 }
1017
1018 =head2 GetBranchcodesWithOverdueRules
1019
1020     my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules()
1021
1022 returns a list of branch codes for branches with overdue rules defined.
1023
1024 =cut
1025
1026 sub GetBranchcodesWithOverdueRules {
1027     my $dbh               = C4::Context->dbh;
1028     my $rqoverduebranches = $dbh->prepare("SELECT DISTINCT branchcode FROM overduerules WHERE delay1 IS NOT NULL AND branchcode <> '' ORDER BY branchcode");
1029     $rqoverduebranches->execute;
1030     my @branches = map { shift @$_ } @{ $rqoverduebranches->fetchall_arrayref };
1031     if (!$branches[0]) {
1032        my $availbranches = C4::Branch::GetBranches();
1033        @branches = keys %$availbranches;
1034     }
1035     return @branches;
1036 }
1037
1038 =head2 CheckAccountLineLevelInfo
1039
1040     ($exist) = &CheckAccountLineLevelInfo($borrowernumber,$itemnumber,$accounttype,notify_level);
1041
1042 Check and Returns the list of all overdue books.
1043
1044 C<$exist> contains number of line in accounlines
1045 with the same .biblionumber,itemnumber,accounttype,and notify_level
1046
1047 C<$borrowernumber> contains the borrower number
1048
1049 C<$itemnumber> contains item number
1050
1051 C<$accounttype> contains account type
1052
1053 C<$notify_level> contains the accountline level 
1054
1055
1056 =cut
1057
1058 sub CheckAccountLineLevelInfo {
1059     my ( $borrowernumber, $itemnumber, $level ) = @_;
1060     my $dbh   = C4::Context->dbh;
1061     my $query = qq|SELECT count(*)
1062             FROM accountlines
1063             WHERE borrowernumber =?
1064             AND itemnumber = ?
1065             AND notify_level=?|;
1066     my $sth = $dbh->prepare($query);
1067     $sth->execute( $borrowernumber, $itemnumber, $level );
1068     my ($exist) = $sth->fetchrow;
1069     return ($exist);
1070 }
1071
1072 =head2 GetOverduerules
1073
1074     ($overduerules) = &GetOverduerules($categorycode);
1075
1076 Returns the value of borrowers (debarred or not) with notify level
1077
1078 C<$overduerules> return value of debbraed field in overduerules table
1079
1080 C<$category> contains the borrower categorycode
1081
1082 C<$notify_level> contains the notify level
1083
1084 =cut
1085
1086 sub GetOverduerules {
1087     my ( $category, $notify_level ) = @_;
1088     my $dbh   = C4::Context->dbh;
1089     my $query = qq|SELECT debarred$notify_level
1090                      FROM overduerules
1091                     WHERE categorycode=?|;
1092     my $sth = $dbh->prepare($query);
1093     $sth->execute($category);
1094     my ($overduerules) = $sth->fetchrow;
1095     return ($overduerules);
1096 }
1097
1098
1099 =head2 CheckBorrowerDebarred
1100
1101     ($debarredstatus) = &CheckBorrowerDebarred($borrowernumber);
1102
1103 Check if the borrowers is already debarred
1104
1105 C<$debarredstatus> return 0 for not debarred and return 1 for debarred
1106
1107 C<$borrowernumber> contains the borrower number
1108
1109 =cut
1110
1111 # FIXME: Shouldn't this be in C4::Members?
1112 sub CheckBorrowerDebarred {
1113     my ($borrowernumber) = @_;
1114     my $dbh   = C4::Context->dbh;
1115     my $query = qq|
1116         SELECT debarred
1117         FROM borrowers
1118         WHERE borrowernumber=?
1119         AND debarred > NOW()
1120     |;
1121     my $sth = $dbh->prepare($query);
1122     $sth->execute($borrowernumber);
1123     my $debarredstatus = $sth->fetchrow;
1124     return $debarredstatus;
1125 }
1126
1127
1128 =head2 CheckExistantNotifyid
1129
1130     ($exist) = &CheckExistantNotifyid($borrowernumber,$itemnumber,$accounttype,$notify_id);
1131
1132 Check and Returns the notify id if exist else return 0.
1133
1134 C<$exist> contains a notify_id 
1135
1136 C<$borrowernumber> contains the borrower number
1137
1138 C<$date_due> contains the date of item return 
1139
1140
1141 =cut
1142
1143 sub CheckExistantNotifyid {
1144     my ( $borrowernumber, $date_due ) = @_;
1145     my $dbh   = C4::Context->dbh;
1146     my $query = qq|SELECT notify_id FROM accountlines
1147              LEFT JOIN issues ON issues.itemnumber= accountlines.itemnumber
1148              WHERE accountlines.borrowernumber =?
1149               AND date_due = ?|;
1150     my $sth = $dbh->prepare($query);
1151     $sth->execute( $borrowernumber, $date_due );
1152     return $sth->fetchrow || 0;
1153 }
1154
1155 =head2 CheckAccountLineItemInfo
1156
1157     ($exist) = &CheckAccountLineItemInfo($borrowernumber,$itemnumber,$accounttype,$notify_id);
1158
1159 Check and Returns the list of all overdue items from the same file number(notify_id).
1160
1161 C<$exist> contains number of line in accounlines
1162 with the same .biblionumber,itemnumber,accounttype,notify_id
1163
1164 C<$borrowernumber> contains the borrower number
1165
1166 C<$itemnumber> contains item number
1167
1168 C<$accounttype> contains account type
1169
1170 C<$notify_id> contains the file number 
1171
1172 =cut
1173
1174 sub CheckAccountLineItemInfo {
1175     my ( $borrowernumber, $itemnumber, $accounttype, $notify_id ) = @_;
1176     my $dbh   = C4::Context->dbh;
1177     my $query = qq|SELECT count(*) FROM accountlines
1178              WHERE borrowernumber =?
1179              AND itemnumber = ?
1180               AND accounttype= ?
1181             AND notify_id = ?|;
1182     my $sth = $dbh->prepare($query);
1183     $sth->execute( $borrowernumber, $itemnumber, $accounttype, $notify_id );
1184     my ($exist) = $sth->fetchrow;
1185     return ($exist);
1186 }
1187
1188 =head2 CheckItemNotify
1189
1190 Sql request to check if the document has alreday been notified
1191 this function is not exported, only used with GetOverduesForBranch
1192
1193 =cut
1194
1195 sub CheckItemNotify {
1196     my ($notify_id,$notify_level,$itemnumber) = @_;
1197     my $dbh = C4::Context->dbh;
1198     my $sth = $dbh->prepare("
1199     SELECT COUNT(*)
1200      FROM notifys
1201     WHERE notify_id    = ?
1202      AND  notify_level = ? 
1203      AND  itemnumber   = ? ");
1204     $sth->execute($notify_id,$notify_level,$itemnumber);
1205     my $notified = $sth->fetchrow;
1206     return ($notified);
1207 }
1208
1209 =head2 GetOverduesForBranch
1210
1211 Sql request for display all information for branchoverdues.pl
1212 2 possibilities : with or without location .
1213 display is filtered by branch
1214
1215 FIXME: This function should be renamed.
1216
1217 =cut
1218
1219 sub GetOverduesForBranch {
1220     my ( $branch, $location) = @_;
1221         my $itype_link =  (C4::Context->preference('item-level_itypes')) ?  " items.itype " :  " biblioitems.itemtype ";
1222     my $dbh = C4::Context->dbh;
1223     my $select = "
1224     SELECT
1225             borrowers.borrowernumber,
1226             borrowers.surname,
1227             borrowers.firstname,
1228             borrowers.phone,
1229             borrowers.email,
1230                biblio.title,
1231                biblio.author,
1232                biblio.biblionumber,
1233                issues.date_due,
1234                issues.returndate,
1235                issues.branchcode,
1236              branches.branchname,
1237                 items.barcode,
1238                 items.homebranch,
1239                 items.itemcallnumber,
1240                 items.location,
1241                 items.itemnumber,
1242             itemtypes.description,
1243          accountlines.notify_id,
1244          accountlines.notify_level,
1245          accountlines.amountoutstanding
1246     FROM  accountlines
1247     LEFT JOIN issues      ON    issues.itemnumber     = accountlines.itemnumber
1248                           AND   issues.borrowernumber = accountlines.borrowernumber
1249     LEFT JOIN borrowers   ON borrowers.borrowernumber = accountlines.borrowernumber
1250     LEFT JOIN items       ON     items.itemnumber     = issues.itemnumber
1251     LEFT JOIN biblio      ON      biblio.biblionumber =  items.biblionumber
1252     LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1253     LEFT JOIN itemtypes   ON itemtypes.itemtype       = $itype_link
1254     LEFT JOIN branches    ON  branches.branchcode     = issues.branchcode
1255     WHERE (accountlines.amountoutstanding  != '0.000000')
1256       AND (accountlines.accounttype         = 'FU'      )
1257       AND (issues.branchcode =  ?   )
1258       AND (issues.date_due  < NOW())
1259     ";
1260     my @getoverdues;
1261     my $i = 0;
1262     my $sth;
1263     if ($location) {
1264         $sth = $dbh->prepare("$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname");
1265         $sth->execute($branch, $location);
1266     } else {
1267         $sth = $dbh->prepare("$select ORDER BY borrowers.surname, borrowers.firstname");
1268         $sth->execute($branch);
1269     }
1270     while ( my $data = $sth->fetchrow_hashref ) {
1271     #check if the document has already been notified
1272         my $countnotify = CheckItemNotify($data->{'notify_id'}, $data->{'notify_level'}, $data->{'itemnumber'});
1273         if ($countnotify eq '0') {
1274             $getoverdues[$i] = $data;
1275             $i++;
1276         }
1277     }
1278     return (@getoverdues);
1279 }
1280
1281
1282 =head2 AddNotifyLine
1283
1284     &AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
1285
1286 Create a line into notify, if the method is phone, the notification_send_date is implemented to
1287
1288 =cut
1289
1290 sub AddNotifyLine {
1291     my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_;
1292     my $dbh = C4::Context->dbh;
1293     if ( $method eq "phone" ) {
1294         my $sth = $dbh->prepare(
1295             "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
1296         VALUES (?,?,now(),now(),?,?,?)"
1297         );
1298         $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
1299             $notifyId );
1300     }
1301     else {
1302         my $sth = $dbh->prepare(
1303             "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
1304         VALUES (?,?,now(),?,?,?)"
1305         );
1306         $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
1307             $notifyId );
1308     }
1309     return 1;
1310 }
1311
1312 =head2 RemoveNotifyLine
1313
1314     &RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
1315
1316 Cancel a notification
1317
1318 =cut
1319
1320 sub RemoveNotifyLine {
1321     my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
1322     my $dbh = C4::Context->dbh;
1323     my $sth = $dbh->prepare(
1324         "DELETE FROM notifys 
1325             WHERE
1326             borrowernumber=?
1327             AND itemnumber=?
1328             AND notify_date=?"
1329     );
1330     $sth->execute( $borrowernumber, $itemnumber, $notify_date );
1331     return 1;
1332 }
1333
1334 1;
1335 __END__
1336
1337 =head1 AUTHOR
1338
1339 Koha Development Team <http://koha-community.org/>
1340
1341 =cut