← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:47 2015

Filename/mnt/catalyst/koha/C4/Overdues.pm
StatementsExecuted 26 statements in 5.95ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11113.2ms475msC4::Overdues::::BEGIN@26C4::Overdues::BEGIN@26
1115.03ms97.0msC4::Overdues::::BEGIN@25C4::Overdues::BEGIN@25
111462µs474µsC4::Overdues::::BEGIN@22C4::Overdues::BEGIN@22
11114µs14µsC4::Overdues::::BEGIN@34C4::Overdues::BEGIN@34
11110µs12µsC4::Overdues::::BEGIN@27C4::Overdues::BEGIN@27
1118µs38µsC4::Overdues::::BEGIN@29C4::Overdues::BEGIN@29
1118µs117µsC4::Overdues::::BEGIN@28C4::Overdues::BEGIN@28
1117µs32µsC4::Overdues::::BEGIN@24C4::Overdues::BEGIN@24
1117µs57µsC4::Overdues::::BEGIN@30C4::Overdues::BEGIN@30
1116µs40µsC4::Overdues::::BEGIN@32C4::Overdues::BEGIN@32
0000s0sC4::Overdues::::AddNotifyLineC4::Overdues::AddNotifyLine
0000s0sC4::Overdues::::AmountNotifyC4::Overdues::AmountNotify
0000s0sC4::Overdues::::BorTypeC4::Overdues::BorType
0000s0sC4::Overdues::::CalcFineC4::Overdues::CalcFine
0000s0sC4::Overdues::::CheckItemNotifyC4::Overdues::CheckItemNotify
0000s0sC4::Overdues::::GetBranchcodesWithOverdueRulesC4::Overdues::GetBranchcodesWithOverdueRules
0000s0sC4::Overdues::::GetFineC4::Overdues::GetFine
0000s0sC4::Overdues::::GetIssuesIteminfoC4::Overdues::GetIssuesIteminfo
0000s0sC4::Overdues::::GetItemsC4::Overdues::GetItems
0000s0sC4::Overdues::::GetOverduesForBranchC4::Overdues::GetOverduesForBranch
0000s0sC4::Overdues::::GetRepeatableHolidaysC4::Overdues::GetRepeatableHolidays
0000s0sC4::Overdues::::GetSpecialHolidaysC4::Overdues::GetSpecialHolidays
0000s0sC4::Overdues::::GetWdayFromItemnumberC4::Overdues::GetWdayFromItemnumber
0000s0sC4::Overdues::::GetoverduesC4::Overdues::Getoverdues
0000s0sC4::Overdues::::NumberNotifyIdC4::Overdues::NumberNotifyId
0000s0sC4::Overdues::::RemoveNotifyLineC4::Overdues::RemoveNotifyLine
0000s0sC4::Overdues::::UpdateFineC4::Overdues::UpdateFine
0000s0sC4::Overdues::::_get_chargeable_unitsC4::Overdues::_get_chargeable_units
0000s0sC4::Overdues::::checkoverduesC4::Overdues::checkoverdues
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package C4::Overdues;
2
3
4# Copyright 2000-2002 Katipo Communications
5# copyright 2010 BibLibre
6#
7# This file is part of Koha.
8#
9# Koha is free software; you can redistribute it and/or modify it under the
10# terms of the GNU General Public License as published by the Free Software
11# Foundation; either version 2 of the License, or (at your option) any later
12# version.
13#
14# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License along
19# with Koha; if not, write to the Free Software Foundation, Inc.,
20# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21
222229µs2486µs
# spent 474µs (462+12) within C4::Overdues::BEGIN@22 which was called: # once (462µs+12µs) by C4::Members::BEGIN@30 at line 22
use strict;
# spent 474µs making 1 call to C4::Overdues::BEGIN@22 # spent 12µs making 1 call to strict::import
23#use warnings; FIXME - Bug 2505
24230µs257µs
# spent 32µs (7+25) within C4::Overdues::BEGIN@24 which was called: # once (7µs+25µs) by C4::Members::BEGIN@30 at line 24
use Date::Calc qw/Today Date_to_Days/;
# spent 32µs making 1 call to C4::Overdues::BEGIN@24 # spent 25µs making 1 call to Exporter::import
252742µs297.1ms
# spent 97.0ms (5.03+92.0) within C4::Overdues::BEGIN@25 which was called: # once (5.03ms+92.0ms) by C4::Members::BEGIN@30 at line 25
use Date::Manip qw/UnixDate/;
# spent 97.0ms making 1 call to C4::Overdues::BEGIN@25 # spent 61µs making 1 call to Exporter::import
2622.28ms2475ms
# spent 475ms (13.2+462) within C4::Overdues::BEGIN@26 which was called: # once (13.2ms+462ms) by C4::Members::BEGIN@30 at line 26
use C4::Circulation;
# spent 475ms making 1 call to C4::Overdues::BEGIN@26 # spent 269µs making 1 call to Exporter::import
27221µs214µs
# spent 12µs (10+2) within C4::Overdues::BEGIN@27 which was called: # once (10µs+2µs) by C4::Members::BEGIN@30 at line 27
use C4::Context;
# spent 12µs making 1 call to C4::Overdues::BEGIN@27 # spent 2µs making 1 call to C4::Context::import
28224µs2227µs
# spent 117µs (8+110) within C4::Overdues::BEGIN@28 which was called: # once (8µs+110µs) by C4::Members::BEGIN@30 at line 28
use C4::Accounts;
# spent 117µs making 1 call to C4::Overdues::BEGIN@28 # spent 110µs making 1 call to Exporter::import
29221µs269µs
# spent 38µs (8+31) within C4::Overdues::BEGIN@29 which was called: # once (8µs+31µs) by C4::Members::BEGIN@30 at line 29
use C4::Log; # logaction
# spent 38µs making 1 call to C4::Overdues::BEGIN@29 # spent 31µs making 1 call to Exporter::import
30226µs2107µs
# spent 57µs (7+50) within C4::Overdues::BEGIN@30 which was called: # once (7µs+50µs) by C4::Members::BEGIN@30 at line 30
use C4::Debug;
# spent 57µs making 1 call to C4::Overdues::BEGIN@30 # spent 50µs making 1 call to Exporter::import
31
32271µs274µs
# spent 40µs (6+34) within C4::Overdues::BEGIN@32 which was called: # once (6µs+34µs) by C4::Members::BEGIN@30 at line 32
use vars qw($VERSION @ISA @EXPORT);
# spent 40µs making 1 call to C4::Overdues::BEGIN@32 # spent 34µs making 1 call to vars::import
33
34
# spent 14µs within C4::Overdues::BEGIN@34 which was called: # once (14µs+0s) by C4::Members::BEGIN@30 at line 73
BEGIN {
35 # set the version for version checking
361800ns $VERSION = 3.07.00.049;
371600ns require Exporter;
3817µs @ISA = qw(Exporter);
39 # subs to rename (and maybe merge some...)
4012µs push @EXPORT, qw(
41 &CalcFine
42 &Getoverdues
43 &checkoverdues
44 &NumberNotifyId
45 &AmountNotify
46 &UpdateFine
47 &GetFine
48
49 &CheckItemNotify
50 &GetOverduesForBranch
51 &RemoveNotifyLine
52 &AddNotifyLine
53 );
54 # subs to remove
551200ns push @EXPORT, qw(
56 &BorType
57 );
58
59 # check that an equivalent don't exist already before moving
60
61 # subs to move to Circulation.pm
621200ns push @EXPORT, qw(
63 &GetIssuesIteminfo
64 );
65
66 # &GetIssuingRules - delete.
67 # use C4::Circulation::GetIssuingRule instead.
68
69 # subs to move to Biblio.pm
7013µs push @EXPORT, qw(
71 &GetItems
72 );
7312.49ms114µs}
# spent 14µs making 1 call to C4::Overdues::BEGIN@34
74
75=head1 NAME
76
77C4::Circulation::Fines - Koha module dealing with fines
78
79=head1 SYNOPSIS
80
81 use C4::Overdues;
82
83=head1 DESCRIPTION
84
85This module contains several functions for dealing with fines for
86overdue items. It is primarily used by the 'misc/fines2.pl' script.
87
88=head1 FUNCTIONS
89
90=head2 Getoverdues
91
92 $overdues = Getoverdues( { minimumdays => 1, maximumdays => 30 } );
93
94Returns the list of all overdue books, with their itemtype.
95
96C<$overdues> is a reference-to-array. Each element is a
97reference-to-hash whose keys are the fields of the issues table in the
98Koha database.
99
100=cut
101
102#'
103sub Getoverdues {
104 my $params = shift;
105 my $dbh = C4::Context->dbh;
106 my $statement;
107 if ( C4::Context->preference('item-level_itypes') ) {
108 $statement = "
109 SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode
110 FROM issues
111LEFT JOIN items USING (itemnumber)
112 WHERE date_due < NOW()
113";
114 } else {
115 $statement = "
116 SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode
117 FROM issues
118LEFT JOIN items USING (itemnumber)
119LEFT JOIN biblioitems USING (biblioitemnumber)
120 WHERE date_due < NOW()
121";
122 }
123
124 my @bind_parameters;
125 if ( exists $params->{'minimumdays'} and exists $params->{'maximumdays'} ) {
126 $statement .= ' AND TO_DAYS( NOW() )-TO_DAYS( date_due ) BETWEEN ? and ? ';
127 push @bind_parameters, $params->{'minimumdays'}, $params->{'maximumdays'};
128 } elsif ( exists $params->{'minimumdays'} ) {
129 $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) > ? ';
130 push @bind_parameters, $params->{'minimumdays'};
131 } elsif ( exists $params->{'maximumdays'} ) {
132 $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ? ';
133 push @bind_parameters, $params->{'maximumdays'};
134 }
135 $statement .= 'ORDER BY borrowernumber';
136 my $sth = $dbh->prepare( $statement );
137 $sth->execute( @bind_parameters );
138 return $sth->fetchall_arrayref({});
139}
140
141
142=head2 checkoverdues
143
144 ($count, $overdueitems) = checkoverdues($borrowernumber);
145
146Returns a count and a list of overdueitems for a given borrowernumber
147
148=cut
149
150sub checkoverdues {
151 my $borrowernumber = shift or return;
152 # don't select biblioitems.marc or biblioitems.marcxml... too slow on large systems
153 my $sth = C4::Context->dbh->prepare(
154 "SELECT biblio.*, items.*, issues.*,
155 biblioitems.volume,
156 biblioitems.number,
157 biblioitems.itemtype,
158 biblioitems.isbn,
159 biblioitems.issn,
160 biblioitems.publicationyear,
161 biblioitems.publishercode,
162 biblioitems.volumedate,
163 biblioitems.volumedesc,
164 biblioitems.collectiontitle,
165 biblioitems.collectionissn,
166 biblioitems.collectionvolume,
167 biblioitems.editionstatement,
168 biblioitems.editionresponsibility,
169 biblioitems.illus,
170 biblioitems.pages,
171 biblioitems.notes,
172 biblioitems.size,
173 biblioitems.place,
174 biblioitems.lccn,
175 biblioitems.url,
176 biblioitems.cn_source,
177 biblioitems.cn_class,
178 biblioitems.cn_item,
179 biblioitems.cn_suffix,
180 biblioitems.cn_sort,
181 biblioitems.totalissues
182 FROM issues
183 LEFT JOIN items ON issues.itemnumber = items.itemnumber
184 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
185 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
186 WHERE issues.borrowernumber = ?
187 AND issues.date_due < NOW()"
188 );
189 # FIXME: SELECT * across 4 tables? do we really need the marc AND marcxml blobs??
190 $sth->execute($borrowernumber);
191 my $results = $sth->fetchall_arrayref({});
192 return ( scalar(@$results), $results); # returning the count and the results is silly
193}
194
195=head2 CalcFine
196
197 ($amount, $chargename, $daycounttotal) = &CalcFine($item,
198 $categorycode, $branch,
199 $start_dt, $end_dt );
200
201Calculates the fine for a book.
202
203The issuingrules table in the Koha database is a fine matrix, listing
204the penalties for each type of patron for each type of item and each branch (e.g., the
205standard fine for books might be $0.50, but $1.50 for DVDs, or staff
206members might get a longer grace period between the first and second
207reminders that a book is overdue).
208
209
210C<$item> is an item object (hashref).
211
212C<$categorycode> is the category code (string) of the patron who currently has
213the book.
214
215C<$branchcode> is the library (string) whose issuingrules govern this transaction.
216
217C<$start_date> & C<$end_date> are DateTime objects
218defining the date range over which to determine the fine.
219
220Fines scripts should just supply the date range over which to calculate the fine.
221
222C<&CalcFine> returns four values:
223
224C<$amount> is the fine owed by the patron (see above).
225
226C<$chargename> is the chargename field from the applicable record in
227the categoryitem table, whatever that is.
228
229C<$unitcount> is the number of chargeable units (days between start and end dates, Calendar adjusted where needed,
230minus any applicable grace period, or hours)
231
232FIXME - What is chargename supposed to be ?
233
234FIXME: previously attempted to return C<$message> as a text message, either "First Notice", "Second Notice",
235or "Final Notice". But CalcFine never defined any value.
236
237=cut
238
239sub CalcFine {
240 my ( $item, $bortype, $branchcode, $due_dt, $end_date ) = @_;
241 my $start_date = $due_dt->clone();
242 # get issuingrules (fines part will be used)
243 my $itemtype = $item->{itemtype} || $item->{itype};
244 my $data = C4::Circulation::GetIssuingRule($bortype, $itemtype, $branchcode);
245 my $fine_unit = $data->{lengthunit};
246 $fine_unit ||= 'days';
247
248 my $chargeable_units = _get_chargeable_units($fine_unit, $start_date, $end_date, $branchcode);
249 my $units_minus_grace = $chargeable_units - $data->{firstremind};
250 my $amount = 0;
251 if ($data->{'chargeperiod'} && ($units_minus_grace > 0) ) {
252 if ( C4::Context->preference('FinesIncludeGracePeriod') ) {
253 $amount = int($chargeable_units / $data->{'chargeperiod'}) * $data->{'fine'};# TODO fine calc should be in cents
254 } else {
255 $amount = int($units_minus_grace / $data->{'chargeperiod'}) * $data->{'fine'};
256 }
257 } else {
258 # a zero (or null) chargeperiod or negative units_minus_grace value means no charge.
259 }
260 $amount = $data->{overduefinescap} if $data->{overduefinescap} && $amount > $data->{overduefinescap};
261 $debug and warn sprintf("CalcFine returning (%s, %s, %s, %s)", $amount, $data->{'chargename'}, $units_minus_grace, $chargeable_units);
262 return ($amount, $data->{'chargename'}, $units_minus_grace, $chargeable_units);
263 # FIXME: chargename is NEVER populated anywhere.
264}
265
266
267=head2 _get_chargeable_units
268
269 _get_chargeable_units($unit, $start_date_ $end_date, $branchcode);
270
271return integer value of units between C<$start_date> and C<$end_date>, factoring in holidays for C<$branchcode>.
272
273C<$unit> is 'days' or 'hours' (default is 'days').
274
275C<$start_date> and C<$end_date> are the two DateTimes to get the number of units between.
276
277C<$branchcode> is the branch whose calendar to use for finding holidays.
278
279=cut
280
281sub _get_chargeable_units {
282 my ($unit, $dt1, $dt2, $branchcode) = @_;
283 my $charge_units = 0;
284 my $charge_duration;
285 if ($unit eq 'hours') {
286 if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
287 my $calendar = Koha::Calendar->new( branchcode => $branchcode );
288 $charge_duration = $calendar->hours_between( $dt1, $dt2 );
289 } else {
290 $charge_duration = $dt2->delta_ms( $dt1 );
291 }
292 if($charge_duration->in_units('hours') == 0 && $charge_duration->in_units('seconds') > 0){
293 return 1;
294 }
295 return $charge_duration->in_units('hours');
296 }
297 else { # days
298 if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
299 my $calendar = Koha::Calendar->new( branchcode => $branchcode );
300 $charge_duration = $calendar->days_between( $dt1, $dt2 );
301 } else {
302 $charge_duration = $dt2->delta_days( $dt1 );
303 }
304 return $charge_duration->in_units('days');
305 }
306}
307
308
309=head2 GetSpecialHolidays
310
311 &GetSpecialHolidays($date_dues,$itemnumber);
312
313return number of special days between date of the day and date due
314
315C<$date_dues> is the envisaged date of book return.
316
317C<$itemnumber> is the book's item number.
318
319=cut
320
321sub GetSpecialHolidays {
322 my ( $date_dues, $itemnumber ) = @_;
323
324 # calcul the today date
325 my $today = join "-", &Today();
326
327 # return the holdingbranch
328 my $iteminfo = GetIssuesIteminfo($itemnumber);
329
330 # use sql request to find all date between date_due and today
331 my $dbh = C4::Context->dbh;
332 my $query =
333 qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') as date
334FROM `special_holidays`
335WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
336AND DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
337AND branchcode=?
338|;
339 my @result = GetWdayFromItemnumber($itemnumber);
340 my @result_date;
341 my $wday;
342 my $dateinsec;
343 my $sth = $dbh->prepare($query);
344 $sth->execute( $date_dues, $today, $iteminfo->{'branchcode'} )
345 ; # FIXME: just use NOW() in SQL instead of passing in $today
346
347 while ( my $special_date = $sth->fetchrow_hashref ) {
348 push( @result_date, $special_date );
349 }
350
351 my $specialdaycount = scalar(@result_date);
352
353 for ( my $i = 0 ; $i < scalar(@result_date) ; $i++ ) {
354 $dateinsec = UnixDate( $result_date[$i]->{'date'}, "%o" );
355 ( undef, undef, undef, undef, undef, undef, $wday, undef, undef ) =
356 localtime($dateinsec);
357 for ( my $j = 0 ; $j < scalar(@result) ; $j++ ) {
358 if ( $wday == ( $result[$j]->{'weekday'} ) ) {
359 $specialdaycount--;
360 }
361 }
362 }
363
364 return $specialdaycount;
365}
366
367=head2 GetRepeatableHolidays
368
369 &GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
370
371return number of day closed between date of the day and date due
372
373C<$date_dues> is the envisaged date of book return.
374
375C<$itemnumber> is item number.
376
377C<$difference> numbers of between day date of the day and date due
378
379=cut
380
381sub GetRepeatableHolidays {
382 my ( $date_dues, $itemnumber, $difference ) = @_;
383 my $dateinsec = UnixDate( $date_dues, "%o" );
384 my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
385 localtime($dateinsec);
386 my @result = GetWdayFromItemnumber($itemnumber);
387 my @dayclosedcount;
388 my $j;
389
390 for ( my $i = 0 ; $i < scalar(@result) ; $i++ ) {
391 my $k = $wday;
392
393 for ( $j = 0 ; $j < $difference ; $j++ ) {
394 if ( $result[$i]->{'weekday'} == $k ) {
395 push( @dayclosedcount, $k );
396 }
397 $k++;
398 ( $k = 0 ) if ( $k eq 7 );
399 }
400 }
401 return scalar(@dayclosedcount);
402}
403
404
405=head2 GetWayFromItemnumber
406
407 &Getwdayfromitemnumber($itemnumber);
408
409return the different week day from repeatable_holidays table
410
411C<$itemnumber> is item number.
412
413=cut
414
415sub GetWdayFromItemnumber {
416 my ($itemnumber) = @_;
417 my $iteminfo = GetIssuesIteminfo($itemnumber);
418 my @result;
419 my $query = qq|SELECT weekday
420 FROM repeatable_holidays
421 WHERE branchcode=?
422|;
423 my $sth = C4::Context->dbh->prepare($query);
424
425 $sth->execute( $iteminfo->{'branchcode'} );
426 while ( my $weekday = $sth->fetchrow_hashref ) {
427 push( @result, $weekday );
428 }
429 return @result;
430}
431
432
433=head2 GetIssuesIteminfo
434
435 &GetIssuesIteminfo($itemnumber);
436
437return all data from issues about item
438
439C<$itemnumber> is item number.
440
441=cut
442
443sub GetIssuesIteminfo {
444 my ($itemnumber) = @_;
445 my $dbh = C4::Context->dbh;
446 my $query = qq|SELECT *
447 FROM issues
448 WHERE itemnumber=?
449 |;
450 my $sth = $dbh->prepare($query);
451 $sth->execute($itemnumber);
452 my ($issuesinfo) = $sth->fetchrow_hashref;
453 return $issuesinfo;
454}
455
456
457=head2 UpdateFine
458
459 &UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description);
460
461(Note: the following is mostly conjecture and guesswork.)
462
463Updates the fine owed on an overdue book.
464
465C<$itemnumber> is the book's item number.
466
467C<$borrowernumber> is the borrower number of the patron who currently
468has the book on loan.
469
470C<$amount> is the current amount owed by the patron.
471
472C<$type> will be used in the description of the fine.
473
474C<$description> is a string that must be present in the description of
475the fine. I think this is expected to be a date in DD/MM/YYYY format.
476
477C<&UpdateFine> looks up the amount currently owed on the given item
478and sets it to C<$amount>, creating, if necessary, a new entry in the
479accountlines table of the Koha database.
480
481=cut
482
483#
484# Question: Why should the caller have to
485# specify both the item number and the borrower number? A book can't
486# be on loan to two different people, so the item number should be
487# sufficient.
488#
489# Possible Answer: You might update a fine for a damaged item, *after* it is returned.
490#
491sub UpdateFine {
492 my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_;
493 $debug and warn "UpdateFine($itemnum, $borrowernumber, $amount, " . ($type||'""') . ", $due) called";
494 my $dbh = C4::Context->dbh;
495 # FIXME - What exactly is this query supposed to do? It looks up an
496 # entry in accountlines that matches the given item and borrower
497 # numbers, where the description contains $due, and where the
498 # account type has one of several values, but what does this _mean_?
499 # Does it look up existing fines for this item?
500 # FIXME - What are these various account types? ("FU", "O", "F", "M")
501 # "L" is LOST item
502 # "A" is Account Management Fee
503 # "N" is New Card
504 # "M" is Sundry
505 # "O" is Overdue ??
506 # "F" is Fine ??
507 # "FU" is Fine UPDATE??
508 # "Pay" is Payment
509 # "REF" is Cash Refund
510 my $sth = $dbh->prepare(
511 "SELECT * FROM accountlines
512 WHERE borrowernumber=?
513 AND accounttype IN ('FU','O','F','M')"
514 );
515 $sth->execute( $borrowernumber );
516 my $data;
517 my $total_amount_other = 0.00;
518 my $due_qr = qr/$due/;
519 # Cycle through the fines and
520 # - find line that relates to the requested $itemnum
521 # - accumulate fines for other items
522 # so we can update $itemnum fine taking in account fine caps
523 while (my $rec = $sth->fetchrow_hashref) {
524 if ($rec->{itemnumber} == $itemnum && $rec->{description} =~ /$due_qr/) {
525 if ($data) {
526 warn "Not a unique accountlines record for item $itemnum borrower $borrowernumber";
527 } else {
528 $data = $rec;
529 next;
530 }
531 }
532 $total_amount_other += $rec->{'amountoutstanding'};
533 }
534
535 if (my $maxfine = C4::Context->preference('MaxFine')) {
536 if ($total_amount_other + $amount > $maxfine) {
537 my $new_amount = $maxfine - $total_amount_other;
538 return if $new_amount <= 0.00;
539 warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached";
540 $amount = $new_amount;
541 }
542 }
543
544 if ( $data ) {
545
546 # we're updating an existing fine. Only modify if amount changed
547 # Note that in the current implementation, you cannot pay against an accruing fine
548 # (i.e. , of accounttype 'FU'). Doing so will break accrual.
549 if ( $data->{'amount'} != $amount ) {
550 my $diff = $amount - $data->{'amount'};
551 #3341: diff could be positive or negative!
552 my $out = $data->{'amountoutstanding'} + $diff;
553 my $query = "
554 UPDATE accountlines
555 SET date=now(), amount=?, amountoutstanding=?,
556 lastincrement=?, accounttype='FU'
557 WHERE borrowernumber=?
558 AND itemnumber=?
559 AND accounttype IN ('FU','O')
560 AND description LIKE ?
561 LIMIT 1 ";
562 my $sth2 = $dbh->prepare($query);
563 # FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!!
564 # LIMIT 1 added to prevent multiple affected lines
565 # FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline.
566 # But actually, we should just have a regular autoincrementing PK and forget accountline,
567 # including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops).
568 # FIXME: Why only 2 account types here?
569 $debug and print STDERR "UpdateFine query: $query\n" .
570 "w/ args: $amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, \"\%$due\%\"\n";
571 $sth2->execute($amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, "%$due%");
572 } else {
573 # print "no update needed $data->{'amount'}"
574 }
575 } else {
576 my $sth4 = $dbh->prepare(
577 "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?"
578 );
579 $sth4->execute($itemnum);
580 my $title = $sth4->fetchrow;
581
582# # print "not in account";
583# my $sth3 = $dbh->prepare("Select max(accountno) from accountlines");
584# $sth3->execute;
585#
586# # FIXME - Make $accountno a scalar.
587# my @accountno = $sth3->fetchrow_array;
588# $sth3->finish;
589# $accountno[0]++;
590# begin transaction
591 my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
592 my $desc = ($type ? "$type " : '') . "$title $due"; # FIXEDME, avoid whitespace prefix on empty $type
593 my $query = "INSERT INTO accountlines
594 (borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno)
595 VALUES (?,?,now(),?,?,'FU',?,?,?)";
596 my $sth2 = $dbh->prepare($query);
597 $debug and print STDERR "UpdateFine query: $query\nw/ args: $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno\n";
598 $sth2->execute($borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno);
599 }
600 # logging action
601 &logaction(
602 "FINES",
603 $type,
604 $borrowernumber,
605 "due=".$due." amount=".$amount." itemnumber=".$itemnum
606 ) if C4::Context->preference("FinesLog");
607}
608
609=head2 BorType
610
611 $borrower = &BorType($borrowernumber);
612
613Looks up a patron by borrower number.
614
615C<$borrower> is a reference-to-hash whose keys are all of the fields
616from the borrowers and categories tables of the Koha database. Thus,
617C<$borrower> contains all information about both the borrower and
618category he or she belongs to.
619
620=cut
621
622sub BorType {
623 my ($borrowernumber) = @_;
624 my $dbh = C4::Context->dbh;
625 my $sth = $dbh->prepare(
626 "SELECT * from borrowers
627 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
628 WHERE borrowernumber=?"
629 );
630 $sth->execute($borrowernumber);
631 return $sth->fetchrow_hashref;
632}
633
634=head2 GetFine
635
636 $data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
637
638return the total of fine
639
640C<$itemnum> is item number
641
642C<$borrowernumber> is the borrowernumber
643
644=cut
645
646sub GetFine {
647 my ( $itemnum, $borrowernumber ) = @_;
648 my $dbh = C4::Context->dbh();
649 my $query = q|SELECT sum(amountoutstanding) as fineamount FROM accountlines
650 where accounttype like 'F%'
651 AND amountoutstanding > 0 AND itemnumber = ? AND borrowernumber=?|;
652 my $sth = $dbh->prepare($query);
653 $sth->execute( $itemnum, $borrowernumber );
654 my $fine = $sth->fetchrow_hashref();
655 if ($fine->{fineamount}) {
656 return $fine->{fineamount};
657 }
658 return 0;
659}
660
661=head2 NumberNotifyId
662
663 (@notify) = &NumberNotifyId($borrowernumber);
664
665Returns amount for all file per borrowers
666C<@notify> array contains all file per borrowers
667
668C<$notify_id> contains the file number for the borrower number nad item number
669
670=cut
671
672sub NumberNotifyId{
673 my ($borrowernumber)=@_;
674 my $dbh = C4::Context->dbh;
675 my $query=qq| SELECT distinct(notify_id)
676 FROM accountlines
677 WHERE borrowernumber=?|;
678 my @notify;
679 my $sth = $dbh->prepare($query);
680 $sth->execute($borrowernumber);
681 while ( my ($numberofnotify) = $sth->fetchrow ) {
682 push( @notify, $numberofnotify );
683 }
684 return (@notify);
685}
686
687=head2 AmountNotify
688
689 ($totalnotify) = &AmountNotify($notifyid);
690
691Returns amount for all file per borrowers
692C<$notifyid> is the file number
693
694C<$totalnotify> contains amount of a file
695
696C<$notify_id> contains the file number for the borrower number and item number
697
698=cut
699
700sub AmountNotify{
701 my ($notifyid,$borrowernumber)=@_;
702 my $dbh = C4::Context->dbh;
703 my $query=qq| SELECT sum(amountoutstanding)
704 FROM accountlines
705 WHERE notify_id=? AND borrowernumber = ?|;
706 my $sth=$dbh->prepare($query);
707 $sth->execute($notifyid,$borrowernumber);
708 my $totalnotify=$sth->fetchrow;
709 $sth->finish;
710 return ($totalnotify);
711}
712
713=head2 GetItems
714
715 ($items) = &GetItems($itemnumber);
716
717Returns the list of all delays from overduerules.
718
719C<$items> is a reference-to-hash whose keys are all of the fields
720from the items tables of the Koha database. Thus,
721
722C<$itemnumber> contains the borrower categorycode
723
724=cut
725
726# FIXME: This is a bad function to have here.
727# Shouldn't it be in C4::Items?
728# Shouldn't it be called GetItem since you only get 1 row?
729# Shouldn't it be called GetItem since you give it only 1 itemnumber?
730
731sub GetItems {
732 my $itemnumber = shift or return;
733 my $query = qq|SELECT *
734 FROM items
735 WHERE itemnumber=?|;
736 my $sth = C4::Context->dbh->prepare($query);
737 $sth->execute($itemnumber);
738 my ($items) = $sth->fetchrow_hashref;
739 return ($items);
740}
741
742=head2 GetBranchcodesWithOverdueRules
743
744 my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules()
745
746returns a list of branch codes for branches with overdue rules defined.
747
748=cut
749
750sub GetBranchcodesWithOverdueRules {
751 my $dbh = C4::Context->dbh;
752 my $rqoverduebranches = $dbh->prepare("SELECT DISTINCT branchcode FROM overduerules WHERE delay1 IS NOT NULL AND branchcode <> '' ORDER BY branchcode");
753 $rqoverduebranches->execute;
754 my @branches = map { shift @$_ } @{ $rqoverduebranches->fetchall_arrayref };
755 if (!$branches[0]) {
756 my $availbranches = C4::Branch::GetBranches();
757 @branches = keys %$availbranches;
758 }
759 return @branches;
760}
761
762=head2 CheckItemNotify
763
764Sql request to check if the document has alreday been notified
765this function is not exported, only used with GetOverduesForBranch
766
767=cut
768
769sub CheckItemNotify {
770 my ($notify_id,$notify_level,$itemnumber) = @_;
771 my $dbh = C4::Context->dbh;
772 my $sth = $dbh->prepare("
773 SELECT COUNT(*)
774 FROM notifys
775 WHERE notify_id = ?
776 AND notify_level = ?
777 AND itemnumber = ? ");
778 $sth->execute($notify_id,$notify_level,$itemnumber);
779 my $notified = $sth->fetchrow;
780 return ($notified);
781}
782
783=head2 GetOverduesForBranch
784
785Sql request for display all information for branchoverdues.pl
7862 possibilities : with or without location .
787display is filtered by branch
788
789FIXME: This function should be renamed.
790
791=cut
792
793sub GetOverduesForBranch {
794 my ( $branch, $location) = @_;
795 my $itype_link = (C4::Context->preference('item-level_itypes')) ? " items.itype " : " biblioitems.itemtype ";
796 my $dbh = C4::Context->dbh;
797 my $select = "
798 SELECT
799 borrowers.cardnumber,
800 borrowers.borrowernumber,
801 borrowers.surname,
802 borrowers.firstname,
803 borrowers.phone,
804 borrowers.email,
805 biblio.title,
806 biblio.author,
807 biblio.biblionumber,
808 issues.date_due,
809 issues.returndate,
810 issues.branchcode,
811 branches.branchname,
812 items.barcode,
813 items.homebranch,
814 items.itemcallnumber,
815 items.location,
816 items.itemnumber,
817 itemtypes.description,
818 accountlines.notify_id,
819 accountlines.notify_level,
820 accountlines.amountoutstanding
821 FROM accountlines
822 LEFT JOIN issues ON issues.itemnumber = accountlines.itemnumber
823 AND issues.borrowernumber = accountlines.borrowernumber
824 LEFT JOIN borrowers ON borrowers.borrowernumber = accountlines.borrowernumber
825 LEFT JOIN items ON items.itemnumber = issues.itemnumber
826 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
827 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
828 LEFT JOIN itemtypes ON itemtypes.itemtype = $itype_link
829 LEFT JOIN branches ON branches.branchcode = issues.branchcode
830 WHERE (accountlines.amountoutstanding != '0.000000')
831 AND (accountlines.accounttype = 'FU' )
832 AND (issues.branchcode = ? )
833 AND (issues.date_due < NOW())
834 ";
835 my @getoverdues;
836 my $i = 0;
837 my $sth;
838 if ($location) {
839 $sth = $dbh->prepare("$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname");
840 $sth->execute($branch, $location);
841 } else {
842 $sth = $dbh->prepare("$select ORDER BY borrowers.surname, borrowers.firstname");
843 $sth->execute($branch);
844 }
845 while ( my $data = $sth->fetchrow_hashref ) {
846 #check if the document has already been notified
847 my $countnotify = CheckItemNotify($data->{'notify_id'}, $data->{'notify_level'}, $data->{'itemnumber'});
848 if ($countnotify eq '0') {
849 $getoverdues[$i] = $data;
850 $i++;
851 }
852 }
853 return (@getoverdues);
854}
855
856
857=head2 AddNotifyLine
858
859 &AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
860
861Create a line into notify, if the method is phone, the notification_send_date is implemented to
862
863=cut
864
865sub AddNotifyLine {
866 my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_;
867 my $dbh = C4::Context->dbh;
868 if ( $method eq "phone" ) {
869 my $sth = $dbh->prepare(
870 "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
871 VALUES (?,?,now(),now(),?,?,?)"
872 );
873 $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
874 $notifyId );
875 }
876 else {
877 my $sth = $dbh->prepare(
878 "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
879 VALUES (?,?,now(),?,?,?)"
880 );
881 $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
882 $notifyId );
883 }
884 return 1;
885}
886
887=head2 RemoveNotifyLine
888
889 &RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
890
891Cancel a notification
892
893=cut
894
895sub RemoveNotifyLine {
896 my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
897 my $dbh = C4::Context->dbh;
898 my $sth = $dbh->prepare(
899 "DELETE FROM notifys
900 WHERE
901 borrowernumber=?
902 AND itemnumber=?
903 AND notify_date=?"
904 );
905 $sth->execute( $borrowernumber, $itemnumber, $notify_date );
906 return 1;
907}
908
90914µs1;
910__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.