← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:01:04 2013

Filename/usr/share/koha/lib/C4/Overdues.pm
StatementsExecuted 36 statements in 4.25ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11117.2ms410msC4::Overdues::::BEGIN@26C4::Overdues::BEGIN@26
1117.62ms113msC4::Overdues::::BEGIN@25C4::Overdues::BEGIN@25
11148µs56µsC4::Overdues::::BEGIN@22C4::Overdues::BEGIN@22
11130µs30µsC4::Overdues::::BEGIN@34C4::Overdues::BEGIN@34
11116µs21µsC4::Overdues::::BEGIN@27C4::Overdues::BEGIN@27
11114µs80µsC4::Overdues::::BEGIN@29C4::Overdues::BEGIN@29
11113µs80µsC4::Overdues::::BEGIN@32C4::Overdues::BEGIN@32
11112µs231µsC4::Overdues::::BEGIN@28C4::Overdues::BEGIN@28
11111µs94µsC4::Overdues::::BEGIN@30C4::Overdues::BEGIN@30
1119µs54µsC4::Overdues::::BEGIN@24C4::Overdues::BEGIN@24
0000s0sC4::Overdues::::AddNotifyLineC4::Overdues::AddNotifyLine
0000s0sC4::Overdues::::AmountNotifyC4::Overdues::AmountNotify
0000s0sC4::Overdues::::BorTypeC4::Overdues::BorType
0000s0sC4::Overdues::::CalcFineC4::Overdues::CalcFine
0000s0sC4::Overdues::::CheckAccountLineItemInfoC4::Overdues::CheckAccountLineItemInfo
0000s0sC4::Overdues::::CheckAccountLineLevelInfoC4::Overdues::CheckAccountLineLevelInfo
0000s0sC4::Overdues::::CheckBorrowerDebarredC4::Overdues::CheckBorrowerDebarred
0000s0sC4::Overdues::::CheckExistantNotifyidC4::Overdues::CheckExistantNotifyid
0000s0sC4::Overdues::::CheckItemNotifyC4::Overdues::CheckItemNotify
0000s0sC4::Overdues::::CreateItemAccountLineC4::Overdues::CreateItemAccountLine
0000s0sC4::Overdues::::GetBranchcodesWithOverdueRulesC4::Overdues::GetBranchcodesWithOverdueRules
0000s0sC4::Overdues::::GetFineC4::Overdues::GetFine
0000s0sC4::Overdues::::GetIssuesIteminfoC4::Overdues::GetIssuesIteminfo
0000s0sC4::Overdues::::GetItemsC4::Overdues::GetItems
0000s0sC4::Overdues::::GetNextIdNotifyC4::Overdues::GetNextIdNotify
0000s0sC4::Overdues::::GetNotifyIdC4::Overdues::GetNotifyId
0000s0sC4::Overdues::::GetOverdueDelaysC4::Overdues::GetOverdueDelays
0000s0sC4::Overdues::::GetOverduerulesC4::Overdues::GetOverduerules
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::::ReplacementCostC4::Overdues::ReplacementCost
0000s0sC4::Overdues::::ReplacementCost2C4::Overdues::ReplacementCost2
0000s0sC4::Overdues::::UpdateAccountLinesC4::Overdues::UpdateAccountLines
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
22339µs264µs
# spent 56µs (48+8) within C4::Overdues::BEGIN@22 which was called: # once (48µs+8µs) by C4::Members::BEGIN@31 at line 22
use strict;
# spent 56µs making 1 call to C4::Overdues::BEGIN@22 # spent 8µs making 1 call to strict::import
23#use warnings; FIXME - Bug 2505
24331µs298µs
# spent 54µs (9+44) within C4::Overdues::BEGIN@24 which was called: # once (9µs+44µs) by C4::Members::BEGIN@31 at line 24
use Date::Calc qw/Today Date_to_Days/;
# spent 54µs making 1 call to C4::Overdues::BEGIN@24 # spent 44µs making 1 call to Exporter::import
253149µs2113ms
# spent 113ms (7.62+105) within C4::Overdues::BEGIN@25 which was called: # once (7.62ms+105ms) by C4::Members::BEGIN@31 at line 25
use Date::Manip qw/UnixDate/;
# spent 113ms making 1 call to C4::Overdues::BEGIN@25 # spent 186µs making 1 call to Exporter::import
263186µs2411ms
# spent 410ms (17.2+393) within C4::Overdues::BEGIN@26 which was called: # once (17.2ms+393ms) by C4::Members::BEGIN@31 at line 26
use C4::Circulation;
# spent 410ms making 1 call to C4::Overdues::BEGIN@26 # spent 610µs making 1 call to Exporter::import
27333µs225µs
# spent 21µs (16+4) within C4::Overdues::BEGIN@27 which was called: # once (16µs+4µs) by C4::Members::BEGIN@31 at line 27
use C4::Context;
# spent 21µs making 1 call to C4::Overdues::BEGIN@27 # spent 4µs making 1 call to C4::Context::import
28336µs2450µs
# spent 231µs (12+219) within C4::Overdues::BEGIN@28 which was called: # once (12µs+219µs) by C4::Members::BEGIN@31 at line 28
use C4::Accounts;
# spent 231µs making 1 call to C4::Overdues::BEGIN@28 # spent 219µs making 1 call to Exporter::import
29334µs2145µs
# spent 80µs (14+65) within C4::Overdues::BEGIN@29 which was called: # once (14µs+65µs) by C4::Members::BEGIN@31 at line 29
use C4::Log; # logaction
# spent 80µs making 1 call to C4::Overdues::BEGIN@29 # spent 65µs making 1 call to Exporter::import
30337µs2178µs
# spent 94µs (11+83) within C4::Overdues::BEGIN@30 which was called: # once (11µs+83µs) by C4::Members::BEGIN@31 at line 30
use C4::Debug;
# spent 94µs making 1 call to C4::Overdues::BEGIN@30 # spent 83µs making 1 call to Exporter::import
31
323135µs2147µs
# spent 80µs (13+67) within C4::Overdues::BEGIN@32 which was called: # once (13µs+67µs) by C4::Members::BEGIN@31 at line 32
use vars qw($VERSION @ISA @EXPORT);
# spent 80µs making 1 call to C4::Overdues::BEGIN@32 # spent 67µs making 1 call to vars::import
33
34
# spent 30µs within C4::Overdues::BEGIN@34 which was called: # once (30µs+0s) by C4::Members::BEGIN@31 at line 84
BEGIN {
35 # set the version for version checking
36830µs $VERSION = 3.07.00.049;
37 require Exporter;
38 @ISA = qw(Exporter);
39 # subs to rename (and maybe merge some...)
40 push @EXPORT, qw(
41 &CalcFine
42 &Getoverdues
43 &checkoverdues
44 &CheckAccountLineLevelInfo
45 &CheckAccountLineItemInfo
46 &CheckExistantNotifyid
47 &GetNextIdNotify
48 &GetNotifyId
49 &NumberNotifyId
50 &AmountNotify
51 &UpdateAccountLines
52 &UpdateFine
53 &GetOverdueDelays
54 &GetOverduerules
55 &GetFine
56 &CreateItemAccountLine
57 &ReplacementCost2
58
59 &CheckItemNotify
60 &GetOverduesForBranch
61 &RemoveNotifyLine
62 &AddNotifyLine
63 );
64 # subs to remove
65 push @EXPORT, qw(
66 &BorType
67 );
68
69 # check that an equivalent don't exist already before moving
70
71 # subs to move to Circulation.pm
72 push @EXPORT, qw(
73 &GetIssuesIteminfo
74 );
75 # subs to move to Members.pm
76 push @EXPORT, qw(
77 &CheckBorrowerDebarred
78 );
79 # subs to move to Biblio.pm
80 push @EXPORT, qw(
81 &GetItems
82 &ReplacementCost
83 );
8413.54ms130µs}
# spent 30µs making 1 call to C4::Overdues::BEGIN@34
85
86=head1 NAME
87
- -
113#'
114sub Getoverdues {
115 my $params = shift;
116 my $dbh = C4::Context->dbh;
117 my $statement;
118 if ( C4::Context->preference('item-level_itypes') ) {
119 $statement = "
120 SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode
121 FROM issues
122LEFT JOIN items USING (itemnumber)
123 WHERE date_due < NOW()
124";
125 } else {
126 $statement = "
127 SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode
128 FROM issues
129LEFT JOIN items USING (itemnumber)
130LEFT JOIN biblioitems USING (biblioitemnumber)
131 WHERE date_due < NOW()
132";
133 }
134
135 my @bind_parameters;
136 if ( exists $params->{'minimumdays'} and exists $params->{'maximumdays'} ) {
137 $statement .= ' AND TO_DAYS( NOW() )-TO_DAYS( date_due ) BETWEEN ? and ? ';
138 push @bind_parameters, $params->{'minimumdays'}, $params->{'maximumdays'};
139 } elsif ( exists $params->{'minimumdays'} ) {
140 $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) > ? ';
141 push @bind_parameters, $params->{'minimumdays'};
142 } elsif ( exists $params->{'maximumdays'} ) {
143 $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ? ';
144 push @bind_parameters, $params->{'maximumdays'};
145 }
146 $statement .= 'ORDER BY borrowernumber';
147 my $sth = $dbh->prepare( $statement );
148 $sth->execute( @bind_parameters );
149 return $sth->fetchall_arrayref({});
150}
151
152
153=head2 checkoverdues
154
- -
161sub checkoverdues {
162 my $borrowernumber = shift or return;
163 # don't select biblioitems.marc or biblioitems.marcxml... too slow on large systems
164 my $sth = C4::Context->dbh->prepare(
165 "SELECT biblio.*, items.*, issues.*,
166 biblioitems.volume,
167 biblioitems.number,
168 biblioitems.itemtype,
169 biblioitems.isbn,
170 biblioitems.issn,
171 biblioitems.publicationyear,
172 biblioitems.publishercode,
173 biblioitems.volumedate,
174 biblioitems.volumedesc,
175 biblioitems.collectiontitle,
176 biblioitems.collectionissn,
177 biblioitems.collectionvolume,
178 biblioitems.editionstatement,
179 biblioitems.editionresponsibility,
180 biblioitems.illus,
181 biblioitems.pages,
182 biblioitems.notes,
183 biblioitems.size,
184 biblioitems.place,
185 biblioitems.lccn,
186 biblioitems.url,
187 biblioitems.cn_source,
188 biblioitems.cn_class,
189 biblioitems.cn_item,
190 biblioitems.cn_suffix,
191 biblioitems.cn_sort,
192 biblioitems.totalissues
193 FROM issues
194 LEFT JOIN items ON issues.itemnumber = items.itemnumber
195 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
196 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
197 WHERE issues.borrowernumber = ?
198 AND issues.date_due < NOW()"
199 );
200 # FIXME: SELECT * across 4 tables? do we really need the marc AND marcxml blobs??
201 $sth->execute($borrowernumber);
202 my $results = $sth->fetchall_arrayref({});
203 return ( scalar(@$results), $results); # returning the count and the results is silly
204}
205
206=head2 CalcFine
207
- -
250sub CalcFine {
251 my ( $item, $bortype, $branchcode, $due_dt, $end_date ) = @_;
252 my $start_date = $due_dt->clone();
253 # get issuingrules (fines part will be used)
254 my $itemtype = $item->{itemtype} || $item->{itype};
255 my $data = C4::Circulation::GetIssuingRule($bortype, $itemtype, $branchcode);
256 my $fine_unit = $data->{lengthunit};
257 $fine_unit ||= 'days';
258
259 my $chargeable_units = _get_chargeable_units($fine_unit, $start_date, $end_date, $branchcode);
260 my $units_minus_grace = $chargeable_units - $data->{firstremind};
261 my $amount = 0;
262 if ($data->{'chargeperiod'} && ($units_minus_grace > 0) ) {
263 if ( C4::Context->preference('FinesIncludeGracePeriod') ) {
264 $amount = int($chargeable_units / $data->{'chargeperiod'}) * $data->{'fine'};# TODO fine calc should be in cents
265 } else {
266 $amount = int($units_minus_grace / $data->{'chargeperiod'}) * $data->{'fine'};
267 }
268 } else {
269 # a zero (or null) chargeperiod or negative units_minus_grace value means no charge.
270 }
271 $amount = $data->{overduefinescap} if $data->{overduefinescap} && $amount > $data->{overduefinescap};
272 $debug and warn sprintf("CalcFine returning (%s, %s, %s, %s)", $amount, $data->{'chargename'}, $units_minus_grace, $chargeable_units);
273 return ($amount, $data->{'chargename'}, $units_minus_grace, $chargeable_units);
274 # FIXME: chargename is NEVER populated anywhere.
275}
276
277
278=head2 _get_chargeable_units
279
- -
292sub _get_chargeable_units {
293 my ($unit, $dt1, $dt2, $branchcode) = @_;
294 my $charge_units = 0;
295 my $charge_duration;
296 if ($unit eq 'hours') {
297 if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
298 my $calendar = Koha::Calendar->new( branchcode => $branchcode );
299 $charge_duration = $calendar->hours_between( $dt1, $dt2 );
300 } else {
301 $charge_duration = $dt2->delta_ms( $dt1 );
302 }
303 if($charge_duration->in_units('hours') == 0 && $charge_duration->in_units('seconds') > 0){
304 return 1;
305 }
306 return $charge_duration->in_units('hours');
307 }
308 else { # days
309 if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') {
310 my $calendar = Koha::Calendar->new( branchcode => $branchcode );
311 $charge_duration = $calendar->days_between( $dt1, $dt2 );
312 } else {
313 $charge_duration = $dt2->delta_days( $dt1 );
314 }
315 return $charge_duration->in_units('days');
316 }
317}
318
319
320=head2 GetSpecialHolidays
321
- -
332sub GetSpecialHolidays {
333 my ( $date_dues, $itemnumber ) = @_;
334
335 # calcul the today date
336 my $today = join "-", &Today();
337
338 # return the holdingbranch
339 my $iteminfo = GetIssuesIteminfo($itemnumber);
340
341 # use sql request to find all date between date_due and today
342 my $dbh = C4::Context->dbh;
343 my $query =
344 qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') as date
345FROM `special_holidays`
346WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
347AND DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
348AND branchcode=?
349|;
350 my @result = GetWdayFromItemnumber($itemnumber);
351 my @result_date;
352 my $wday;
353 my $dateinsec;
354 my $sth = $dbh->prepare($query);
355 $sth->execute( $date_dues, $today, $iteminfo->{'branchcode'} )
356 ; # FIXME: just use NOW() in SQL instead of passing in $today
357
358 while ( my $special_date = $sth->fetchrow_hashref ) {
359 push( @result_date, $special_date );
360 }
361
362 my $specialdaycount = scalar(@result_date);
363
364 for ( my $i = 0 ; $i < scalar(@result_date) ; $i++ ) {
365 $dateinsec = UnixDate( $result_date[$i]->{'date'}, "%o" );
366 ( undef, undef, undef, undef, undef, undef, $wday, undef, undef ) =
367 localtime($dateinsec);
368 for ( my $j = 0 ; $j < scalar(@result) ; $j++ ) {
369 if ( $wday == ( $result[$j]->{'weekday'} ) ) {
370 $specialdaycount--;
371 }
372 }
373 }
374
375 return $specialdaycount;
376}
377
378=head2 GetRepeatableHolidays
379
- -
392sub GetRepeatableHolidays {
393 my ( $date_dues, $itemnumber, $difference ) = @_;
394 my $dateinsec = UnixDate( $date_dues, "%o" );
395 my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
396 localtime($dateinsec);
397 my @result = GetWdayFromItemnumber($itemnumber);
398 my @dayclosedcount;
399 my $j;
400
401 for ( my $i = 0 ; $i < scalar(@result) ; $i++ ) {
402 my $k = $wday;
403
404 for ( $j = 0 ; $j < $difference ; $j++ ) {
405 if ( $result[$i]->{'weekday'} == $k ) {
406 push( @dayclosedcount, $k );
407 }
408 $k++;
409 ( $k = 0 ) if ( $k eq 7 );
410 }
411 }
412 return scalar(@dayclosedcount);
413}
414
415
416=head2 GetWayFromItemnumber
417
- -
426sub GetWdayFromItemnumber {
427 my ($itemnumber) = @_;
428 my $iteminfo = GetIssuesIteminfo($itemnumber);
429 my @result;
430 my $query = qq|SELECT weekday
431 FROM repeatable_holidays
432 WHERE branchcode=?
433|;
434 my $sth = C4::Context->dbh->prepare($query);
435
436 $sth->execute( $iteminfo->{'branchcode'} );
437 while ( my $weekday = $sth->fetchrow_hashref ) {
438 push( @result, $weekday );
439 }
440 return @result;
441}
442
443
444=head2 GetIssuesIteminfo
445
- -
454sub GetIssuesIteminfo {
455 my ($itemnumber) = @_;
456 my $dbh = C4::Context->dbh;
457 my $query = qq|SELECT *
458 FROM issues
459 WHERE itemnumber=?
460 |;
461 my $sth = $dbh->prepare($query);
462 $sth->execute($itemnumber);
463 my ($issuesinfo) = $sth->fetchrow_hashref;
464 return $issuesinfo;
465}
466
467
468=head2 UpdateFine
469
- -
494#
495# Question: Why should the caller have to
496# specify both the item number and the borrower number? A book can't
497# be on loan to two different people, so the item number should be
498# sufficient.
499#
500# Possible Answer: You might update a fine for a damaged item, *after* it is returned.
501#
502sub UpdateFine {
503 my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_;
504 $debug and warn "UpdateFine($itemnum, $borrowernumber, $amount, " . ($type||'""') . ", $due) called";
505 my $dbh = C4::Context->dbh;
506 # FIXME - What exactly is this query supposed to do? It looks up an
507 # entry in accountlines that matches the given item and borrower
508 # numbers, where the description contains $due, and where the
509 # account type has one of several values, but what does this _mean_?
510 # Does it look up existing fines for this item?
511 # FIXME - What are these various account types? ("FU", "O", "F", "M")
512 # "L" is LOST item
513 # "A" is Account Management Fee
514 # "N" is New Card
515 # "M" is Sundry
516 # "O" is Overdue ??
517 # "F" is Fine ??
518 # "FU" is Fine UPDATE??
519 # "Pay" is Payment
520 # "REF" is Cash Refund
521 my $sth = $dbh->prepare(
522 "SELECT * FROM accountlines
523 WHERE borrowernumber=?
524 AND accounttype IN ('FU','O','F','M')"
525 );
526 $sth->execute( $borrowernumber );
527 my $data;
528 my $total_amount_other = 0.00;
529 my $due_qr = qr/$due/;
530 # Cycle through the fines and
531 # - find line that relates to the requested $itemnum
532 # - accumulate fines for other items
533 # so we can update $itemnum fine taking in account fine caps
534 while (my $rec = $sth->fetchrow_hashref) {
535 if ($rec->{itemnumber} == $itemnum && $rec->{description} =~ /$due_qr/) {
536 if ($data) {
537 warn "Not a unique accountlines record for item $itemnum borrower $borrowernumber";
538 } else {
539 $data = $rec;
540 next;
541 }
542 }
543 $total_amount_other += $rec->{'amountoutstanding'};
544 }
545
546 if (my $maxfine = C4::Context->preference('MaxFine')) {
547 if ($total_amount_other + $amount > $maxfine) {
548 my $new_amount = $maxfine - $total_amount_other;
549 return if $new_amount <= 0.00;
550 warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached";
551 $amount = $new_amount;
552 }
553 }
554
555 if ( $data ) {
556
557 # we're updating an existing fine. Only modify if amount changed
558 # Note that in the current implementation, you cannot pay against an accruing fine
559 # (i.e. , of accounttype 'FU'). Doing so will break accrual.
560 if ( $data->{'amount'} != $amount ) {
561 my $diff = $amount - $data->{'amount'};
562 #3341: diff could be positive or negative!
563 my $out = $data->{'amountoutstanding'} + $diff;
564 my $query = "
565 UPDATE accountlines
566 SET date=now(), amount=?, amountoutstanding=?,
567 lastincrement=?, accounttype='FU'
568 WHERE borrowernumber=?
569 AND itemnumber=?
570 AND accounttype IN ('FU','O')
571 AND description LIKE ?
572 LIMIT 1 ";
573 my $sth2 = $dbh->prepare($query);
574 # FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!!
575 # LIMIT 1 added to prevent multiple affected lines
576 # FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline.
577 # But actually, we should just have a regular autoincrementing PK and forget accountline,
578 # including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops).
579 # FIXME: Why only 2 account types here?
580 $debug and print STDERR "UpdateFine query: $query\n" .
581 "w/ args: $amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, \"\%$due\%\"\n";
582 $sth2->execute($amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, "%$due%");
583 } else {
584 # print "no update needed $data->{'amount'}"
585 }
586 } else {
587 my $sth4 = $dbh->prepare(
588 "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?"
589 );
590 $sth4->execute($itemnum);
591 my $title = $sth4->fetchrow;
592
593# # print "not in account";
594# my $sth3 = $dbh->prepare("Select max(accountno) from accountlines");
595# $sth3->execute;
596#
597# # FIXME - Make $accountno a scalar.
598# my @accountno = $sth3->fetchrow_array;
599# $sth3->finish;
600# $accountno[0]++;
601# begin transaction
602 my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
603 my $desc = ($type ? "$type " : '') . "$title $due"; # FIXEDME, avoid whitespace prefix on empty $type
604 my $query = "INSERT INTO accountlines
605 (borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno)
606 VALUES (?,?,now(),?,?,'FU',?,?,?)";
607 my $sth2 = $dbh->prepare($query);
608 $debug and print STDERR "UpdateFine query: $query\nw/ args: $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno\n";
609 $sth2->execute($borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno);
610 }
611 # logging action
612 &logaction(
613 "FINES",
614 $type,
615 $borrowernumber,
616 "due=".$due." amount=".$amount." itemnumber=".$itemnum
617 ) if C4::Context->preference("FinesLog");
618}
619
620=head2 BorType
621
- -
633#'
634sub BorType {
635 my ($borrowernumber) = @_;
636 my $dbh = C4::Context->dbh;
637 my $sth = $dbh->prepare(
638 "SELECT * from borrowers
639 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
640 WHERE borrowernumber=?"
641 );
642 $sth->execute($borrowernumber);
643 return $sth->fetchrow_hashref;
644}
645
646=head2 ReplacementCost
647
- -
654#'
655sub ReplacementCost {
656 my ($itemnum) = @_;
657 my $dbh = C4::Context->dbh;
658 my $sth =
659 $dbh->prepare("Select replacementprice from items where itemnumber=?");
660 $sth->execute($itemnum);
661
662 # FIXME - Use fetchrow_array or a slice.
663 my $data = $sth->fetchrow_hashref;
664 return ( $data->{'replacementprice'} );
665}
666
667=head2 GetFine
668
- -
680sub GetFine {
681 my ( $itemnum, $borrowernumber ) = @_;
682 my $dbh = C4::Context->dbh();
683 my $query = q|SELECT sum(amountoutstanding) as fineamount FROM accountlines
684 where accounttype like 'F%'
685 AND amountoutstanding > 0 AND itemnumber = ? AND borrowernumber=?|;
686 my $sth = $dbh->prepare($query);
687 $sth->execute( $itemnum, $borrowernumber );
688 my $fine = $sth->fetchrow_hashref();
689 if ($fine->{fineamount}) {
690 return $fine->{fineamount};
691 }
692 return 0;
693}
694
695sub ReplacementCost2 {
696 my ( $itemnum, $borrowernumber ) = @_;
697 my $dbh = C4::Context->dbh();
698 my $query = "SELECT amountoutstanding
699 FROM accountlines
700 WHERE accounttype like 'L'
701 AND amountoutstanding > 0
702 AND itemnumber = ?
703 AND borrowernumber= ?";
704 my $sth = $dbh->prepare($query);
705 $sth->execute( $itemnum, $borrowernumber );
706 my $data = $sth->fetchrow_hashref();
707 return ( $data->{'amountoutstanding'} );
708}
709
710
711=head2 GetNextIdNotify
712
- -
723sub GetNextIdNotify {
724 my ($reference) = @_;
725 my $query = qq|SELECT max(notify_id)
726 FROM accountlines
727 WHERE notify_id like \"$reference%\"
728 |;
729
730 # AND borrowernumber=?|;
731 my $dbh = C4::Context->dbh;
732 my $sth = $dbh->prepare($query);
733 $sth->execute();
734 my $result = $sth->fetchrow;
735 my $count;
736 if ( $result eq '' ) {
737 ( $result = $reference . "01" );
738 }
739 else {
740 $count = substr( $result, 6 ) + 1;
741
742 if ( $count < 10 ) {
743 ( $count = "0" . $count );
744 }
745 $result = $reference . $count;
746 }
747 return $result;
748}
749
750=head2 NumberNotifyId
751
- -
761sub NumberNotifyId{
762 my ($borrowernumber)=@_;
763 my $dbh = C4::Context->dbh;
764 my $query=qq| SELECT distinct(notify_id)
765 FROM accountlines
766 WHERE borrowernumber=?|;
767 my @notify;
768 my $sth = $dbh->prepare($query);
769 $sth->execute($borrowernumber);
770 while ( my ($numberofnotify) = $sth->fetchrow ) {
771 push( @notify, $numberofnotify );
772 }
773 return (@notify);
774}
775
776=head2 AmountNotify
777
- -
789sub AmountNotify{
790 my ($notifyid,$borrowernumber)=@_;
791 my $dbh = C4::Context->dbh;
792 my $query=qq| SELECT sum(amountoutstanding)
793 FROM accountlines
794 WHERE notify_id=? AND borrowernumber = ?|;
795 my $sth=$dbh->prepare($query);
796 $sth->execute($notifyid,$borrowernumber);
797 my $totalnotify=$sth->fetchrow;
798 $sth->finish;
799 return ($totalnotify);
800}
801
802
803=head2 GetNotifyId
804
- -
818sub GetNotifyId {
819 my ( $borrowernumber, $itemnumber ) = @_;
820 my $query = qq|SELECT notify_id
821 FROM accountlines
822 WHERE borrowernumber=?
823 AND itemnumber=?
824 AND (accounttype='FU' or accounttype='O')|;
825 my $dbh = C4::Context->dbh;
826 my $sth = $dbh->prepare($query);
827 $sth->execute( $borrowernumber, $itemnumber );
828 my ($notify_id) = $sth->fetchrow;
829 $sth->finish;
830 return ($notify_id);
831}
832
833=head2 CreateItemAccountLine
834
- -
866sub CreateItemAccountLine {
867 my (
868 $borrowernumber, $itemnumber, $date, $amount,
869 $description, $accounttype, $amountoutstanding, $timestamp,
870 $notify_id, $level
871 ) = @_;
872 my $dbh = C4::Context->dbh;
873 my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber);
874 my $query = "INSERT into accountlines
875 (borrowernumber,accountno,itemnumber,date,amount,description,accounttype,amountoutstanding,timestamp,notify_id,notify_level)
876 VALUES
877 (?,?,?,?,?,?,?,?,?,?,?)";
878
879 my $sth = $dbh->prepare($query);
880 $sth->execute(
881 $borrowernumber, $nextaccntno, $itemnumber,
882 $date, $amount, $description,
883 $accounttype, $amountoutstanding, $timestamp,
884 $notify_id, $level
885 );
886}
887
888=head2 UpdateAccountLines
889
- -
907sub UpdateAccountLines {
908 my ( $notify_id, $notify_level, $borrowernumber, $itemnumber ) = @_;
909 my $query;
910 if ( $notify_id eq '' ) {
911 $query = qq|UPDATE accountlines
912 SET notify_level=?
913 WHERE borrowernumber=? AND itemnumber=?
914 AND (accounttype='FU' or accounttype='O')|;
915 } else {
916 $query = qq|UPDATE accountlines
917 SET notify_id=?, notify_level=?
918 WHERE borrowernumber=?
919 AND itemnumber=?
920 AND (accounttype='FU' or accounttype='O')|;
921 }
922
923 my $sth = C4::Context->dbh->prepare($query);
924 if ( $notify_id eq '' ) {
925 $sth->execute( $notify_level, $borrowernumber, $itemnumber );
926 } else {
927 $sth->execute( $notify_id, $notify_level, $borrowernumber, $itemnumber );
928 }
929}
930
931=head2 GetItems
932
- -
944# FIXME: This is a bad function to have here.
945# Shouldn't it be in C4::Items?
946# Shouldn't it be called GetItem since you only get 1 row?
947# Shouldn't it be called GetItem since you give it only 1 itemnumber?
948
949sub GetItems {
950 my $itemnumber = shift or return;
951 my $query = qq|SELECT *
952 FROM items
953 WHERE itemnumber=?|;
954 my $sth = C4::Context->dbh->prepare($query);
955 $sth->execute($itemnumber);
956 my ($items) = $sth->fetchrow_hashref;
957 return ($items);
958}
959
960=head2 GetOverdueDelays
961
- -
972sub GetOverdueDelays {
973 my ($category) = @_;
974 my $query = qq|SELECT delay1,delay2,delay3
975 FROM overduerules
976 WHERE categorycode=?|;
977 my $sth = C4::Context->dbh->prepare($query);
978 $sth->execute($category);
979 my (@delays) = $sth->fetchrow_array;
980 return (@delays);
981}
982
983=head2 GetBranchcodesWithOverdueRules
984
- -
991sub GetBranchcodesWithOverdueRules {
992 my $dbh = C4::Context->dbh;
993 my $rqoverduebranches = $dbh->prepare("SELECT DISTINCT branchcode FROM overduerules WHERE delay1 IS NOT NULL AND branchcode <> '' ORDER BY branchcode");
994 $rqoverduebranches->execute;
995 my @branches = map { shift @$_ } @{ $rqoverduebranches->fetchall_arrayref };
996 if (!$branches[0]) {
997 my $availbranches = C4::Branch::GetBranches();
998 @branches = keys %$availbranches;
999 }
1000 return @branches;
1001}
1002
1003=head2 CheckAccountLineLevelInfo
1004
- -
1023sub CheckAccountLineLevelInfo {
1024 my ( $borrowernumber, $itemnumber, $level ) = @_;
1025 my $dbh = C4::Context->dbh;
1026 my $query = qq|SELECT count(*)
1027 FROM accountlines
1028 WHERE borrowernumber =?
1029 AND itemnumber = ?
1030 AND notify_level=?|;
1031 my $sth = $dbh->prepare($query);
1032 $sth->execute( $borrowernumber, $itemnumber, $level );
1033 my ($exist) = $sth->fetchrow;
1034 return ($exist);
1035}
1036
1037=head2 GetOverduerules
1038
- -
1051sub GetOverduerules {
1052 my ( $category, $notify_level ) = @_;
1053 my $dbh = C4::Context->dbh;
1054 my $query = qq|SELECT debarred$notify_level
1055 FROM overduerules
1056 WHERE categorycode=?|;
1057 my $sth = $dbh->prepare($query);
1058 $sth->execute($category);
1059 my ($overduerules) = $sth->fetchrow;
1060 return ($overduerules);
1061}
1062
1063
1064=head2 CheckBorrowerDebarred
1065
- -
1076# FIXME: Shouldn't this be in C4::Members?
1077sub CheckBorrowerDebarred {
1078 my ($borrowernumber) = @_;
1079 my $dbh = C4::Context->dbh;
1080 my $query = qq|
1081 SELECT debarred
1082 FROM borrowers
1083 WHERE borrowernumber=?
1084 AND debarred > NOW()
1085 |;
1086 my $sth = $dbh->prepare($query);
1087 $sth->execute($borrowernumber);
1088 my $debarredstatus = $sth->fetchrow;
1089 return $debarredstatus;
1090}
1091
1092
1093=head2 CheckExistantNotifyid
1094
- -
1108sub CheckExistantNotifyid {
1109 my ( $borrowernumber, $date_due ) = @_;
1110 my $dbh = C4::Context->dbh;
1111 my $query = qq|SELECT notify_id FROM accountlines
1112 LEFT JOIN issues ON issues.itemnumber= accountlines.itemnumber
1113 WHERE accountlines.borrowernumber =?
1114 AND date_due = ?|;
1115 my $sth = $dbh->prepare($query);
1116 $sth->execute( $borrowernumber, $date_due );
1117 return $sth->fetchrow || 0;
1118}
1119
1120=head2 CheckAccountLineItemInfo
1121
- -
1139sub CheckAccountLineItemInfo {
1140 my ( $borrowernumber, $itemnumber, $accounttype, $notify_id ) = @_;
1141 my $dbh = C4::Context->dbh;
1142 my $query = qq|SELECT count(*) FROM accountlines
1143 WHERE borrowernumber =?
1144 AND itemnumber = ?
1145 AND accounttype= ?
1146 AND notify_id = ?|;
1147 my $sth = $dbh->prepare($query);
1148 $sth->execute( $borrowernumber, $itemnumber, $accounttype, $notify_id );
1149 my ($exist) = $sth->fetchrow;
1150 return ($exist);
1151}
1152
1153=head2 CheckItemNotify
1154
- -
1160sub CheckItemNotify {
1161 my ($notify_id,$notify_level,$itemnumber) = @_;
1162 my $dbh = C4::Context->dbh;
1163 my $sth = $dbh->prepare("
1164 SELECT COUNT(*)
1165 FROM notifys
1166 WHERE notify_id = ?
1167 AND notify_level = ?
1168 AND itemnumber = ? ");
1169 $sth->execute($notify_id,$notify_level,$itemnumber);
1170 my $notified = $sth->fetchrow;
1171 return ($notified);
1172}
1173
1174=head2 GetOverduesForBranch
1175
- -
1184sub GetOverduesForBranch {
1185 my ( $branch, $location) = @_;
1186 my $itype_link = (C4::Context->preference('item-level_itypes')) ? " items.itype " : " biblioitems.itemtype ";
1187 my $dbh = C4::Context->dbh;
1188 my $select = "
1189 SELECT
1190 borrowers.borrowernumber,
1191 borrowers.surname,
1192 borrowers.firstname,
1193 borrowers.phone,
1194 borrowers.email,
1195 biblio.title,
1196 biblio.author,
1197 biblio.biblionumber,
1198 issues.date_due,
1199 issues.returndate,
1200 issues.branchcode,
1201 branches.branchname,
1202 items.barcode,
1203 items.homebranch,
1204 items.itemcallnumber,
1205 items.location,
1206 items.itemnumber,
1207 itemtypes.description,
1208 accountlines.notify_id,
1209 accountlines.notify_level,
1210 accountlines.amountoutstanding
1211 FROM accountlines
1212 LEFT JOIN issues ON issues.itemnumber = accountlines.itemnumber
1213 AND issues.borrowernumber = accountlines.borrowernumber
1214 LEFT JOIN borrowers ON borrowers.borrowernumber = accountlines.borrowernumber
1215 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1216 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1217 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1218 LEFT JOIN itemtypes ON itemtypes.itemtype = $itype_link
1219 LEFT JOIN branches ON branches.branchcode = issues.branchcode
1220 WHERE (accountlines.amountoutstanding != '0.000000')
1221 AND (accountlines.accounttype = 'FU' )
1222 AND (issues.branchcode = ? )
1223 AND (issues.date_due < NOW())
1224 ";
1225 my @getoverdues;
1226 my $i = 0;
1227 my $sth;
1228 if ($location) {
1229 $sth = $dbh->prepare("$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname");
1230 $sth->execute($branch, $location);
1231 } else {
1232 $sth = $dbh->prepare("$select ORDER BY borrowers.surname, borrowers.firstname");
1233 $sth->execute($branch);
1234 }
1235 while ( my $data = $sth->fetchrow_hashref ) {
1236 #check if the document has already been notified
1237 my $countnotify = CheckItemNotify($data->{'notify_id'}, $data->{'notify_level'}, $data->{'itemnumber'});
1238 if ($countnotify eq '0') {
1239 $getoverdues[$i] = $data;
1240 $i++;
1241 }
1242 }
1243 return (@getoverdues);
1244}
1245
1246
1247=head2 AddNotifyLine
1248
- -
1255sub AddNotifyLine {
1256 my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_;
1257 my $dbh = C4::Context->dbh;
1258 if ( $method eq "phone" ) {
1259 my $sth = $dbh->prepare(
1260 "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
1261 VALUES (?,?,now(),now(),?,?,?)"
1262 );
1263 $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
1264 $notifyId );
1265 }
1266 else {
1267 my $sth = $dbh->prepare(
1268 "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
1269 VALUES (?,?,now(),?,?,?)"
1270 );
1271 $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
1272 $notifyId );
1273 }
1274 return 1;
1275}
1276
1277=head2 RemoveNotifyLine
1278
- -
1285sub RemoveNotifyLine {
1286 my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
1287 my $dbh = C4::Context->dbh;
1288 my $sth = $dbh->prepare(
1289 "DELETE FROM notifys
1290 WHERE
1291 borrowernumber=?
1292 AND itemnumber=?
1293 AND notify_date=?"
1294 );
1295 $sth->execute( $borrowernumber, $itemnumber, $notify_date );
1296 return 1;
1297}
1298
129914µs1;
1300__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.