Bug 24217: use Modern::Perl for modules when strict is missing
[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
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.
13 #
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.
18 #
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>.
21
22 use Modern::Perl;
23 use Date::Calc qw/Today Date_to_Days/;
24 use Date::Manip qw/UnixDate/;
25 use List::MoreUtils qw( uniq );
26 use POSIX qw( floor ceil );
27 use Locale::Currency::Format 1.28;
28 use Carp;
29
30 use C4::Circulation;
31 use C4::Context;
32 use C4::Accounts;
33 use C4::Log; # logaction
34 use C4::Debug;
35 use Koha::DateUtils;
36 use Koha::Account::Lines;
37 use Koha::Account::Offsets;
38 use Koha::IssuingRules;
39 use Koha::Libraries;
40
41 use vars qw(@ISA @EXPORT);
42
43 BEGIN {
44     require Exporter;
45     @ISA = qw(Exporter);
46
47     # subs to rename (and maybe merge some...)
48     push @EXPORT, qw(
49       &CalcFine
50       &Getoverdues
51       &checkoverdues
52       &UpdateFine
53       &GetFine
54       &get_chargeable_units
55       &GetOverduesForBranch
56       &GetOverdueMessageTransportTypes
57       &parse_overdues_letter
58     );
59
60     # subs to remove
61     push @EXPORT, qw(
62       &BorType
63     );
64
65     # check that an equivalent don't exist already before moving
66
67     # subs to move to Circulation.pm
68     push @EXPORT, qw(
69       &GetIssuesIteminfo
70     );
71 }
72
73 =head1 NAME
74
75 C4::Circulation::Fines - Koha module dealing with fines
76
77 =head1 SYNOPSIS
78
79   use C4::Overdues;
80
81 =head1 DESCRIPTION
82
83 This module contains several functions for dealing with fines for
84 overdue items. It is primarily used by the 'misc/fines2.pl' script.
85
86 =head1 FUNCTIONS
87
88 =head2 Getoverdues
89
90   $overdues = Getoverdues( { minimumdays => 1, maximumdays => 30 } );
91
92 Returns the list of all overdue books, with their itemtype.
93
94 C<$overdues> is a reference-to-array. Each element is a
95 reference-to-hash whose keys are the fields of the issues table in the
96 Koha database.
97
98 =cut
99
100 #'
101 sub Getoverdues {
102     my $params = shift;
103     my $dbh = C4::Context->dbh;
104     my $statement;
105     if ( C4::Context->preference('item-level_itypes') ) {
106         $statement = "
107    SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode, items.itemlost, items.replacementprice
108      FROM issues 
109 LEFT JOIN items       USING (itemnumber)
110     WHERE date_due < NOW()
111 ";
112     } else {
113         $statement = "
114    SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode, items.itemlost, replacementprice
115      FROM issues 
116 LEFT JOIN items       USING (itemnumber)
117 LEFT JOIN biblioitems USING (biblioitemnumber)
118     WHERE date_due < NOW()
119 ";
120     }
121
122     my @bind_parameters;
123     if ( exists $params->{'minimumdays'} and exists $params->{'maximumdays'} ) {
124         $statement .= ' AND TO_DAYS( NOW() )-TO_DAYS( date_due ) BETWEEN ? and ? ';
125         push @bind_parameters, $params->{'minimumdays'}, $params->{'maximumdays'};
126     } elsif ( exists $params->{'minimumdays'} ) {
127         $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) > ? ';
128         push @bind_parameters, $params->{'minimumdays'};
129     } elsif ( exists $params->{'maximumdays'} ) {
130         $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ? ';
131         push @bind_parameters, $params->{'maximumdays'};
132     }
133     $statement .= 'ORDER BY borrowernumber';
134     my $sth = $dbh->prepare( $statement );
135     $sth->execute( @bind_parameters );
136     return $sth->fetchall_arrayref({});
137 }
138
139
140 =head2 checkoverdues
141
142     ($count, $overdueitems) = checkoverdues($borrowernumber);
143
144 Returns a count and a list of overdueitems for a given borrowernumber
145
146 =cut
147
148 sub checkoverdues {
149     my $borrowernumber = shift or return;
150     my $sth = C4::Context->dbh->prepare(
151         "SELECT biblio.*, items.*, issues.*,
152                 biblioitems.volume,
153                 biblioitems.number,
154                 biblioitems.itemtype,
155                 biblioitems.isbn,
156                 biblioitems.issn,
157                 biblioitems.publicationyear,
158                 biblioitems.publishercode,
159                 biblioitems.volumedate,
160                 biblioitems.volumedesc,
161                 biblioitems.collectiontitle,
162                 biblioitems.collectionissn,
163                 biblioitems.collectionvolume,
164                 biblioitems.editionstatement,
165                 biblioitems.editionresponsibility,
166                 biblioitems.illus,
167                 biblioitems.pages,
168                 biblioitems.notes,
169                 biblioitems.size,
170                 biblioitems.place,
171                 biblioitems.lccn,
172                 biblioitems.url,
173                 biblioitems.cn_source,
174                 biblioitems.cn_class,
175                 biblioitems.cn_item,
176                 biblioitems.cn_suffix,
177                 biblioitems.cn_sort,
178                 biblioitems.totalissues
179          FROM issues
180          LEFT JOIN items       ON issues.itemnumber      = items.itemnumber
181          LEFT JOIN biblio      ON items.biblionumber     = biblio.biblionumber
182          LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
183             WHERE issues.borrowernumber  = ?
184             AND   issues.date_due < NOW()"
185     );
186     $sth->execute($borrowernumber);
187     my $results = $sth->fetchall_arrayref({});
188     return ( scalar(@$results), $results);  # returning the count and the results is silly
189 }
190
191 =head2 CalcFine
192
193     ($amount, $units_minus_grace, $chargeable_units) = &CalcFine($item,
194                                   $categorycode, $branch,
195                                   $start_dt, $end_dt );
196
197 Calculates the fine for a book.
198
199 The issuingrules table in the Koha database is a fine matrix, listing
200 the penalties for each type of patron for each type of item and each branch (e.g., the
201 standard fine for books might be $0.50, but $1.50 for DVDs, or staff
202 members might get a longer grace period between the first and second
203 reminders that a book is overdue).
204
205
206 C<$item> is an item object (hashref).
207
208 C<$categorycode> is the category code (string) of the patron who currently has
209 the book.
210
211 C<$branchcode> is the library (string) whose issuingrules govern this transaction.
212
213 C<$start_date> & C<$end_date> are DateTime objects
214 defining the date range over which to determine the fine.
215
216 Fines scripts should just supply the date range over which to calculate the fine.
217
218 C<&CalcFine> returns three values:
219
220 C<$amount> is the fine owed by the patron (see above).
221
222 C<$units_minus_grace> is the number of chargeable units minus the grace period
223
224 C<$chargeable_units> is the number of chargeable units (days between start and end dates, Calendar adjusted where needed,
225 minus any applicable grace period, or hours)
226
227 FIXME: previously attempted to return C<$message> as a text message, either "First Notice", "Second Notice",
228 or "Final Notice".  But CalcFine never defined any value.
229
230 =cut
231
232 sub CalcFine {
233     my ( $item, $bortype, $branchcode, $due_dt, $end_date  ) = @_;
234
235     # Skip calculations if item is not overdue
236     return ( 0, 0, 0 ) unless (DateTime->compare( $due_dt, $end_date ) == -1);
237
238     my $start_date = $due_dt->clone();
239     # get issuingrules (fines part will be used)
240     my $itemtype = $item->{itemtype} || $item->{itype};
241     my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule({ categorycode => $bortype, itemtype => $itemtype, branchcode => $branchcode });
242
243     $itemtype = Koha::ItemTypes->find($itemtype);
244
245     return unless $issuing_rule; # If not rule exist, there is no fine
246
247     my $fine_unit = $issuing_rule->lengthunit || 'days';
248
249     my $chargeable_units = get_chargeable_units($fine_unit, $start_date, $end_date, $branchcode);
250     my $units_minus_grace = $chargeable_units - $issuing_rule->firstremind;
251     my $amount = 0;
252     if ( $issuing_rule->chargeperiod && ( $units_minus_grace > 0 ) ) {
253         my $units = C4::Context->preference('FinesIncludeGracePeriod') ? $chargeable_units : $units_minus_grace;
254         my $charge_periods = $units / $issuing_rule->chargeperiod;
255         # If chargeperiod_charge_at = 1, we charge a fine at the start of each charge period
256         # if chargeperiod_charge_at = 0, we charge at the end of each charge period
257         $charge_periods = $issuing_rule->chargeperiod_charge_at == 1 ? ceil($charge_periods) : floor($charge_periods);
258         $amount = $charge_periods * $issuing_rule->fine;
259     } # else { # a zero (or null) chargeperiod or negative units_minus_grace value means no charge. }
260
261     $amount = $issuing_rule->overduefinescap if $issuing_rule->overduefinescap && $amount > $issuing_rule->overduefinescap;
262
263     # This must be moved to Koha::Item (see also similar code in C4::Accounts::chargelostitem
264     $item->{replacementprice} ||= $itemtype->defaultreplacecost
265       if $itemtype
266       && $item->{replacementprice} == 0
267       && C4::Context->preference("useDefaultReplacementCost");
268
269     $amount = $item->{replacementprice} if ( $issuing_rule->cap_fine_to_replacement_price && $item->{replacementprice} && $amount > $item->{replacementprice} );
270
271     $debug and warn sprintf("CalcFine returning (%s, %s, %s)", $amount, $units_minus_grace, $chargeable_units);
272     return ($amount, $units_minus_grace, $chargeable_units);
273 }
274
275
276 =head2 get_chargeable_units
277
278     get_chargeable_units($unit, $start_date_ $end_date, $branchcode);
279
280 return integer value of units between C<$start_date> and C<$end_date>, factoring in holidays for C<$branchcode>.
281
282 C<$unit> is 'days' or 'hours' (default is 'days').
283
284 C<$start_date> and C<$end_date> are the two DateTimes to get the number of units between.
285
286 C<$branchcode> is the branch whose calendar to use for finding holidays.
287
288 =cut
289
290 sub get_chargeable_units {
291     my ($unit, $date_due, $date_returned, $branchcode) = @_;
292
293     # If the due date is later than the return date
294     return 0 unless ( $date_returned > $date_due );
295
296     my $charge_units = 0;
297     my $charge_duration;
298     if ($unit eq 'hours') {
299         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
300             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
301             $charge_duration = $calendar->hours_between( $date_due, $date_returned );
302         } else {
303             $charge_duration = $date_returned->delta_ms( $date_due );
304         }
305         if($charge_duration->in_units('hours') == 0 && $charge_duration->in_units('seconds') > 0){
306             return 1;
307         }
308         return $charge_duration->in_units('hours');
309     }
310     else { # days
311         if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
312             my $calendar = Koha::Calendar->new( branchcode => $branchcode );
313             $charge_duration = $calendar->days_between( $date_due, $date_returned );
314         } else {
315             $charge_duration = $date_returned->delta_days( $date_due );
316         }
317         return $charge_duration->in_units('days');
318     }
319 }
320
321
322 =head2 GetSpecialHolidays
323
324     &GetSpecialHolidays($date_dues,$itemnumber);
325
326 return number of special days  between date of the day and date due
327
328 C<$date_dues> is the envisaged date of book return.
329
330 C<$itemnumber> is the book's item number.
331
332 =cut
333
334 sub GetSpecialHolidays {
335     my ( $date_dues, $itemnumber ) = @_;
336
337     # calcul the today date
338     my $today = join "-", &Today();
339
340     # return the holdingbranch
341     my $iteminfo = GetIssuesIteminfo($itemnumber);
342
343     # use sql request to find all date between date_due and today
344     my $dbh = C4::Context->dbh;
345     my $query =
346       qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') as date
347 FROM `special_holidays`
348 WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
349 AND   DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
350 AND branchcode=?
351 |;
352     my @result = GetWdayFromItemnumber($itemnumber);
353     my @result_date;
354     my $wday;
355     my $dateinsec;
356     my $sth = $dbh->prepare($query);
357     $sth->execute( $date_dues, $today, $iteminfo->{'branchcode'} )
358       ;    # FIXME: just use NOW() in SQL instead of passing in $today
359
360     while ( my $special_date = $sth->fetchrow_hashref ) {
361         push( @result_date, $special_date );
362     }
363
364     my $specialdaycount = scalar(@result_date);
365
366     for ( my $i = 0 ; $i < scalar(@result_date) ; $i++ ) {
367         $dateinsec = UnixDate( $result_date[$i]->{'date'}, "%o" );
368         ( undef, undef, undef, undef, undef, undef, $wday, undef, undef ) =
369           localtime($dateinsec);
370         for ( my $j = 0 ; $j < scalar(@result) ; $j++ ) {
371             if ( $wday == ( $result[$j]->{'weekday'} ) ) {
372                 $specialdaycount--;
373             }
374         }
375     }
376
377     return $specialdaycount;
378 }
379
380 =head2 GetRepeatableHolidays
381
382     &GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
383
384 return number of day closed between date of the day and date due
385
386 C<$date_dues> is the envisaged date of book return.
387
388 C<$itemnumber> is item number.
389
390 C<$difference> numbers of between day date of the day and date due
391
392 =cut
393
394 sub GetRepeatableHolidays {
395     my ( $date_dues, $itemnumber, $difference ) = @_;
396     my $dateinsec = UnixDate( $date_dues, "%o" );
397     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
398       localtime($dateinsec);
399     my @result = GetWdayFromItemnumber($itemnumber);
400     my @dayclosedcount;
401     my $j;
402
403     for ( my $i = 0 ; $i < scalar(@result) ; $i++ ) {
404         my $k = $wday;
405
406         for ( $j = 0 ; $j < $difference ; $j++ ) {
407             if ( $result[$i]->{'weekday'} == $k ) {
408                 push( @dayclosedcount, $k );
409             }
410             $k++;
411             ( $k = 0 ) if ( $k eq 7 );
412         }
413     }
414     return scalar(@dayclosedcount);
415 }
416
417
418 =head2 GetWayFromItemnumber
419
420     &Getwdayfromitemnumber($itemnumber);
421
422 return the different week day from repeatable_holidays table
423
424 C<$itemnumber> is  item number.
425
426 =cut
427
428 sub GetWdayFromItemnumber {
429     my ($itemnumber) = @_;
430     my $iteminfo = GetIssuesIteminfo($itemnumber);
431     my @result;
432     my $query = qq|SELECT weekday
433     FROM repeatable_holidays
434     WHERE branchcode=?
435 |;
436     my $sth = C4::Context->dbh->prepare($query);
437
438     $sth->execute( $iteminfo->{'branchcode'} );
439     while ( my $weekday = $sth->fetchrow_hashref ) {
440         push( @result, $weekday );
441     }
442     return @result;
443 }
444
445
446 =head2 GetIssuesIteminfo
447
448     &GetIssuesIteminfo($itemnumber);
449
450 return all data from issues about item
451
452 C<$itemnumber> is  item number.
453
454 =cut
455
456 sub GetIssuesIteminfo {
457     my ($itemnumber) = @_;
458     my $dbh          = C4::Context->dbh;
459     my $query        = qq|SELECT *
460     FROM issues
461     WHERE itemnumber=?
462     |;
463     my $sth = $dbh->prepare($query);
464     $sth->execute($itemnumber);
465     my ($issuesinfo) = $sth->fetchrow_hashref;
466     return $issuesinfo;
467 }
468
469
470 =head2 UpdateFine
471
472     &UpdateFine(
473         {
474             issue_id       => $issue_id,
475             itemnumber     => $itemnumber,
476             borrowernumber => $borrowernumber,
477             amount         => $amount,
478             due            => $date_due
479         }
480     );
481
482 (Note: the following is mostly conjecture and guesswork.)
483
484 Updates the fine owed on an overdue book.
485
486 C<$itemnumber> is the book's item number.
487
488 C<$borrowernumber> is the borrower number of the patron who currently
489 has the book on loan.
490
491 C<$amount> is the current amount owed by the patron.
492
493 C<$due> is the due date formatted to the currently specified date format
494
495 C<&UpdateFine> looks up the amount currently owed on the given item
496 and sets it to C<$amount>, creating, if necessary, a new entry in the
497 accountlines table of the Koha database.
498
499 =cut
500
501 #
502 # Question: Why should the caller have to
503 # specify both the item number and the borrower number? A book can't
504 # be on loan to two different people, so the item number should be
505 # sufficient.
506 #
507 # Possible Answer: You might update a fine for a damaged item, *after* it is returned.
508 #
509 sub UpdateFine {
510     my ($params) = @_;
511
512     my $issue_id       = $params->{issue_id};
513     my $itemnum        = $params->{itemnumber};
514     my $borrowernumber = $params->{borrowernumber};
515     my $amount         = $params->{amount};
516     my $due            = $params->{due};
517
518     $debug and warn "UpdateFine({ itemnumber => $itemnum, borrowernumber => $borrowernumber, due => $due, issue_id => $issue_id})";
519
520     unless ( $issue_id ) {
521         carp("No issue_id passed in!");
522         return;
523     }
524
525     my $dbh = C4::Context->dbh;
526     my $overdues = Koha::Account::Lines->search(
527         {
528             borrowernumber    => $borrowernumber,
529             debit_type_code   => 'OVERDUE',
530             amountoutstanding => { '<>' => 0 }
531         }
532     );
533
534     my $accountline;
535     my $total_amount_other = 0.00;
536     my $due_qr = qr/$due/;
537     # Cycle through the fines and
538     # - find line that relates to the requested $itemnum
539     # - accumulate fines for other items
540     # so we can update $itemnum fine taking in account fine caps
541     while (my $overdue = $overdues->next) {
542         if ( $overdue->issue_id == $issue_id && $overdue->status eq 'UNRETURNED' ) {
543             if ($accountline) {
544                 $debug and warn "Not a unique accountlines record for issue_id $issue_id";
545                 #FIXME Should we still count this one in total_amount ??
546             }
547             else {
548                 $accountline = $overdue;
549                 next;
550             }
551         }
552         $total_amount_other += $overdue->amountoutstanding;
553     }
554
555     if (my $maxfine = C4::Context->preference('MaxFine')) {
556         if ($total_amount_other + $amount > $maxfine) {
557             my $new_amount = $maxfine - $total_amount_other;
558             return if $new_amount <= 0.00;
559             $debug and warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached";
560             $amount = $new_amount;
561         }
562     }
563
564
565     if ( $accountline ) {
566         if ( $accountline->amount != $amount ) {
567             $accountline->adjust(
568                 {
569                     amount    => $amount,
570                     type      => 'overdue_update',
571                     interface => C4::Context->interface
572                 }
573             );
574         }
575     } else {
576         if ( $amount ) { # Don't add new fines with an amount of 0
577             my $sth4 = $dbh->prepare(
578                 "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?"
579             );
580             $sth4->execute($itemnum);
581             my $title = $sth4->fetchrow;
582             my $desc = "$title $due";
583
584             my $account = Koha::Account->new({ patron_id => $borrowernumber });
585             $accountline = $account->add_debit(
586                 {
587                     amount      => $amount,
588                     description => $desc,
589                     note        => undef,
590                     user_id     => undef,
591                     interface   => C4::Context->interface,
592                     library_id  => undef, #FIXME: Should we grab the checkout or circ-control branch here perhaps?
593                     type        => 'OVERDUE',
594                     item_id     => $itemnum,
595                     issue_id    => $issue_id,
596                 }
597             );
598         }
599     }
600 }
601
602 =head2 BorType
603
604     $borrower = &BorType($borrowernumber);
605
606 Looks up a patron by borrower number.
607
608 C<$borrower> is a reference-to-hash whose keys are all of the fields
609 from the borrowers and categories tables of the Koha database. Thus,
610 C<$borrower> contains all information about both the borrower and
611 category they belong to.
612
613 =cut
614
615 sub BorType {
616     my ($borrowernumber) = @_;
617     my $dbh              = C4::Context->dbh;
618     my $sth              = $dbh->prepare(
619         "SELECT * from borrowers
620       LEFT JOIN categories ON borrowers.categorycode=categories.categorycode 
621       WHERE borrowernumber=?"
622     );
623     $sth->execute($borrowernumber);
624     return $sth->fetchrow_hashref;
625 }
626
627 =head2 GetFine
628
629     $data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
630
631 return the total of fine
632
633 C<$itemnum> is item number
634
635 C<$borrowernumber> is the borrowernumber
636
637 =cut 
638
639 sub GetFine {
640     my ( $itemnum, $borrowernumber ) = @_;
641     my $dbh   = C4::Context->dbh();
642     my $query = q|SELECT sum(amountoutstanding) as fineamount FROM accountlines
643     WHERE debit_type_code = 'OVERDUE'
644   AND amountoutstanding > 0 AND borrowernumber=?|;
645     my @query_param;
646     push @query_param, $borrowernumber;
647     if (defined $itemnum )
648     {
649         $query .= " AND itemnumber=?";
650         push @query_param, $itemnum;
651     }
652     my $sth = $dbh->prepare($query);
653     $sth->execute( @query_param );
654     my $fine = $sth->fetchrow_hashref();
655     if ($fine->{fineamount}) {
656         return $fine->{fineamount};
657     }
658     return 0;
659 }
660
661 =head2 GetBranchcodesWithOverdueRules
662
663     my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules()
664
665 returns a list of branch codes for branches with overdue rules defined.
666
667 =cut
668
669 sub GetBranchcodesWithOverdueRules {
670     my $dbh               = C4::Context->dbh;
671     my $branchcodes = $dbh->selectcol_arrayref(q|
672         SELECT DISTINCT(branchcode)
673         FROM overduerules
674         WHERE delay1 IS NOT NULL
675         ORDER BY branchcode
676     |);
677     if ( $branchcodes->[0] eq '' ) {
678         # If a default rule exists, all branches should be returned
679         return map { $_->branchcode } Koha::Libraries->search({}, { order_by => 'branchname' });
680     }
681     return @$branchcodes;
682 }
683
684 =head2 GetOverduesForBranch
685
686 Sql request for display all information for branchoverdues.pl
687 2 possibilities : with or without location .
688 display is filtered by branch
689
690 FIXME: This function should be renamed.
691
692 =cut
693
694 sub GetOverduesForBranch {
695     my ( $branch, $location) = @_;
696         my $itype_link =  (C4::Context->preference('item-level_itypes')) ?  " items.itype " :  " biblioitems.itemtype ";
697     my $dbh = C4::Context->dbh;
698     my $select = "
699     SELECT
700             borrowers.cardnumber,
701             borrowers.borrowernumber,
702             borrowers.surname,
703             borrowers.firstname,
704             borrowers.phone,
705             borrowers.email,
706                biblio.title,
707                biblio.subtitle,
708                biblio.medium,
709                biblio.part_number,
710                biblio.part_name,
711                biblio.author,
712                biblio.biblionumber,
713                issues.date_due,
714                issues.returndate,
715                issues.branchcode,
716              branches.branchname,
717                 items.barcode,
718                 items.homebranch,
719                 items.itemcallnumber,
720                 items.location,
721                 items.itemnumber,
722             itemtypes.description,
723          accountlines.amountoutstanding
724     FROM  accountlines
725     LEFT JOIN issues      ON    issues.itemnumber     = accountlines.itemnumber
726                           AND   issues.borrowernumber = accountlines.borrowernumber
727     LEFT JOIN borrowers   ON borrowers.borrowernumber = accountlines.borrowernumber
728     LEFT JOIN items       ON     items.itemnumber     = issues.itemnumber
729     LEFT JOIN biblio      ON      biblio.biblionumber =  items.biblionumber
730     LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
731     LEFT JOIN itemtypes   ON itemtypes.itemtype       = $itype_link
732     LEFT JOIN branches    ON  branches.branchcode     = issues.branchcode
733     WHERE (accountlines.amountoutstanding  != '0.000000')
734       AND (accountlines.debit_type_code     = 'OVERDUE' )
735       AND (accountlines.status              = 'UNRETURNED' )
736       AND (issues.branchcode =  ?   )
737       AND (issues.date_due  < NOW())
738     ";
739     if ($location) {
740         my $q = "$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname";
741         return @{ $dbh->selectall_arrayref($q, { Slice => {} }, $branch, $location ) };
742     } else {
743         my $q = "$select ORDER BY borrowers.surname, borrowers.firstname";
744         return @{ $dbh->selectall_arrayref($q, { Slice => {} }, $branch ) };
745     }
746 }
747
748 =head2 GetOverdueMessageTransportTypes
749
750     my $message_transport_types = GetOverdueMessageTransportTypes( $branchcode, $categorycode, $letternumber);
751
752     return a arrayref with all message_transport_type for given branchcode, categorycode and letternumber(1,2 or 3)
753
754 =cut
755
756 sub GetOverdueMessageTransportTypes {
757     my ( $branchcode, $categorycode, $letternumber ) = @_;
758     return unless $categorycode and $letternumber;
759     my $dbh = C4::Context->dbh;
760     my $sth = $dbh->prepare("
761         SELECT message_transport_type
762         FROM overduerules odr LEFT JOIN overduerules_transport_types ott USING (overduerules_id)
763         WHERE branchcode = ?
764           AND categorycode = ?
765           AND letternumber = ?
766     ");
767     $sth->execute( $branchcode, $categorycode, $letternumber );
768     my @mtts;
769     while ( my $mtt = $sth->fetchrow ) {
770         push @mtts, $mtt;
771     }
772
773     # Put 'print' in first if exists
774     # It avoid to sent a print notice with an email or sms template is no email or sms is defined
775     @mtts = uniq( 'print', @mtts )
776         if grep {/^print$/} @mtts;
777
778     return \@mtts;
779 }
780
781 =head2 parse_overdues_letter
782
783 parses the letter template, replacing the placeholders with data
784 specific to this patron, biblio, or item for overdues
785
786 named parameters:
787   letter - required hashref
788   borrowernumber - required integer
789   substitute - optional hashref of other key/value pairs that should
790     be substituted in the letter content
791
792 returns the C<letter> hashref, with the content updated to reflect the
793 substituted keys and values.
794
795 =cut
796
797 sub parse_overdues_letter {
798     my $params = shift;
799     foreach my $required (qw( letter_code borrowernumber )) {
800         return unless ( exists $params->{$required} && $params->{$required} );
801     }
802
803     my $patron = Koha::Patrons->find( $params->{borrowernumber} );
804
805     my $substitute = $params->{'substitute'} || {};
806
807     my %tables = ( 'borrowers' => $params->{'borrowernumber'} );
808     if ( my $p = $params->{'branchcode'} ) {
809         $tables{'branches'} = $p;
810     }
811
812     my $active_currency = Koha::Acquisition::Currencies->get_active;
813
814     my $currency_format;
815     $currency_format = $active_currency->currency if defined($active_currency);
816
817     my @item_tables;
818     if ( my $i = $params->{'items'} ) {
819         foreach my $item (@$i) {
820             my $fine = GetFine($item->{'itemnumber'}, $params->{'borrowernumber'});
821             $item->{'fine'} = currency_format($currency_format, "$fine", FMT_SYMBOL);
822             # if active currency isn't correct ISO code fallback to sprintf
823             $item->{'fine'} = sprintf('%.2f', $fine) unless $item->{'fine'};
824
825             push @item_tables, {
826                 'biblio' => $item->{'biblionumber'},
827                 'biblioitems' => $item->{'biblionumber'},
828                 'items' => $item,
829                 'issues' => $item->{'itemnumber'},
830             };
831         }
832     }
833
834     return C4::Letters::GetPreparedLetter (
835         module => 'circulation',
836         letter_code => $params->{'letter_code'},
837         branchcode => $params->{'branchcode'},
838         lang => $patron->lang,
839         tables => \%tables,
840         loops => {
841             overdues => [ map { $_->{items}->{itemnumber} } @item_tables ],
842         },
843         substitute => $substitute,
844         repeat => { item => \@item_tables },
845         message_transport_type => $params->{message_transport_type},
846     );
847 }
848
849 1;
850 __END__
851
852 =head1 AUTHOR
853
854 Koha Development Team <http://koha-community.org/>
855
856 =cut