File Coverage

File:	C4/Circulation.pm
Coverage:	7.9%

line	stmt	bran	cond	sub	time	code
1						package C4::Circulation;
2
3						# Copyright 2000-2002 Katipo Communications
4						# copyright 2010 BibLibre
5						#
6						# This file is part of Koha.
7						#
8						# Koha is free software; you can redistribute it and/or modify it under the
9						# terms of the GNU General Public License as published by the Free Software
10						# Foundation; either version 2 of the License, or (at your option) any later
11						# version.
12						#
13						# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14						# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15						# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16						#
17						# You should have received a copy of the GNU General Public License along
18						# with Koha; if not, write to the Free Software Foundation, Inc.,
19						# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20
21
22	12 12 12			12	19278 183 704	use strict;
23						#use warnings; FIXME - Bug 2505
24	12 12 12			12	524 117 266	use C4::Context;
25	12 12 12			12	2248 65 1121	use C4::Stats;
26	12 12 12			12	2193 133 4385	use C4::Reserves;
27	12 12 12			12	156 93 6238	use C4::Biblio;
28	12 12 12			12	484 89 3018	use C4::Items;
29	12 12 12			12	157 73 2207	use C4::Members;
30	12 12 12			12	115 134 609	use C4::Dates;
31	12 12 12			12	3450 122 787	use C4::Calendar;
32	12 12 12			12	143 86 2695	use C4::Accounts;
33	12 12 12			12	2797 63 758	use C4::ItemCirculationAlertPreference;
34	12 12 12			12	100 57 946	use C4::Dates qw(format_date);
35	12 12 12			12	2240 43 699	use C4::Message;
36	12 12 12			12	90 36 1380	use C4::Debug;
37	12				1295	use Date::Calc qw(
38						Today
39						Today_and_Now
40						Add_Delta_YM
41						Add_Delta_DHMS
42						Date_to_Days
43						Day_of_Week
44						Add_Delta_Days
45						check_date
46						Delta_Days
47	12 12			12	69 43	);
48	12 12 12			12	83 25 161	use POSIX qw(strftime);
49	12 12 12			12	970 43 2052	use C4::Branch; # GetBranches
50	12 12 12			12	62 22 1404	use C4::Log; # logaction
51
52	12 12 12			12	65 22 826	use Data::Dumper;
53
54	12 12 12			12	61 24 2757	use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
55
56						BEGIN {
57	12			12	90	require Exporter;
58	12				26	$VERSION = 3.02; # for version checking
59	12				144	@ISA = qw(Exporter);
60
61						# FIXME subs that should probably be elsewhere
62	12				45	push @EXPORT, qw(
63						&barcodedecode
64						&LostItem
65						&ReturnLostItem
66						);
67
68						# subs to deal with issuing a book
69	12				101	push @EXPORT, qw(
70						&CanBookBeIssued
71						&CanBookBeRenewed
72						&AddIssue
73						&AddRenewal
74						&GetRenewCount
75						&GetItemIssue
76						&GetItemIssues
77						&GetIssuingCharges
78						&GetIssuingRule
79						&GetBranchBorrowerCircRule
80						&GetBranchItemRule
81						&GetBiblioIssues
82						&GetOpenIssue
83						&AnonymiseIssueHistory
84						);
85
86						# subs to deal with returns
87	12				30	push @EXPORT, qw(
88						&AddReturn
89						&MarkIssueReturned
90						);
91
92						# subs to deal with transfers
93	12				198337	push @EXPORT, qw(
94						&transferbook
95						&GetTransfers
96						&GetTransfersFromTo
97						&updateWrongTransfer
98						&DeleteTransfer
99						&IsBranchTransferAllowed
100						&CreateBranchTransferLimit
101						&DeleteBranchTransferLimits
102						);
103						}
104
105 - 136						=head1 NAME C4::Circulation - Koha circulation module =head1 SYNOPSIS use C4::Circulation; =head1 DESCRIPTION The functions in this module deal with circulation, issues, and returns, as well as general information about the library. Also deals with stocktaking. =head1 FUNCTIONS =head2 barcodedecode $str = &barcodedecode($barcode, [$filter]); Generic filter function for barcode string. Called on every circ if the System Pref itemBarcodeInputFilter is set. Will do some manipulation of the barcode for systems that deliver a barcode to circulation.pl that differs from the barcode stored for the item. For proper functioning of this filter, calling the function on the correct barcode string (items.barcode) should return an unaltered barcode. The optional $filter argument is to allow for testing or explicit behavior that ignores the System Pref. Valid values are the same as the System Pref options. =cut
137
138						# FIXME -- the &decode fcn below should be wrapped into this one.
139						# FIXME -- these plugins should be moved out of Circulation.pm
140						#
141						sub barcodedecode {
142	23			23	11745	my ($barcode, $filter) = @_;
143	23				137	my $branch = C4::Branch::mybranch();
144	23	50			47	$filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
145	23	50			42	$filter or return $barcode; # ensure filter is defined, else return untouched barcode
146	23	100 100 100 100			72	if ($filter eq 'whitespace') {
147	3				10	$barcode =~ s/\s//g;
148						} elsif ($filter eq 'cuecat') {
149	5				9	chomp($barcode);
150	5				20	my @fields = split( /\./, $barcode );
151	5				29	my @results = map( decode($_), @fields[ 1 .. $#fields ] );
152	5	100			46	($#results == 2) and return $results[2];
153						} elsif ($filter eq 'T-prefix') {
154	2	50			11	if ($barcode =~ /^[Tt](\d)/) {
155	2	100	67		22	(defined($1) and $1 eq '0') and return $barcode;
156	1				4	$barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
157						}
158	1				10	return sprintf("T%07d", $barcode);
159						# FIXME: $barcode could be "T1", causing warning: substr outside of string
160						# Why drop the nonzero digit after the T?
161						# Why pass non-digits (or empty string) to "T%07d"?
162						} elsif ($filter eq 'libsuite8') {
163	8	100			52	unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it.
164	6	100			16	if($barcode =~ m/^(\d)/i){ #Some barcodes even start with 0's & numbers and are assumed to have b as the item type in the libsuite8 software
165	2				16	$barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
166						}else{
167	4				55	$barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
168						}
169						}
170						}
171	17				104	return $barcode; # return barcode, modified or not
172						}
173
174 - 184						=head2 decode $str = &decode($chunk); Decodes a segment of a string emitted by a CueCat barcode scanner and returns it. FIXME: Should be replaced with Barcode::Cuecat from CPAN or Javascript based decoding on the client side. =cut
185
186						sub decode {
187	13			13	19	my ($encoded) = @_;
188	13				21	my $seq =
189						'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
190	13 185				62 283	my @s = map { index( $seq, $_ ); } split( //, $encoded );
191	13				72	my $l = ( $#s + 1 ) % 4;
192	13	100			29	if ($l) {
193	1	50			4	if ( $l == 1 ) {
194						# warn "Error: Cuecat decode parsing failed!";
195	1				3	return;
196						}
197	0				0	$l = 4 - $l;
198	0				0	$#s += $l;
199						}
200	12				18	my $r = '';
201	12				29	while ( $#s >= 0 ) {
202	46				71	my $n = ( ( $s[0] << 6 \| $s[1] ) << 6 \| $s[2] ) << 6 \| $s[3];
203	46				89	$r .=
204						chr( ( $n >> 16 ) ^ 67 )
205						.chr( ( $n >> 8 & 255 ) ^ 67 )
206						.chr( ( $n & 255 ) ^ 67 );
207	46				249	@s = @s[ 4 .. $#s ];
208						}
209	12				25	$r = substr( $r, 0, length($r) - $l );
210	12				40	return $r;
211						}
212
213 - 269						=head2 transferbook ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves); Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer. C<$newbranch> is the code for the branch to which the item should be transferred. C<$barcode> is the barcode of the item to be transferred. If C<$ignore_reserves> is true, C<&transferbook> ignores reserves. Otherwise, if an item is reserved, the transfer fails. Returns three values: =over =item $dotransfer is true if the transfer was successful. =item $messages is a reference-to-hash which may have any of the following keys: =over =item C<BadBarcode> There is no item in the catalog with the given barcode. The value is C<$barcode>. =item C<IsPermanent> The item's home branch is permanent. This doesn't prevent the item from being transferred, though. The value is the code of the item's home branch. =item C<DestinationEqualsHolding> The item is already at the branch to which it is being transferred. The transfer is nonetheless considered to have failed. The value should be ignored. =item C<WasReturned> The item was on loan, and C<&transferbook> automatically returned it before transferring it. The value is the borrower number of the patron who had the item. =item C<ResFound> The item was reserved. The value is a reference-to-hash whose keys are fields from the reserves table of the Koha database, and C<biblioitemnumber>. It also has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>. =item C<WasTransferred> The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored. =back =back =cut
270
271						sub transferbook {
272	0			0		my ( $tbr, $barcode, $ignoreRs ) = @_;
273	0					my $messages;
274	0					my $dotransfer = 1;
275	0					my $branches = GetBranches();
276	0					my $itemnumber = GetItemnumberFromBarcode( $barcode );
277	0					my $issue = GetItemIssue($itemnumber);
278	0					my $biblio = GetBiblioFromItemNumber($itemnumber);
279
280						# bad barcode..
281	0	0				if ( not $itemnumber ) {
282	0					$messages->{'BadBarcode'} = $barcode;
283	0					$dotransfer = 0;
284						}
285
286						# get branches of book...
287	0					my $hbr = $biblio->{'homebranch'};
288	0					my $fbr = $biblio->{'holdingbranch'};
289
290						# if using Branch Transfer Limits
291	0	0				if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
292	0	0 0	0			if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
293	0	0				if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
294	0					$messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
295	0					$dotransfer = 0;
296						}
297						} elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
298	0					$messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
299	0					$dotransfer = 0;
300						}
301						}
302
303						# if is permanent...
304	0	0	0			if ( $hbr && $branches->{$hbr}->{'PE'} ) {
305	0					$messages->{'IsPermanent'} = $hbr;
306	0					$dotransfer = 0;
307						}
308
309						# can't transfer book if is already there....
310	0	0				if ( $fbr eq $tbr ) {
311	0					$messages->{'DestinationEqualsHolding'} = 1;
312	0					$dotransfer = 0;
313						}
314
315						# check if it is still issued to someone, return it...
316	0	0				if ($issue->{borrowernumber}) {
317	0					AddReturn( $barcode, $fbr );
318	0					$messages->{'WasReturned'} = $issue->{borrowernumber};
319						}
320
321						# find reserves.....
322						# That'll save a database query.
323	0					my ( $resfound, $resrec, undef ) =
324						CheckReserves( $itemnumber );
325	0	0	0			if ( $resfound and not $ignoreRs ) {
326	0					$resrec->{'ResFound'} = $resfound;
327
328						# $messages->{'ResFound'} = $resrec;
329	0					$dotransfer = 1;
330						}
331
332						#actually do the transfer....
333	0	0				if ($dotransfer) {
334	0					ModItemTransfer( $itemnumber, $fbr, $tbr );
335
336						# don't need to update MARC anymore, we do it in batch now
337	0					$messages->{'WasTransfered'} = 1;
338
339						}
340	0					ModDateLastSeen( $itemnumber );
341	0					return ( $dotransfer, $messages, $biblio );
342						}
343
344
345						sub TooMany {
346	0			0		my $borrower = shift;
347	0					my $biblionumber = shift;
348	0					my $item = shift;
349	0					my $cat_borrower = $borrower->{'categorycode'};
350	0					my $dbh = C4::Context->dbh;
351	0					my $branch;
352						# Get which branchcode we need
353	0					$branch = _GetCircControlBranch($item,$borrower);
354	0	0				my $type = (C4::Context->preference('item-level_itypes'))
355						? $item->{'itype'} # item-level
356						: $item->{'itemtype'}; # biblio-level
357
358						# given branch, patron category, and item type, determine
359						# applicable issuing rule
360	0					my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
361
362						# if a rule is found and has a loan limit set, count
363						# how many loans the patron already has that meet that
364						# rule
365	0	0	0			if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
366	0					my @bind_params;
367	0					my $count_query = "SELECT COUNT(*) FROM issues
368						JOIN items USING (itemnumber) ";
369
370	0					my $rule_itemtype = $issuing_rule->{itemtype};
371	0	0				if ($rule_itemtype eq "*") {
372						# matching rule has the default item type, so count only
373						# those existing loans that don't fall under a more
374						# specific rule
375	0	0				if (C4::Context->preference('item-level_itypes')) {
376	0					$count_query .= " WHERE items.itype NOT IN (
377						SELECT itemtype FROM issuingrules
378						WHERE branchcode = ?
379						AND (categorycode = ? OR categorycode = ?)
380						AND itemtype <> '*'
381						) ";
382						} else {
383	0					$count_query .= " JOIN biblioitems USING (biblionumber)
384						WHERE biblioitems.itemtype NOT IN (
385						SELECT itemtype FROM issuingrules
386						WHERE branchcode = ?
387						AND (categorycode = ? OR categorycode = ?)
388						AND itemtype <> '*'
389						) ";
390						}
391	0					push @bind_params, $issuing_rule->{branchcode};
392	0					push @bind_params, $issuing_rule->{categorycode};
393	0					push @bind_params, $cat_borrower;
394						} else {
395						# rule has specific item type, so count loans of that
396						# specific item type
397	0	0				if (C4::Context->preference('item-level_itypes')) {
398	0					$count_query .= " WHERE items.itype = ? ";
399						} else {
400	0					$count_query .= " JOIN biblioitems USING (biblionumber)
401						WHERE biblioitems.itemtype= ? ";
402						}
403	0					push @bind_params, $type;
404						}
405
406	0					$count_query .= " AND borrowernumber = ? ";
407	0					push @bind_params, $borrower->{'borrowernumber'};
408	0					my $rule_branch = $issuing_rule->{branchcode};
409	0	0				if ($rule_branch ne "*") {
410	0	0 0				if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
411	0					$count_query .= " AND issues.branchcode = ? ";
412	0					push @bind_params, $branch;
413						} elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
414						; # if branch is the patron's home branch, then count all loans by patron
415						} else {
416	0					$count_query .= " AND items.homebranch = ? ";
417	0					push @bind_params, $branch;
418						}
419						}
420
421	0					my $count_sth = $dbh->prepare($count_query);
422	0					$count_sth->execute(@bind_params);
423	0					my ($current_loan_count) = $count_sth->fetchrow_array;
424
425	0					my $max_loans_allowed = $issuing_rule->{'maxissueqty'};
426	0	0				if ($current_loan_count >= $max_loans_allowed) {
427	0					return ($current_loan_count, $max_loans_allowed);
428						}
429						}
430
431						# Now count total loans against the limit for the branch
432	0					my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
433	0	0				if (defined($branch_borrower_circ_rule->{maxissueqty})) {
434	0					my @bind_params = ();
435	0					my $branch_count_query = "SELECT COUNT(*) FROM issues
436						JOIN items USING (itemnumber)
437						WHERE borrowernumber = ? ";
438	0					push @bind_params, $borrower->{borrowernumber};
439
440	0	0 0				if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
441	0					$branch_count_query .= " AND issues.branchcode = ? ";
442	0					push @bind_params, $branch;
443						} elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
444						; # if branch is the patron's home branch, then count all loans by patron
445						} else {
446	0					$branch_count_query .= " AND items.homebranch = ? ";
447	0					push @bind_params, $branch;
448						}
449	0					my $branch_count_sth = $dbh->prepare($branch_count_query);
450	0					$branch_count_sth->execute(@bind_params);
451	0					my ($current_loan_count) = $branch_count_sth->fetchrow_array;
452
453	0					my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty};
454	0	0				if ($current_loan_count >= $max_loans_allowed) {
455	0					return ($current_loan_count, $max_loans_allowed);
456						}
457						}
458
459						# OK, the patron can issue !!!
460	0					return;
461						}
462
463 - 505						=head2 itemissues @issues = &itemissues($biblioitemnumber, $biblio); Looks up information about who has borrowed the bookZ<>(s) with the given biblioitemnumber. C<$biblio> is ignored. C<&itemissues> returns an array of references-to-hash. The keys include the fields from the C<items> table in the Koha database. Additional keys include: =over 4 =item C<date_due> If the item is currently on loan, this gives the due date. If the item is not on loan, then this is either "Available" or "Cancelled", if the item has been withdrawn. =item C<card> If the item is currently on loan, this gives the card number of the patron who currently has the item. =item C<timestamp0>, C<timestamp1>, C<timestamp2> These give the timestamp for the last three times the item was borrowed. =item C<card0>, C<card1>, C<card2> The card number of the last three patrons who borrowed this item. =item C<borrower0>, C<borrower1>, C<borrower2> The borrower number of the last three patrons who borrowed this item. =back =cut
506
507						#'
508						sub itemissues {
509	0			0		my ( $bibitem, $biblio ) = @_;
510	0					my $dbh = C4::Context->dbh;
511	0		0			my $sth =
512						$dbh->prepare("Select * from items where items.biblioitemnumber = ?")
513						\|\| die $dbh->errstr;
514	0					my $i = 0;
515	0					my @results;
516
517	0	0				$sth->execute($bibitem) \|\| die $sth->errstr;
518
519	0					while ( my $data = $sth->fetchrow_hashref ) {
520
521						# Find out who currently has this item.
522						# FIXME - Wouldn't it be better to do this as a left join of
523						# some sort? Currently, this code assumes that if
524						# fetchrow_hashref() fails, then the book is on the shelf.
525						# fetchrow_hashref() can fail for any number of reasons (e.g.,
526						# database server crash), not just because no items match the
527						# search criteria.
528	0					my $sth2 = $dbh->prepare(
529						"SELECT * FROM issues
530						LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
531						WHERE itemnumber = ?
532						"
533						);
534
535	0					$sth2->execute( $data->{'itemnumber'} );
536	0	0				if ( my $data2 = $sth2->fetchrow_hashref ) {
537	0					$data->{'date_due'} = $data2->{'date_due'};
538	0					$data->{'card'} = $data2->{'cardnumber'};
539	0					$data->{'borrower'} = $data2->{'borrowernumber'};
540						}
541						else {
542	0	0				$data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
543						}
544
545
546						# Find the last 3 people who borrowed this item.
547	0					$sth2 = $dbh->prepare(
548						"SELECT * FROM old_issues
549						LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
550						WHERE itemnumber = ?
551						ORDER BY returndate DESC,timestamp DESC"
552						);
553
554	0					$sth2->execute( $data->{'itemnumber'} );
555						for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
556						{ # FIXME : error if there is less than 3 pple borrowing this item
557	0	0				if ( my $data2 = $sth2->fetchrow_hashref ) {
558	0					$data->{"timestamp$i2"} = $data2->{'timestamp'};
559	0					$data->{"card$i2"} = $data2->{'cardnumber'};
560	0					$data->{"borrower$i2"} = $data2->{'borrowernumber'};
561						} # if
562	0					} # for
563
564	0					$results[$i] = $data;
565	0					$i++;
566						}
567
568	0					return (@results);
569						}
570
571 - 663						=head2 CanBookBeIssued ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess, $ignore_reserves ); Check if a book can be issued. C<$issuingimpossible> and C<$needsconfirmation> are some hashref. =over 4 =item C<$borrower> hash with borrower informations (from GetMember or GetMemberDetails) =item C<$barcode> is the bar code of the book being issued. =item C<$duedatespec> is a C4::Dates object. =item C<$inprocess> boolean switch =item C<$ignore_reserves> boolean switch =back Returns : =over 4 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible. Possible values are : =back =head3 INVALID_DATE sticky due date is invalid =head3 GNA borrower gone with no address =head3 CARD_LOST borrower declared it's card lost =head3 DEBARRED borrower debarred =head3 UNKNOWN_BARCODE barcode unknown =head3 NOT_FOR_LOAN item is not for loan =head3 WTHDRAWN item withdrawn. =head3 RESTRICTED item is restricted (set by ??) C<$needsconfirmation> a reference to a hash. It contains reasons why the loan could be prevented, but ones that can be overriden by the operator. Possible values are : =head3 DEBT borrower has debts. =head3 RENEW_ISSUE renewing, not issuing =head3 ISSUED_TO_ANOTHER issued to someone else. =head3 RESERVED reserved for someone else. =head3 INVALID_DATE sticky due date is invalid or due date in the past =head3 TOO_MANY if the borrower borrows to much things =cut
664
665						sub CanBookBeIssued {
666	0			0		my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves ) = @_;
667	0					my %needsconfirmation; # filled with problems that needs confirmations
668	0					my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
669	0					my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
670	0					my $issue = GetItemIssue($item->{itemnumber});
671	0					my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
672	0					$item->{'itemtype'}=$item->{'itype'};
673	0					my $dbh = C4::Context->dbh;
674
675						# MANDATORY CHECKS - unless item exists, nothing else matters
676	0	0				unless ( $item->{barcode} ) {
677	0					$issuingimpossible{UNKNOWN_BARCODE} = 1;
678						}
679	0	0				return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
680
681						#
682						# DUE DATE is OK ? -- should already have checked.
683						#
684	0	0				unless ( $duedate ) {
685	0					my $issuedate = strftime( "%Y-%m-%d", localtime );
686
687	0					my $branch = _GetCircControlBranch($item,$borrower);
688	0	0				my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
689	0					$duedate = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $itype, $branch, $borrower );
690
691						# Offline circ calls AddIssue directly, doesn't run through here
692						# So issuingimpossible should be ok.
693						}
694	0	0				if ($duedate) {
695	0	0				$needsconfirmation{INVALID_DATE} = $duedate->output('syspref')
696						unless $duedate->output('iso') ge C4::Dates->today('iso');
697						} else {
698	0					$issuingimpossible{INVALID_DATE} = $duedate->output('syspref');
699						}
700
701						#
702						# BORROWER STATUS
703						#
704	0	0	0			if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
705						# stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
706	0					&UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
707	0					ModDateLastSeen( $item->{'itemnumber'} );
708	0					return( { STATS => 1 }, {});
709						}
710	0	0				if ( $borrower->{flags}->{GNA} ) {
711	0					$issuingimpossible{GNA} = 1;
712						}
713	0	0				if ( $borrower->{flags}->{'LOST'} ) {
714	0					$issuingimpossible{CARD_LOST} = 1;
715						}
716	0	0				if ( $borrower->{flags}->{'DBARRED'} ) {
717	0					$issuingimpossible{DEBARRED} = 1;
718						}
719	0	0				if ( $borrower->{'dateexpiry'} eq '0000-00-00') {
720	0					$issuingimpossible{EXPIRED} = 1;
721						} else {
722	0					my @expirydate= split /-/,$borrower->{'dateexpiry'};
723	0	0	0			if($expirydate[0]==0 \|\| $expirydate[1]==0\|\| $expirydate[2]==0 \|\|
724						Date_to_Days(Today) > Date_to_Days( @expirydate )) {
725	0					$issuingimpossible{EXPIRED} = 1;
726						}
727						}
728						#
729						# BORROWER STATUS
730						#
731
732						# DEBTS
733	0					my ($amount) =
734						C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') );
735	0					my $amountlimit = C4::Context->preference("noissuescharge");
736	0					my $allowfineoverride = C4::Context->preference("AllowFineOverride");
737	0					my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
738	0	0				if ( C4::Context->preference("IssuingInProcess") ) {
739	0	0 0 0	0 0 0 0			if ( $amount > $amountlimit && !$inprocess && !$allowfineoverride) {
740	0					$issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
741						} elsif ( $amount > $amountlimit && !$inprocess && $allowfineoverride) {
742	0					$needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
743						} elsif ( $allfinesneedoverride && $amount > 0 && $amount <= $amountlimit && !$inprocess ) {
744	0					$needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
745						}
746						}
747						else {
748	0	0 0 0	0 0 0			if ( $amount > $amountlimit && $allowfineoverride ) {
749	0					$needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
750						} elsif ( $amount > $amountlimit && !$allowfineoverride) {
751	0					$issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
752						} elsif ( $amount > 0 && $allfinesneedoverride ) {
753	0					$needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
754						}
755						}
756
757	0					my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
758	0	0 0				if ($blocktype == -1) {
759						## patron has outstanding overdue loans
760	0	0 0				if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
761	0					$issuingimpossible{USERBLOCKEDOVERDUE} = $count;
762						}
763						elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
764	0					$needsconfirmation{USERBLOCKEDOVERDUE} = $count;
765						}
766						} elsif($blocktype == 1) {
767						# patron has accrued fine days
768	0					$issuingimpossible{USERBLOCKEDREMAINING} = $count;
769						}
770
771						#
772						# JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
773						#
774	0					my ($current_loan_count, $max_loans_allowed) = TooMany( $borrower, $item->{biblionumber}, $item );
775						# if TooMany max_loans_allowed returns 0 the user doesn't have permission to check out this book
776	0	0				if ($max_loans_allowed eq 0) {
777	0					$needsconfirmation{PATRON_CANT} = 1;
778						} else {
779	0	0				if($max_loans_allowed){
780	0					$needsconfirmation{TOO_MANY} = 1;
781	0					$needsconfirmation{current_loan_count} = $current_loan_count;
782	0					$needsconfirmation{max_loans_allowed} = $max_loans_allowed;
783						}
784						}
785
786						#
787						# ITEM CHECKING
788						#
789	0	0 0	0			if ( $item->{'notforloan'}
790						&& $item->{'notforloan'} > 0 )
791						{
792	0	0				if(!C4::Context->preference("AllowNotForLoanOverride")){
793	0					$issuingimpossible{NOT_FOR_LOAN} = 1;
794						}else{
795	0					$needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
796						}
797						}
798						elsif ( !$item->{'notforloan'} ){
799						# we have to check itemtypes.notforloan also
800	0	0 0				if (C4::Context->preference('item-level_itypes')){
801						# this should probably be a subroutine
802	0					my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
803	0					$sth->execute($item->{'itemtype'});
804	0					my $notforloan=$sth->fetchrow_hashref();
805	0					$sth->finish();
806	0	0				if ($notforloan->{'notforloan'}) {
807	0	0				if (!C4::Context->preference("AllowNotForLoanOverride")) {
808	0					$issuingimpossible{NOT_FOR_LOAN} = 1;
809						} else {
810	0					$needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
811						}
812						}
813						}
814						elsif ($biblioitem->{'notforloan'} == 1){
815	0	0				if (!C4::Context->preference("AllowNotForLoanOverride")) {
816	0					$issuingimpossible{NOT_FOR_LOAN} = 1;
817						} else {
818	0					$needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
819						}
820						}
821						}
822	0	0	0			if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} > 0 )
823						{
824	0					$issuingimpossible{WTHDRAWN} = 1;
825						}
826	0	0	0			if ( $item->{'restricted'}
827						&& $item->{'restricted'} == 1 )
828						{
829	0					$issuingimpossible{RESTRICTED} = 1;
830						}
831	0	0				if ( C4::Context->preference("IndependantBranches") ) {
832	0					my $userenv = C4::Context->userenv;
833	0	0	0			if ( ($userenv) && ( $userenv->{flags} % 2 != 1 ) ) {
834	0	0				$issuingimpossible{ITEMNOTSAMEBRANCH} = 1
835						if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
836	0	0				$needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
837						if ( $borrower->{'branchcode'} ne $userenv->{branch} );
838						}
839						}
840
841						#
842						# CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
843						#
844	0	0 0	0			if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
845						{
846
847						# Already issued to current borrower. Ask whether the loan should
848						# be renewed.
849	0					my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
850						$borrower->{'borrowernumber'},
851						$item->{'itemnumber'}
852						);
853	0	0				if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
854	0					$issuingimpossible{NO_MORE_RENEWALS} = 1;
855						}
856						else {
857	0					$needsconfirmation{RENEW_ISSUE} = 1;
858						}
859						}
860						elsif ($issue->{borrowernumber}) {
861
862						# issued to someone else
863	0					my $currborinfo = C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
864
865						# warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
866	0					$needsconfirmation{ISSUED_TO_ANOTHER} = 1;
867	0					$needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
868	0					$needsconfirmation{issued_surname} = $currborinfo->{'surname'};
869	0					$needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
870	0					$needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
871						}
872
873	0	0				unless ( $ignore_reserves ) {
874						# See if the item is on reserve.
875	0					my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
876	0	0				if ($restype) {
877	0					my $resbor = $res->{'borrowernumber'};
878	0	0				if ( $resbor ne $borrower->{'borrowernumber'} ) {
879	0					my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
880	0					my $branchname = GetBranchName( $res->{'branchcode'} );
881	0	0 0				if ( $restype eq "Waiting" )
882						{
883						# The item is on reserve and waiting, but has been
884						# reserved by some other patron.
885	0					$needsconfirmation{RESERVE_WAITING} = 1;
886	0					$needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
887	0					$needsconfirmation{'ressurname'} = $resborrower->{'surname'};
888	0					$needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
889	0					$needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
890	0					$needsconfirmation{'resbranchname'} = $branchname;
891	0					$needsconfirmation{'reswaitingdate'} = format_date($res->{'waitingdate'});
892						}
893						elsif ( $restype eq "Reserved" ) {
894						# The item is on reserve for someone else.
895	0					$needsconfirmation{RESERVED} = 1;
896	0					$needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
897	0					$needsconfirmation{'ressurname'} = $resborrower->{'surname'};
898	0					$needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
899	0					$needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
900	0					$needsconfirmation{'resbranchname'} = $branchname;
901	0					$needsconfirmation{'resreservedate'} = format_date($res->{'reservedate'});
902						}
903						}
904						}
905						}
906	0					return ( \%issuingimpossible, \%needsconfirmation );
907						}
908
909 - 945						=head2 AddIssue &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate]) Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed. =over 4 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails). =item C<$barcode> is the barcode of the item being issued. =item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional). Calculated if empty. =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional). =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional). Defaults to today. Unlike C<$datedue>, NOT a C4::Dates object, unfortunately. AddIssue does the following things : - step 01: check that there is a borrowernumber & a barcode provided - check for RENEWAL (book issued & being issued to the same patron) - renewal YES = Calculate Charge & renew - renewal NO = * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else) * RESERVE PLACED ? - fill reserve if reserve to this patron - cancel reserve or not, otherwise * TRANSFERT PENDING ? - complete the transfert * ISSUE THE BOOK =back =cut
946
947						sub AddIssue {
948	0			0		my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_;
949	0					my $dbh = C4::Context->dbh;
950	0					my $barcodecheck=CheckValidBarcode($barcode);
951						# $issuedate defaults to today.
952	0	0				if ( ! defined $issuedate ) {
953	0					$issuedate = strftime( "%Y-%m-%d", localtime );
954						# TODO: for hourly circ, this will need to be a C4::Dates object
955						# and all calls to AddIssue including issuedate will need to pass a Dates object.
956						}
957	0	0	0			if ($borrower and $barcode and $barcodecheck ne '0'){
958						# find which item we issue
959	0	0				my $item = GetItem('', $barcode) or return undef; # if we don't get an Item, abort.
960	0					my $branch = _GetCircControlBranch($item,$borrower);
961
962						# get actual issuing if there is one
963	0					my $actualissue = GetItemIssue( $item->{itemnumber});
964
965						# get biblioinformation for this item
966	0					my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
967
968						#
969						# check if we just renew the issue.
970						#
971	0	0				if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
972	0					$datedue = AddRenewal(
973						$borrower->{'borrowernumber'},
974						$item->{'itemnumber'},
975						$branch,
976						$datedue,
977						$issuedate, # here interpreted as the renewal date
978						);
979						}
980						else {
981						# it's NOT a renewal
982	0	0				if ( $actualissue->{borrowernumber}) {
983						# This book is currently on loan, but not to the person
984						# who wants to borrow it now. mark it returned before issuing to the new borrower
985	0					AddReturn(
986						$item->{'barcode'},
987						C4::Context->userenv->{'branch'}
988						);
989						}
990
991	0					MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
992
993						# Starting process for transfer job (checking transfert and validate it if we have one)
994	0					my ($datesent) = GetTransfers($item->{'itemnumber'});
995	0	0				if ($datesent) {
996						# updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
997	0					my $sth =
998						$dbh->prepare(
999						"UPDATE branchtransfers
1000						SET datearrived = now(),
1001						tobranch = ?,
1002						comments = 'Forced branchtransfer'
1003						WHERE itemnumber= ? AND datearrived IS NULL"
1004						);
1005	0					$sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
1006						}
1007
1008						# Record in the database the fact that the book was issued.
1009	0					my $sth =
1010						$dbh->prepare(
1011						"INSERT INTO issues
1012						(borrowernumber, itemnumber,issuedate, date_due, branchcode)
1013						VALUES (?,?,?,?,?)"
1014						);
1015	0	0				unless ($datedue) {
1016	0	0				my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1017	0					$datedue = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $itype, $branch, $borrower );
1018
1019						}
1020						$sth->execute(
1021	0					$borrower->{'borrowernumber'}, # borrowernumber
1022						$item->{'itemnumber'}, # itemnumber
1023						$issuedate, # issuedate
1024						$datedue->output('iso'), # date_due
1025						C4::Context->userenv->{'branch'} # branchcode
1026						);
1027	0					$sth->finish;
1028	0	0				if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1029	0					CartToShelf( $item->{'itemnumber'} );
1030						}
1031	0					$item->{'issues'}++;
1032
1033						## If item was lost, it has now been found, reverse any list item charges if neccessary.
1034	0	0				if ( $item->{'itemlost'} ) {
1035	0					_FixAccountForLostAndReturned( $item->{'itemnumber'}, undef, $item->{'barcode'} );
1036						}
1037
1038	0					ModItem({ issues => $item->{'issues'},
1039						holdingbranch => C4::Context->userenv->{'branch'},
1040						itemlost => 0,
1041						datelastborrowed => C4::Dates->new()->output('iso'),
1042						onloan => $datedue->output('iso'),
1043						}, $item->{'biblionumber'}, $item->{'itemnumber'});
1044	0					ModDateLastSeen( $item->{'itemnumber'} );
1045
1046						# If it costs to borrow this book, charge it to the patron's account.
1047	0					my ( $charge, $itemtype ) = GetIssuingCharges(
1048						$item->{'itemnumber'},
1049						$borrower->{'borrowernumber'}
1050						);
1051	0	0				if ( $charge > 0 ) {
1052	0					AddIssuingCharge(
1053						$item->{'itemnumber'},
1054						$borrower->{'borrowernumber'}, $charge
1055						);
1056	0					$item->{'charge'} = $charge;
1057						}
1058
1059						# Record the fact that this book was issued.
1060						&UpdateStats(
1061	0	0				C4::Context->userenv->{'branch'},
1062						'issue', $charge,
1063						($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
1064						$item->{'itype'}, $borrower->{'borrowernumber'}
1065						);
1066
1067						# Send a checkout slip.
1068	0					my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1069	0					my %conditions = (
1070						branchcode => $branch,
1071						categorycode => $borrower->{categorycode},
1072						item_type => $item->{itype},
1073						notification => 'CHECKOUT',
1074						);
1075	0	0				if ($circulation_alert->is_enabled_for(\%conditions)) {
1076	0					SendCirculationAlert({
1077						type => 'CHECKOUT',
1078						item => $item,
1079						borrower => $borrower,
1080						branch => $branch,
1081						});
1082						}
1083						}
1084
1085	0	0				logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1086						if C4::Context->preference("IssueLog");
1087						}
1088	0					return ($datedue); # not necessarily the same as when it came in!
1089						}
1090
1091 - 1097						=head2 GetLoanLength my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode) Get loan length for an itemtype, a borrower type and a branch =cut
1098
1099						sub GetLoanLength {
1100	0			0		my ( $borrowertype, $itemtype, $branchcode ) = @_;
1101	0					my $dbh = C4::Context->dbh;
1102	0					my $sth =
1103						$dbh->prepare(
1104						"select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1105						);
1106						# warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1107						# try to find issuelength & return the 1st available.
1108						# check with borrowertype, itemtype and branchcode, then without one of those parameters
1109	0					$sth->execute( $borrowertype, $itemtype, $branchcode );
1110	0					my $loanlength = $sth->fetchrow_hashref;
1111	0	0	0			return $loanlength->{issuelength}
1112						if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1113
1114	0					$sth->execute( $borrowertype, "*", $branchcode );
1115	0					$loanlength = $sth->fetchrow_hashref;
1116	0	0	0			return $loanlength->{issuelength}
1117						if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1118
1119	0					$sth->execute( "*", $itemtype, $branchcode );
1120	0					$loanlength = $sth->fetchrow_hashref;
1121	0	0	0			return $loanlength->{issuelength}
1122						if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1123
1124	0					$sth->execute( "", "", $branchcode );
1125	0					$loanlength = $sth->fetchrow_hashref;
1126	0	0	0			return $loanlength->{issuelength}
1127						if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1128
1129	0					$sth->execute( $borrowertype, $itemtype, "*" );
1130	0					$loanlength = $sth->fetchrow_hashref;
1131	0	0	0			return $loanlength->{issuelength}
1132						if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1133
1134	0					$sth->execute( $borrowertype, "", "" );
1135	0					$loanlength = $sth->fetchrow_hashref;
1136	0	0	0			return $loanlength->{issuelength}
1137						if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1138
1139	0					$sth->execute( "", $itemtype, "" );
1140	0					$loanlength = $sth->fetchrow_hashref;
1141	0	0	0			return $loanlength->{issuelength}
1142						if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1143
1144	0					$sth->execute( "", "", "*" );
1145	0					$loanlength = $sth->fetchrow_hashref;
1146	0	0	0			return $loanlength->{issuelength}
1147						if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1148
1149						# if no rule is set => 21 days (hardcoded)
1150	0					return 21;
1151						}
1152
1153
1154 - 1160						=head2 GetHardDueDate my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode) Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch =cut
1161
1162						sub GetHardDueDate {
1163	0			0		my ( $borrowertype, $itemtype, $branchcode ) = @_;
1164	0					my $dbh = C4::Context->dbh;
1165	0					my $sth =
1166						$dbh->prepare(
1167						"select hardduedate, hardduedatecompare from issuingrules where categorycode=? and itemtype=? and branchcode=?"
1168						);
1169	0					$sth->execute( $borrowertype, $itemtype, $branchcode );
1170	0					my $results = $sth->fetchrow_hashref;
1171	0	0	0			return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1172						if defined($results) && $results->{hardduedate} ne 'NULL';
1173
1174	0					$sth->execute( $borrowertype, "*", $branchcode );
1175	0					$results = $sth->fetchrow_hashref;
1176	0	0	0			return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1177						if defined($results) && $results->{hardduedate} ne 'NULL';
1178
1179	0					$sth->execute( "*", $itemtype, $branchcode );
1180	0					$results = $sth->fetchrow_hashref;
1181	0	0	0			return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1182						if defined($results) && $results->{hardduedate} ne 'NULL';
1183
1184	0					$sth->execute( "", "", $branchcode );
1185	0					$results = $sth->fetchrow_hashref;
1186	0	0	0			return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1187						if defined($results) && $results->{hardduedate} ne 'NULL';
1188
1189	0					$sth->execute( $borrowertype, $itemtype, "*" );
1190	0					$results = $sth->fetchrow_hashref;
1191	0	0	0			return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1192						if defined($results) && $results->{hardduedate} ne 'NULL';
1193
1194	0					$sth->execute( $borrowertype, "", "" );
1195	0					$results = $sth->fetchrow_hashref;
1196	0	0	0			return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1197						if defined($results) && $results->{hardduedate} ne 'NULL';
1198
1199	0					$sth->execute( "", $itemtype, "" );
1200	0					$results = $sth->fetchrow_hashref;
1201	0	0	0			return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1202						if defined($results) && $results->{hardduedate} ne 'NULL';
1203
1204	0					$sth->execute( "", "", "*" );
1205	0					$results = $sth->fetchrow_hashref;
1206	0	0	0			return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1207						if defined($results) && $results->{hardduedate} ne 'NULL';
1208
1209						# if no rule is set => return undefined
1210	0					return (undef, undef);
1211						}
1212
1213 - 1224						=head2 GetIssuingRule my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode) FIXME - This is a copy-paste of GetLoanLength as a stop-gap. Do not wish to change API for GetLoanLength this close to release, however, Overdues::GetIssuingRules is broken. Get the issuing rule for an itemtype, a borrower type and a branch Returns a hashref from the issuingrules table. =cut
1225
1226						sub GetIssuingRule {
1227	0			0		my ( $borrowertype, $itemtype, $branchcode ) = @_;
1228	0					my $dbh = C4::Context->dbh;
1229	0					my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" );
1230	0					my $irule;
1231
1232	0					$sth->execute( $borrowertype, $itemtype, $branchcode );
1233	0					$irule = $sth->fetchrow_hashref;
1234	0	0				return $irule if defined($irule) ;
1235
1236	0					$sth->execute( $borrowertype, "*", $branchcode );
1237	0					$irule = $sth->fetchrow_hashref;
1238	0	0				return $irule if defined($irule) ;
1239
1240	0					$sth->execute( "*", $itemtype, $branchcode );
1241	0					$irule = $sth->fetchrow_hashref;
1242	0	0				return $irule if defined($irule) ;
1243
1244	0					$sth->execute( "", "", $branchcode );
1245	0					$irule = $sth->fetchrow_hashref;
1246	0	0				return $irule if defined($irule) ;
1247
1248	0					$sth->execute( $borrowertype, $itemtype, "*" );
1249	0					$irule = $sth->fetchrow_hashref;
1250	0	0				return $irule if defined($irule) ;
1251
1252	0					$sth->execute( $borrowertype, "", "" );
1253	0					$irule = $sth->fetchrow_hashref;
1254	0	0				return $irule if defined($irule) ;
1255
1256	0					$sth->execute( "", $itemtype, "" );
1257	0					$irule = $sth->fetchrow_hashref;
1258	0	0				return $irule if defined($irule) ;
1259
1260	0					$sth->execute( "", "", "*" );
1261	0					$irule = $sth->fetchrow_hashref;
1262	0	0				return $irule if defined($irule) ;
1263
1264						# if no rule matches,
1265	0					return undef;
1266						}
1267
1268 - 1298						=head2 GetBranchBorrowerCircRule my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode); Retrieves circulation rule attributes that apply to the given branch and patron category, regardless of item type. The return value is a hashref containing the following key: maxissueqty - maximum number of loans that a patron of the given category can have at the given branch. If the value is undef, no limit. This will first check for a specific branch and category match from branch_borrower_circ_rules. If no rule is found, it will then check default_branch_circ_rules (same branch, default category). If no rule is found, it will then check default_borrower_circ_rules (default branch, same category), then failing that, default_circ_rules (default branch, default category). If no rule has been found in the database, it will default to the buillt in rule: maxissueqty - undef C<$branchcode> and C<$categorycode> should contain the literal branch code and patron category code, respectively - no wildcards. =cut
1299
1300						sub GetBranchBorrowerCircRule {
1301	0			0		my $branchcode = shift;
1302	0					my $categorycode = shift;
1303
1304	0					my $branch_cat_query = "SELECT maxissueqty
1305						FROM branch_borrower_circ_rules
1306						WHERE branchcode = ?
1307						AND categorycode = ?";
1308	0					my $dbh = C4::Context->dbh();
1309	0					my $sth = $dbh->prepare($branch_cat_query);
1310	0					$sth->execute($branchcode, $categorycode);
1311	0					my $result;
1312	0	0				if ($result = $sth->fetchrow_hashref()) {
1313	0					return $result;
1314						}
1315
1316						# try same branch, default borrower category
1317	0					my $branch_query = "SELECT maxissueqty
1318						FROM default_branch_circ_rules
1319						WHERE branchcode = ?";
1320	0					$sth = $dbh->prepare($branch_query);
1321	0					$sth->execute($branchcode);
1322	0	0				if ($result = $sth->fetchrow_hashref()) {
1323	0					return $result;
1324						}
1325
1326						# try default branch, same borrower category
1327	0					my $category_query = "SELECT maxissueqty
1328						FROM default_borrower_circ_rules
1329						WHERE categorycode = ?";
1330	0					$sth = $dbh->prepare($category_query);
1331	0					$sth->execute($categorycode);
1332	0	0				if ($result = $sth->fetchrow_hashref()) {
1333	0					return $result;
1334						}
1335
1336						# try default branch, default borrower category
1337	0					my $default_query = "SELECT maxissueqty
1338						FROM default_circ_rules";
1339	0					$sth = $dbh->prepare($default_query);
1340	0					$sth->execute();
1341	0	0				if ($result = $sth->fetchrow_hashref()) {
1342	0					return $result;
1343						}
1344
1345						# built-in default circulation rule
1346						return {
1347	0					maxissueqty => undef,
1348						};
1349						}
1350
1351 - 1374						=head2 GetBranchItemRule my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype); Retrieves circulation rule attributes that apply to the given branch and item type, regardless of patron category. The return value is a hashref containing the following key: holdallowed => Hold policy for this branch and itemtype. Possible values: 0: No holds allowed. 1: Holds allowed only by patrons that have the same homebranch as the item. 2: Holds allowed from any patron. This searches branchitemrules in the following order: * Same branchcode and itemtype * Same branchcode, itemtype '' branchcode '', same itemtype branchcode and itemtype '' Neither C<$branchcode> nor C<$categorycode> should be ''. =cut
1375
1376						sub GetBranchItemRule {
1377	0			0		my ( $branchcode, $itemtype ) = @_;
1378	0					my $dbh = C4::Context->dbh();
1379	0					my $result = {};
1380
1381	0					my @attempts = (
1382						['SELECT holdallowed
1383						FROM branch_item_rules
1384						WHERE branchcode = ?
1385						AND itemtype = ?', $branchcode, $itemtype],
1386						['SELECT holdallowed
1387						FROM default_branch_circ_rules
1388						WHERE branchcode = ?', $branchcode],
1389						['SELECT holdallowed
1390						FROM default_branch_item_rules
1391						WHERE itemtype = ?', $itemtype],
1392						['SELECT holdallowed
1393						FROM default_circ_rules'],
1394						);
1395
1396	0					foreach my $attempt (@attempts) {
1397	0 0					my ($query, @bind_params) = @{$attempt};
1398
1399						# Since branch/category and branch/itemtype use the same per-branch
1400						# defaults tables, we have to check that the key we want is set, not
1401						# just that a row was returned
1402	0	0				return $result if ( defined( $result->{'holdallowed'} = $dbh->selectrow_array( $query, {}, @bind_params ) ) );
1403						}
1404
1405						# built-in default circulation rule
1406						return {
1407	0					holdallowed => 2,
1408						};
1409						}
1410
1411 - 1483						=head2 AddReturn ($doreturn, $messages, $iteminformation, $borrower) = &AddReturn($barcode, $branch, $exemptfine, $dropbox); Returns a book. =over 4 =item C<$barcode> is the bar code of the book being returned. =item C<$branch> is the code of the branch where the book is being returned. =item C<$exemptfine> indicates that overdue charges for the item will be removed. =item C<$dropbox> indicates that the check-in date is assumed to be yesterday, or the last non-holiday as defined in C4::Calendar . If overdue charges are applied and C<$dropbox> is true, the last charge will be removed. This assumes that the fines accrual script has run for _today_. =back C<&AddReturn> returns a list of four items: C<$doreturn> is true iff the return succeeded. C<$messages> is a reference-to-hash giving feedback on the operation. The keys of the hash are: =over 4 =item C<BadBarcode> No item with this barcode exists. The value is C<$barcode>. =item C<NotIssued> The book is not currently on loan. The value is C<$barcode>. =item C<IsPermanent> The book's home branch is a permanent collection. If you have borrowed this book, you are not allowed to return it. The value is the code for the book's home branch. =item C<wthdrawn> This book has been withdrawn/cancelled. The value should be ignored. =item C<Wrongbranch> This book has was returned to the wrong branch. The value is a hashref so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}> contain the branchcode of the incorrect and correct return library, respectively. =item C<ResFound> The item was reserved. The value is a reference-to-hash whose keys are fields from the reserves table of the Koha database, and C<biblioitemnumber>. It also has the key C<ResFound>, whose value is either C<Waiting>, C<Reserved>, or 0. =back C<$iteminformation> is a reference-to-hash, giving information about the returned item from the issues table. C<$borrower> is a reference-to-hash, giving information about the patron who last borrowed the book. =cut
1484
1485						sub AddReturn {
1486	0			0		my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1487	0	0	0			if ($branch and not GetBranchDetail($branch)) {
1488	0					warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1489	0					undef $branch;
1490						}
1491	0	0				$branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1492	0					my $messages;
1493	0					my $borrower;
1494	0					my $biblio;
1495	0					my $doreturn = 1;
1496	0					my $validTransfert = 0;
1497	0					my $stat_type = 'return';
1498
1499						# get information on item
1500	0					my $itemnumber = GetItemnumberFromBarcode( $barcode );
1501	0	0				unless ($itemnumber) {
1502	0					return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out.
1503						}
1504	0					my $issue = GetItemIssue($itemnumber);
1505						# warn Dumper($iteminformation);
1506	0	0	0			if ($issue and $issue->{borrowernumber}) {
1507	0	0				$borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1508						or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existant borrowernumber '$issue->{borrowernumber}'\n"
1509						. Dumper($issue) . "\n";
1510						} else {
1511	0					$messages->{'NotIssued'} = $barcode;
1512						# even though item is not on loan, it may still be transferred; therefore, get current branch info
1513	0					$doreturn = 0;
1514						# No issue, no borrowernumber. ONLY if $doreturn, might you have a $borrower later.
1515						# Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1516	0	0				if (C4::Context->preference("RecordLocalUseOnReturn")) {
1517	0					$messages->{'LocalUse'} = 1;
1518	0					$stat_type = 'localuse';
1519						}
1520						}
1521
1522	0	0				my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1523						# full item data, but no borrowernumber or checkout info (no issue)
1524						# we know GetItem should work because GetItemnumberFromBarcode worked
1525	0		0			my $hbr = C4::Context->preference("HomeOrHoldingBranchReturn") \|\| "homebranch";
1526	0		0			$hbr = $item->{$hbr} \|\| '';
1527						# item must be from items table -- issues table has branchcode and issuingbranch, not homebranch nor holdingbranch
1528
1529	0		0			my $borrowernumber = $borrower->{'borrowernumber'} \|\| undef; # we don't know if we had a borrower or not
1530
1531						# check if the book is in a permanent collection....
1532						# FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1533	0	0				if ( $hbr ) {
1534	0					my $branches = GetBranches(); # a potentially expensive call for a non-feature.
1535	0	0				$branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr;
1536						}
1537
1538						# if indy branches and returning to different branch, refuse the return
1539	0	0	0			if ($hbr ne $branch && C4::Context->preference("IndependantBranches")){
1540	0					$messages->{'Wrongbranch'} = {
1541						Wrongbranch => $branch,
1542						Rightbranch => $hbr,
1543						};
1544	0					$doreturn = 0;
1545						# bailing out here - in this case, current desired behavior
1546						# is to act as if no return ever happened at all.
1547						# FIXME - even in an indy branches situation, there should
1548						# still be an option for the library to accept the item
1549						# and transfer it to its owning library.
1550	0					return ( $doreturn, $messages, $issue, $borrower );
1551						}
1552
1553	0	0				if ( $item->{'wthdrawn'} ) { # book has been cancelled
1554	0					$messages->{'wthdrawn'} = 1;
1555	0					$doreturn = 0;
1556						}
1557
1558						# case of a return of document (deal with issues and holdingbranch)
1559	0	0				if ($doreturn) {
1560	0	0				$borrower or warn "AddReturn without current borrower";
1561	0					my $circControlBranch;
1562	0	0				if ($dropbox) {
1563						# define circControlBranch only if dropbox mode is set
1564						# don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1565						# FIXME: check issuedate > returndate, factoring in holidays
1566	0	0				$circControlBranch = _GetCircControlBranch($item,$borrower) unless ( $item->{'issuedate'} eq C4::Dates->today('iso') );;
1567						}
1568
1569	0	0				if ($borrowernumber) {
1570	0					MarkIssueReturned($borrowernumber, $item->{'itemnumber'}, $circControlBranch, '', $borrower->{'privacy'});
1571	0					$messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? This could be the borrower hash.
1572						}
1573
1574	0					ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1575						}
1576
1577						# the holdingbranch is updated if the document is returned to another location.
1578						# this is always done regardless of whether the item was on loan or not
1579	0	0				if ($item->{'holdingbranch'} ne $branch) {
1580	0					UpdateHoldingbranch($branch, $item->{'itemnumber'});
1581	0					$item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1582						}
1583	0					ModDateLastSeen( $item->{'itemnumber'} );
1584
1585						# check if we have a transfer for this document
1586	0					my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1587
1588						# if we have a transfer to do, we update the line of transfers with the datearrived
1589	0	0				if ($datesent) {
1590	0	0				if ( $tobranch eq $branch ) {
1591	0					my $sth = C4::Context->dbh->prepare(
1592						"UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1593						);
1594	0					$sth->execute( $item->{'itemnumber'} );
1595						# if we have a reservation with valid transfer, we can set it's status to 'W'
1596	0					C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1597						} else {
1598	0					$messages->{'WrongTransfer'} = $tobranch;
1599	0					$messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1600						}
1601	0					$validTransfert = 1;
1602						}
1603
1604						# fix up the accounts.....
1605	0	0				if ($item->{'itemlost'}) {
1606	0					_FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode); # can tolerate undef $borrowernumber
1607	0					$messages->{'WasLost'} = 1;
1608						}
1609
1610						# fix up the overdues in accounts...
1611	0	0				if ($borrowernumber) {
1612	0					my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1613	0	0				defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
1614
1615						# fix fine days
1616	0					my $debardate = _FixFineDaysOnReturn( $borrower, $item, $issue->{date_due} );
1617	0	0				$messages->{'Debarred'} = $debardate if ($debardate);
1618						}
1619
1620						# find reserves.....
1621						# if we don't have a reserve with the status W, we launch the Checkreserves routine
1622	0					my ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1623	0	0				if ($resfound) {
1624	0					$resrec->{'ResFound'} = $resfound;
1625	0					$messages->{'ResFound'} = $resrec;
1626						}
1627
1628						# update stats?
1629						# Record the fact that this book was returned.
1630						UpdateStats(
1631	0					$branch, $stat_type, '0', '',
1632						$item->{'itemnumber'},
1633						$biblio->{'itemtype'},
1634						$borrowernumber
1635						);
1636
1637						# Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
1638	0					my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1639	0					my %conditions = (
1640						branchcode => $branch,
1641						categorycode => $borrower->{categorycode},
1642						item_type => $item->{itype},
1643						notification => 'CHECKIN',
1644						);
1645	0	0	0			if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
1646	0					SendCirculationAlert({
1647						type => 'CHECKIN',
1648						item => $item,
1649						borrower => $borrower,
1650						branch => $branch,
1651						});
1652						}
1653
1654	0	0				logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'})
1655						if C4::Context->preference("ReturnLog");
1656
1657						# FIXME: make this comment intelligible.
1658						#adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1659						#we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1660
1661	0	0	0			if (($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $hbr) and not $messages->{'WrongTransfer'}){
1662	0	0	0			if ( C4::Context->preference("AutomaticItemReturn" ) or
1663						(C4::Context->preference("UseBranchTransferLimits") and
1664						! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} )
1665						)) {
1666	0	0				$debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
1667	0	0				$debug and warn "item: " . Dumper($item);
1668	0					ModItemTransfer($item->{'itemnumber'}, $branch, $hbr);
1669	0					$messages->{'WasTransfered'} = 1;
1670						} else {
1671	0					$messages->{'NeedsTransfer'} = 1; # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
1672						}
1673						}
1674	0					return ( $doreturn, $messages, $issue, $borrower );
1675						}
1676
1677 - 1698						=head2 MarkIssueReturned MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy); Unconditionally marks an issue as being returned by moving the C<issues> row to C<old_issues> and setting C<returndate> to the current date, or the last non-holiday date of the branccode specified in C<dropbox_branch> . Assumes you've already checked that it's safe to do this, i.e. last non-holiday > issuedate. if C<$returndate> is specified (in iso format), it is used as the date of the return. It is ignored when a dropbox_branch is passed in. C<$privacy> contains the privacy parameter. If the patron has set privacy to 2, the old_issue is immediately anonymised Ideally, this function would be internal to C<C4::Circulation>, not exported, but it is currently needed by one routine in C<C4::Accounts>. =cut
1699
1700						sub MarkIssueReturned {
1701	0			0		my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
1702	0					my $dbh = C4::Context->dbh;
1703	0					my $query = "UPDATE issues SET returndate=";
1704	0					my @bind;
1705	0	0 0				if ($dropbox_branch) {
1706	0					my $calendar = C4::Calendar->new( branchcode => $dropbox_branch );
1707	0					my $dropboxdate = $calendar->addDate( C4::Dates->new(), -1 );
1708	0					$query .= " ? ";
1709	0					push @bind, $dropboxdate->output('iso');
1710						} elsif ($returndate) {
1711	0					$query .= " ? ";
1712	0					push @bind, $returndate;
1713						} else {
1714	0					$query .= " now() ";
1715						}
1716	0					$query .= " WHERE borrowernumber = ? AND itemnumber = ?";
1717	0					push @bind, $borrowernumber, $itemnumber;
1718						# FIXME transaction
1719	0					my $sth_upd = $dbh->prepare($query);
1720	0					$sth_upd->execute(@bind);
1721	0					my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1722						WHERE borrowernumber = ?
1723						AND itemnumber = ?");
1724	0					$sth_copy->execute($borrowernumber, $itemnumber);
1725						# anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
1726	0	0				if ( $privacy == 2) {
1727						# The default of 0 does not work due to foreign key constraints
1728						# The anonymisation will fail quietly if AnonymousPatron is not a valid entry
1729	0	0				my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
1730	0					my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
1731						WHERE borrowernumber = ?
1732						AND itemnumber = ?");
1733	0					$sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
1734						}
1735	0					my $sth_del = $dbh->prepare("DELETE FROM issues
1736						WHERE borrowernumber = ?
1737						AND itemnumber = ?");
1738	0					$sth_del->execute($borrowernumber, $itemnumber);
1739						}
1740
1741 - 1753						=head2 _FixFineDaysOnReturn &_FixFineDaysOnReturn($borrower, $item, $datedue); C<$borrower> borrower hashref C<$item> item hashref C<$datedue> date due Internal function, called only by AddReturn that calculate and update the user fine days, and debars him =cut
1754
1755						sub _FixFineDaysOnReturn {
1756	0			0		my ( $borrower, $item, $datedue ) = @_;
1757
1758	0	0				if ($datedue) {
1759	0					$datedue = C4::Dates->new( $datedue, "iso" );
1760						} else {
1761	0					return;
1762						}
1763
1764	0					my $branchcode = _GetCircControlBranch( $item, $borrower );
1765	0					my $calendar = C4::Calendar->new( branchcode => $branchcode );
1766	0					my $today = C4::Dates->new();
1767
1768	0					my $deltadays = $calendar->daysBetween( $datedue, C4::Dates->new() );
1769
1770	0					my $circcontrol = C4::Context::preference('CircControl');
1771	0					my $issuingrule = GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
1772	0					my $finedays = $issuingrule->{finedays};
1773
1774						# exit if no finedays defined
1775	0	0				return unless $finedays;
1776	0					my $grace = $issuingrule->{firstremind};
1777
1778	0	0				if ( $deltadays - $grace > 0 ) {
1779	0					my @newdate = Add_Delta_Days( Today(), $deltadays * $finedays );
1780	0					my $isonewdate = join( '-', @newdate );
1781	0					my ( $deby, $debm, $debd ) = split( /-/, $borrower->{debarred} );
1782	0	0				if ( check_date( $deby, $debm, $debd ) ) {
1783	0					my @olddate = split( /-/, $borrower->{debarred} );
1784
1785	0	0				if ( Delta_Days( @olddate, @newdate ) > 0 ) {
1786	0					C4::Members::DebarMember( $borrower->{borrowernumber}, $isonewdate );
1787	0					return $isonewdate;
1788						}
1789						} else {
1790	0					C4::Members::DebarMember( $borrower->{borrowernumber}, $isonewdate );
1791	0					return $isonewdate;
1792						}
1793						}
1794						}
1795
1796 - 1809						=head2 _FixOverduesOnReturn &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode); C<$brn> borrowernumber C<$itm> itemnumber C<$exemptfine> BOOL -- remove overdue charge associated with this issue. C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue. Internal function, called only by AddReturn =cut
1810
1811						sub _FixOverduesOnReturn {
1812	0			0		my ($borrowernumber, $item);
1813	0	0				unless ($borrowernumber = shift) {
1814	0					warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
1815	0					return;
1816						}
1817	0	0				unless ($item = shift) {
1818	0					warn "_FixOverduesOnReturn() not supplied valid itemnumber";
1819	0					return;
1820						}
1821	0					my ($exemptfine, $dropbox) = @_;
1822	0					my $dbh = C4::Context->dbh;
1823
1824						# check for overdue fine
1825	0					my $sth = $dbh->prepare(
1826						"SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1827						);
1828	0					$sth->execute( $borrowernumber, $item );
1829
1830						# alter fine to show that the book has been returned
1831	0					my $data = $sth->fetchrow_hashref;
1832	0	0				return 0 unless $data; # no warning, there's just nothing to fix
1833
1834	0					my $uquery;
1835	0					my @bind = ($borrowernumber, $item, $data->{'accountno'});
1836	0	0 0	0			if ($exemptfine) {
1837	0					$uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1838	0	0				if (C4::Context->preference("FinesLog")) {
1839	0					&logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1840						}
1841						} elsif ($dropbox && $data->{lastincrement}) {
1842	0					my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1843	0					my $amt = $data->{amount} - $data->{lastincrement} ;
1844	0	0				if (C4::Context->preference("FinesLog")) {
1845	0					&logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1846						}
1847	0					$uquery = "update accountlines set accounttype='F' ";
1848	0	0	0			if($outstanding >= 0 && $amt >=0) {
1849	0					$uquery .= ", amount = ? , amountoutstanding=? ";
1850	0					unshift @bind, ($amt, $outstanding) ;
1851						}
1852						} else {
1853	0					$uquery = "update accountlines set accounttype='F' ";
1854						}
1855	0					$uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1856	0					my $usth = $dbh->prepare($uquery);
1857	0					return $usth->execute(@bind);
1858						}
1859
1860 - 1871						=head2 _FixAccountForLostAndReturned &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]); Calculates the charge for a book lost and returned. Internal function, not exported, called only by AddReturn. FIXME: This function reflects how inscrutable fines logic is. Fix both. FIXME: Give a positive return value on success. It might be the $borrowernumber who received credit, or the amount forgiven. =cut
1872
1873						sub _FixAccountForLostAndReturned {
1874	0	0		0		my $itemnumber = shift or return;
1875	0	0				my $borrowernumber = @_ ? shift : undef;
1876	0	0				my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
1877	0					my $dbh = C4::Context->dbh;
1878						# check for charge made for lost book
1879	0					my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
1880	0					$sth->execute($itemnumber);
1881	0					my $data = $sth->fetchrow_hashref;
1882	0	0				$data or return; # bail if there is nothing to do
1883	0	0				$data->{accounttype} eq 'W' and return; # Written off
1884
1885						# writeoff this amount
1886	0					my $offset;
1887	0					my $amount = $data->{'amount'};
1888	0					my $acctno = $data->{'accountno'};
1889	0					my $amountleft; # Starts off undef/zero.
1890	0	0				if ($data->{'amountoutstanding'} == $amount) {
1891	0					$offset = $data->{'amount'};
1892	0					$amountleft = 0; # Hey, it's zero here, too.
1893						} else {
1894	0					$offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are ==
1895	0					$amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are ==
1896						}
1897	0					my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1898						WHERE (borrowernumber = ?)
1899						AND (itemnumber = ?) AND (accountno = ?) ");
1900	0					$usth->execute($data->{'borrowernumber'},$itemnumber,$acctno); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in.
1901						#check if any credit is left if so writeoff other accounts
1902	0					my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1903	0	0				$amountleft *= -1 if ($amountleft < 0);
1904	0	0				if ($amountleft > 0) {
1905	0					my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1906						AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first)
1907	0					$msth->execute($data->{'borrowernumber'});
1908						# offset transactions
1909	0					my $newamtos;
1910	0					my $accdata;
1911	0		0			while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1912	0	0				if ($accdata->{'amountoutstanding'} < $amountleft) {
1913	0					$newamtos = 0;
1914	0					$amountleft -= $accdata->{'amountoutstanding'};
1915						} else {
1916	0					$newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1917	0					$amountleft = 0;
1918						}
1919	0					my $thisacct = $accdata->{'accountno'};
1920						# FIXME: move prepares outside while loop!
1921	0					my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1922						WHERE (borrowernumber = ?)
1923						AND (accountno=?)");
1924	0					$usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct'); # FIXME: '$thisacct' is a string literal!
1925	0					$usth = $dbh->prepare("INSERT INTO accountoffsets
1926						(borrowernumber, accountno, offsetaccount, offsetamount)
1927						VALUES
1928						(?,?,?,?)");
1929	0					$usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1930						}
1931	0					$msth->finish; # $msth might actually have data left
1932						}
1933	0	0				$amountleft *= -1 if ($amountleft > 0);
1934	0					my $desc = "Item Returned " . $item_id;
1935	0					$usth = $dbh->prepare("INSERT INTO accountlines
1936						(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1937						VALUES (?,?,now(),?,?,'CR',?)");
1938	0					$usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1939	0	0				if ($borrowernumber) {
1940						# FIXME: same as query above. use 1 sth for both
1941	0					$usth = $dbh->prepare("INSERT INTO accountoffsets
1942						(borrowernumber, accountno, offsetaccount, offsetamount)
1943						VALUES (?,?,?,?)");
1944	0					$usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
1945						}
1946	0					ModItem({ paidfor => '' }, undef, $itemnumber);
1947	0					return;
1948						}
1949
1950 - 1964						=head2 _GetCircControlBranch my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower); Internal function : Return the library code to be used to determine which circulation policy applies to a transaction. Looks up the CircControl and HomeOrHoldingBranch system preferences. C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used. C<$borrower> is a hashref to borrower. Only {branchcode} is used. =cut
1965
1966						sub _GetCircControlBranch {
1967	0			0		my ($item, $borrower) = @_;
1968	0					my $circcontrol = C4::Context->preference('CircControl');
1969	0					my $branch;
1970
1971	0	0 0	0 0			if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
1972	0					$branch= C4::Context->userenv->{'branch'};
1973						} elsif ($circcontrol eq 'PatronLibrary') {
1974	0					$branch=$borrower->{branchcode};
1975						} else {
1976	0		0			my $branchfield = C4::Context->preference('HomeOrHoldingBranch') \|\| 'homebranch';
1977	0					$branch = $item->{$branchfield};
1978						# default to item home branch if holdingbranch is used
1979						# and is not defined
1980	0	0	0			if (!defined($branch) && $branchfield eq 'holdingbranch') {
1981	0					$branch = $item->{homebranch};
1982						}
1983						}
1984	0					return $branch;
1985						}
1986
1987
1988
1989
1990
1991
1992 - 2002						=head2 GetItemIssue $issue = &GetItemIssue($itemnumber); Returns patron currently having a book, or undef if not checked out. C<$itemnumber> is the itemnumber. C<$issue> is a hashref of the row from the issues table. =cut
2003
2004						sub GetItemIssue {
2005	0			0		my ($itemnumber) = @_;
2006	0	0				return unless $itemnumber;
2007	0					my $sth = C4::Context->dbh->prepare(
2008						"SELECT *
2009						FROM issues
2010						LEFT JOIN items ON issues.itemnumber=items.itemnumber
2011						WHERE issues.itemnumber=?");
2012	0					$sth->execute($itemnumber);
2013	0					my $data = $sth->fetchrow_hashref;
2014	0	0				return unless $data;
2015	0	0				$data->{'overdue'} = ($data->{'date_due'} lt C4::Dates->today('iso')) ? 1 : 0;
2016	0					return ($data);
2017						}
2018
2019 - 2029						=head2 GetOpenIssue $issue = GetOpenIssue( $itemnumber ); Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued C<$itemnumber> is the item's itemnumber Returns a hashref =cut
2030
2031						sub GetOpenIssue {
2032	0			0		my ( $itemnumber ) = @_;
2033
2034	0					my $dbh = C4::Context->dbh;
2035	0					my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2036	0					$sth->execute( $itemnumber );
2037	0					my $issue = $sth->fetchrow_hashref();
2038	0					return $issue;
2039						}
2040
2041 - 2053						=head2 GetItemIssues $issues = &GetItemIssues($itemnumber, $history); Returns patrons that have issued a book C<$itemnumber> is the itemnumber C<$history> is false if you just want the current "issuer" (if any) and true if you want issues history from old_issues also. Returns reference to an array of hashes =cut
2054
2055						sub GetItemIssues {
2056	0			0		my ( $itemnumber, $history ) = @_;
2057
2058	0					my $today = C4::Dates->today('iso'); # get today date
2059	0					my $sql = "SELECT * FROM issues
2060						JOIN borrowers USING (borrowernumber)
2061						JOIN items USING (itemnumber)
2062						WHERE issues.itemnumber = ? ";
2063	0	0				if ($history) {
2064	0					$sql .= "UNION ALL
2065						SELECT * FROM old_issues
2066						LEFT JOIN borrowers USING (borrowernumber)
2067						JOIN items USING (itemnumber)
2068						WHERE old_issues.itemnumber = ? ";
2069						}
2070	0					$sql .= "ORDER BY date_due DESC";
2071	0					my $sth = C4::Context->dbh->prepare($sql);
2072	0	0				if ($history) {
2073	0					$sth->execute($itemnumber, $itemnumber);
2074						} else {
2075	0					$sth->execute($itemnumber);
2076						}
2077	0					my $results = $sth->fetchall_arrayref({});
2078	0					foreach (@$results) {
2079	0	0				$_->{'overdue'} = ($_->{'date_due'} lt $today) ? 1 : 0;
2080						}
2081	0					return $results;
2082						}
2083
2084 - 2094						=head2 GetBiblioIssues $issues = GetBiblioIssues($biblionumber); this function get all issues from a biblionumber. Return: C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from tables issues and the firstname,surname & cardnumber from borrowers. =cut
2095
2096						sub GetBiblioIssues {
2097	0			0		my $biblionumber = shift;
2098	0	0				return undef unless $biblionumber;
2099	0					my $dbh = C4::Context->dbh;
2100	0					my $query = "
2101						SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2102						FROM issues
2103						LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2104						LEFT JOIN items ON issues.itemnumber = items.itemnumber
2105						LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2106						LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2107						WHERE biblio.biblionumber = ?
2108						UNION ALL
2109						SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2110						FROM old_issues
2111						LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2112						LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2113						LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2114						LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2115						WHERE biblio.biblionumber = ?
2116						ORDER BY timestamp
2117						";
2118	0					my $sth = $dbh->prepare($query);
2119	0					$sth->execute($biblionumber, $biblionumber);
2120
2121	0					my @issues;
2122	0					while ( my $data = $sth->fetchrow_hashref ) {
2123	0					push @issues, $data;
2124						}
2125	0					return \@issues;
2126						}
2127
2128 - 2132						=head2 GetUpcomingDueIssues my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } ); =cut
2133
2134						sub GetUpcomingDueIssues {
2135	0			0		my $params = shift;
2136
2137	0	0				$params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2138	0					my $dbh = C4::Context->dbh;
2139
2140	0					my $statement = <<END_SQL;
2141						SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2142						FROM issues
2143						LEFT JOIN items USING (itemnumber)
2144						LEFT OUTER JOIN branches USING (branchcode)
2145						WhERE returndate is NULL
2146						AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
2147						END_SQL
2148
2149	0					my @bind_parameters = ( $params->{'days_in_advance'} );
2150
2151	0					my $sth = $dbh->prepare( $statement );
2152	0					$sth->execute( @bind_parameters );
2153	0					my $upcoming_dues = $sth->fetchall_arrayref({});
2154	0					$sth->finish;
2155
2156	0					return $upcoming_dues;
2157						}
2158
2159 - 2181						=head2 CanBookBeRenewed ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]); Find out whether a borrowed item may be renewed. C<$dbh> is a DBI handle to the Koha database. C<$borrowernumber> is the borrower number of the patron who currently has the item on loan. C<$itemnumber> is the number of the item to renew. C<$override_limit>, if supplied with a true value, causes the limit on the number of times that the loan can be renewed (as controlled by the item type) to be ignored. C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The item must currently be on loan to the specified borrower; renewals must be allowed for the item's type; and the borrower must not have already renewed the loan. $error will contain the reason the renewal can not proceed =cut
2182
2183						sub CanBookBeRenewed {
2184
2185						# check renewal status
2186	0			0		my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2187	0					my $dbh = C4::Context->dbh;
2188	0					my $renews = 1;
2189	0					my $renewokay = 0;
2190	0					my $error;
2191
2192						# Look in the issues table for this item, lent to this borrower,
2193						# and not yet returned.
2194
2195						# Look in the issues table for this item, lent to this borrower,
2196						# and not yet returned.
2197	0					my %branch = (
2198						'ItemHomeLibrary' => 'items.homebranch',
2199						'PickupLibrary' => 'items.holdingbranch',
2200						'PatronLibrary' => 'borrowers.branchcode'
2201						);
2202	0					my $controlbranch = $branch{C4::Context->preference('CircControl')};
2203	0	0				my $itype = C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype';
2204
2205	0					my $sthcount = $dbh->prepare("
2206						SELECT
2207						borrowers.categorycode, biblioitems.itemtype, issues.renewals, renewalsallowed, $controlbranch
2208						FROM issuingrules,
2209						issues
2210						LEFT JOIN items USING (itemnumber)
2211						LEFT JOIN borrowers USING (borrowernumber)
2212						LEFT JOIN biblioitems USING (biblioitemnumber)
2213
2214						WHERE
2215						(issuingrules.categorycode = borrowers.categorycode OR issuingrules.categorycode = '*')
2216						AND
2217						(issuingrules.itemtype = $itype OR issuingrules.itemtype = '*')
2218						AND
2219						(issuingrules.branchcode = $controlbranch OR issuingrules.branchcode = '*')
2220						AND
2221						borrowernumber = ?
2222						AND
2223						itemnumber = ?
2224						ORDER BY
2225						issuingrules.categorycode desc,
2226						issuingrules.itemtype desc,
2227						issuingrules.branchcode desc
2228						LIMIT 1;
2229						");
2230
2231	0					$sthcount->execute( $borrowernumber, $itemnumber );
2232	0	0				if ( my $data1 = $sthcount->fetchrow_hashref ) {
2233
2234	0	0	0			if ( ( $data1->{renewalsallowed} && $data1->{renewalsallowed} > $data1->{renewals} ) \|\| $override_limit ) {
2235	0					$renewokay = 1;
2236						}
2237						else {
2238	0					$error="too_many";
2239						}
2240
2241	0					my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2242	0	0				if ($resfound) {
2243	0					$renewokay = 0;
2244	0					$error="on_reserve"
2245						}
2246
2247						}
2248	0					return ($renewokay,$error);
2249						}
2250
2251 - 2273						=head2 AddRenewal &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]); Renews a loan. C<$borrowernumber> is the borrower number of the patron who currently has the item. C<$itemnumber> is the number of the item to renew. C<$branch> is the library where the renewal took place (if any). The library that controls the circ policies for the renewal is retrieved from the issues record. C<$datedue> can be a C4::Dates object used to set the due date. C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If this parameter is not supplied, lastreneweddate is set to the current date. If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically from the book's item type. =cut
2274
2275						sub AddRenewal {
2276	0	0		0		my $borrowernumber = shift or return undef;
2277	0	0				my $itemnumber = shift or return undef;
2278	0					my $branch = shift;
2279	0					my $datedue = shift;
2280	0		0			my $lastreneweddate = shift \|\| C4::Dates->new()->output('iso');
2281	0	0				my $item = GetItem($itemnumber) or return undef;
2282	0	0				my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
2283
2284	0					my $dbh = C4::Context->dbh;
2285						# Find the issues record for this book
2286	0					my $sth =
2287						$dbh->prepare("SELECT * FROM issues
2288						WHERE borrowernumber=?
2289						AND itemnumber=?"
2290						);
2291	0					$sth->execute( $borrowernumber, $itemnumber );
2292	0					my $issuedata = $sth->fetchrow_hashref;
2293	0					$sth->finish;
2294	0	0	0			if($datedue && ! $datedue->output('iso')){
2295	0					warn "Invalid date passed to AddRenewal.";
2296	0					return undef;
2297						}
2298						# If the due date wasn't specified, calculate it by adding the
2299						# book's loan length to today's date or the current due date
2300						# based on the value of the RenewalPeriodBase syspref.
2301	0	0				unless ($datedue) {
2302
2303	0	0				my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return undef;
2304	0	0				my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2305
2306	0	0				$datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2307						C4::Dates->new($issuedata->{date_due}, 'iso') :
2308						C4::Dates->new();
2309	0					$datedue = CalcDateDue($datedue,$itemtype,$issuedata->{'branchcode'},$borrower);
2310						}
2311
2312						# Update the issues record to have the new due date, and a new count
2313						# of how many times it has been renewed.
2314	0					my $renews = $issuedata->{'renewals'} + 1;
2315	0					$sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2316						WHERE borrowernumber=?
2317						AND itemnumber=?"
2318						);
2319	0					$sth->execute( $datedue->output('iso'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2320	0					$sth->finish;
2321
2322						# Update the renewal count on the item, and tell zebra to reindex
2323	0					$renews = $biblio->{'renewals'} + 1;
2324	0					ModItem({ renewals => $renews, onloan => $datedue->output('iso') }, $biblio->{'biblionumber'}, $itemnumber);
2325
2326						# Charge a new rental fee, if applicable?
2327	0					my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2328	0	0				if ( $charge > 0 ) {
2329	0					my $accountno = getnextacctno( $borrowernumber );
2330	0					my $item = GetBiblioFromItemNumber($itemnumber);
2331	0					my $manager_id = 0;
2332	0	0				$manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2333	0					$sth = $dbh->prepare(
2334						"INSERT INTO accountlines
2335						(date, borrowernumber, accountno, amount, manager_id,
2336						description,accounttype, amountoutstanding, itemnumber)
2337						VALUES (now(),?,?,?,?,?,?,?,?)"
2338						);
2339	0					$sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2340						"Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2341						'Rent', $charge, $itemnumber );
2342	0					$sth->finish;
2343						}
2344						# Log the renewal
2345	0					UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2346	0					return $datedue;
2347						}
2348
2349						sub GetRenewCount {
2350						# check renewal status
2351	0			0		my ( $bornum, $itemno ) = @_;
2352	0					my $dbh = C4::Context->dbh;
2353	0					my $renewcount = 0;
2354	0					my $renewsallowed = 0;
2355	0					my $renewsleft = 0;
2356
2357	0					my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
2358	0					my $item = GetItem($itemno);
2359
2360						# Look in the issues table for this item, lent to this borrower,
2361						# and not yet returned.
2362
2363						# FIXME - I think this function could be redone to use only one SQL call.
2364	0					my $sth = $dbh->prepare(
2365						"select * from issues
2366						where (borrowernumber = ?)
2367						and (itemnumber = ?)"
2368						);
2369	0					$sth->execute( $bornum, $itemno );
2370	0					my $data = $sth->fetchrow_hashref;
2371	0	0				$renewcount = $data->{'renewals'} if $data->{'renewals'};
2372	0					$sth->finish;
2373						# $item and $borrower should be calculated
2374	0					my $branchcode = _GetCircControlBranch($item, $borrower);
2375
2376	0					my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2377
2378	0					$renewsallowed = $issuingrule->{'renewalsallowed'};
2379	0					$renewsleft = $renewsallowed - $renewcount;
2380	0 0	0				if($renewsleft < 0){ $renewsleft = 0; }
2381	0					return ( $renewcount, $renewsallowed, $renewsleft );
2382						}
2383
2384 - 2399						=head2 GetIssuingCharges ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber); Calculate how much it would cost for a given patron to borrow a given item, including any applicable discounts. C<$itemnumber> is the item number of item the patron wishes to borrow. C<$borrowernumber> is the patron's borrower number. C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge, and C<$item_type> is the code for the item's item type (e.g., C<VID> if it's a video). =cut
2400
2401						sub GetIssuingCharges {
2402
2403						# calculate charges due
2404	0			0		my ( $itemnumber, $borrowernumber ) = @_;
2405	0					my $charge = 0;
2406	0					my $dbh = C4::Context->dbh;
2407	0					my $item_type;
2408
2409						# Get the book's item type and rental charge (via its biblioitem).
2410	0					my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
2411						LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
2412	0	0				$charge_query .= (C4::Context->preference('item-level_itypes'))
2413						? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
2414						: ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
2415
2416	0					$charge_query .= ' WHERE items.itemnumber =?';
2417
2418	0					my $sth = $dbh->prepare($charge_query);
2419	0					$sth->execute($itemnumber);
2420	0	0				if ( my $item_data = $sth->fetchrow_hashref ) {
2421	0					$item_type = $item_data->{itemtype};
2422	0					$charge = $item_data->{rentalcharge};
2423	0					my $branch = C4::Branch::mybranch();
2424	0					my $discount_query = q\|SELECT rentaldiscount,
2425						issuingrules.itemtype, issuingrules.branchcode
2426						FROM borrowers
2427						LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2428						WHERE borrowers.borrowernumber = ?
2429						AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
2430						AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')\|;
2431	0					my $discount_sth = $dbh->prepare($discount_query);
2432	0					$discount_sth->execute( $borrowernumber, $item_type, $branch );
2433	0					my $discount_rules = $discount_sth->fetchall_arrayref({});
2434	0 0	0				if (@{$discount_rules}) {
2435						# We may have multiple rules so get the most specific
2436	0					my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
2437	0					$charge = ( $charge * ( 100 - $discount ) ) / 100;
2438						}
2439						}
2440
2441	0					$sth->finish; # we havent _explicitly_ fetched all rows
2442	0					return ( $charge, $item_type );
2443						}
2444
2445						# Select most appropriate discount rule from those returned
2446						sub _get_discount_from_rule {
2447	0			0		my ($rules_ref, $branch, $itemtype) = @_;
2448	0					my $discount;
2449
2450	0 0	0				if (@{$rules_ref} == 1) { # only 1 applicable rule use it
2451	0					$discount = $rules_ref->[0]->{rentaldiscount};
2452	0	0				return (defined $discount) ? $discount : 0;
2453						}
2454						# could have up to 4 does one match $branch and $itemtype
2455	0 0 0	0				my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
2456	0	0				if (@d) {
2457	0					$discount = $d[0]->{rentaldiscount};
2458	0	0				return (defined $discount) ? $discount : 0;
2459						}
2460						# do we have item type + all branches
2461	0 0 0	0				@d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
2462	0	0				if (@d) {
2463	0					$discount = $d[0]->{rentaldiscount};
2464	0	0				return (defined $discount) ? $discount : 0;
2465						}
2466						# do we all item types + this branch
2467	0 0 0	0				@d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
2468	0	0				if (@d) {
2469	0					$discount = $d[0]->{rentaldiscount};
2470	0	0				return (defined $discount) ? $discount : 0;
2471						}
2472						# so all and all (surely we wont get here)
2473	0 0 0	0				@d = grep { $_->{branchcode} eq q{} && $_->{itemtype} eq q{} } @{$rules_ref};
2474	0	0				if (@d) {
2475	0					$discount = $d[0]->{rentaldiscount};
2476	0	0				return (defined $discount) ? $discount : 0;
2477						}
2478						# none of the above
2479	0					return 0;
2480						}
2481
2482 - 2486						=head2 AddIssuingCharge &AddIssuingCharge( $itemno, $borrowernumber, $charge ) =cut
2487
2488						sub AddIssuingCharge {
2489	0			0		my ( $itemnumber, $borrowernumber, $charge ) = @_;
2490	0					my $dbh = C4::Context->dbh;
2491	0					my $nextaccntno = getnextacctno( $borrowernumber );
2492	0					my $manager_id = 0;
2493	0	0				$manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2494	0					my $query ="
2495						INSERT INTO accountlines
2496						(borrowernumber, itemnumber, accountno,
2497						date, amount, description, accounttype,
2498						amountoutstanding, manager_id)
2499						VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
2500						";
2501	0					my $sth = $dbh->prepare($query);
2502	0					$sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
2503	0					$sth->finish;
2504						}
2505
2506 - 2510						=head2 GetTransfers GetTransfers($itemnumber); =cut
2511
2512						sub GetTransfers {
2513	0			0		my ($itemnumber) = @_;
2514
2515	0					my $dbh = C4::Context->dbh;
2516
2517	0					my $query = '
2518						SELECT datesent,
2519						frombranch,
2520						tobranch
2521						FROM branchtransfers
2522						WHERE itemnumber = ?
2523						AND datearrived IS NULL
2524						';
2525	0					my $sth = $dbh->prepare($query);
2526	0					$sth->execute($itemnumber);
2527	0					my @row = $sth->fetchrow_array();
2528	0					$sth->finish;
2529	0					return @row;
2530						}
2531
2532 - 2538						=head2 GetTransfersFromTo @results = GetTransfersFromTo($frombranch,$tobranch); Returns the list of pending transfers between $from and $to branch =cut
2539
2540						sub GetTransfersFromTo {
2541	0			0		my ( $frombranch, $tobranch ) = @_;
2542	0	0	0			return unless ( $frombranch && $tobranch );
2543	0					my $dbh = C4::Context->dbh;
2544	0					my $query = "
2545						SELECT itemnumber,datesent,frombranch
2546						FROM branchtransfers
2547						WHERE frombranch=?
2548						AND tobranch=?
2549						AND datearrived IS NULL
2550						";
2551	0					my $sth = $dbh->prepare($query);
2552	0					$sth->execute( $frombranch, $tobranch );
2553	0					my @gettransfers;
2554
2555	0					while ( my $data = $sth->fetchrow_hashref ) {
2556	0					push @gettransfers, $data;
2557						}
2558	0					$sth->finish;
2559	0					return (@gettransfers);
2560						}
2561
2562 - 2566						=head2 DeleteTransfer &DeleteTransfer($itemnumber); =cut
2567
2568						sub DeleteTransfer {
2569	0			0		my ($itemnumber) = @_;
2570	0					my $dbh = C4::Context->dbh;
2571	0					my $sth = $dbh->prepare(
2572						"DELETE FROM branchtransfers
2573						WHERE itemnumber=?
2574						AND datearrived IS NULL "
2575						);
2576	0					$sth->execute($itemnumber);
2577	0					$sth->finish;
2578						}
2579
2580 - 2592						=head2 AnonymiseIssueHistory $rows = AnonymiseIssueHistory($date,$borrowernumber) This function write NULL instead of C<$borrowernumber> given on input arg into the table issues. if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>. If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy setting (force delete). return the number of affected rows. =cut
2593
2594						sub AnonymiseIssueHistory {
2595	0			0		my $date = shift;
2596	0					my $borrowernumber = shift;
2597	0					my $dbh = C4::Context->dbh;
2598	0					my $query = "
2599						UPDATE old_issues
2600						SET borrowernumber = ?
2601						WHERE returndate < ?
2602						AND borrowernumber IS NOT NULL
2603						";
2604
2605						# The default of 0 does not work due to foreign key constraints
2606						# The anonymisation will fail quietly if AnonymousPatron is not a valid entry
2607	0	0				my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
2608	0					my @bind_params = ($anonymouspatron, $date);
2609	0	0				if (defined $borrowernumber) {
2610	0					$query .= " AND borrowernumber = ?";
2611	0					push @bind_params, $borrowernumber;
2612						} else {
2613	0					$query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
2614						}
2615	0					my $sth = $dbh->prepare($query);
2616	0					$sth->execute(@bind_params);
2617	0					my $rows_affected = $sth->rows; ### doublecheck row count return function
2618	0					return $rows_affected;
2619						}
2620
2621 - 2656						=head2 SendCirculationAlert Send out a C<check-in> or C<checkout> alert using the messaging system. B<Parameters>: =over 4 =item type Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>. =item item Hashref of information about the item being checked in or out. =item borrower Hashref of information about the borrower of the item. =item branch The branchcode from where the checkout or check-in took place. =back B<Example>: SendCirculationAlert({ type => 'CHECKOUT', item => $item, borrower => $borrower, branch => $branch, }); =cut
2657
2658						sub SendCirculationAlert {
2659	0			0		my ($opts) = @_;
2660	0					my ($type, $item, $borrower, $branch) =
2661						($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
2662	0					my %message_name = (
2663						CHECKIN => 'Item_Check_in',
2664						CHECKOUT => 'Item_Checkout',
2665						);
2666	0					my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
2667						borrowernumber => $borrower->{borrowernumber},
2668						message_name => $message_name{$type},
2669						});
2670	0					my $letter = C4::Letters::getletter('circulation', $type);
2671	0					C4::Letters::parseletter($letter, 'biblio', $item->{biblionumber});
2672	0					C4::Letters::parseletter($letter, 'biblioitems', $item->{biblionumber});
2673	0					C4::Letters::parseletter($letter, 'borrowers', $borrower->{borrowernumber});
2674	0					C4::Letters::parseletter($letter, 'branches', $branch);
2675	0 0					my @transports = @{ $borrower_preferences->{transports} };
2676						# warn "no transports" unless @transports;
2677	0					for (@transports) {
2678						# warn "transport: $_";
2679	0					my $message = C4::Message->find_last_message($borrower, $type, $_);
2680	0	0				if (!$message) {
2681						#warn "create new message";
2682	0					C4::Message->enqueue($letter, $borrower, $_);
2683						} else {
2684						#warn "append to old message";
2685	0					$message->append($letter);
2686	0					$message->update;
2687						}
2688						}
2689	0					$letter;
2690						}
2691
2692 - 2698						=head2 updateWrongTransfer $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary); This function validate the line of brachtransfer but with the wrong destination (mistake from a librarian ...), and create a new line in branchtransfer from the actual library to the original library of reservation =cut
2699
2700						sub updateWrongTransfer {
2701	0			0		my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2702	0					my $dbh = C4::Context->dbh;
2703						# first step validate the actual line of transfert .
2704	0					my $sth =
2705						$dbh->prepare(
2706						"update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2707						);
2708	0					$sth->execute($FromLibrary,$itemNumber);
2709	0					$sth->finish;
2710
2711						# second step create a new line of branchtransfer to the right location .
2712	0					ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2713
2714						#third step changing holdingbranch of item
2715	0					UpdateHoldingbranch($FromLibrary,$itemNumber);
2716						}
2717
2718 - 2724						=head2 UpdateHoldingbranch $items = UpdateHoldingbranch($branch,$itmenumber); Simple methode for updating hodlingbranch in items BDD line =cut
2725
2726						sub UpdateHoldingbranch {
2727	0			0		my ( $branch,$itemnumber ) = @_;
2728	0					ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2729						}
2730
2731 - 2742						=head2 CalcDateDue $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower); this function calculates the due date given the start date and configured circulation rules, checking against the holidays calendar as per the 'useDaysMode' syspref. C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today) C<$itemtype> = itemtype code of item in question C<$branch> = location whose calendar to use C<$borrower> = Borrower object =cut
2743
2744						sub CalcDateDue {
2745	0			0		my ($startdate,$itemtype,$branch,$borrower) = @_;
2746	0					my $datedue;
2747	0					my $loanlength = GetLoanLength($borrower->{'categorycode'},$itemtype, $branch);
2748
2749						# if globalDueDate ON the datedue is set to that date
2750	0	0	0			if ( C4::Context->preference('globalDueDate')
2751						&& ( C4::Context->preference('globalDueDate') =~ C4::Dates->regexp('syspref') ) ) {
2752	0					$datedue = C4::Dates->new( C4::Context->preference('globalDueDate') );
2753						} else {
2754						# otherwise, calculate the datedue as normal
2755	0	0				if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar
2756	0					my $timedue = time + ($loanlength) * 86400;
2757						#FIXME - assumes now even though we take a startdate
2758	0					my @datearr = localtime($timedue);
2759	0					$datedue = C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2760						} else {
2761	0					my $calendar = C4::Calendar->new( branchcode => $branch );
2762	0					$datedue = $calendar->addDate($startdate, $loanlength);
2763						}
2764						}
2765
2766						# if Hard Due Dates are used, retreive them and apply as necessary
2767	0					my ($hardduedate, $hardduedatecompare) = GetHardDueDate($borrower->{'categorycode'},$itemtype, $branch);
2768	0	0	0			if ( $hardduedate && $hardduedate->output('iso') && $hardduedate->output('iso') ne '0000-00-00') {
2769						# if the calculated due date is after the 'before' Hard Due Date (ceiling), override
2770	0	0 0 0	0 0			if ( $datedue->output( 'iso' ) gt $hardduedate->output( 'iso' ) && $hardduedatecompare == -1) {
2771	0					$datedue = $hardduedate;
2772						# if the calculated date is before the 'after' Hard Due Date (floor), override
2773						} elsif ( $datedue->output( 'iso' ) lt $hardduedate->output( 'iso' ) && $hardduedatecompare == 1) {
2774	0					$datedue = $hardduedate;
2775						# if the hard due date is set to 'exactly', overrride
2776						} elsif ( $hardduedatecompare == 0) {
2777	0					$datedue = $hardduedate;
2778						}
2779						# in all other cases, keep the date due as it is
2780						}
2781
2782						# if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
2783	0	0	0			if ( C4::Context->preference('ReturnBeforeExpiry') && $datedue->output('iso') gt $borrower->{dateexpiry} ) {
2784	0					$datedue = C4::Dates->new( $borrower->{dateexpiry}, 'iso' );
2785						}
2786
2787	0					return $datedue;
2788						}
2789
2790 - 2803						=head2 CheckValidDatedue $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode); This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref . To be replaced by CalcDateDue() once C4::Calendar use is tested. this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref. C<$date_due> = returndate calculate with no day check C<$itemnumber> = itemnumber C<$branchcode> = location of issue (affected by 'CircControl' syspref) C<$loanlength> = loan length prior to adjustment =cut
2804
2805						sub CheckValidDatedue {
2806	0			0		my ($date_due,$itemnumber,$branchcode)=@_;
2807	0					my @datedue=split('-',$date_due->output('iso'));
2808	0					my $years=$datedue[0];
2809	0					my $month=$datedue[1];
2810	0					my $day=$datedue[2];
2811						# die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2812	0					my $dow;
2813						for (my $i=0;$i<2;$i++){
2814	0					$dow=Day_of_Week($years,$month,$day);
2815	0	0				($dow=0) if ($dow>6);
2816	0					my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2817	0					my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2818	0					my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2819	0	0	0			if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2820	0					$i=0;
2821	0	0				(($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2822						}
2823	0					}
2824	0					my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2825	0					return $newdatedue;
2826						}
2827
2828
2829 - 2839						=head2 CheckRepeatableHolidays $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode); This function checks if the date due is a repeatable holiday C<$date_due> = returndate calculate with no day check C<$itemnumber> = itemnumber C<$branchcode> = localisation of issue =cut
2840
2841						sub CheckRepeatableHolidays{
2842	0			0		my($itemnumber,$week_day,$branchcode)=@_;
2843	0					my $dbh = C4::Context->dbh;
2844	0					my $query = qq\|SELECT count(*)
2845						FROM repeatable_holidays
2846						WHERE branchcode=?
2847						AND weekday=?\|;
2848	0					my $sth = $dbh->prepare($query);
2849	0					$sth->execute($branchcode,$week_day);
2850	0					my $result=$sth->fetchrow;
2851	0					$sth->finish;
2852	0					return $result;
2853						}
2854
2855
2856 - 2868						=head2 CheckSpecialHolidays $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode); This function check if the date is a special holiday C<$years> = the years of datedue C<$month> = the month of datedue C<$day> = the day of datedue C<$itemnumber> = itemnumber C<$branchcode> = localisation of issue =cut
2869
2870						sub CheckSpecialHolidays{
2871	0			0		my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2872	0					my $dbh = C4::Context->dbh;
2873	0					my $query=qq\|SELECT count(*)
2874						FROM `special_holidays`
2875						WHERE year=?
2876						AND month=?
2877						AND day=?
2878						AND branchcode=?
2879						\|;
2880	0					my $sth = $dbh->prepare($query);
2881	0					$sth->execute($years,$month,$day,$branchcode);
2882	0					my $countspecial=$sth->fetchrow ;
2883	0					$sth->finish;
2884	0					return $countspecial;
2885						}
2886
2887 - 2898						=head2 CheckRepeatableSpecialHolidays $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode); This function check if the date is a repeatble special holidays C<$month> = the month of datedue C<$day> = the day of datedue C<$itemnumber> = itemnumber C<$branchcode> = localisation of issue =cut
2899
2900						sub CheckRepeatableSpecialHolidays{
2901	0			0		my ($month,$day,$itemnumber,$branchcode) = @_;
2902	0					my $dbh = C4::Context->dbh;
2903	0					my $query=qq\|SELECT count(*)
2904						FROM `repeatable_holidays`
2905						WHERE month=?
2906						AND day=?
2907						AND branchcode=?
2908						\|;
2909	0					my $sth = $dbh->prepare($query);
2910	0					$sth->execute($month,$day,$branchcode);
2911	0					my $countspecial=$sth->fetchrow ;
2912	0					$sth->finish;
2913	0					return $countspecial;
2914						}
2915
2916
2917
2918						sub CheckValidBarcode{
2919	0			0		my ($barcode) = @_;
2920	0					my $dbh = C4::Context->dbh;
2921	0					my $query=qq\|SELECT count(*)
2922						FROM items
2923						WHERE barcode=?
2924						\|;
2925	0					my $sth = $dbh->prepare($query);
2926	0					$sth->execute($barcode);
2927	0					my $exist=$sth->fetchrow ;
2928	0					$sth->finish;
2929	0					return $exist;
2930						}
2931
2932 - 2938						=head2 IsBranchTransferAllowed $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code ); Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType =cut
2939
2940						sub IsBranchTransferAllowed {
2941	0			0		my ( $toBranch, $fromBranch, $code ) = @_;
2942
2943	0 0	0				if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
2944
2945	0					my $limitType = C4::Context->preference("BranchTransferLimitsType");
2946	0					my $dbh = C4::Context->dbh;
2947
2948	0					my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
2949	0					$sth->execute( $toBranch, $fromBranch, $code );
2950	0					my $limit = $sth->fetchrow_hashref();
2951
2952						## If a row is found, then that combination is not allowed, if no matching row is found, then the combination is allowed
2953	0	0				if ( $limit->{'limitId'} ) {
2954	0					return 0;
2955						} else {
2956	0					return 1;
2957						}
2958						}
2959
2960 - 2966						=head2 CreateBranchTransferLimit CreateBranchTransferLimit( $toBranch, $fromBranch, $code ); $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to. =cut
2967
2968						sub CreateBranchTransferLimit {
2969	0			0		my ( $toBranch, $fromBranch, $code ) = @_;
2970
2971	0					my $limitType = C4::Context->preference("BranchTransferLimitsType");
2972
2973	0					my $dbh = C4::Context->dbh;
2974
2975	0					my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
2976	0					$sth->execute( $code, $toBranch, $fromBranch );
2977						}
2978
2979 - 2985						=head2 DeleteBranchTransferLimits DeleteBranchTransferLimits($frombranch); Deletes all the branch transfer limits for one branch =cut
2986
2987						sub DeleteBranchTransferLimits {
2988	0			0		my $branch = shift;
2989	0					my $dbh = C4::Context->dbh;
2990	0					my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
2991	0					$sth->execute($branch);
2992						}
2993
2994						sub ReturnLostItem{
2995	0			0		my ( $borrowernumber, $itemnum ) = @_;
2996
2997	0					MarkIssueReturned( $borrowernumber, $itemnum );
2998	0					my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
2999	0					my @datearr = localtime(time);
3000	0					my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3001	0					my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3002	0					ModItem({ paidfor => "Paid for by $bor $date" }, undef, $itemnum);
3003						}
3004
3005
3006						sub LostItem{
3007	0			0		my ($itemnumber, $mark_returned, $charge_fee) = @_;
3008
3009	0					my $dbh = C4::Context->dbh();
3010	0					my $sth=$dbh->prepare("SELECT issues.,items.,biblio.title
3011						FROM issues
3012						JOIN items USING (itemnumber)
3013						JOIN biblio USING (biblionumber)
3014						WHERE issues.itemnumber=?");
3015	0					$sth->execute($itemnumber);
3016	0					my $issues=$sth->fetchrow_hashref();
3017	0					$sth->finish;
3018
3019						# if a borrower lost the item, add a replacement cost to the their record
3020	0	0				if ( my $borrowernumber = $issues->{borrowernumber} ){
3021
3022	0	0				C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}")
3023						if $charge_fee;
3024						#FIXME : Should probably have a way to distinguish this from an item that really was returned.
3025						#warn " $issues->{'borrowernumber'} / $itemnumber ";
3026	0	0				MarkIssueReturned($borrowernumber,$itemnumber) if $mark_returned;
3027						}
3028						}
3029
3030
3031						1;
3032