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