Merge remote-tracking branch 'origin/new/bug_7781'
[koha.git] / C4 / Overdues.pm
blob23e75f56536c0e9f8a8b101dd712aae90536424e
1 package C4::Overdues;
4 # Copyright 2000-2002 Katipo Communications
5 # copyright 2010 BibLibre
7 # This file is part of Koha.
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.
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.
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.
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;
32 use vars qw($VERSION @ISA @EXPORT);
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
59 &CheckItemNotify
60 &GetOverduesForBranch
61 &RemoveNotifyLine
62 &AddNotifyLine
64 # subs to remove
65 push @EXPORT, qw(
66 &BorType
69 # check that an equivalent don't exist already before moving
71 # subs to move to Circulation.pm
72 push @EXPORT, qw(
73 &GetIssuesIteminfo
76 # &GetIssuingRules - delete.
77 # use C4::Circulation::GetIssuingRule instead.
79 # subs to move to Members.pm
80 push @EXPORT, qw(
81 &CheckBorrowerDebarred
83 # subs to move to Biblio.pm
84 push @EXPORT, qw(
85 &GetItems
86 &ReplacementCost
90 =head1 NAME
92 C4::Circulation::Fines - Koha module dealing with fines
94 =head1 SYNOPSIS
96 use C4::Overdues;
98 =head1 DESCRIPTION
100 This module contains several functions for dealing with fines for
101 overdue items. It is primarily used by the 'misc/fines2.pl' script.
103 =head1 FUNCTIONS
105 =head2 Getoverdues
107 $overdues = Getoverdues( { minimumdays => 1, maximumdays => 30 } );
109 Returns the list of all overdue books, with their itemtype.
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.
115 =cut
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()
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()
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'};
150 $statement .= 'ORDER BY borrowernumber';
151 my $sth = $dbh->prepare( $statement );
152 $sth->execute( @bind_parameters );
153 return $sth->fetchall_arrayref({});
157 =head2 checkoverdues
159 ($count, $overdueitems) = checkoverdues($borrowernumber);
161 Returns a count and a list of overdueitems for a given borrowernumber
163 =cut
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()"
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
210 =head2 CalcFine
212 ($amount, $chargename, $daycounttotal) = &CalcFine($item,
213 $categorycode, $branch,
214 $start_dt, $end_dt );
216 Calculates the fine for a book.
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).
225 C<$item> is an item object (hashref).
227 C<$categorycode> is the category code (string) of the patron who currently has
228 the book.
230 C<$branchcode> is the library (string) whose issuingrules govern this transaction.
232 C<$start_date> & C<$end_date> are DateTime objects
233 defining the date range over which to determine the fine.
235 Fines scripts should just supply the date range over which to calculate the fine.
237 C<&CalcFine> returns four values:
239 C<$amount> is the fine owed by the patron (see above).
241 C<$chargename> is the chargename field from the applicable record in
242 the categoryitem table, whatever that is.
244 C<$daycount> is the number of days between start and end dates, Calendar adjusted (where needed),
245 minus any applicable grace period.
247 FIXME - What is chargename supposed to be ?
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.
252 =cut
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 $data = C4::Circulation::GetIssuingRule($bortype, $item->{itemtype}, $branchcode);
259 my $fine_unit = $data->{lengthunit};
260 $fine_unit ||= 'days';
262 my $chargeable_units = _get_chargeable_units($fine_unit, $start_date, $end_date, $branchcode);
263 my $units_minus_grace = $chargeable_units - $data->{firstremind};
264 my $amount = 0;
265 if ($data->{'chargeperiod'} && $units_minus_grace ) {
266 $amount = int($chargeable_units / $data->{'chargeperiod'}) * $data->{'fine'};# TODO fine calc should be in cents
267 } else {
268 # a zero (or null) chargeperiod means no charge.
270 if(C4::Context->preference('maxFine') && ( $amount > C4::Context->preference('maxFine'))) {
271 $amount = C4::Context->preference('maxFine');
273 return ($amount, $data->{chargename}, $units_minus_grace);
274 # FIXME: chargename is NEVER populated anywhere.
278 =head2 _get_chargeable_units
280 _get_chargeable_units($unit, $start_date_ $end_date, $branchcode);
282 return integer value of units between C<$start_date> and C<$end_date>, factoring in holidays for C<$branchcode>.
284 C<$unit> is 'days' or 'hours' (default is 'days').
286 C<$start_date> and C<$end_date> are the two DateTimes to get the number of units between.
288 C<$branchcode> is the branch whose calendar to use for finding holidays.
290 =cut
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 );
303 return $charge_duration->in_units('hours');
305 else { # days
306 if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
307 my $calendar = Koha::Calendar->new( branchcode => $branchcode );
308 $charge_duration = $calendar->days_between( $dt1, $dt2 );
309 } else {
310 $charge_duration = $dt2->delta_days( $dt1 );
312 return $charge_duration->in_units('days');
317 =head2 GetSpecialHolidays
319 &GetSpecialHolidays($date_dues,$itemnumber);
321 return number of special days between date of the day and date due
323 C<$date_dues> is the envisaged date of book return.
325 C<$itemnumber> is the book's item number.
327 =cut
329 sub GetSpecialHolidays {
330 my ( $date_dues, $itemnumber ) = @_;
332 # calcul the today date
333 my $today = join "-", &Today();
335 # return the holdingbranch
336 my $iteminfo = GetIssuesIteminfo($itemnumber);
338 # use sql request to find all date between date_due and today
339 my $dbh = C4::Context->dbh;
340 my $query =
341 qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') as date
342 FROM `special_holidays`
343 WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
344 AND DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
345 AND branchcode=?
347 my @result = GetWdayFromItemnumber($itemnumber);
348 my @result_date;
349 my $wday;
350 my $dateinsec;
351 my $sth = $dbh->prepare($query);
352 $sth->execute( $date_dues, $today, $iteminfo->{'branchcode'} )
353 ; # FIXME: just use NOW() in SQL instead of passing in $today
355 while ( my $special_date = $sth->fetchrow_hashref ) {
356 push( @result_date, $special_date );
359 my $specialdaycount = scalar(@result_date);
361 for ( my $i = 0 ; $i < scalar(@result_date) ; $i++ ) {
362 $dateinsec = UnixDate( $result_date[$i]->{'date'}, "%o" );
363 ( undef, undef, undef, undef, undef, undef, $wday, undef, undef ) =
364 localtime($dateinsec);
365 for ( my $j = 0 ; $j < scalar(@result) ; $j++ ) {
366 if ( $wday == ( $result[$j]->{'weekday'} ) ) {
367 $specialdaycount--;
372 return $specialdaycount;
375 =head2 GetRepeatableHolidays
377 &GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
379 return number of day closed between date of the day and date due
381 C<$date_dues> is the envisaged date of book return.
383 C<$itemnumber> is item number.
385 C<$difference> numbers of between day date of the day and date due
387 =cut
389 sub GetRepeatableHolidays {
390 my ( $date_dues, $itemnumber, $difference ) = @_;
391 my $dateinsec = UnixDate( $date_dues, "%o" );
392 my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
393 localtime($dateinsec);
394 my @result = GetWdayFromItemnumber($itemnumber);
395 my @dayclosedcount;
396 my $j;
398 for ( my $i = 0 ; $i < scalar(@result) ; $i++ ) {
399 my $k = $wday;
401 for ( $j = 0 ; $j < $difference ; $j++ ) {
402 if ( $result[$i]->{'weekday'} == $k ) {
403 push( @dayclosedcount, $k );
405 $k++;
406 ( $k = 0 ) if ( $k eq 7 );
409 return scalar(@dayclosedcount);
413 =head2 GetWayFromItemnumber
415 &Getwdayfromitemnumber($itemnumber);
417 return the different week day from repeatable_holidays table
419 C<$itemnumber> is item number.
421 =cut
423 sub GetWdayFromItemnumber {
424 my ($itemnumber) = @_;
425 my $iteminfo = GetIssuesIteminfo($itemnumber);
426 my @result;
427 my $query = qq|SELECT weekday
428 FROM repeatable_holidays
429 WHERE branchcode=?
431 my $sth = C4::Context->dbh->prepare($query);
433 $sth->execute( $iteminfo->{'branchcode'} );
434 while ( my $weekday = $sth->fetchrow_hashref ) {
435 push( @result, $weekday );
437 return @result;
441 =head2 GetIssuesIteminfo
443 &GetIssuesIteminfo($itemnumber);
445 return all data from issues about item
447 C<$itemnumber> is item number.
449 =cut
451 sub GetIssuesIteminfo {
452 my ($itemnumber) = @_;
453 my $dbh = C4::Context->dbh;
454 my $query = qq|SELECT *
455 FROM issues
456 WHERE itemnumber=?
458 my $sth = $dbh->prepare($query);
459 $sth->execute($itemnumber);
460 my ($issuesinfo) = $sth->fetchrow_hashref;
461 return $issuesinfo;
465 =head2 UpdateFine
467 &UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description);
469 (Note: the following is mostly conjecture and guesswork.)
471 Updates the fine owed on an overdue book.
473 C<$itemnumber> is the book's item number.
475 C<$borrowernumber> is the borrower number of the patron who currently
476 has the book on loan.
478 C<$amount> is the current amount owed by the patron.
480 C<$type> will be used in the description of the fine.
482 C<$description> is a string that must be present in the description of
483 the fine. I think this is expected to be a date in DD/MM/YYYY format.
485 C<&UpdateFine> looks up the amount currently owed on the given item
486 and sets it to C<$amount>, creating, if necessary, a new entry in the
487 accountlines table of the Koha database.
489 =cut
492 # Question: Why should the caller have to
493 # specify both the item number and the borrower number? A book can't
494 # be on loan to two different people, so the item number should be
495 # sufficient.
497 # Possible Answer: You might update a fine for a damaged item, *after* it is returned.
499 sub UpdateFine {
500 my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_;
501 $debug and warn "UpdateFine($itemnum, $borrowernumber, $amount, " . ($type||'""') . ", $due) called";
502 my $dbh = C4::Context->dbh;
503 # FIXME - What exactly is this query supposed to do? It looks up an
504 # entry in accountlines that matches the given item and borrower
505 # numbers, where the description contains $due, and where the
506 # account type has one of several values, but what does this _mean_?
507 # Does it look up existing fines for this item?
508 # FIXME - What are these various account types? ("FU", "O", "F", "M")
509 # "L" is LOST item
510 # "A" is Account Management Fee
511 # "N" is New Card
512 # "M" is Sundry
513 # "O" is Overdue ??
514 # "F" is Fine ??
515 # "FU" is Fine UPDATE??
516 # "Pay" is Payment
517 # "REF" is Cash Refund
518 my $sth = $dbh->prepare(
519 "SELECT * FROM accountlines
520 WHERE itemnumber=?
521 AND borrowernumber=?
522 AND accounttype IN ('FU','O','F','M')
523 AND description like ? "
525 $sth->execute( $itemnum, $borrowernumber, "%$due%" );
527 if ( my $data = $sth->fetchrow_hashref ) {
529 # we're updating an existing fine. Only modify if amount changed
530 # Note that in the current implementation, you cannot pay against an accruing fine
531 # (i.e. , of accounttype 'FU'). Doing so will break accrual.
532 if ( $data->{'amount'} != $amount ) {
533 my $diff = $amount - $data->{'amount'};
534 #3341: diff could be positive or negative!
535 my $out = $data->{'amountoutstanding'} + $diff;
536 my $query = "
537 UPDATE accountlines
538 SET date=now(), amount=?, amountoutstanding=?,
539 lastincrement=?, accounttype='FU'
540 WHERE borrowernumber=?
541 AND itemnumber=?
542 AND accounttype IN ('FU','O')
543 AND description LIKE ?
544 LIMIT 1 ";
545 my $sth2 = $dbh->prepare($query);
546 # FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!!
547 # LIMIT 1 added to prevent multiple affected lines
548 # FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline.
549 # But actually, we should just have a regular autoincrementing PK and forget accountline,
550 # including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops).
551 # FIXME: Why only 2 account types here?
552 $debug and print STDERR "UpdateFine query: $query\n" .
553 "w/ args: $amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, \"\%$due\%\"\n";
554 $sth2->execute($amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, "%$due%");
555 } else {
556 # print "no update needed $data->{'amount'}"
558 } else {
559 my $sth4 = $dbh->prepare(
560 "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?"
562 $sth4->execute($itemnum);
563 my $title = $sth4->fetchrow;
565 # # print "not in account";
566 # my $sth3 = $dbh->prepare("Select max(accountno) from accountlines");
567 # $sth3->execute;
569 # # FIXME - Make $accountno a scalar.
570 # my @accountno = $sth3->fetchrow_array;
571 # $sth3->finish;
572 # $accountno[0]++;
573 # begin transaction
574 my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
575 my $desc = ($type ? "$type " : '') . "$title $due"; # FIXEDME, avoid whitespace prefix on empty $type
576 my $query = "INSERT INTO accountlines
577 (borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno)
578 VALUES (?,?,now(),?,?,'FU',?,?,?)";
579 my $sth2 = $dbh->prepare($query);
580 $debug and print STDERR "UpdateFine query: $query\nw/ args: $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno\n";
581 $sth2->execute($borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno);
583 # logging action
584 &logaction(
585 "FINES",
586 $type,
587 $borrowernumber,
588 "due=".$due." amount=".$amount." itemnumber=".$itemnum
589 ) if C4::Context->preference("FinesLog");
592 =head2 BorType
594 $borrower = &BorType($borrowernumber);
596 Looks up a patron by borrower number.
598 C<$borrower> is a reference-to-hash whose keys are all of the fields
599 from the borrowers and categories tables of the Koha database. Thus,
600 C<$borrower> contains all information about both the borrower and
601 category he or she belongs to.
603 =cut
606 sub BorType {
607 my ($borrowernumber) = @_;
608 my $dbh = C4::Context->dbh;
609 my $sth = $dbh->prepare(
610 "SELECT * from borrowers
611 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
612 WHERE borrowernumber=?"
614 $sth->execute($borrowernumber);
615 return $sth->fetchrow_hashref;
618 =head2 ReplacementCost
620 $cost = &ReplacementCost($itemnumber);
622 Returns the replacement cost of the item with the given item number.
624 =cut
627 sub ReplacementCost {
628 my ($itemnum) = @_;
629 my $dbh = C4::Context->dbh;
630 my $sth =
631 $dbh->prepare("Select replacementprice from items where itemnumber=?");
632 $sth->execute($itemnum);
634 # FIXME - Use fetchrow_array or a slice.
635 my $data = $sth->fetchrow_hashref;
636 return ( $data->{'replacementprice'} );
639 =head2 GetFine
641 $data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
643 return the total of fine
645 C<$itemnum> is item number
647 C<$borrowernumber> is the borrowernumber
649 =cut
652 sub GetFine {
653 my ( $itemnum, $borrowernumber ) = @_;
654 my $dbh = C4::Context->dbh();
655 my $query = q|SELECT sum(amountoutstanding) as fineamount FROM accountlines
656 where accounttype like 'F%'
657 AND amountoutstanding > 0 AND itemnumber = ? AND borrowernumber=?|;
658 my $sth = $dbh->prepare($query);
659 $sth->execute( $itemnum, $borrowernumber );
660 my $fine = $sth->fetchrow_hashref();
661 if ($fine->{fineamount}) {
662 return $fine->{fineamount};
664 return 0;
668 =head2 GetIssuingRules
670 FIXME - This sub should be deprecated and removed.
671 It ignores branch and defaults.
673 $data = &GetIssuingRules($itemtype,$categorycode);
675 Looks up for all issuingrules an item info
677 C<$itemnumber> is a reference-to-hash whose keys are all of the fields
678 from the borrowers and categories tables of the Koha database. Thus,
680 C<$categorycode> contains information about borrowers category
682 C<$data> contains all information about both the borrower and
683 category he or she belongs to.
684 =cut
686 sub GetIssuingRules {
687 warn "GetIssuingRules is deprecated: use GetIssuingRule from C4::Circulation instead.";
688 my ($itemtype,$categorycode)=@_;
689 my $dbh = C4::Context->dbh();
690 my $query=qq|SELECT *
691 FROM issuingrules
692 WHERE issuingrules.itemtype=?
693 AND issuingrules.categorycode=?
695 my $sth = $dbh->prepare($query);
696 # print $query;
697 $sth->execute($itemtype,$categorycode);
698 return $sth->fetchrow_hashref;
702 sub ReplacementCost2 {
703 my ( $itemnum, $borrowernumber ) = @_;
704 my $dbh = C4::Context->dbh();
705 my $query = "SELECT amountoutstanding
706 FROM accountlines
707 WHERE accounttype like 'L'
708 AND amountoutstanding > 0
709 AND itemnumber = ?
710 AND borrowernumber= ?";
711 my $sth = $dbh->prepare($query);
712 $sth->execute( $itemnum, $borrowernumber );
713 my $data = $sth->fetchrow_hashref();
714 return ( $data->{'amountoutstanding'} );
718 =head2 GetNextIdNotify
720 ($result) = &GetNextIdNotify($reference);
722 Returns the new file number
724 C<$result> contains the next file number
726 C<$reference> contains the beggining of file number
728 =cut
730 sub GetNextIdNotify {
731 my ($reference) = @_;
732 my $query = qq|SELECT max(notify_id)
733 FROM accountlines
734 WHERE notify_id like \"$reference%\"
737 # AND borrowernumber=?|;
738 my $dbh = C4::Context->dbh;
739 my $sth = $dbh->prepare($query);
740 $sth->execute();
741 my $result = $sth->fetchrow;
742 my $count;
743 if ( $result eq '' ) {
744 ( $result = $reference . "01" );
746 else {
747 $count = substr( $result, 6 ) + 1;
749 if ( $count < 10 ) {
750 ( $count = "0" . $count );
752 $result = $reference . $count;
754 return $result;
757 =head2 NumberNotifyId
759 (@notify) = &NumberNotifyId($borrowernumber);
761 Returns amount for all file per borrowers
762 C<@notify> array contains all file per borrowers
764 C<$notify_id> contains the file number for the borrower number nad item number
766 =cut
768 sub NumberNotifyId{
769 my ($borrowernumber)=@_;
770 my $dbh = C4::Context->dbh;
771 my $query=qq| SELECT distinct(notify_id)
772 FROM accountlines
773 WHERE borrowernumber=?|;
774 my @notify;
775 my $sth = $dbh->prepare($query);
776 $sth->execute($borrowernumber);
777 while ( my ($numberofnotify) = $sth->fetchrow ) {
778 push( @notify, $numberofnotify );
780 return (@notify);
783 =head2 AmountNotify
785 ($totalnotify) = &AmountNotify($notifyid);
787 Returns amount for all file per borrowers
788 C<$notifyid> is the file number
790 C<$totalnotify> contains amount of a file
792 C<$notify_id> contains the file number for the borrower number and item number
794 =cut
796 sub AmountNotify{
797 my ($notifyid,$borrowernumber)=@_;
798 my $dbh = C4::Context->dbh;
799 my $query=qq| SELECT sum(amountoutstanding)
800 FROM accountlines
801 WHERE notify_id=? AND borrowernumber = ?|;
802 my $sth=$dbh->prepare($query);
803 $sth->execute($notifyid,$borrowernumber);
804 my $totalnotify=$sth->fetchrow;
805 $sth->finish;
806 return ($totalnotify);
810 =head2 GetNotifyId
812 ($notify_id) = &GetNotifyId($borrowernumber,$itemnumber);
814 Returns the file number per borrower and itemnumber
816 C<$borrowernumber> is a reference-to-hash whose keys are all of the fields
817 from the items tables of the Koha database. Thus,
819 C<$itemnumber> contains the borrower categorycode
821 C<$notify_id> contains the file number for the borrower number nad item number
823 =cut
825 sub GetNotifyId {
826 my ( $borrowernumber, $itemnumber ) = @_;
827 my $query = qq|SELECT notify_id
828 FROM accountlines
829 WHERE borrowernumber=?
830 AND itemnumber=?
831 AND (accounttype='FU' or accounttype='O')|;
832 my $dbh = C4::Context->dbh;
833 my $sth = $dbh->prepare($query);
834 $sth->execute( $borrowernumber, $itemnumber );
835 my ($notify_id) = $sth->fetchrow;
836 $sth->finish;
837 return ($notify_id);
840 =head2 CreateItemAccountLine
842 () = &CreateItemAccountLine($borrowernumber, $itemnumber, $date, $amount,
843 $description, $accounttype, $amountoutstanding,
844 $timestamp, $notify_id, $level);
846 update the account lines with file number or with file level
848 C<$items> is a reference-to-hash whose keys are all of the fields
849 from the items tables of the Koha database. Thus,
851 C<$itemnumber> contains the item number
853 C<$borrowernumber> contains the borrower number
855 C<$date> contains the date of the day
857 C<$amount> contains item price
859 C<$description> contains the descritpion of accounttype
861 C<$accounttype> contains the account type
863 C<$amountoutstanding> contains the $amountoutstanding
865 C<$timestamp> contains the timestamp with time and the date of the day
867 C<$notify_id> contains the file number
869 C<$level> contains the file level
871 =cut
873 sub CreateItemAccountLine {
874 my (
875 $borrowernumber, $itemnumber, $date, $amount,
876 $description, $accounttype, $amountoutstanding, $timestamp,
877 $notify_id, $level
878 ) = @_;
879 my $dbh = C4::Context->dbh;
880 my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
881 my $query = "INSERT into accountlines
882 (borrowernumber,accountno,itemnumber,date,amount,description,accounttype,amountoutstanding,timestamp,notify_id,notify_level)
883 VALUES
884 (?,?,?,?,?,?,?,?,?,?,?)";
886 my $sth = $dbh->prepare($query);
887 $sth->execute(
888 $borrowernumber, $nextaccntno, $itemnumber,
889 $date, $amount, $description,
890 $accounttype, $amountoutstanding, $timestamp,
891 $notify_id, $level
895 =head2 UpdateAccountLines
897 () = &UpdateAccountLines($notify_id,$notify_level,$borrowernumber,$itemnumber);
899 update the account lines with file number or with file level
901 C<$items> is a reference-to-hash whose keys are all of the fields
902 from the items tables of the Koha database. Thus,
904 C<$itemnumber> contains the item number
906 C<$notify_id> contains the file number
908 C<$notify_level> contains the file level
910 C<$borrowernumber> contains the borrowernumber
912 =cut
914 sub UpdateAccountLines {
915 my ( $notify_id, $notify_level, $borrowernumber, $itemnumber ) = @_;
916 my $query;
917 if ( $notify_id eq '' ) {
918 $query = qq|UPDATE accountlines
919 SET notify_level=?
920 WHERE borrowernumber=? AND itemnumber=?
921 AND (accounttype='FU' or accounttype='O')|;
922 } else {
923 $query = qq|UPDATE accountlines
924 SET notify_id=?, notify_level=?
925 WHERE borrowernumber=?
926 AND itemnumber=?
927 AND (accounttype='FU' or accounttype='O')|;
930 my $sth = C4::Context->dbh->prepare($query);
931 if ( $notify_id eq '' ) {
932 $sth->execute( $notify_level, $borrowernumber, $itemnumber );
933 } else {
934 $sth->execute( $notify_id, $notify_level, $borrowernumber, $itemnumber );
938 =head2 GetItems
940 ($items) = &GetItems($itemnumber);
942 Returns the list of all delays from overduerules.
944 C<$items> is a reference-to-hash whose keys are all of the fields
945 from the items tables of the Koha database. Thus,
947 C<$itemnumber> contains the borrower categorycode
949 =cut
951 # FIXME: This is a bad function to have here.
952 # Shouldn't it be in C4::Items?
953 # Shouldn't it be called GetItem since you only get 1 row?
954 # Shouldn't it be called GetItem since you give it only 1 itemnumber?
956 sub GetItems {
957 my $itemnumber = shift or return;
958 my $query = qq|SELECT *
959 FROM items
960 WHERE itemnumber=?|;
961 my $sth = C4::Context->dbh->prepare($query);
962 $sth->execute($itemnumber);
963 my ($items) = $sth->fetchrow_hashref;
964 return ($items);
967 =head2 GetOverdueDelays
969 (@delays) = &GetOverdueDelays($categorycode);
971 Returns the list of all delays from overduerules.
973 C<@delays> it's an array contains the three delays from overduerules table
975 C<$categorycode> contains the borrower categorycode
977 =cut
979 sub GetOverdueDelays {
980 my ($category) = @_;
981 my $query = qq|SELECT delay1,delay2,delay3
982 FROM overduerules
983 WHERE categorycode=?|;
984 my $sth = C4::Context->dbh->prepare($query);
985 $sth->execute($category);
986 my (@delays) = $sth->fetchrow_array;
987 return (@delays);
990 =head2 GetBranchcodesWithOverdueRules
992 my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules()
994 returns a list of branch codes for branches with overdue rules defined.
996 =cut
998 sub GetBranchcodesWithOverdueRules {
999 my $dbh = C4::Context->dbh;
1000 my $rqoverduebranches = $dbh->prepare("SELECT DISTINCT branchcode FROM overduerules WHERE delay1 IS NOT NULL AND branchcode <> '' ORDER BY branchcode");
1001 $rqoverduebranches->execute;
1002 my @branches = map { shift @$_ } @{ $rqoverduebranches->fetchall_arrayref };
1003 if (!$branches[0]) {
1004 my $availbranches = C4::Branch::GetBranches();
1005 @branches = keys %$availbranches;
1007 return @branches;
1010 =head2 CheckAccountLineLevelInfo
1012 ($exist) = &CheckAccountLineLevelInfo($borrowernumber,$itemnumber,$accounttype,notify_level);
1014 Check and Returns the list of all overdue books.
1016 C<$exist> contains number of line in accounlines
1017 with the same .biblionumber,itemnumber,accounttype,and notify_level
1019 C<$borrowernumber> contains the borrower number
1021 C<$itemnumber> contains item number
1023 C<$accounttype> contains account type
1025 C<$notify_level> contains the accountline level
1028 =cut
1030 sub CheckAccountLineLevelInfo {
1031 my ( $borrowernumber, $itemnumber, $level ) = @_;
1032 my $dbh = C4::Context->dbh;
1033 my $query = qq|SELECT count(*)
1034 FROM accountlines
1035 WHERE borrowernumber =?
1036 AND itemnumber = ?
1037 AND notify_level=?|;
1038 my $sth = $dbh->prepare($query);
1039 $sth->execute( $borrowernumber, $itemnumber, $level );
1040 my ($exist) = $sth->fetchrow;
1041 return ($exist);
1044 =head2 GetOverduerules
1046 ($overduerules) = &GetOverduerules($categorycode);
1048 Returns the value of borrowers (debarred or not) with notify level
1050 C<$overduerules> return value of debbraed field in overduerules table
1052 C<$category> contains the borrower categorycode
1054 C<$notify_level> contains the notify level
1056 =cut
1058 sub GetOverduerules {
1059 my ( $category, $notify_level ) = @_;
1060 my $dbh = C4::Context->dbh;
1061 my $query = qq|SELECT debarred$notify_level
1062 FROM overduerules
1063 WHERE categorycode=?|;
1064 my $sth = $dbh->prepare($query);
1065 $sth->execute($category);
1066 my ($overduerules) = $sth->fetchrow;
1067 return ($overduerules);
1071 =head2 CheckBorrowerDebarred
1073 ($debarredstatus) = &CheckBorrowerDebarred($borrowernumber);
1075 Check if the borrowers is already debarred
1077 C<$debarredstatus> return 0 for not debarred and return 1 for debarred
1079 C<$borrowernumber> contains the borrower number
1081 =cut
1083 # FIXME: Shouldn't this be in C4::Members?
1084 sub CheckBorrowerDebarred {
1085 my ($borrowernumber) = @_;
1086 my $dbh = C4::Context->dbh;
1087 my $query = qq|
1088 SELECT debarred
1089 FROM borrowers
1090 WHERE borrowernumber=?
1091 AND debarred > NOW()
1093 my $sth = $dbh->prepare($query);
1094 $sth->execute($borrowernumber);
1095 my $debarredstatus = $sth->fetchrow;
1096 return $debarredstatus;
1100 =head2 CheckExistantNotifyid
1102 ($exist) = &CheckExistantNotifyid($borrowernumber,$itemnumber,$accounttype,$notify_id);
1104 Check and Returns the notify id if exist else return 0.
1106 C<$exist> contains a notify_id
1108 C<$borrowernumber> contains the borrower number
1110 C<$date_due> contains the date of item return
1113 =cut
1115 sub CheckExistantNotifyid {
1116 my ( $borrowernumber, $date_due ) = @_;
1117 my $dbh = C4::Context->dbh;
1118 my $query = qq|SELECT notify_id FROM accountlines
1119 LEFT JOIN issues ON issues.itemnumber= accountlines.itemnumber
1120 WHERE accountlines.borrowernumber =?
1121 AND date_due = ?|;
1122 my $sth = $dbh->prepare($query);
1123 $sth->execute( $borrowernumber, $date_due );
1124 return $sth->fetchrow || 0;
1127 =head2 CheckAccountLineItemInfo
1129 ($exist) = &CheckAccountLineItemInfo($borrowernumber,$itemnumber,$accounttype,$notify_id);
1131 Check and Returns the list of all overdue items from the same file number(notify_id).
1133 C<$exist> contains number of line in accounlines
1134 with the same .biblionumber,itemnumber,accounttype,notify_id
1136 C<$borrowernumber> contains the borrower number
1138 C<$itemnumber> contains item number
1140 C<$accounttype> contains account type
1142 C<$notify_id> contains the file number
1144 =cut
1146 sub CheckAccountLineItemInfo {
1147 my ( $borrowernumber, $itemnumber, $accounttype, $notify_id ) = @_;
1148 my $dbh = C4::Context->dbh;
1149 my $query = qq|SELECT count(*) FROM accountlines
1150 WHERE borrowernumber =?
1151 AND itemnumber = ?
1152 AND accounttype= ?
1153 AND notify_id = ?|;
1154 my $sth = $dbh->prepare($query);
1155 $sth->execute( $borrowernumber, $itemnumber, $accounttype, $notify_id );
1156 my ($exist) = $sth->fetchrow;
1157 return ($exist);
1160 =head2 CheckItemNotify
1162 Sql request to check if the document has alreday been notified
1163 this function is not exported, only used with GetOverduesForBranch
1165 =cut
1167 sub CheckItemNotify {
1168 my ($notify_id,$notify_level,$itemnumber) = @_;
1169 my $dbh = C4::Context->dbh;
1170 my $sth = $dbh->prepare("
1171 SELECT COUNT(*)
1172 FROM notifys
1173 WHERE notify_id = ?
1174 AND notify_level = ?
1175 AND itemnumber = ? ");
1176 $sth->execute($notify_id,$notify_level,$itemnumber);
1177 my $notified = $sth->fetchrow;
1178 return ($notified);
1181 =head2 GetOverduesForBranch
1183 Sql request for display all information for branchoverdues.pl
1184 2 possibilities : with or without location .
1185 display is filtered by branch
1187 FIXME: This function should be renamed.
1189 =cut
1191 sub GetOverduesForBranch {
1192 my ( $branch, $location) = @_;
1193 my $itype_link = (C4::Context->preference('item-level_itypes')) ? " items.itype " : " biblioitems.itemtype ";
1194 my $dbh = C4::Context->dbh;
1195 my $select = "
1196 SELECT
1197 borrowers.borrowernumber,
1198 borrowers.surname,
1199 borrowers.firstname,
1200 borrowers.phone,
1201 borrowers.email,
1202 biblio.title,
1203 biblio.author,
1204 biblio.biblionumber,
1205 issues.date_due,
1206 issues.returndate,
1207 issues.branchcode,
1208 branches.branchname,
1209 items.barcode,
1210 items.homebranch,
1211 items.itemcallnumber,
1212 items.location,
1213 items.itemnumber,
1214 itemtypes.description,
1215 accountlines.notify_id,
1216 accountlines.notify_level,
1217 accountlines.amountoutstanding
1218 FROM accountlines
1219 LEFT JOIN issues ON issues.itemnumber = accountlines.itemnumber
1220 AND issues.borrowernumber = accountlines.borrowernumber
1221 LEFT JOIN borrowers ON borrowers.borrowernumber = accountlines.borrowernumber
1222 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1223 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1224 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1225 LEFT JOIN itemtypes ON itemtypes.itemtype = $itype_link
1226 LEFT JOIN branches ON branches.branchcode = issues.branchcode
1227 WHERE (accountlines.amountoutstanding != '0.000000')
1228 AND (accountlines.accounttype = 'FU' )
1229 AND (issues.branchcode = ? )
1230 AND (issues.date_due < NOW())
1232 my @getoverdues;
1233 my $i = 0;
1234 my $sth;
1235 if ($location) {
1236 $sth = $dbh->prepare("$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname");
1237 $sth->execute($branch, $location);
1238 } else {
1239 $sth = $dbh->prepare("$select ORDER BY borrowers.surname, borrowers.firstname");
1240 $sth->execute($branch);
1242 while ( my $data = $sth->fetchrow_hashref ) {
1243 #check if the document has already been notified
1244 my $countnotify = CheckItemNotify($data->{'notify_id'}, $data->{'notify_level'}, $data->{'itemnumber'});
1245 if ($countnotify eq '0') {
1246 $getoverdues[$i] = $data;
1247 $i++;
1250 return (@getoverdues);
1254 =head2 AddNotifyLine
1256 &AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
1258 Create a line into notify, if the method is phone, the notification_send_date is implemented to
1260 =cut
1262 sub AddNotifyLine {
1263 my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_;
1264 my $dbh = C4::Context->dbh;
1265 if ( $method eq "phone" ) {
1266 my $sth = $dbh->prepare(
1267 "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
1268 VALUES (?,?,now(),now(),?,?,?)"
1270 $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
1271 $notifyId );
1273 else {
1274 my $sth = $dbh->prepare(
1275 "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
1276 VALUES (?,?,now(),?,?,?)"
1278 $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
1279 $notifyId );
1281 return 1;
1284 =head2 RemoveNotifyLine
1286 &RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
1288 Cancel a notification
1290 =cut
1292 sub RemoveNotifyLine {
1293 my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
1294 my $dbh = C4::Context->dbh;
1295 my $sth = $dbh->prepare(
1296 "DELETE FROM notifys
1297 WHERE
1298 borrowernumber=?
1299 AND itemnumber=?
1300 AND notify_date=?"
1302 $sth->execute( $borrowernumber, $itemnumber, $notify_date );
1303 return 1;
1307 __END__
1309 =head1 AUTHOR
1311 Koha Development Team <http://koha-community.org/>
1313 =cut