| File: | C4/Overdues.pm |
| Coverage: | 9.5% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 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 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 | ||||||
| 22 | 24 24 24 | 44430 135 1085 | use strict; | |||
| 23 | #use warnings; FIXME - Bug 2505 | |||||
| 24 | 24 24 24 | 524 5708 1728 | use Date::Calc qw/Today Date_to_Days/; | |||
| 25 | 24 24 24 | 27624 3653255 3398 | use Date::Manip qw/UnixDate/; | |||
| 26 | 24 24 24 | 3897 461 6639 | use C4::Circulation; | |||
| 27 | 24 24 24 | 585 344 662 | use C4::Context; | |||
| 28 | 24 24 24 | 1414 264 4244 | use C4::Accounts; | |||
| 29 | 24 24 24 | 348 210 2414 | use C4::Log; # logaction | |||
| 30 | 24 24 24 | 308 182 2131 | use C4::Debug; | |||
| 31 | ||||||
| 32 | 24 24 24 | 402 187 4726 | use vars qw($VERSION @ISA @EXPORT); | |||
| 33 | ||||||
| 34 | BEGIN { | |||||
| 35 | # set the version for version checking | |||||
| 36 | 24 | 166 | $VERSION = 3.01; | |||
| 37 | 24 | 227 | require Exporter; | |||
| 38 | 24 | 566 | @ISA = qw(Exporter); | |||
| 39 | # subs to rename (and maybe merge some...) | |||||
| 40 | 24 | 447 | 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 | 24 | 161 | 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 | 24 | 148 | push @EXPORT, qw( | |||
| 73 | &GetIssuesIteminfo | |||||
| 74 | ); | |||||
| 75 | # | |||||
| 76 | # &GetIssuingRules - delete. | |||||
| 77 | # use C4::Circulation::GetIssuingRule instead. | |||||
| 78 | ||||||
| 79 | # subs to move to Members.pm | |||||
| 80 | 24 | 145 | push @EXPORT, qw( | |||
| 81 | &CheckBorrowerDebarred | |||||
| 82 | ); | |||||
| 83 | # subs to move to Biblio.pm | |||||
| 84 | 24 | 108122 | push @EXPORT, qw( | |||
| 85 | &GetItems | |||||
| 86 | &ReplacementCost | |||||
| 87 | ); | |||||
| 88 | } | |||||
| 89 | ||||||
| 90 - 115 | =head1 NAME
C4::Circulation::Fines - Koha module dealing with fines
=head1 SYNOPSIS
use C4::Overdues;
=head1 DESCRIPTION
This module contains several functions for dealing with fines for
overdue items. It is primarily used by the 'misc/fines2.pl' script.
=head1 FUNCTIONS
=head2 Getoverdues
$overdues = Getoverdues( { minimumdays => 1, maximumdays => 30 } );
Returns the list of all overdue books, with their itemtype.
C<$overdues> is a reference-to-array. Each element is a
reference-to-hash whose keys are the fields of the issues table in the
Koha database.
=cut | |||||
| 116 | ||||||
| 117 | #' | |||||
| 118 | sub Getoverdues { | |||||
| 119 | 0 | my $params = shift; | ||||
| 120 | 0 | my $dbh = C4::Context->dbh; | ||||
| 121 | 0 | my $statement; | ||||
| 122 | 0 | if ( C4::Context->preference('item-level_itypes') ) { | ||||
| 123 | 0 | $statement = " | ||||
| 124 | SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode | |||||
| 125 | FROM issues | |||||
| 126 | LEFT JOIN items USING (itemnumber) | |||||
| 127 | WHERE date_due < CURDATE() | |||||
| 128 | "; | |||||
| 129 | } else { | |||||
| 130 | 0 | $statement = " | ||||
| 131 | SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode | |||||
| 132 | FROM issues | |||||
| 133 | LEFT JOIN items USING (itemnumber) | |||||
| 134 | LEFT JOIN biblioitems USING (biblioitemnumber) | |||||
| 135 | WHERE date_due < CURDATE() | |||||
| 136 | "; | |||||
| 137 | } | |||||
| 138 | ||||||
| 139 | 0 | my @bind_parameters; | ||||
| 140 | 0 | if ( exists $params->{'minimumdays'} and exists $params->{'maximumdays'} ) { | ||||
| 141 | 0 | $statement .= ' AND TO_DAYS( NOW() )-TO_DAYS( date_due ) BETWEEN ? and ? '; | ||||
| 142 | 0 | push @bind_parameters, $params->{'minimumdays'}, $params->{'maximumdays'}; | ||||
| 143 | } elsif ( exists $params->{'minimumdays'} ) { | |||||
| 144 | 0 | $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) > ? '; | ||||
| 145 | 0 | push @bind_parameters, $params->{'minimumdays'}; | ||||
| 146 | } elsif ( exists $params->{'maximumdays'} ) { | |||||
| 147 | 0 | $statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ? '; | ||||
| 148 | 0 | push @bind_parameters, $params->{'maximumdays'}; | ||||
| 149 | } | |||||
| 150 | 0 | $statement .= 'ORDER BY borrowernumber'; | ||||
| 151 | 0 | my $sth = $dbh->prepare( $statement ); | ||||
| 152 | 0 | $sth->execute( @bind_parameters ); | ||||
| 153 | 0 | return $sth->fetchall_arrayref({}); | ||||
| 154 | } | |||||
| 155 | ||||||
| 156 | ||||||
| 157 - 163 | =head2 checkoverdues
($count, $overdueitems) = checkoverdues($borrowernumber);
Returns a count and a list of overdueitems for a given borrowernumber
=cut | |||||
| 164 | ||||||
| 165 | sub checkoverdues { | |||||
| 166 | 0 | my $borrowernumber = shift or return; | ||||
| 167 | # don't select biblioitems.marc or biblioitems.marcxml... too slow on large systems | |||||
| 168 | 0 | my $sth = C4::Context->dbh->prepare( | ||||
| 169 | "SELECT biblio.*, items.*, issues.*, | |||||
| 170 | biblioitems.volume, | |||||
| 171 | biblioitems.number, | |||||
| 172 | biblioitems.itemtype, | |||||
| 173 | biblioitems.isbn, | |||||
| 174 | biblioitems.issn, | |||||
| 175 | biblioitems.publicationyear, | |||||
| 176 | biblioitems.publishercode, | |||||
| 177 | biblioitems.volumedate, | |||||
| 178 | biblioitems.volumedesc, | |||||
| 179 | biblioitems.collectiontitle, | |||||
| 180 | biblioitems.collectionissn, | |||||
| 181 | biblioitems.collectionvolume, | |||||
| 182 | biblioitems.editionstatement, | |||||
| 183 | biblioitems.editionresponsibility, | |||||
| 184 | biblioitems.illus, | |||||
| 185 | biblioitems.pages, | |||||
| 186 | biblioitems.notes, | |||||
| 187 | biblioitems.size, | |||||
| 188 | biblioitems.place, | |||||
| 189 | biblioitems.lccn, | |||||
| 190 | biblioitems.url, | |||||
| 191 | biblioitems.cn_source, | |||||
| 192 | biblioitems.cn_class, | |||||
| 193 | biblioitems.cn_item, | |||||
| 194 | biblioitems.cn_suffix, | |||||
| 195 | biblioitems.cn_sort, | |||||
| 196 | biblioitems.totalissues | |||||
| 197 | FROM issues | |||||
| 198 | LEFT JOIN items ON issues.itemnumber = items.itemnumber | |||||
| 199 | LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber | |||||
| 200 | LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber | |||||
| 201 | WHERE issues.borrowernumber = ? | |||||
| 202 | AND issues.date_due < CURDATE()" | |||||
| 203 | ); | |||||
| 204 | # FIXME: SELECT * across 4 tables? do we really need the marc AND marcxml blobs?? | |||||
| 205 | 0 | $sth->execute($borrowernumber); | ||||
| 206 | 0 | my $results = $sth->fetchall_arrayref({}); | ||||
| 207 | 0 | return ( scalar(@$results), $results); # returning the count and the results is silly | ||||
| 208 | } | |||||
| 209 | ||||||
| 210 - 259 | =head2 CalcFine
($amount, $chargename, $daycount, $daycounttotal) = &CalcFine($item,
$categorycode, $branch, $days_overdue,
$description, $start_date, $end_date );
Calculates the fine for a book.
The issuingrules table in the Koha database is a fine matrix, listing
the penalties for each type of patron for each type of item and each branch (e.g., the
standard fine for books might be $0.50, but $1.50 for DVDs, or staff
members might get a longer grace period between the first and second
reminders that a book is overdue).
C<$item> is an item object (hashref).
C<$categorycode> is the category code (string) of the patron who currently has
the book.
C<$branchcode> is the library (string) whose issuingrules govern this transaction.
C<$days_overdue> is the number of days elapsed since the book's due date.
NOTE: supplying days_overdue is deprecated.
C<$start_date> & C<$end_date> are C4::Dates objects
defining the date range over which to determine the fine.
Note that if these are defined, we ignore C<$difference> and C<$dues> ,
but retain these for backwards-comptibility with extant fines scripts.
Fines scripts should just supply the date range over which to calculate the fine.
C<&CalcFine> returns four values:
C<$amount> is the fine owed by the patron (see above).
C<$chargename> is the chargename field from the applicable record in
the categoryitem table, whatever that is.
C<$daycount> is the number of days between start and end dates, Calendar adjusted (where needed),
minus any applicable grace period.
C<$daycounttotal> is C<$daycount> without consideration of grace period.
FIXME - What is chargename supposed to be ?
FIXME: previously attempted to return C<$message> as a text message, either "First Notice", "Second Notice",
or "Final Notice". But CalcFine never defined any value.
=cut | |||||
| 260 | ||||||
| 261 | sub CalcFine { | |||||
| 262 | 0 | my ( $item, $bortype, $branchcode, $difference ,$dues , $start_date, $end_date ) = @_; | ||||
| 263 | 0 | $debug and warn sprintf("CalcFine(%s, %s, %s, %s, %s, %s, %s)", | ||||
| 264 | ($item ? '{item}' : 'UNDEF'), | |||||
| 265 | ($bortype || 'UNDEF'), | |||||
| 266 | ($branchcode || 'UNDEF'), | |||||
| 267 | ($difference || 'UNDEF'), | |||||
| 268 | ($dues || 'UNDEF'), | |||||
| 269 | ($start_date ? ($start_date->output('iso') || 'Not a C4::Dates object') : 'UNDEF'), | |||||
| 270 | ( $end_date ? ( $end_date->output('iso') || 'Not a C4::Dates object') : 'UNDEF') | |||||
| 271 | ); | |||||
| 272 | 0 | my $dbh = C4::Context->dbh; | ||||
| 273 | 0 | my $amount = 0; | ||||
| 274 | 0 | my $daystocharge; | ||||
| 275 | # get issuingrules (fines part will be used) | |||||
| 276 | 0 | $debug and warn sprintf("CalcFine calling GetIssuingRule(%s, %s, %s)", $bortype, $item->{'itemtype'}, $branchcode); | ||||
| 277 | 0 | my $data = C4::Circulation::GetIssuingRule($bortype, $item->{'itemtype'}, $branchcode); | ||||
| 278 | 0 | if($difference) { | ||||
| 279 | # if $difference is supplied, the difference has already been calculated, but we still need to adjust for the calendar. | |||||
| 280 | # use copy-pasted functions from calendar module. (deprecated -- these functions will be removed from C4::Overdues ). | |||||
| 281 | 0 | my $countspecialday = &GetSpecialHolidays($dues,$item->{itemnumber}); | ||||
| 282 | 0 | my $countrepeatableday = &GetRepeatableHolidays($dues,$item->{itemnumber},$difference); | ||||
| 283 | 0 | my $countalldayclosed = $countspecialday + $countrepeatableday; | ||||
| 284 | 0 | $daystocharge = $difference - $countalldayclosed; | ||||
| 285 | } else { | |||||
| 286 | # if $difference is not supplied, we have C4::Dates objects giving us the date range, and we use the calendar module. | |||||
| 287 | 0 | if(C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed') { | ||||
| 288 | 0 | my $calendar = C4::Calendar->new( branchcode => $branchcode ); | ||||
| 289 | 0 | $daystocharge = $calendar->daysBetween( $start_date, $end_date ); | ||||
| 290 | } else { | |||||
| 291 | 0 | $daystocharge = Date_to_Days(split('-',$end_date->output('iso'))) - Date_to_Days(split('-',$start_date->output('iso'))); | ||||
| 292 | } | |||||
| 293 | } | |||||
| 294 | # correct for grace period. | |||||
| 295 | 0 | my $days_minus_grace = $daystocharge - $data->{'firstremind'}; | ||||
| 296 | 0 | if ($data->{'chargeperiod'} > 0 && $days_minus_grace > 0 ) { | ||||
| 297 | 0 | $amount = int($daystocharge / $data->{'chargeperiod'}) * $data->{'fine'}; | ||||
| 298 | } else { | |||||
| 299 | # a zero (or null) chargeperiod means no charge. | |||||
| 300 | } | |||||
| 301 | 0 | $amount = C4::Context->preference('maxFine') if(C4::Context->preference('maxFine') && ( $amount > C4::Context->preference('maxFine'))); | ||||
| 302 | 0 | $debug and warn sprintf("CalcFine returning (%s, %s, %s, %s)", $amount, $data->{'chargename'}, $days_minus_grace, $daystocharge); | ||||
| 303 | 0 | return ($amount, $data->{'chargename'}, $days_minus_grace, $daystocharge); | ||||
| 304 | # FIXME: chargename is NEVER populated anywhere. | |||||
| 305 | } | |||||
| 306 | ||||||
| 307 | ||||||
| 308 - 318 | =head2 GetSpecialHolidays
&GetSpecialHolidays($date_dues,$itemnumber);
return number of special days between date of the day and date due
C<$date_dues> is the envisaged date of book return.
C<$itemnumber> is the book's item number.
=cut | |||||
| 319 | ||||||
| 320 | sub GetSpecialHolidays { | |||||
| 321 | 0 | my ( $date_dues, $itemnumber ) = @_; | ||||
| 322 | ||||||
| 323 | # calcul the today date | |||||
| 324 | 0 | my $today = join "-", &Today(); | ||||
| 325 | ||||||
| 326 | # return the holdingbranch | |||||
| 327 | 0 | my $iteminfo = GetIssuesIteminfo($itemnumber); | ||||
| 328 | ||||||
| 329 | # use sql request to find all date between date_due and today | |||||
| 330 | 0 | my $dbh = C4::Context->dbh; | ||||
| 331 | 0 | my $query = | ||||
| 332 | qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') as date | |||||
| 333 | FROM `special_holidays` | |||||
| 334 | WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ? | |||||
| 335 | AND DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ? | |||||
| 336 | AND branchcode=? | |||||
| 337 | |; | |||||
| 338 | 0 | my @result = GetWdayFromItemnumber($itemnumber); | ||||
| 339 | 0 | my @result_date; | ||||
| 340 | 0 | my $wday; | ||||
| 341 | 0 | my $dateinsec; | ||||
| 342 | 0 | my $sth = $dbh->prepare($query); | ||||
| 343 | 0 | $sth->execute( $date_dues, $today, $iteminfo->{'branchcode'} ) | ||||
| 344 | ; # FIXME: just use NOW() in SQL instead of passing in $today | |||||
| 345 | ||||||
| 346 | 0 | while ( my $special_date = $sth->fetchrow_hashref ) { | ||||
| 347 | 0 | push( @result_date, $special_date ); | ||||
| 348 | } | |||||
| 349 | ||||||
| 350 | 0 | my $specialdaycount = scalar(@result_date); | ||||
| 351 | ||||||
| 352 | for ( my $i = 0 ; $i < scalar(@result_date) ; $i++ ) { | |||||
| 353 | 0 | $dateinsec = UnixDate( $result_date[$i]->{'date'}, "%o" ); | ||||
| 354 | 0 | ( undef, undef, undef, undef, undef, undef, $wday, undef, undef ) = | ||||
| 355 | localtime($dateinsec); | |||||
| 356 | for ( my $j = 0 ; $j < scalar(@result) ; $j++ ) { | |||||
| 357 | 0 | if ( $wday == ( $result[$j]->{'weekday'} ) ) { | ||||
| 358 | 0 | $specialdaycount--; | ||||
| 359 | } | |||||
| 360 | 0 | } | ||||
| 361 | 0 | } | ||||
| 362 | ||||||
| 363 | 0 | return $specialdaycount; | ||||
| 364 | } | |||||
| 365 | ||||||
| 366 - 378 | =head2 GetRepeatableHolidays
&GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
return number of day closed between date of the day and date due
C<$date_dues> is the envisaged date of book return.
C<$itemnumber> is item number.
C<$difference> numbers of between day date of the day and date due
=cut | |||||
| 379 | ||||||
| 380 | sub GetRepeatableHolidays { | |||||
| 381 | 0 | my ( $date_dues, $itemnumber, $difference ) = @_; | ||||
| 382 | 0 | my $dateinsec = UnixDate( $date_dues, "%o" ); | ||||
| 383 | 0 | my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = | ||||
| 384 | localtime($dateinsec); | |||||
| 385 | 0 | my @result = GetWdayFromItemnumber($itemnumber); | ||||
| 386 | 0 | my @dayclosedcount; | ||||
| 387 | 0 | my $j; | ||||
| 388 | ||||||
| 389 | for ( my $i = 0 ; $i < scalar(@result) ; $i++ ) { | |||||
| 390 | 0 | my $k = $wday; | ||||
| 391 | ||||||
| 392 | for ( $j = 0 ; $j < $difference ; $j++ ) { | |||||
| 393 | 0 | if ( $result[$i]->{'weekday'} == $k ) { | ||||
| 394 | 0 | push( @dayclosedcount, $k ); | ||||
| 395 | } | |||||
| 396 | 0 | $k++; | ||||
| 397 | 0 | ( $k = 0 ) if ( $k eq 7 ); | ||||
| 398 | 0 | } | ||||
| 399 | 0 | } | ||||
| 400 | 0 | return scalar(@dayclosedcount); | ||||
| 401 | } | |||||
| 402 | ||||||
| 403 | ||||||
| 404 - 412 | =head2 GetWayFromItemnumber
&Getwdayfromitemnumber($itemnumber);
return the different week day from repeatable_holidays table
C<$itemnumber> is item number.
=cut | |||||
| 413 | ||||||
| 414 | sub GetWdayFromItemnumber { | |||||
| 415 | 0 | my ($itemnumber) = @_; | ||||
| 416 | 0 | my $iteminfo = GetIssuesIteminfo($itemnumber); | ||||
| 417 | 0 | my @result; | ||||
| 418 | 0 | my $query = qq|SELECT weekday | ||||
| 419 | FROM repeatable_holidays | |||||
| 420 | WHERE branchcode=? | |||||
| 421 | |; | |||||
| 422 | 0 | my $sth = C4::Context->dbh->prepare($query); | ||||
| 423 | ||||||
| 424 | 0 | $sth->execute( $iteminfo->{'branchcode'} ); | ||||
| 425 | 0 | while ( my $weekday = $sth->fetchrow_hashref ) { | ||||
| 426 | 0 | push( @result, $weekday ); | ||||
| 427 | } | |||||
| 428 | 0 | return @result; | ||||
| 429 | } | |||||
| 430 | ||||||
| 431 | ||||||
| 432 - 440 | =head2 GetIssuesIteminfo
&GetIssuesIteminfo($itemnumber);
return all data from issues about item
C<$itemnumber> is item number.
=cut | |||||
| 441 | ||||||
| 442 | sub GetIssuesIteminfo { | |||||
| 443 | 0 | my ($itemnumber) = @_; | ||||
| 444 | 0 | my $dbh = C4::Context->dbh; | ||||
| 445 | 0 | my $query = qq|SELECT * | ||||
| 446 | FROM issues | |||||
| 447 | WHERE itemnumber=? | |||||
| 448 | |; | |||||
| 449 | 0 | my $sth = $dbh->prepare($query); | ||||
| 450 | 0 | $sth->execute($itemnumber); | ||||
| 451 | 0 | my ($issuesinfo) = $sth->fetchrow_hashref; | ||||
| 452 | 0 | return $issuesinfo; | ||||
| 453 | } | |||||
| 454 | ||||||
| 455 | ||||||
| 456 - 480 | =head2 UpdateFine
&UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description);
(Note: the following is mostly conjecture and guesswork.)
Updates the fine owed on an overdue book.
C<$itemnumber> is the book's item number.
C<$borrowernumber> is the borrower number of the patron who currently
has the book on loan.
C<$amount> is the current amount owed by the patron.
C<$type> will be used in the description of the fine.
C<$description> is a string that must be present in the description of
the fine. I think this is expected to be a date in DD/MM/YYYY format.
C<&UpdateFine> looks up the amount currently owed on the given item
and sets it to C<$amount>, creating, if necessary, a new entry in the
accountlines table of the Koha database.
=cut | |||||
| 481 | ||||||
| 482 | # | |||||
| 483 | # Question: Why should the caller have to | |||||
| 484 | # specify both the item number and the borrower number? A book can't | |||||
| 485 | # be on loan to two different people, so the item number should be | |||||
| 486 | # sufficient. | |||||
| 487 | # | |||||
| 488 | # Possible Answer: You might update a fine for a damaged item, *after* it is returned. | |||||
| 489 | # | |||||
| 490 | sub UpdateFine { | |||||
| 491 | 0 | my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_; | ||||
| 492 | 0 | $debug and warn "UpdateFine($itemnum, $borrowernumber, $amount, " . ($type||'""') . ", $due) called"; | ||||
| 493 | 0 | my $dbh = C4::Context->dbh; | ||||
| 494 | # FIXME - What exactly is this query supposed to do? It looks up an | |||||
| 495 | # entry in accountlines that matches the given item and borrower | |||||
| 496 | # numbers, where the description contains $due, and where the | |||||
| 497 | # account type has one of several values, but what does this _mean_? | |||||
| 498 | # Does it look up existing fines for this item? | |||||
| 499 | # FIXME - What are these various account types? ("FU", "O", "F", "M") | |||||
| 500 | # "L" is LOST item | |||||
| 501 | # "A" is Account Management Fee | |||||
| 502 | # "N" is New Card | |||||
| 503 | # "M" is Sundry | |||||
| 504 | # "O" is Overdue ?? | |||||
| 505 | # "F" is Fine ?? | |||||
| 506 | # "FU" is Fine UPDATE?? | |||||
| 507 | # "Pay" is Payment | |||||
| 508 | # "REF" is Cash Refund | |||||
| 509 | 0 | my $sth = $dbh->prepare( | ||||
| 510 | "SELECT * FROM accountlines | |||||
| 511 | WHERE itemnumber=? | |||||
| 512 | AND borrowernumber=? | |||||
| 513 | AND accounttype IN ('FU','O','F','M') | |||||
| 514 | AND description like ? " | |||||
| 515 | ); | |||||
| 516 | 0 | $sth->execute( $itemnum, $borrowernumber, "%$due%" ); | ||||
| 517 | ||||||
| 518 | 0 | if ( my $data = $sth->fetchrow_hashref ) { | ||||
| 519 | ||||||
| 520 | # we're updating an existing fine. Only modify if amount changed | |||||
| 521 | # Note that in the current implementation, you cannot pay against an accruing fine | |||||
| 522 | # (i.e. , of accounttype 'FU'). Doing so will break accrual. | |||||
| 523 | 0 | if ( $data->{'amount'} != $amount ) { | ||||
| 524 | 0 | my $diff = $amount - $data->{'amount'}; | ||||
| 525 | #3341: diff could be positive or negative! | |||||
| 526 | 0 | my $out = $data->{'amountoutstanding'} + $diff; | ||||
| 527 | 0 | my $query = " | ||||
| 528 | UPDATE accountlines | |||||
| 529 | SET date=now(), amount=?, amountoutstanding=?, | |||||
| 530 | lastincrement=?, accounttype='FU' | |||||
| 531 | WHERE borrowernumber=? | |||||
| 532 | AND itemnumber=? | |||||
| 533 | AND accounttype IN ('FU','O') | |||||
| 534 | AND description LIKE ? | |||||
| 535 | LIMIT 1 "; | |||||
| 536 | 0 | my $sth2 = $dbh->prepare($query); | ||||
| 537 | # FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!! | |||||
| 538 | # LIMIT 1 added to prevent multiple affected lines | |||||
| 539 | # FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline. | |||||
| 540 | # But actually, we should just have a regular autoincrementing PK and forget accountline, | |||||
| 541 | # including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops). | |||||
| 542 | # FIXME: Why only 2 account types here? | |||||
| 543 | 0 | $debug and print STDERR "UpdateFine query: $query\n" . | ||||
| 544 | "w/ args: $amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, \"\%$due\%\"\n"; | |||||
| 545 | 0 | $sth2->execute($amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, "%$due%"); | ||||
| 546 | } else { | |||||
| 547 | # print "no update needed $data->{'amount'}" | |||||
| 548 | } | |||||
| 549 | } else { | |||||
| 550 | 0 | my $sth4 = $dbh->prepare( | ||||
| 551 | "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?" | |||||
| 552 | ); | |||||
| 553 | 0 | $sth4->execute($itemnum); | ||||
| 554 | 0 | my $title = $sth4->fetchrow; | ||||
| 555 | ||||||
| 556 | # # print "not in account"; | |||||
| 557 | # my $sth3 = $dbh->prepare("Select max(accountno) from accountlines"); | |||||
| 558 | # $sth3->execute; | |||||
| 559 | # | |||||
| 560 | # # FIXME - Make $accountno a scalar. | |||||
| 561 | # my @accountno = $sth3->fetchrow_array; | |||||
| 562 | # $sth3->finish; | |||||
| 563 | # $accountno[0]++; | |||||
| 564 | # begin transaction | |||||
| 565 | 0 | my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber); | ||||
| 566 | 0 | my $desc = ($type ? "$type " : '') . "$title $due"; # FIXEDME, avoid whitespace prefix on empty $type | ||||
| 567 | 0 | my $query = "INSERT INTO accountlines | ||||
| 568 | (borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno) | |||||
| 569 | VALUES (?,?,now(),?,?,'FU',?,?,?)"; | |||||
| 570 | 0 | my $sth2 = $dbh->prepare($query); | ||||
| 571 | 0 | $debug and print STDERR "UpdateFine query: $query\nw/ args: $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno\n"; | ||||
| 572 | 0 | $sth2->execute($borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno); | ||||
| 573 | } | |||||
| 574 | # logging action | |||||
| 575 | 0 | &logaction( | ||||
| 576 | "FINES", | |||||
| 577 | $type, | |||||
| 578 | $borrowernumber, | |||||
| 579 | "due=".$due." amount=".$amount." itemnumber=".$itemnum | |||||
| 580 | ) if C4::Context->preference("FinesLog"); | |||||
| 581 | } | |||||
| 582 | ||||||
| 583 - 594 | =head2 BorType
$borrower = &BorType($borrowernumber);
Looks up a patron by borrower number.
C<$borrower> is a reference-to-hash whose keys are all of the fields
from the borrowers and categories tables of the Koha database. Thus,
C<$borrower> contains all information about both the borrower and
category he or she belongs to.
=cut | |||||
| 595 | ||||||
| 596 | #' | |||||
| 597 | sub BorType { | |||||
| 598 | 0 | my ($borrowernumber) = @_; | ||||
| 599 | 0 | my $dbh = C4::Context->dbh; | ||||
| 600 | 0 | my $sth = $dbh->prepare( | ||||
| 601 | "SELECT * from borrowers | |||||
| 602 | LEFT JOIN categories ON borrowers.categorycode=categories.categorycode | |||||
| 603 | WHERE borrowernumber=?" | |||||
| 604 | ); | |||||
| 605 | 0 | $sth->execute($borrowernumber); | ||||
| 606 | 0 | return $sth->fetchrow_hashref; | ||||
| 607 | } | |||||
| 608 | ||||||
| 609 - 615 | =head2 ReplacementCost
$cost = &ReplacementCost($itemnumber);
Returns the replacement cost of the item with the given item number.
=cut | |||||
| 616 | ||||||
| 617 | #' | |||||
| 618 | sub ReplacementCost { | |||||
| 619 | 0 | my ($itemnum) = @_; | ||||
| 620 | 0 | my $dbh = C4::Context->dbh; | ||||
| 621 | 0 | my $sth = | ||||
| 622 | $dbh->prepare("Select replacementprice from items where itemnumber=?"); | |||||
| 623 | 0 | $sth->execute($itemnum); | ||||
| 624 | ||||||
| 625 | # FIXME - Use fetchrow_array or a slice. | |||||
| 626 | 0 | my $data = $sth->fetchrow_hashref; | ||||
| 627 | 0 | return ( $data->{'replacementprice'} ); | ||||
| 628 | } | |||||
| 629 | ||||||
| 630 - 640 | =head2 GetFine
$data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
return the total of fine
C<$itemnum> is item number
C<$borrowernumber> is the borrowernumber
=cut | |||||
| 641 | ||||||
| 642 | ||||||
| 643 | sub GetFine { | |||||
| 644 | 0 | my ( $itemnum, $borrowernumber ) = @_; | ||||
| 645 | 0 | my $dbh = C4::Context->dbh(); | ||||
| 646 | 0 | my $query = q|SELECT sum(amountoutstanding) as fineamount FROM accountlines | ||||
| 647 | where accounttype like 'F%' | |||||
| 648 | AND amountoutstanding > 0 AND itemnumber = ? AND borrowernumber=?|; | |||||
| 649 | 0 | my $sth = $dbh->prepare($query); | ||||
| 650 | 0 | $sth->execute( $itemnum, $borrowernumber ); | ||||
| 651 | 0 | my $fine = $sth->fetchrow_hashref(); | ||||
| 652 | 0 | if ($fine->{fineamount}) { | ||||
| 653 | 0 | return $fine->{fineamount}; | ||||
| 654 | } | |||||
| 655 | 0 | return 0; | ||||
| 656 | } | |||||
| 657 | ||||||
| 658 | ||||||
| 659 - 675 | =head2 GetIssuingRules
FIXME - This sub should be deprecated and removed.
It ignores branch and defaults.
$data = &GetIssuingRules($itemtype,$categorycode);
Looks up for all issuingrules an item info
C<$itemnumber> is a reference-to-hash whose keys are all of the fields
from the borrowers and categories tables of the Koha database. Thus,
C<$categorycode> contains information about borrowers category
C<$data> contains all information about both the borrower and
category he or she belongs to.
=cut | |||||
| 676 | ||||||
| 677 | sub GetIssuingRules { | |||||
| 678 | 0 | warn "GetIssuingRules is deprecated: use GetIssuingRule from C4::Circulation instead."; | ||||
| 679 | 0 | my ($itemtype,$categorycode)=@_; | ||||
| 680 | 0 | my $dbh = C4::Context->dbh(); | ||||
| 681 | 0 | my $query=qq|SELECT * | ||||
| 682 | FROM issuingrules | |||||
| 683 | WHERE issuingrules.itemtype=? | |||||
| 684 | AND issuingrules.categorycode=? | |||||
| 685 | |; | |||||
| 686 | 0 | my $sth = $dbh->prepare($query); | ||||
| 687 | # print $query; | |||||
| 688 | 0 | $sth->execute($itemtype,$categorycode); | ||||
| 689 | 0 | return $sth->fetchrow_hashref; | ||||
| 690 | } | |||||
| 691 | ||||||
| 692 | ||||||
| 693 | sub ReplacementCost2 { | |||||
| 694 | 0 | my ( $itemnum, $borrowernumber ) = @_; | ||||
| 695 | 0 | my $dbh = C4::Context->dbh(); | ||||
| 696 | 0 | my $query = "SELECT amountoutstanding | ||||
| 697 | FROM accountlines | |||||
| 698 | WHERE accounttype like 'L' | |||||
| 699 | AND amountoutstanding > 0 | |||||
| 700 | AND itemnumber = ? | |||||
| 701 | AND borrowernumber= ?"; | |||||
| 702 | 0 | my $sth = $dbh->prepare($query); | ||||
| 703 | 0 | $sth->execute( $itemnum, $borrowernumber ); | ||||
| 704 | 0 | my $data = $sth->fetchrow_hashref(); | ||||
| 705 | 0 | return ( $data->{'amountoutstanding'} ); | ||||
| 706 | } | |||||
| 707 | ||||||
| 708 | ||||||
| 709 - 719 | =head2 GetNextIdNotify
($result) = &GetNextIdNotify($reference);
Returns the new file number
C<$result> contains the next file number
C<$reference> contains the beggining of file number
=cut | |||||
| 720 | ||||||
| 721 | sub GetNextIdNotify { | |||||
| 722 | 0 | my ($reference) = @_; | ||||
| 723 | 0 | my $query = qq|SELECT max(notify_id) | ||||
| 724 | FROM accountlines | |||||
| 725 | WHERE notify_id like \"$reference%\" | |||||
| 726 | |; | |||||
| 727 | ||||||
| 728 | # AND borrowernumber=?|; | |||||
| 729 | 0 | my $dbh = C4::Context->dbh; | ||||
| 730 | 0 | my $sth = $dbh->prepare($query); | ||||
| 731 | 0 | $sth->execute(); | ||||
| 732 | 0 | my $result = $sth->fetchrow; | ||||
| 733 | 0 | my $count; | ||||
| 734 | 0 | if ( $result eq '' ) { | ||||
| 735 | 0 | ( $result = $reference . "01" ); | ||||
| 736 | } | |||||
| 737 | else { | |||||
| 738 | 0 | $count = substr( $result, 6 ) + 1; | ||||
| 739 | ||||||
| 740 | 0 | if ( $count < 10 ) { | ||||
| 741 | 0 | ( $count = "0" . $count ); | ||||
| 742 | } | |||||
| 743 | 0 | $result = $reference . $count; | ||||
| 744 | } | |||||
| 745 | 0 | return $result; | ||||
| 746 | } | |||||
| 747 | ||||||
| 748 - 757 | =head2 NumberNotifyId
(@notify) = &NumberNotifyId($borrowernumber);
Returns amount for all file per borrowers
C<@notify> array contains all file per borrowers
C<$notify_id> contains the file number for the borrower number nad item number
=cut | |||||
| 758 | ||||||
| 759 | sub NumberNotifyId{ | |||||
| 760 | 0 | my ($borrowernumber)=@_; | ||||
| 761 | 0 | my $dbh = C4::Context->dbh; | ||||
| 762 | 0 | my $query=qq| SELECT distinct(notify_id) | ||||
| 763 | FROM accountlines | |||||
| 764 | WHERE borrowernumber=?|; | |||||
| 765 | 0 | my @notify; | ||||
| 766 | 0 | my $sth = $dbh->prepare($query); | ||||
| 767 | 0 | $sth->execute($borrowernumber); | ||||
| 768 | 0 | while ( my ($numberofnotify) = $sth->fetchrow ) { | ||||
| 769 | 0 | push( @notify, $numberofnotify ); | ||||
| 770 | } | |||||
| 771 | 0 | return (@notify); | ||||
| 772 | } | |||||
| 773 | ||||||
| 774 - 785 | =head2 AmountNotify
($totalnotify) = &AmountNotify($notifyid);
Returns amount for all file per borrowers
C<$notifyid> is the file number
C<$totalnotify> contains amount of a file
C<$notify_id> contains the file number for the borrower number and item number
=cut | |||||
| 786 | ||||||
| 787 | sub AmountNotify{ | |||||
| 788 | 0 | my ($notifyid,$borrowernumber)=@_; | ||||
| 789 | 0 | my $dbh = C4::Context->dbh; | ||||
| 790 | 0 | my $query=qq| SELECT sum(amountoutstanding) | ||||
| 791 | FROM accountlines | |||||
| 792 | WHERE notify_id=? AND borrowernumber = ?|; | |||||
| 793 | 0 | my $sth=$dbh->prepare($query); | ||||
| 794 | 0 | $sth->execute($notifyid,$borrowernumber); | ||||
| 795 | 0 | my $totalnotify=$sth->fetchrow; | ||||
| 796 | 0 | $sth->finish; | ||||
| 797 | 0 | return ($totalnotify); | ||||
| 798 | } | |||||
| 799 | ||||||
| 800 | ||||||
| 801 - 814 | =head2 GetNotifyId
($notify_id) = &GetNotifyId($borrowernumber,$itemnumber);
Returns the file number per borrower and itemnumber
C<$borrowernumber> is a reference-to-hash whose keys are all of the fields
from the items tables of the Koha database. Thus,
C<$itemnumber> contains the borrower categorycode
C<$notify_id> contains the file number for the borrower number nad item number
=cut | |||||
| 815 | ||||||
| 816 | sub GetNotifyId { | |||||
| 817 | 0 | my ( $borrowernumber, $itemnumber ) = @_; | ||||
| 818 | 0 | my $query = qq|SELECT notify_id | ||||
| 819 | FROM accountlines | |||||
| 820 | WHERE borrowernumber=? | |||||
| 821 | AND itemnumber=? | |||||
| 822 | AND (accounttype='FU' or accounttype='O')|; | |||||
| 823 | 0 | my $dbh = C4::Context->dbh; | ||||
| 824 | 0 | my $sth = $dbh->prepare($query); | ||||
| 825 | 0 | $sth->execute( $borrowernumber, $itemnumber ); | ||||
| 826 | 0 | my ($notify_id) = $sth->fetchrow; | ||||
| 827 | 0 | $sth->finish; | ||||
| 828 | 0 | return ($notify_id); | ||||
| 829 | } | |||||
| 830 | ||||||
| 831 - 862 | =head2 CreateItemAccountLine
() = &CreateItemAccountLine($borrowernumber, $itemnumber, $date, $amount,
$description, $accounttype, $amountoutstanding,
$timestamp, $notify_id, $level);
update the account lines with file number or with file level
C<$items> is a reference-to-hash whose keys are all of the fields
from the items tables of the Koha database. Thus,
C<$itemnumber> contains the item number
C<$borrowernumber> contains the borrower number
C<$date> contains the date of the day
C<$amount> contains item price
C<$description> contains the descritpion of accounttype
C<$accounttype> contains the account type
C<$amountoutstanding> contains the $amountoutstanding
C<$timestamp> contains the timestamp with time and the date of the day
C<$notify_id> contains the file number
C<$level> contains the file level
=cut | |||||
| 863 | ||||||
| 864 | sub CreateItemAccountLine { | |||||
| 865 | my ( | |||||
| 866 | 0 | $borrowernumber, $itemnumber, $date, $amount, | ||||
| 867 | $description, $accounttype, $amountoutstanding, $timestamp, | |||||
| 868 | $notify_id, $level | |||||
| 869 | ) = @_; | |||||
| 870 | 0 | my $dbh = C4::Context->dbh; | ||||
| 871 | 0 | my $nextaccntno = C4::Accounts::getnextacctno($borrowernumber); | ||||
| 872 | 0 | my $query = "INSERT into accountlines | ||||
| 873 | (borrowernumber,accountno,itemnumber,date,amount,description,accounttype,amountoutstanding,timestamp,notify_id,notify_level) | |||||
| 874 | VALUES | |||||
| 875 | (?,?,?,?,?,?,?,?,?,?,?)"; | |||||
| 876 | ||||||
| 877 | 0 | my $sth = $dbh->prepare($query); | ||||
| 878 | 0 | $sth->execute( | ||||
| 879 | $borrowernumber, $nextaccntno, $itemnumber, | |||||
| 880 | $date, $amount, $description, | |||||
| 881 | $accounttype, $amountoutstanding, $timestamp, | |||||
| 882 | $notify_id, $level | |||||
| 883 | ); | |||||
| 884 | } | |||||
| 885 | ||||||
| 886 - 903 | =head2 UpdateAccountLines
() = &UpdateAccountLines($notify_id,$notify_level,$borrowernumber,$itemnumber);
update the account lines with file number or with file level
C<$items> is a reference-to-hash whose keys are all of the fields
from the items tables of the Koha database. Thus,
C<$itemnumber> contains the item number
C<$notify_id> contains the file number
C<$notify_level> contains the file level
C<$borrowernumber> contains the borrowernumber
=cut | |||||
| 904 | ||||||
| 905 | sub UpdateAccountLines { | |||||
| 906 | 0 | my ( $notify_id, $notify_level, $borrowernumber, $itemnumber ) = @_; | ||||
| 907 | 0 | my $query; | ||||
| 908 | 0 | if ( $notify_id eq '' ) { | ||||
| 909 | 0 | $query = qq|UPDATE accountlines | ||||
| 910 | SET notify_level=? | |||||
| 911 | WHERE borrowernumber=? AND itemnumber=? | |||||
| 912 | AND (accounttype='FU' or accounttype='O')|; | |||||
| 913 | } else { | |||||
| 914 | 0 | $query = qq|UPDATE accountlines | ||||
| 915 | SET notify_id=?, notify_level=? | |||||
| 916 | WHERE borrowernumber=? | |||||
| 917 | AND itemnumber=? | |||||
| 918 | AND (accounttype='FU' or accounttype='O')|; | |||||
| 919 | } | |||||
| 920 | ||||||
| 921 | 0 | my $sth = C4::Context->dbh->prepare($query); | ||||
| 922 | 0 | if ( $notify_id eq '' ) { | ||||
| 923 | 0 | $sth->execute( $notify_level, $borrowernumber, $itemnumber ); | ||||
| 924 | } else { | |||||
| 925 | 0 | $sth->execute( $notify_id, $notify_level, $borrowernumber, $itemnumber ); | ||||
| 926 | } | |||||
| 927 | } | |||||
| 928 | ||||||
| 929 - 940 | =head2 GetItems
($items) = &GetItems($itemnumber);
Returns the list of all delays from overduerules.
C<$items> is a reference-to-hash whose keys are all of the fields
from the items tables of the Koha database. Thus,
C<$itemnumber> contains the borrower categorycode
=cut | |||||
| 941 | ||||||
| 942 | # FIXME: This is a bad function to have here. | |||||
| 943 | # Shouldn't it be in C4::Items? | |||||
| 944 | # Shouldn't it be called GetItem since you only get 1 row? | |||||
| 945 | # Shouldn't it be called GetItem since you give it only 1 itemnumber? | |||||
| 946 | ||||||
| 947 | sub GetItems { | |||||
| 948 | 0 | my $itemnumber = shift or return; | ||||
| 949 | 0 | my $query = qq|SELECT * | ||||
| 950 | FROM items | |||||
| 951 | WHERE itemnumber=?|; | |||||
| 952 | 0 | my $sth = C4::Context->dbh->prepare($query); | ||||
| 953 | 0 | $sth->execute($itemnumber); | ||||
| 954 | 0 | my ($items) = $sth->fetchrow_hashref; | ||||
| 955 | 0 | return ($items); | ||||
| 956 | } | |||||
| 957 | ||||||
| 958 - 968 | =head2 GetOverdueDelays
(@delays) = &GetOverdueDelays($categorycode);
Returns the list of all delays from overduerules.
C<@delays> it's an array contains the three delays from overduerules table
C<$categorycode> contains the borrower categorycode
=cut | |||||
| 969 | ||||||
| 970 | sub GetOverdueDelays { | |||||
| 971 | 0 | my ($category) = @_; | ||||
| 972 | 0 | my $query = qq|SELECT delay1,delay2,delay3 | ||||
| 973 | FROM overduerules | |||||
| 974 | WHERE categorycode=?|; | |||||
| 975 | 0 | my $sth = C4::Context->dbh->prepare($query); | ||||
| 976 | 0 | $sth->execute($category); | ||||
| 977 | 0 | my (@delays) = $sth->fetchrow_array; | ||||
| 978 | 0 | return (@delays); | ||||
| 979 | } | |||||
| 980 | ||||||
| 981 - 987 | =head2 GetBranchcodesWithOverdueRules
my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules()
returns a list of branch codes for branches with overdue rules defined.
=cut | |||||
| 988 | ||||||
| 989 | sub GetBranchcodesWithOverdueRules { | |||||
| 990 | 0 | my $dbh = C4::Context->dbh; | ||||
| 991 | 0 | my $rqoverduebranches = $dbh->prepare("SELECT DISTINCT branchcode FROM overduerules WHERE delay1 IS NOT NULL AND branchcode <> '' ORDER BY branchcode"); | ||||
| 992 | 0 | $rqoverduebranches->execute; | ||||
| 993 | 0 0 0 | my @branches = map { shift @$_ } @{ $rqoverduebranches->fetchall_arrayref }; | ||||
| 994 | 0 | if (!$branches[0]) { | ||||
| 995 | 0 | my $availbranches = C4::Branch::GetBranches(); | ||||
| 996 | 0 | @branches = keys %$availbranches; | ||||
| 997 | } | |||||
| 998 | 0 | return @branches; | ||||
| 999 | } | |||||
| 1000 | ||||||
| 1001 - 1019 | =head2 CheckAccountLineLevelInfo
($exist) = &CheckAccountLineLevelInfo($borrowernumber,$itemnumber,$accounttype,notify_level);
Check and Returns the list of all overdue books.
C<$exist> contains number of line in accounlines
with the same .biblionumber,itemnumber,accounttype,and notify_level
C<$borrowernumber> contains the borrower number
C<$itemnumber> contains item number
C<$accounttype> contains account type
C<$notify_level> contains the accountline level
=cut | |||||
| 1020 | ||||||
| 1021 | sub CheckAccountLineLevelInfo { | |||||
| 1022 | 0 | my ( $borrowernumber, $itemnumber, $level ) = @_; | ||||
| 1023 | 0 | my $dbh = C4::Context->dbh; | ||||
| 1024 | 0 | my $query = qq|SELECT count(*) | ||||
| 1025 | FROM accountlines | |||||
| 1026 | WHERE borrowernumber =? | |||||
| 1027 | AND itemnumber = ? | |||||
| 1028 | AND notify_level=?|; | |||||
| 1029 | 0 | my $sth = $dbh->prepare($query); | ||||
| 1030 | 0 | $sth->execute( $borrowernumber, $itemnumber, $level ); | ||||
| 1031 | 0 | my ($exist) = $sth->fetchrow; | ||||
| 1032 | 0 | return ($exist); | ||||
| 1033 | } | |||||
| 1034 | ||||||
| 1035 - 1047 | =head2 GetOverduerules
($overduerules) = &GetOverduerules($categorycode);
Returns the value of borrowers (debarred or not) with notify level
C<$overduerules> return value of debbraed field in overduerules table
C<$category> contains the borrower categorycode
C<$notify_level> contains the notify level
=cut | |||||
| 1048 | ||||||
| 1049 | sub GetOverduerules { | |||||
| 1050 | 0 | my ( $category, $notify_level ) = @_; | ||||
| 1051 | 0 | my $dbh = C4::Context->dbh; | ||||
| 1052 | 0 | my $query = qq|SELECT debarred$notify_level | ||||
| 1053 | FROM overduerules | |||||
| 1054 | WHERE categorycode=?|; | |||||
| 1055 | 0 | my $sth = $dbh->prepare($query); | ||||
| 1056 | 0 | $sth->execute($category); | ||||
| 1057 | 0 | my ($overduerules) = $sth->fetchrow; | ||||
| 1058 | 0 | return ($overduerules); | ||||
| 1059 | } | |||||
| 1060 | ||||||
| 1061 | ||||||
| 1062 - 1072 | =head2 CheckBorrowerDebarred
($debarredstatus) = &CheckBorrowerDebarred($borrowernumber);
Check if the borrowers is already debarred
C<$debarredstatus> return 0 for not debarred and return 1 for debarred
C<$borrowernumber> contains the borrower number
=cut | |||||
| 1073 | ||||||
| 1074 | # FIXME: Shouldn't this be in C4::Members? | |||||
| 1075 | sub CheckBorrowerDebarred { | |||||
| 1076 | 0 | my ($borrowernumber) = @_; | ||||
| 1077 | 0 | my $dbh = C4::Context->dbh; | ||||
| 1078 | 0 | my $query = qq| | ||||
| 1079 | SELECT debarred | |||||
| 1080 | FROM borrowers | |||||
| 1081 | WHERE borrowernumber=? | |||||
| 1082 | AND debarred > NOW() | |||||
| 1083 | |; | |||||
| 1084 | 0 | my $sth = $dbh->prepare($query); | ||||
| 1085 | 0 | $sth->execute($borrowernumber); | ||||
| 1086 | 0 | my $debarredstatus = $sth->fetchrow; | ||||
| 1087 | 0 | return $debarredstatus; | ||||
| 1088 | } | |||||
| 1089 | ||||||
| 1090 | ||||||
| 1091 - 1104 | =head2 CheckExistantNotifyid
($exist) = &CheckExistantNotifyid($borrowernumber,$itemnumber,$accounttype,$notify_id);
Check and Returns the notify id if exist else return 0.
C<$exist> contains a notify_id
C<$borrowernumber> contains the borrower number
C<$date_due> contains the date of item return
=cut | |||||
| 1105 | ||||||
| 1106 | sub CheckExistantNotifyid { | |||||
| 1107 | 0 | my ( $borrowernumber, $date_due ) = @_; | ||||
| 1108 | 0 | my $dbh = C4::Context->dbh; | ||||
| 1109 | 0 | my $query = qq|SELECT notify_id FROM accountlines | ||||
| 1110 | LEFT JOIN issues ON issues.itemnumber= accountlines.itemnumber | |||||
| 1111 | WHERE accountlines.borrowernumber =? | |||||
| 1112 | AND date_due = ?|; | |||||
| 1113 | 0 | my $sth = $dbh->prepare($query); | ||||
| 1114 | 0 | $sth->execute( $borrowernumber, $date_due ); | ||||
| 1115 | 0 | return $sth->fetchrow || 0; | ||||
| 1116 | } | |||||
| 1117 | ||||||
| 1118 - 1135 | =head2 CheckAccountLineItemInfo
($exist) = &CheckAccountLineItemInfo($borrowernumber,$itemnumber,$accounttype,$notify_id);
Check and Returns the list of all overdue items from the same file number(notify_id).
C<$exist> contains number of line in accounlines
with the same .biblionumber,itemnumber,accounttype,notify_id
C<$borrowernumber> contains the borrower number
C<$itemnumber> contains item number
C<$accounttype> contains account type
C<$notify_id> contains the file number
=cut | |||||
| 1136 | ||||||
| 1137 | sub CheckAccountLineItemInfo { | |||||
| 1138 | 0 | my ( $borrowernumber, $itemnumber, $accounttype, $notify_id ) = @_; | ||||
| 1139 | 0 | my $dbh = C4::Context->dbh; | ||||
| 1140 | 0 | my $query = qq|SELECT count(*) FROM accountlines | ||||
| 1141 | WHERE borrowernumber =? | |||||
| 1142 | AND itemnumber = ? | |||||
| 1143 | AND accounttype= ? | |||||
| 1144 | AND notify_id = ?|; | |||||
| 1145 | 0 | my $sth = $dbh->prepare($query); | ||||
| 1146 | 0 | $sth->execute( $borrowernumber, $itemnumber, $accounttype, $notify_id ); | ||||
| 1147 | 0 | my ($exist) = $sth->fetchrow; | ||||
| 1148 | 0 | return ($exist); | ||||
| 1149 | } | |||||
| 1150 | ||||||
| 1151 - 1156 | =head2 CheckItemNotify Sql request to check if the document has alreday been notified this function is not exported, only used with GetOverduesForBranch =cut | |||||
| 1157 | ||||||
| 1158 | sub CheckItemNotify { | |||||
| 1159 | 0 | my ($notify_id,$notify_level,$itemnumber) = @_; | ||||
| 1160 | 0 | my $dbh = C4::Context->dbh; | ||||
| 1161 | 0 | my $sth = $dbh->prepare(" | ||||
| 1162 | SELECT COUNT(*) | |||||
| 1163 | FROM notifys | |||||
| 1164 | WHERE notify_id = ? | |||||
| 1165 | AND notify_level = ? | |||||
| 1166 | AND itemnumber = ? "); | |||||
| 1167 | 0 | $sth->execute($notify_id,$notify_level,$itemnumber); | ||||
| 1168 | 0 | my $notified = $sth->fetchrow; | ||||
| 1169 | 0 | return ($notified); | ||||
| 1170 | } | |||||
| 1171 | ||||||
| 1172 - 1180 | =head2 GetOverduesForBranch Sql request for display all information for branchoverdues.pl 2 possibilities : with or without location . display is filtered by branch FIXME: This function should be renamed. =cut | |||||
| 1181 | ||||||
| 1182 | sub GetOverduesForBranch { | |||||
| 1183 | 0 | my ( $branch, $location) = @_; | ||||
| 1184 | 0 | my $itype_link = (C4::Context->preference('item-level_itypes')) ? " items.itype " : " biblioitems.itemtype "; | ||||
| 1185 | 0 | my $dbh = C4::Context->dbh; | ||||
| 1186 | 0 | my $select = " | ||||
| 1187 | SELECT | |||||
| 1188 | borrowers.borrowernumber, | |||||
| 1189 | borrowers.surname, | |||||
| 1190 | borrowers.firstname, | |||||
| 1191 | borrowers.phone, | |||||
| 1192 | borrowers.email, | |||||
| 1193 | biblio.title, | |||||
| 1194 | biblio.author, | |||||
| 1195 | biblio.biblionumber, | |||||
| 1196 | issues.date_due, | |||||
| 1197 | issues.returndate, | |||||
| 1198 | issues.branchcode, | |||||
| 1199 | branches.branchname, | |||||
| 1200 | items.barcode, | |||||
| 1201 | items.homebranch, | |||||
| 1202 | items.itemcallnumber, | |||||
| 1203 | items.location, | |||||
| 1204 | items.itemnumber, | |||||
| 1205 | itemtypes.description, | |||||
| 1206 | accountlines.notify_id, | |||||
| 1207 | accountlines.notify_level, | |||||
| 1208 | accountlines.amountoutstanding | |||||
| 1209 | FROM accountlines | |||||
| 1210 | LEFT JOIN issues ON issues.itemnumber = accountlines.itemnumber | |||||
| 1211 | AND issues.borrowernumber = accountlines.borrowernumber | |||||
| 1212 | LEFT JOIN borrowers ON borrowers.borrowernumber = accountlines.borrowernumber | |||||
| 1213 | LEFT JOIN items ON items.itemnumber = issues.itemnumber | |||||
| 1214 | LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber | |||||
| 1215 | LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber | |||||
| 1216 | LEFT JOIN itemtypes ON itemtypes.itemtype = $itype_link | |||||
| 1217 | LEFT JOIN branches ON branches.branchcode = issues.branchcode | |||||
| 1218 | WHERE (accountlines.amountoutstanding != '0.000000') | |||||
| 1219 | AND (accountlines.accounttype = 'FU' ) | |||||
| 1220 | AND (issues.branchcode = ? ) | |||||
| 1221 | AND (issues.date_due < CURDATE()) | |||||
| 1222 | "; | |||||
| 1223 | 0 | my @getoverdues; | ||||
| 1224 | 0 | my $i = 0; | ||||
| 1225 | 0 | my $sth; | ||||
| 1226 | 0 | if ($location) { | ||||
| 1227 | 0 | $sth = $dbh->prepare("$select AND items.location = ? ORDER BY borrowers.surname, borrowers.firstname"); | ||||
| 1228 | 0 | $sth->execute($branch, $location); | ||||
| 1229 | } else { | |||||
| 1230 | 0 | $sth = $dbh->prepare("$select ORDER BY borrowers.surname, borrowers.firstname"); | ||||
| 1231 | 0 | $sth->execute($branch); | ||||
| 1232 | } | |||||
| 1233 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 1234 | #check if the document has already been notified | |||||
| 1235 | 0 | my $countnotify = CheckItemNotify($data->{'notify_id'}, $data->{'notify_level'}, $data->{'itemnumber'}); | ||||
| 1236 | 0 | if ($countnotify eq '0') { | ||||
| 1237 | 0 | $getoverdues[$i] = $data; | ||||
| 1238 | 0 | $i++; | ||||
| 1239 | } | |||||
| 1240 | } | |||||
| 1241 | 0 | return (@getoverdues); | ||||
| 1242 | } | |||||
| 1243 | ||||||
| 1244 | ||||||
| 1245 - 1251 | =head2 AddNotifyLine
&AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
Create a line into notify, if the method is phone, the notification_send_date is implemented to
=cut | |||||
| 1252 | ||||||
| 1253 | sub AddNotifyLine { | |||||
| 1254 | 0 | my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_; | ||||
| 1255 | 0 | my $dbh = C4::Context->dbh; | ||||
| 1256 | 0 | if ( $method eq "phone" ) { | ||||
| 1257 | 0 | my $sth = $dbh->prepare( | ||||
| 1258 | "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id) | |||||
| 1259 | VALUES (?,?,now(),now(),?,?,?)" | |||||
| 1260 | ); | |||||
| 1261 | 0 | $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method, | ||||
| 1262 | $notifyId ); | |||||
| 1263 | } | |||||
| 1264 | else { | |||||
| 1265 | 0 | my $sth = $dbh->prepare( | ||||
| 1266 | "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id) | |||||
| 1267 | VALUES (?,?,now(),?,?,?)" | |||||
| 1268 | ); | |||||
| 1269 | 0 | $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method, | ||||
| 1270 | $notifyId ); | |||||
| 1271 | } | |||||
| 1272 | 0 | return 1; | ||||
| 1273 | } | |||||
| 1274 | ||||||
| 1275 - 1281 | =head2 RemoveNotifyLine
&RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
Cancel a notification
=cut | |||||
| 1282 | ||||||
| 1283 | sub RemoveNotifyLine { | |||||
| 1284 | 0 | my ( $borrowernumber, $itemnumber, $notify_date ) = @_; | ||||
| 1285 | 0 | my $dbh = C4::Context->dbh; | ||||
| 1286 | 0 | my $sth = $dbh->prepare( | ||||
| 1287 | "DELETE FROM notifys | |||||
| 1288 | WHERE | |||||
| 1289 | borrowernumber=? | |||||
| 1290 | AND itemnumber=? | |||||
| 1291 | AND notify_date=?" | |||||
| 1292 | ); | |||||
| 1293 | 0 | $sth->execute( $borrowernumber, $itemnumber, $notify_date ); | ||||
| 1294 | 0 | return 1; | ||||
| 1295 | } | |||||
| 1296 | ||||||
| 1297 | 1; | |||||