← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:12:34 2013

Filename/usr/share/koha/lib/C4/Circulation.pm
StatementsExecuted 596 statements in 94.0ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11116.1ms131msC4::Circulation::::BEGIN@24C4::Circulation::BEGIN@24
1116.77ms265msC4::Circulation::::BEGIN@27C4::Circulation::BEGIN@27
64224.91ms146msC4::Circulation::::GetTransfersC4::Circulation::GetTransfers
1112.05ms36.1msC4::Circulation::::BEGIN@49C4::Circulation::BEGIN@49
1111.33ms2.51msC4::Circulation::::BEGIN@34C4::Circulation::BEGIN@34
1111.32ms1.71msC4::Circulation::::BEGIN@35C4::Circulation::BEGIN@35
1111.03ms1.29msC4::Circulation::::BEGIN@45C4::Circulation::BEGIN@45
111704µs1.49msC4::Circulation::::BEGIN@26C4::Circulation::BEGIN@26
11149µs54µsC4::Circulation::::BEGIN@30C4::Circulation::BEGIN@30
11141µs45µsC4::Circulation::::BEGIN@44C4::Circulation::BEGIN@44
11134µs34µsC4::Circulation::::BEGIN@62C4::Circulation::BEGIN@62
11133µs40µsC4::Circulation::::BEGIN@25C4::Circulation::BEGIN@25
11130µs38µsC4::Circulation::::BEGIN@22C4::Circulation::BEGIN@22
11126µs221µsC4::Circulation::::BEGIN@39C4::Circulation::BEGIN@39
11124µs250µsC4::Circulation::::BEGIN@37C4::Circulation::BEGIN@37
11122µs80µsC4::Circulation::::BEGIN@38C4::Circulation::BEGIN@38
11120µs575µsC4::Circulation::::BEGIN@28C4::Circulation::BEGIN@28
11120µs210µsC4::Circulation::::BEGIN@36C4::Circulation::BEGIN@36
11120µs259µsC4::Circulation::::BEGIN@29C4::Circulation::BEGIN@29
11115µs53µsC4::Circulation::::BEGIN@47C4::Circulation::BEGIN@47
11114µs217µsC4::Circulation::::BEGIN@33C4::Circulation::BEGIN@33
11113µs38µsC4::Circulation::::BEGIN@31C4::Circulation::BEGIN@31
11113µs80µsC4::Circulation::::BEGIN@48C4::Circulation::BEGIN@48
11113µs92µsC4::Circulation::::BEGIN@51C4::Circulation::BEGIN@51
11112µs46µsC4::Circulation::::BEGIN@32C4::Circulation::BEGIN@32
11111µs58µsC4::Circulation::::BEGIN@50C4::Circulation::BEGIN@50
11111µs170µsC4::Circulation::::BEGIN@60C4::Circulation::BEGIN@60
0000s0sC4::Circulation::::AddIssueC4::Circulation::AddIssue
0000s0sC4::Circulation::::AddIssuingChargeC4::Circulation::AddIssuingCharge
0000s0sC4::Circulation::::AddOfflineOperationC4::Circulation::AddOfflineOperation
0000s0sC4::Circulation::::AddRenewalC4::Circulation::AddRenewal
0000s0sC4::Circulation::::AddReturnC4::Circulation::AddReturn
0000s0sC4::Circulation::::AnonymiseIssueHistoryC4::Circulation::AnonymiseIssueHistory
0000s0sC4::Circulation::::CalcDateDueC4::Circulation::CalcDateDue
0000s0sC4::Circulation::::CanBookBeIssuedC4::Circulation::CanBookBeIssued
0000s0sC4::Circulation::::CanBookBeRenewedC4::Circulation::CanBookBeRenewed
0000s0sC4::Circulation::::CanBookBeReturnedC4::Circulation::CanBookBeReturned
0000s0sC4::Circulation::::CheckIfIssuedToPatronC4::Circulation::CheckIfIssuedToPatron
0000s0sC4::Circulation::::CheckRepeatableHolidaysC4::Circulation::CheckRepeatableHolidays
0000s0sC4::Circulation::::CheckRepeatableSpecialHolidaysC4::Circulation::CheckRepeatableSpecialHolidays
0000s0sC4::Circulation::::CheckSpecialHolidaysC4::Circulation::CheckSpecialHolidays
0000s0sC4::Circulation::::CheckValidBarcodeC4::Circulation::CheckValidBarcode
0000s0sC4::Circulation::::CreateBranchTransferLimitC4::Circulation::CreateBranchTransferLimit
0000s0sC4::Circulation::::DeleteBranchTransferLimitsC4::Circulation::DeleteBranchTransferLimits
0000s0sC4::Circulation::::DeleteOfflineOperationC4::Circulation::DeleteOfflineOperation
0000s0sC4::Circulation::::DeleteTransferC4::Circulation::DeleteTransfer
0000s0sC4::Circulation::::GetBiblioIssuesC4::Circulation::GetBiblioIssues
0000s0sC4::Circulation::::GetBranchBorrowerCircRuleC4::Circulation::GetBranchBorrowerCircRule
0000s0sC4::Circulation::::GetBranchItemRuleC4::Circulation::GetBranchItemRule
0000s0sC4::Circulation::::GetHardDueDateC4::Circulation::GetHardDueDate
0000s0sC4::Circulation::::GetIssuingChargesC4::Circulation::GetIssuingCharges
0000s0sC4::Circulation::::GetIssuingRuleC4::Circulation::GetIssuingRule
0000s0sC4::Circulation::::GetItemIssueC4::Circulation::GetItemIssue
0000s0sC4::Circulation::::GetItemIssuesC4::Circulation::GetItemIssues
0000s0sC4::Circulation::::GetLoanLengthC4::Circulation::GetLoanLength
0000s0sC4::Circulation::::GetOfflineOperationC4::Circulation::GetOfflineOperation
0000s0sC4::Circulation::::GetOfflineOperationsC4::Circulation::GetOfflineOperations
0000s0sC4::Circulation::::GetOpenIssueC4::Circulation::GetOpenIssue
0000s0sC4::Circulation::::GetRenewCountC4::Circulation::GetRenewCount
0000s0sC4::Circulation::::GetTransfersFromToC4::Circulation::GetTransfersFromTo
0000s0sC4::Circulation::::GetUpcomingDueIssuesC4::Circulation::GetUpcomingDueIssues
0000s0sC4::Circulation::::IsBranchTransferAllowedC4::Circulation::IsBranchTransferAllowed
0000s0sC4::Circulation::::LostItemC4::Circulation::LostItem
0000s0sC4::Circulation::::MarkIssueReturnedC4::Circulation::MarkIssueReturned
0000s0sC4::Circulation::::ProcessOfflineIssueC4::Circulation::ProcessOfflineIssue
0000s0sC4::Circulation::::ProcessOfflineOperationC4::Circulation::ProcessOfflineOperation
0000s0sC4::Circulation::::ProcessOfflinePaymentC4::Circulation::ProcessOfflinePayment
0000s0sC4::Circulation::::ProcessOfflineReturnC4::Circulation::ProcessOfflineReturn
0000s0sC4::Circulation::::ReturnLostItemC4::Circulation::ReturnLostItem
0000s0sC4::Circulation::::SendCirculationAlertC4::Circulation::SendCirculationAlert
0000s0sC4::Circulation::::TooManyC4::Circulation::TooMany
0000s0sC4::Circulation::::TransferSlipC4::Circulation::TransferSlip
0000s0sC4::Circulation::::UpdateHoldingbranchC4::Circulation::UpdateHoldingbranch
0000s0sC4::Circulation::::_FixAccountForLostAndReturnedC4::Circulation::_FixAccountForLostAndReturned
0000s0sC4::Circulation::::_FixOverduesOnReturnC4::Circulation::_FixOverduesOnReturn
0000s0sC4::Circulation::::_GetCircControlBranchC4::Circulation::_GetCircControlBranch
0000s0sC4::Circulation::::_debar_user_on_returnC4::Circulation::_debar_user_on_return
0000s0sC4::Circulation::::_get_discount_from_ruleC4::Circulation::_get_discount_from_rule
0000s0sC4::Circulation::::barcodedecodeC4::Circulation::barcodedecode
0000s0sC4::Circulation::::checkHighHoldsC4::Circulation::checkHighHolds
0000s0sC4::Circulation::::decodeC4::Circulation::decode
0000s0sC4::Circulation::::itemissuesC4::Circulation::itemissues
0000s0sC4::Circulation::::transferbookC4::Circulation::transferbook
0000s0sC4::Circulation::::updateWrongTransferC4::Circulation::updateWrongTransfer
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package 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
22344µs246µs
# spent 38µs (30+8) within C4::Circulation::BEGIN@22 which was called: # once (30µs+8µs) by C4::Overdues::BEGIN@26 at line 22
use strict;
# spent 38µs making 1 call to C4::Circulation::BEGIN@22 # spent 8µs making 1 call to strict::import
23#use warnings; FIXME - Bug 2505
243163µs2131ms
# spent 131ms (16.1+115) within C4::Circulation::BEGIN@24 which was called: # once (16.1ms+115ms) by C4::Overdues::BEGIN@26 at line 24
use DateTime;
# spent 131ms making 1 call to C4::Circulation::BEGIN@24 # spent 6µs making 1 call to UNIVERSAL::import
25354µs248µs
# spent 40µs (33+8) within C4::Circulation::BEGIN@25 which was called: # once (33µs+8µs) by C4::Overdues::BEGIN@26 at line 25
use C4::Context;
# spent 40µs making 1 call to C4::Circulation::BEGIN@25 # spent 8µs making 1 call to C4::Context::import
263234µs21.59ms
# spent 1.49ms (704µs+788µs) within C4::Circulation::BEGIN@26 which was called: # once (704µs+788µs) by C4::Overdues::BEGIN@26 at line 26
use C4::Stats;
# spent 1.49ms making 1 call to C4::Circulation::BEGIN@26 # spent 100µs making 1 call to Exporter::import
273153µs2265ms
# spent 265ms (6.77+258) within C4::Circulation::BEGIN@27 which was called: # once (6.77ms+258ms) by C4::Overdues::BEGIN@26 at line 27
use C4::Reserves;
# spent 265ms making 1 call to C4::Circulation::BEGIN@27 # spent 387µs making 1 call to Exporter::import
28346µs21.13ms
# spent 575µs (20+555) within C4::Circulation::BEGIN@28 which was called: # once (20µs+555µs) by C4::Overdues::BEGIN@26 at line 28
use C4::Biblio;
# spent 575µs making 1 call to C4::Circulation::BEGIN@28 # spent 555µs making 1 call to Exporter::import
29338µs2499µs
# spent 259µs (20+239) within C4::Circulation::BEGIN@29 which was called: # once (20µs+239µs) by C4::Overdues::BEGIN@26 at line 29
use C4::Items;
# spent 259µs making 1 call to C4::Circulation::BEGIN@29 # spent 240µs making 1 call to Exporter::import
30339µs259µs
# spent 54µs (49+5) within C4::Circulation::BEGIN@30 which was called: # once (49µs+5µs) by C4::Overdues::BEGIN@26 at line 30
use C4::Members;
# spent 54µs making 1 call to C4::Circulation::BEGIN@30 # spent 5µs making 1 call to UNIVERSAL::import
31345µs262µs
# spent 38µs (13+24) within C4::Circulation::BEGIN@31 which was called: # once (13µs+24µs) by C4::Overdues::BEGIN@26 at line 31
use C4::Dates;
# spent 38µs making 1 call to C4::Circulation::BEGIN@31 # spent 24µs making 1 call to Exporter::import
32329µs281µs
# spent 46µs (12+35) within C4::Circulation::BEGIN@32 which was called: # once (12µs+35µs) by C4::Overdues::BEGIN@26 at line 32
use C4::Dates qw(format_date);
# spent 46µs making 1 call to C4::Circulation::BEGIN@32 # spent 35µs making 1 call to Exporter::import
33338µs2420µs
# spent 217µs (14+203) within C4::Circulation::BEGIN@33 which was called: # once (14µs+203µs) by C4::Overdues::BEGIN@26 at line 33
use C4::Accounts;
# spent 217µs making 1 call to C4::Circulation::BEGIN@33 # spent 203µs making 1 call to Exporter::import
343166µs22.51ms
# spent 2.51ms (1.33+1.17) within C4::Circulation::BEGIN@34 which was called: # once (1.33ms+1.17ms) by C4::Overdues::BEGIN@26 at line 34
use C4::ItemCirculationAlertPreference;
# spent 2.51ms making 1 call to C4::Circulation::BEGIN@34 # spent 3µs making 1 call to UNIVERSAL::import
353181µs21.72ms
# spent 1.71ms (1.32+389µs) within C4::Circulation::BEGIN@35 which was called: # once (1.32ms+389µs) by C4::Overdues::BEGIN@26 at line 35
use C4::Message;
# spent 1.71ms making 1 call to C4::Circulation::BEGIN@35 # spent 5µs making 1 call to UNIVERSAL::import
36359µs2401µs
# spent 210µs (20+190) within C4::Circulation::BEGIN@36 which was called: # once (20µs+190µs) by C4::Overdues::BEGIN@26 at line 36
use C4::Debug;
# spent 210µs making 1 call to C4::Circulation::BEGIN@36 # spent 190µs making 1 call to Exporter::import
373125µs2477µs
# spent 250µs (24+227) within C4::Circulation::BEGIN@37 which was called: # once (24µs+227µs) by C4::Overdues::BEGIN@26 at line 37
use C4::Branch; # GetBranches
# spent 250µs making 1 call to C4::Circulation::BEGIN@37 # spent 227µs making 1 call to Exporter::import
38366µs2139µs
# spent 80µs (22+58) within C4::Circulation::BEGIN@38 which was called: # once (22µs+58µs) by C4::Overdues::BEGIN@26 at line 38
use C4::Log; # logaction
# spent 80µs making 1 call to C4::Circulation::BEGIN@38 # spent 58µs making 1 call to Exporter::import
39119µs1195µs
# spent 221µs (26+195) within C4::Circulation::BEGIN@39 which was called: # once (26µs+195µs) by C4::Overdues::BEGIN@26 at line 43
use C4::Koha qw(
# spent 195µs making 1 call to Exporter::import
40 GetAuthorisedValueByCode
41 GetAuthValCode
42 GetKohaAuthorisedValueLib
43252µs1221µs);
# spent 221µs making 1 call to C4::Circulation::BEGIN@39
44363µs249µs
# spent 45µs (41+4) within C4::Circulation::BEGIN@44 which was called: # once (41µs+4µs) by C4::Overdues::BEGIN@26 at line 44
use C4::Overdues qw(CalcFine UpdateFine);
# spent 45µs making 1 call to C4::Circulation::BEGIN@44 # spent 4µs making 1 call to UNIVERSAL::import
453136µs21.33ms
# spent 1.29ms (1.03+257µs) within C4::Circulation::BEGIN@45 which was called: # once (1.03ms+257µs) by C4::Overdues::BEGIN@26 at line 45
use Algorithm::CheckDigits;
# spent 1.29ms making 1 call to C4::Circulation::BEGIN@45 # spent 45µs making 1 call to Exporter::import
46
47335µs291µs
# spent 53µs (15+38) within C4::Circulation::BEGIN@47 which was called: # once (15µs+38µs) by C4::Overdues::BEGIN@26 at line 47
use Data::Dumper;
# spent 53µs making 1 call to C4::Circulation::BEGIN@47 # spent 38µs making 1 call to Exporter::import
48334µs2147µs
# spent 80µs (13+67) within C4::Circulation::BEGIN@48 which was called: # once (13µs+67µs) by C4::Overdues::BEGIN@26 at line 48
use Koha::DateUtils;
# spent 80µs making 1 call to C4::Circulation::BEGIN@48 # spent 67µs making 1 call to Exporter::import
493131µs236.1ms
# spent 36.1ms (2.05+34.0) within C4::Circulation::BEGIN@49 which was called: # once (2.05ms+34.0ms) by C4::Overdues::BEGIN@26 at line 49
use Koha::Calendar;
# spent 36.1ms making 1 call to C4::Circulation::BEGIN@49 # spent 3µs making 1 call to UNIVERSAL::import
50339µs2105µs
# spent 58µs (11+47) within C4::Circulation::BEGIN@50 which was called: # once (11µs+47µs) by C4::Overdues::BEGIN@26 at line 50
use Carp;
# spent 58µs making 1 call to C4::Circulation::BEGIN@50 # spent 47µs making 1 call to Exporter::import
5117µs180µs
# spent 92µs (13+80) within C4::Circulation::BEGIN@51 which was called: # once (13µs+80µs) by C4::Overdues::BEGIN@26 at line 59
use Date::Calc qw(
# spent 80µs making 1 call to Exporter::import
52 Today
53 Today_and_Now
54 Add_Delta_YM
55 Add_Delta_DHMS
56 Date_to_Days
57 Day_of_Week
58 Add_Delta_Days
59230µs192µs);
# spent 92µs making 1 call to C4::Circulation::BEGIN@51
603136µs2329µs
# spent 170µs (11+159) within C4::Circulation::BEGIN@60 which was called: # once (11µs+159µs) by C4::Overdues::BEGIN@26 at line 60
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# spent 170µs making 1 call to C4::Circulation::BEGIN@60 # spent 159µs making 1 call to vars::import
61
62
# spent 34µs within C4::Circulation::BEGIN@62 which was called: # once (34µs+0s) by C4::Overdues::BEGIN@26 at line 120
BEGIN {
631800ns require Exporter;
6416µs $VERSION = 3.07.00.049; # for version checking
6519µs @ISA = qw(Exporter);
66
67 # FIXME subs that should probably be elsewhere
6812µs push @EXPORT, qw(
69 &barcodedecode
70 &LostItem
71 &ReturnLostItem
72 );
73
74 # subs to deal with issuing a book
7513µs push @EXPORT, qw(
76 &CanBookBeIssued
77 &CanBookBeRenewed
78 &AddIssue
79 &AddRenewal
80 &GetRenewCount
81 &GetItemIssue
82 &GetItemIssues
83 &GetIssuingCharges
84 &GetIssuingRule
85 &GetBranchBorrowerCircRule
86 &GetBranchItemRule
87 &GetBiblioIssues
88 &GetOpenIssue
89 &AnonymiseIssueHistory
90 &CheckIfIssuedToPatron
91 );
92
93 # subs to deal with returns
9413µs push @EXPORT, qw(
95 &AddReturn
96 &MarkIssueReturned
97 );
98
99 # subs to deal with transfers
10012µs push @EXPORT, qw(
101 &transferbook
102 &GetTransfers
103 &GetTransfersFromTo
104 &updateWrongTransfer
105 &DeleteTransfer
106 &IsBranchTransferAllowed
107 &CreateBranchTransferLimit
108 &DeleteBranchTransferLimits
109 &TransferSlip
110 );
111
112 # subs to deal with offline circulation
11319µs push @EXPORT, qw(
114 &GetOfflineOperations
115 &GetOfflineOperation
116 &AddOfflineOperation
117 &DeleteOfflineOperation
118 &ProcessOfflineOperation
119 );
120112.0ms134µs}
# spent 34µs making 1 call to C4::Circulation::BEGIN@62
121
122=head1 NAME
123
- -
155# FIXME -- the &decode fcn below should be wrapped into this one.
156# FIXME -- these plugins should be moved out of Circulation.pm
157#
158sub barcodedecode {
159 my ($barcode, $filter) = @_;
160 my $branch = C4::Branch::mybranch();
161 $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
162 $filter or return $barcode; # ensure filter is defined, else return untouched barcode
163 if ($filter eq 'whitespace') {
164 $barcode =~ s/\s//g;
165 } elsif ($filter eq 'cuecat') {
166 chomp($barcode);
167 my @fields = split( /\./, $barcode );
168 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
169 ($#results == 2) and return $results[2];
170 } elsif ($filter eq 'T-prefix') {
171 if ($barcode =~ /^[Tt](\d)/) {
172 (defined($1) and $1 eq '0') and return $barcode;
173 $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
174 }
175 return sprintf("T%07d", $barcode);
176 # FIXME: $barcode could be "T1", causing warning: substr outside of string
177 # Why drop the nonzero digit after the T?
178 # Why pass non-digits (or empty string) to "T%07d"?
179 } elsif ($filter eq 'libsuite8') {
180 unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it.
181 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
182 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
183 }else{
184 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
185 }
186 }
187 } elsif ($filter eq 'EAN13') {
188 my $ean = CheckDigits('ean');
189 if ( $ean->is_valid($barcode) ) {
190 #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
191 $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
192 } else {
193 warn "# [$barcode] not valid EAN-13/UPC-A\n";
194 }
195 }
196 return $barcode; # return barcode, modified or not
197}
198
199=head2 decode
200
- -
211sub decode {
212 my ($encoded) = @_;
213 my $seq =
214 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
215 my @s = map { index( $seq, $_ ); } split( //, $encoded );
216 my $l = ( $#s + 1 ) % 4;
217 if ($l) {
218 if ( $l == 1 ) {
219 # warn "Error: Cuecat decode parsing failed!";
220 return;
221 }
222 $l = 4 - $l;
223 $#s += $l;
224 }
225 my $r = '';
226 while ( $#s >= 0 ) {
227 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
228 $r .=
229 chr( ( $n >> 16 ) ^ 67 )
230 .chr( ( $n >> 8 & 255 ) ^ 67 )
231 .chr( ( $n & 255 ) ^ 67 );
232 @s = @s[ 4 .. $#s ];
233 }
234 $r = substr( $r, 0, length($r) - $l );
235 return $r;
236}
237
238=head2 transferbook
239
- -
296sub transferbook {
297 my ( $tbr, $barcode, $ignoreRs ) = @_;
298 my $messages;
299 my $dotransfer = 1;
300 my $branches = GetBranches();
301 my $itemnumber = GetItemnumberFromBarcode( $barcode );
302 my $issue = GetItemIssue($itemnumber);
303 my $biblio = GetBiblioFromItemNumber($itemnumber);
304
305 # bad barcode..
306 if ( not $itemnumber ) {
307 $messages->{'BadBarcode'} = $barcode;
308 $dotransfer = 0;
309 }
310
311 # get branches of book...
312 my $hbr = $biblio->{'homebranch'};
313 my $fbr = $biblio->{'holdingbranch'};
314
315 # if using Branch Transfer Limits
316 if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
317 if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
318 if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
319 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
320 $dotransfer = 0;
321 }
322 } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
323 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
324 $dotransfer = 0;
325 }
326 }
327
328 # if is permanent...
329 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
330 $messages->{'IsPermanent'} = $hbr;
331 $dotransfer = 0;
332 }
333
334 # can't transfer book if is already there....
335 if ( $fbr eq $tbr ) {
336 $messages->{'DestinationEqualsHolding'} = 1;
337 $dotransfer = 0;
338 }
339
340 # check if it is still issued to someone, return it...
341 if ($issue->{borrowernumber}) {
342 AddReturn( $barcode, $fbr );
343 $messages->{'WasReturned'} = $issue->{borrowernumber};
344 }
345
346 # find reserves.....
347 # That'll save a database query.
348 my ( $resfound, $resrec, undef ) =
349 CheckReserves( $itemnumber );
350 if ( $resfound and not $ignoreRs ) {
351 $resrec->{'ResFound'} = $resfound;
352
353 # $messages->{'ResFound'} = $resrec;
354 $dotransfer = 1;
355 }
356
357 #actually do the transfer....
358 if ($dotransfer) {
359 ModItemTransfer( $itemnumber, $fbr, $tbr );
360
361 # don't need to update MARC anymore, we do it in batch now
362 $messages->{'WasTransfered'} = 1;
363
364 }
365 ModDateLastSeen( $itemnumber );
366 return ( $dotransfer, $messages, $biblio );
367}
368
369
370sub TooMany {
371 my $borrower = shift;
372 my $biblionumber = shift;
373 my $item = shift;
374 my $cat_borrower = $borrower->{'categorycode'};
375 my $dbh = C4::Context->dbh;
376 my $branch;
377 # Get which branchcode we need
378 $branch = _GetCircControlBranch($item,$borrower);
379 my $type = (C4::Context->preference('item-level_itypes'))
380 ? $item->{'itype'} # item-level
381 : $item->{'itemtype'}; # biblio-level
382
383 # given branch, patron category, and item type, determine
384 # applicable issuing rule
385 my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
386
387 # if a rule is found and has a loan limit set, count
388 # how many loans the patron already has that meet that
389 # rule
390 if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
391 my @bind_params;
392 my $count_query = "SELECT COUNT(*) FROM issues
393 JOIN items USING (itemnumber) ";
394
395 my $rule_itemtype = $issuing_rule->{itemtype};
396 if ($rule_itemtype eq "*") {
397 # matching rule has the default item type, so count only
398 # those existing loans that don't fall under a more
399 # specific rule
400 if (C4::Context->preference('item-level_itypes')) {
401 $count_query .= " WHERE items.itype NOT IN (
402 SELECT itemtype FROM issuingrules
403 WHERE branchcode = ?
404 AND (categorycode = ? OR categorycode = ?)
405 AND itemtype <> '*'
406 ) ";
407 } else {
408 $count_query .= " JOIN biblioitems USING (biblionumber)
409 WHERE biblioitems.itemtype NOT IN (
410 SELECT itemtype FROM issuingrules
411 WHERE branchcode = ?
412 AND (categorycode = ? OR categorycode = ?)
413 AND itemtype <> '*'
414 ) ";
415 }
416 push @bind_params, $issuing_rule->{branchcode};
417 push @bind_params, $issuing_rule->{categorycode};
418 push @bind_params, $cat_borrower;
419 } else {
420 # rule has specific item type, so count loans of that
421 # specific item type
422 if (C4::Context->preference('item-level_itypes')) {
423 $count_query .= " WHERE items.itype = ? ";
424 } else {
425 $count_query .= " JOIN biblioitems USING (biblionumber)
426 WHERE biblioitems.itemtype= ? ";
427 }
428 push @bind_params, $type;
429 }
430
431 $count_query .= " AND borrowernumber = ? ";
432 push @bind_params, $borrower->{'borrowernumber'};
433 my $rule_branch = $issuing_rule->{branchcode};
434 if ($rule_branch ne "*") {
435 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
436 $count_query .= " AND issues.branchcode = ? ";
437 push @bind_params, $branch;
438 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
439 ; # if branch is the patron's home branch, then count all loans by patron
440 } else {
441 $count_query .= " AND items.homebranch = ? ";
442 push @bind_params, $branch;
443 }
444 }
445
446 my $count_sth = $dbh->prepare($count_query);
447 $count_sth->execute(@bind_params);
448 my ($current_loan_count) = $count_sth->fetchrow_array;
449
450 my $max_loans_allowed = $issuing_rule->{'maxissueqty'};
451 if ($current_loan_count >= $max_loans_allowed) {
452 return ($current_loan_count, $max_loans_allowed);
453 }
454 }
455
456 # Now count total loans against the limit for the branch
457 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
458 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
459 my @bind_params = ();
460 my $branch_count_query = "SELECT COUNT(*) FROM issues
461 JOIN items USING (itemnumber)
462 WHERE borrowernumber = ? ";
463 push @bind_params, $borrower->{borrowernumber};
464
465 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
466 $branch_count_query .= " AND issues.branchcode = ? ";
467 push @bind_params, $branch;
468 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
469 ; # if branch is the patron's home branch, then count all loans by patron
470 } else {
471 $branch_count_query .= " AND items.homebranch = ? ";
472 push @bind_params, $branch;
473 }
474 my $branch_count_sth = $dbh->prepare($branch_count_query);
475 $branch_count_sth->execute(@bind_params);
476 my ($current_loan_count) = $branch_count_sth->fetchrow_array;
477
478 my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty};
479 if ($current_loan_count >= $max_loans_allowed) {
480 return ($current_loan_count, $max_loans_allowed);
481 }
482 }
483
484 # OK, the patron can issue !!!
485 return;
486}
487
488=head2 itemissues
489
- -
532#'
533sub itemissues {
534 my ( $bibitem, $biblio ) = @_;
535 my $dbh = C4::Context->dbh;
536 my $sth =
537 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
538 || die $dbh->errstr;
539 my $i = 0;
540 my @results;
541
542 $sth->execute($bibitem) || die $sth->errstr;
543
544 while ( my $data = $sth->fetchrow_hashref ) {
545
546 # Find out who currently has this item.
547 # FIXME - Wouldn't it be better to do this as a left join of
548 # some sort? Currently, this code assumes that if
549 # fetchrow_hashref() fails, then the book is on the shelf.
550 # fetchrow_hashref() can fail for any number of reasons (e.g.,
551 # database server crash), not just because no items match the
552 # search criteria.
553 my $sth2 = $dbh->prepare(
554 "SELECT * FROM issues
555 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
556 WHERE itemnumber = ?
557 "
558 );
559
560 $sth2->execute( $data->{'itemnumber'} );
561 if ( my $data2 = $sth2->fetchrow_hashref ) {
562 $data->{'date_due'} = $data2->{'date_due'};
563 $data->{'card'} = $data2->{'cardnumber'};
564 $data->{'borrower'} = $data2->{'borrowernumber'};
565 }
566 else {
567 $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
568 }
569
570
571 # Find the last 3 people who borrowed this item.
572 $sth2 = $dbh->prepare(
573 "SELECT * FROM old_issues
574 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
575 WHERE itemnumber = ?
576 ORDER BY returndate DESC,timestamp DESC"
577 );
578
579 $sth2->execute( $data->{'itemnumber'} );
580 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
581 { # FIXME : error if there is less than 3 pple borrowing this item
582 if ( my $data2 = $sth2->fetchrow_hashref ) {
583 $data->{"timestamp$i2"} = $data2->{'timestamp'};
584 $data->{"card$i2"} = $data2->{'cardnumber'};
585 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
586 } # if
587 } # for
588
589 $results[$i] = $data;
590 $i++;
591 }
592
593 return (@results);
594}
595
596=head2 CanBookBeIssued
597
- -
690sub CanBookBeIssued {
691 my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves ) = @_;
692 my %needsconfirmation; # filled with problems that needs confirmations
693 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
694 my %alerts; # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
695
696 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
697 my $issue = GetItemIssue($item->{itemnumber});
698 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
699 $item->{'itemtype'}=$item->{'itype'};
700 my $dbh = C4::Context->dbh;
701
702 # MANDATORY CHECKS - unless item exists, nothing else matters
703 unless ( $item->{barcode} ) {
704 $issuingimpossible{UNKNOWN_BARCODE} = 1;
705 }
706 return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
707
708 #
709 # DUE DATE is OK ? -- should already have checked.
710 #
711 if ($duedate && ref $duedate ne 'DateTime') {
712 $duedate = dt_from_string($duedate);
713 }
714 my $now = DateTime->now( time_zone => C4::Context->tz() );
715 unless ( $duedate ) {
716 my $issuedate = $now->clone();
717
718 my $branch = _GetCircControlBranch($item,$borrower);
719 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
720 $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
721
722 # Offline circ calls AddIssue directly, doesn't run through here
723 # So issuingimpossible should be ok.
724 }
725 if ($duedate) {
726 my $today = $now->clone();
727 $today->truncate( to => 'minute');
728 if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
729 $needsconfirmation{INVALID_DATE} = output_pref($duedate);
730 }
731 } else {
732 $issuingimpossible{INVALID_DATE} = output_pref($duedate);
733 }
734
735 #
736 # BORROWER STATUS
737 #
738 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
739 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
740 &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'}, undef, $item->{'ccode'});
741 ModDateLastSeen( $item->{'itemnumber'} );
742 return( { STATS => 1 }, {});
743 }
744 if ( $borrower->{flags}->{GNA} ) {
745 $issuingimpossible{GNA} = 1;
746 }
747 if ( $borrower->{flags}->{'LOST'} ) {
748 $issuingimpossible{CARD_LOST} = 1;
749 }
750 if ( $borrower->{flags}->{'DBARRED'} ) {
751 $issuingimpossible{DEBARRED} = 1;
752 }
753 if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
754 $issuingimpossible{EXPIRED} = 1;
755 } else {
756 my ($y, $m, $d) = split /-/,$borrower->{'dateexpiry'};
757 if ($y && $m && $d) { # are we really writing oinvalid dates to borrs
758 my $expiry_dt = DateTime->new(
759 year => $y,
760 month => $m,
761 day => $d,
762 time_zone => C4::Context->tz,
763 );
764 $expiry_dt->truncate( to => 'day');
765 my $today = $now->clone()->truncate(to => 'day');
766 if (DateTime->compare($today, $expiry_dt) == 1) {
767 $issuingimpossible{EXPIRED} = 1;
768 }
769 } else {
770 carp("Invalid expity date in borr");
771 $issuingimpossible{EXPIRED} = 1;
772 }
773 }
774 #
775 # BORROWER STATUS
776 #
777
778 # DEBTS
779 my ($balance, $non_issue_charges, $other_charges) =
780 C4::Members::GetMemberAccountBalance( $borrower->{'borrowernumber'} );
781 my $amountlimit = C4::Context->preference("noissuescharge");
782 my $allowfineoverride = C4::Context->preference("AllowFineOverride");
783 my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
784 if ( C4::Context->preference("IssuingInProcess") ) {
785 if ( $non_issue_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
786 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
787 } elsif ( $non_issue_charges > $amountlimit && !$inprocess && $allowfineoverride) {
788 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
789 } elsif ( $allfinesneedoverride && $non_issue_charges > 0 && $non_issue_charges <= $amountlimit && !$inprocess ) {
790 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
791 }
792 }
793 else {
794 if ( $non_issue_charges > $amountlimit && $allowfineoverride ) {
795 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
796 } elsif ( $non_issue_charges > $amountlimit && !$allowfineoverride) {
797 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
798 } elsif ( $non_issue_charges > 0 && $allfinesneedoverride ) {
799 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
800 }
801 }
802 if ($balance > 0 && $other_charges > 0) {
803 $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
804 }
805
806 my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
807 if ($blocktype == -1) {
808 ## patron has outstanding overdue loans
809 if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
810 $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
811 }
812 elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
813 $needsconfirmation{USERBLOCKEDOVERDUE} = $count;
814 }
815 } elsif($blocktype == 1) {
816 # patron has accrued fine days
817 $issuingimpossible{USERBLOCKEDREMAINING} = $count;
818 }
819
820#
821 # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
822 #
823 my ($current_loan_count, $max_loans_allowed) = TooMany( $borrower, $item->{biblionumber}, $item );
824 # if TooMany max_loans_allowed returns 0 the user doesn't have permission to check out this book
825 if (defined $max_loans_allowed && $max_loans_allowed == 0) {
826 $needsconfirmation{PATRON_CANT} = 1;
827 } else {
828 if($max_loans_allowed){
829 $needsconfirmation{TOO_MANY} = 1;
830 $needsconfirmation{current_loan_count} = $current_loan_count;
831 $needsconfirmation{max_loans_allowed} = $max_loans_allowed;
832 }
833 }
834
835 #
836 # ITEM CHECKING
837 #
838 if ( $item->{'notforloan'} )
839 {
840 if(!C4::Context->preference("AllowNotForLoanOverride")){
841 $issuingimpossible{NOT_FOR_LOAN} = 1;
842 $issuingimpossible{item_notforloan} = $item->{'notforloan'};
843 }else{
844 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
845 $needsconfirmation{item_notforloan} = $item->{'notforloan'};
846 }
847 }
848 else {
849 # we have to check itemtypes.notforloan also
850 if (C4::Context->preference('item-level_itypes')){
851 # this should probably be a subroutine
852 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
853 $sth->execute($item->{'itemtype'});
854 my $notforloan=$sth->fetchrow_hashref();
855 $sth->finish();
856 if ($notforloan->{'notforloan'}) {
857 if (!C4::Context->preference("AllowNotForLoanOverride")) {
858 $issuingimpossible{NOT_FOR_LOAN} = 1;
859 $issuingimpossible{itemtype_notforloan} = $item->{'itype'};
860 } else {
861 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
862 $needsconfirmation{itemtype_notforloan} = $item->{'itype'};
863 }
864 }
865 }
866 elsif ($biblioitem->{'notforloan'} == 1){
867 if (!C4::Context->preference("AllowNotForLoanOverride")) {
868 $issuingimpossible{NOT_FOR_LOAN} = 1;
869 $issuingimpossible{itemtype_notforloan} = $biblioitem->{'itemtype'};
870 } else {
871 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
872 $needsconfirmation{itemtype_notforloan} = $biblioitem->{'itemtype'};
873 }
874 }
875 }
876 if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} > 0 )
877 {
878 $issuingimpossible{WTHDRAWN} = 1;
879 }
880 if ( $item->{'restricted'}
881 && $item->{'restricted'} == 1 )
882 {
883 $issuingimpossible{RESTRICTED} = 1;
884 }
885 if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
886 my $code = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
887 $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
888 $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
889 }
890 if ( C4::Context->preference("IndependantBranches") ) {
891 my $userenv = C4::Context->userenv;
892 if ( ($userenv) && ( $userenv->{flags} % 2 != 1 ) ) {
893 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1
894 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
895 $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
896 if ( $borrower->{'branchcode'} ne $userenv->{branch} );
897 }
898 }
899
900 #
901 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
902 #
903 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
904 {
905
906 # Already issued to current borrower. Ask whether the loan should
907 # be renewed.
908 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
909 $borrower->{'borrowernumber'},
910 $item->{'itemnumber'}
911 );
912 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
913 $issuingimpossible{NO_MORE_RENEWALS} = 1;
914 }
915 else {
916 $needsconfirmation{RENEW_ISSUE} = 1;
917 }
918 }
919 elsif ($issue->{borrowernumber}) {
920
921 # issued to someone else
922 my $currborinfo = C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
923
924# warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
925 $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
926 $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
927 $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
928 $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
929 $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
930 }
931
932 unless ( $ignore_reserves ) {
933 # See if the item is on reserve.
934 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
935 if ($restype) {
936 my $resbor = $res->{'borrowernumber'};
937 if ( $resbor ne $borrower->{'borrowernumber'} ) {
938 my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
939 my $branchname = GetBranchName( $res->{'branchcode'} );
940 if ( $restype eq "Waiting" )
941 {
942 # The item is on reserve and waiting, but has been
943 # reserved by some other patron.
944 $needsconfirmation{RESERVE_WAITING} = 1;
945 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
946 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
947 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
948 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
949 $needsconfirmation{'resbranchname'} = $branchname;
950 $needsconfirmation{'reswaitingdate'} = format_date($res->{'waitingdate'});
951 }
952 elsif ( $restype eq "Reserved" ) {
953 # The item is on reserve for someone else.
954 $needsconfirmation{RESERVED} = 1;
955 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
956 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
957 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
958 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
959 $needsconfirmation{'resbranchname'} = $branchname;
960 $needsconfirmation{'resreservedate'} = format_date($res->{'reservedate'});
961 }
962 }
963 }
964 }
965 #
966 # CHECK AGE RESTRICTION
967 #
968
969 # get $marker from preferences. Could be something like "FSK|PEGI|Alter|Age:"
970 my $markers = C4::Context->preference('AgeRestrictionMarker' );
971 my $bibvalues = $biblioitem->{'agerestriction'};
972 if (($markers)&&($bibvalues))
973 {
974 # Split $bibvalues to something like FSK 16 or PEGI 6
975 my @values = split ' ', $bibvalues;
976
977 # Search first occurence of one of the markers
978 my @markers = split /\|/, $markers;
979 my $index = 0;
980 my $take = -1;
981 for my $value (@values) {
982 $index ++;
983 for my $marker (@markers) {
984 $marker =~ s/^\s+//; #remove leading spaces
985 $marker =~ s/\s+$//; #remove trailing spaces
986 if (uc($marker) eq uc($value)) {
987 $take = $index;
988 last;
989 }
990 }
991 if ($take > -1) {
992 last;
993 }
994 }
995 # Index points to the next value
996 my $restrictionyear = 0;
997 if (($take <= $#values) && ($take >= 0)){
998 $restrictionyear += $values[$take];
999 }
1000
1001 if ($restrictionyear > 0) {
1002 if ( $borrower->{'dateofbirth'} ) {
1003 my @alloweddate = split /-/,$borrower->{'dateofbirth'} ;
1004 $alloweddate[0] += $restrictionyear;
1005 #Prevent runime eror on leap year (invalid date)
1006 if (($alloweddate[1] == 2) && ($alloweddate[2] == 29)) {
1007 $alloweddate[2] = 28;
1008 }
1009
1010 if ( Date_to_Days(Today) < Date_to_Days(@alloweddate) -1 ) {
1011 if (C4::Context->preference('AgeRestrictionOverride' )) {
1012 $needsconfirmation{AGE_RESTRICTION} = "$bibvalues";
1013 }
1014 else {
1015 $issuingimpossible{AGE_RESTRICTION} = "$bibvalues";
1016 }
1017 }
1018 }
1019 }
1020 }
1021
1022## check for high holds decreasing loan period
1023 my $decrease_loan = C4::Context->preference('decreaseLoanHighHolds');
1024 if ( $decrease_loan && $decrease_loan == 1 ) {
1025 my ( $reserved, $num, $duration, $returndate ) =
1026 checkHighHolds( $item, $borrower );
1027
1028 if ( $num >= C4::Context->preference('decreaseLoanHighHoldsValue') ) {
1029 $needsconfirmation{HIGHHOLDS} = {
1030 num_holds => $num,
1031 duration => $duration,
1032 returndate => output_pref($returndate),
1033 };
1034 }
1035 }
1036
1037 return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1038}
1039
1040=head2 CanBookBeReturned
1041
- -
1066sub CanBookBeReturned {
1067 my ($item, $branch) = @_;
1068 my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1069
1070 # assume return is allowed to start
1071 my $allowed = 1;
1072 my $message;
1073
1074 # identify all cases where return is forbidden
1075 if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1076 $allowed = 0;
1077 $message = $item->{'homebranch'};
1078 } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1079 $allowed = 0;
1080 $message = $item->{'holdingbranch'};
1081 } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1082 $allowed = 0;
1083 $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1084 }
1085
1086 return ($allowed, $message);
1087}
1088
1089=head2 CheckHighHolds
1090
- -
1097sub checkHighHolds {
1098 my ( $item, $borrower ) = @_;
1099 my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1100 my $branch = _GetCircControlBranch( $item, $borrower );
1101 my $dbh = C4::Context->dbh;
1102 my $sth = $dbh->prepare(
1103'select count(borrowernumber) as num_holds from reserves where biblionumber=?'
1104 );
1105 $sth->execute( $item->{'biblionumber'} );
1106 my ($holds) = $sth->fetchrow_array;
1107 if ($holds) {
1108 my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1109
1110 my $calendar = Koha::Calendar->new( branchcode => $branch );
1111
1112 my $itype =
1113 ( C4::Context->preference('item-level_itypes') )
1114 ? $biblio->{'itype'}
1115 : $biblio->{'itemtype'};
1116 my $orig_due =
1117 C4::Circulation::CalcDateDue( $issuedate, $itype, $branch,
1118 $borrower );
1119
1120 my $reduced_datedue =
1121 $calendar->addDate( $issuedate,
1122 C4::Context->preference('decreaseLoanHighHoldsDuration') );
1123
1124 if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1125 return ( 1, $holds,
1126 C4::Context->preference('decreaseLoanHighHoldsDuration'),
1127 $reduced_datedue );
1128 }
1129 }
1130 return ( 0, 0, 0, undef );
1131}
1132
1133=head2 AddIssue
1134
- -
1171sub AddIssue {
1172 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_;
1173 my $dbh = C4::Context->dbh;
1174 my $barcodecheck=CheckValidBarcode($barcode);
1175 if ($datedue && ref $datedue ne 'DateTime') {
1176 $datedue = dt_from_string($datedue);
1177 }
1178 # $issuedate defaults to today.
1179 if ( ! defined $issuedate ) {
1180 $issuedate = DateTime->now(time_zone => C4::Context->tz());
1181 }
1182 else {
1183 if ( ref $issuedate ne 'DateTime') {
1184 $issuedate = dt_from_string($issuedate);
1185
1186 }
1187 }
1188 if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf
1189 # find which item we issue
1190 my $item = GetItem('', $barcode) or return; # if we don't get an Item, abort.
1191 my $branch = _GetCircControlBranch($item,$borrower);
1192
1193 # get actual issuing if there is one
1194 my $actualissue = GetItemIssue( $item->{itemnumber});
1195
1196 # get biblioinformation for this item
1197 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
1198
1199 #
1200 # check if we just renew the issue.
1201 #
1202 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
1203 $datedue = AddRenewal(
1204 $borrower->{'borrowernumber'},
1205 $item->{'itemnumber'},
1206 $branch,
1207 $datedue,
1208 $issuedate, # here interpreted as the renewal date
1209 );
1210 }
1211 else {
1212 # it's NOT a renewal
1213 if ( $actualissue->{borrowernumber}) {
1214 # This book is currently on loan, but not to the person
1215 # who wants to borrow it now. mark it returned before issuing to the new borrower
1216 AddReturn(
1217 $item->{'barcode'},
1218 C4::Context->userenv->{'branch'}
1219 );
1220 }
1221
1222 MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1223 # Starting process for transfer job (checking transfert and validate it if we have one)
1224 my ($datesent) = GetTransfers($item->{'itemnumber'});
1225 if ($datesent) {
1226 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1227 my $sth =
1228 $dbh->prepare(
1229 "UPDATE branchtransfers
1230 SET datearrived = now(),
1231 tobranch = ?,
1232 comments = 'Forced branchtransfer'
1233 WHERE itemnumber= ? AND datearrived IS NULL"
1234 );
1235 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
1236 }
1237
1238 # Record in the database the fact that the book was issued.
1239 my $sth =
1240 $dbh->prepare(
1241 "INSERT INTO issues
1242 (borrowernumber, itemnumber,issuedate, date_due, branchcode)
1243 VALUES (?,?,?,?,?)"
1244 );
1245 unless ($datedue) {
1246 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1247 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1248
1249 }
1250 $datedue->truncate( to => 'minute');
1251 $sth->execute(
1252 $borrower->{'borrowernumber'}, # borrowernumber
1253 $item->{'itemnumber'}, # itemnumber
1254 $issuedate->strftime('%Y-%m-%d %H:%M:00'), # issuedate
1255 $datedue->strftime('%Y-%m-%d %H:%M:00'), # date_due
1256 C4::Context->userenv->{'branch'} # branchcode
1257 );
1258 if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1259 CartToShelf( $item->{'itemnumber'} );
1260 }
1261 $item->{'issues'}++;
1262 if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1263 UpdateTotalIssues($item->{'biblionumber'}, 1);
1264 }
1265
1266 ## If item was lost, it has now been found, reverse any list item charges if neccessary.
1267 if ( $item->{'itemlost'} ) {
1268 if ( C4::Context->preference('RefundLostItemFeeOnReturn' ) ) {
1269 _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef, $item->{'barcode'} );
1270 }
1271 }
1272
1273 ModItem({ issues => $item->{'issues'},
1274 holdingbranch => C4::Context->userenv->{'branch'},
1275 itemlost => 0,
1276 datelastborrowed => DateTime->now(time_zone => C4::Context->tz())->ymd(),
1277 onloan => $datedue->ymd(),
1278 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1279 ModDateLastSeen( $item->{'itemnumber'} );
1280
1281 # If it costs to borrow this book, charge it to the patron's account.
1282 my ( $charge, $itemtype ) = GetIssuingCharges(
1283 $item->{'itemnumber'},
1284 $borrower->{'borrowernumber'}
1285 );
1286 if ( $charge > 0 ) {
1287 AddIssuingCharge(
1288 $item->{'itemnumber'},
1289 $borrower->{'borrowernumber'}, $charge
1290 );
1291 $item->{'charge'} = $charge;
1292 }
1293
1294 # Record the fact that this book was issued.
1295 &UpdateStats(
1296 C4::Context->userenv->{'branch'},
1297 'issue', $charge,
1298 ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
1299 $item->{'itype'}, $borrower->{'borrowernumber'}, undef, $item->{'ccode'}
1300 );
1301
1302 # Send a checkout slip.
1303 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1304 my %conditions = (
1305 branchcode => $branch,
1306 categorycode => $borrower->{categorycode},
1307 item_type => $item->{itype},
1308 notification => 'CHECKOUT',
1309 );
1310 if ($circulation_alert->is_enabled_for(\%conditions)) {
1311 SendCirculationAlert({
1312 type => 'CHECKOUT',
1313 item => $item,
1314 borrower => $borrower,
1315 branch => $branch,
1316 });
1317 }
1318 }
1319
1320 logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'itemnumber'})
1321 if C4::Context->preference("IssueLog");
1322 }
1323 return ($datedue); # not necessarily the same as when it came in!
1324}
1325
1326=head2 GetLoanLength
1327
- -
1334sub GetLoanLength {
1335 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1336 my $dbh = C4::Context->dbh;
1337 my $sth = $dbh->prepare(qq{
1338 SELECT issuelength, lengthunit, renewalperiod
1339 FROM issuingrules
1340 WHERE categorycode=?
1341 AND itemtype=?
1342 AND branchcode=?
1343 AND issuelength IS NOT NULL
1344 });
1345
1346 # try to find issuelength & return the 1st available.
1347 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1348 $sth->execute( $borrowertype, $itemtype, $branchcode );
1349 my $loanlength = $sth->fetchrow_hashref;
1350
1351 return $loanlength
1352 if defined($loanlength) && $loanlength->{issuelength};
1353
1354 $sth->execute( $borrowertype, '*', $branchcode );
1355 $loanlength = $sth->fetchrow_hashref;
1356 return $loanlength
1357 if defined($loanlength) && $loanlength->{issuelength};
1358
1359 $sth->execute( '*', $itemtype, $branchcode );
1360 $loanlength = $sth->fetchrow_hashref;
1361 return $loanlength
1362 if defined($loanlength) && $loanlength->{issuelength};
1363
1364 $sth->execute( '*', '*', $branchcode );
1365 $loanlength = $sth->fetchrow_hashref;
1366 return $loanlength
1367 if defined($loanlength) && $loanlength->{issuelength};
1368
1369 $sth->execute( $borrowertype, $itemtype, '*' );
1370 $loanlength = $sth->fetchrow_hashref;
1371 return $loanlength
1372 if defined($loanlength) && $loanlength->{issuelength};
1373
1374 $sth->execute( $borrowertype, '*', '*' );
1375 $loanlength = $sth->fetchrow_hashref;
1376 return $loanlength
1377 if defined($loanlength) && $loanlength->{issuelength};
1378
1379 $sth->execute( '*', $itemtype, '*' );
1380 $loanlength = $sth->fetchrow_hashref;
1381 return $loanlength
1382 if defined($loanlength) && $loanlength->{issuelength};
1383
1384 $sth->execute( '*', '*', '*' );
1385 $loanlength = $sth->fetchrow_hashref;
1386 return $loanlength
1387 if defined($loanlength) && $loanlength->{issuelength};
1388
1389 # if no rule is set => 21 days (hardcoded)
1390 return {
1391 issuelength => 21,
1392 renewalperiod => 21,
1393 lengthunit => 'days',
1394 };
1395
1396}
1397
1398
1399=head2 GetHardDueDate
1400
- -
1407sub GetHardDueDate {
1408 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1409
1410 my $rule = GetIssuingRule( $borrowertype, $itemtype, $branchcode );
1411
1412 if ( defined( $rule ) ) {
1413 if ( $rule->{hardduedate} ) {
1414 return (dt_from_string($rule->{hardduedate}, 'iso'),$rule->{hardduedatecompare});
1415 } else {
1416 return (undef, undef);
1417 }
1418 }
1419}
1420
1421=head2 GetIssuingRule
1422
- -
1434sub GetIssuingRule {
1435 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1436 my $dbh = C4::Context->dbh;
1437 my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" );
1438 my $irule;
1439
1440 $sth->execute( $borrowertype, $itemtype, $branchcode );
1441 $irule = $sth->fetchrow_hashref;
1442 return $irule if defined($irule) ;
1443
1444 $sth->execute( $borrowertype, "*", $branchcode );
1445 $irule = $sth->fetchrow_hashref;
1446 return $irule if defined($irule) ;
1447
1448 $sth->execute( "*", $itemtype, $branchcode );
1449 $irule = $sth->fetchrow_hashref;
1450 return $irule if defined($irule) ;
1451
1452 $sth->execute( "*", "*", $branchcode );
1453 $irule = $sth->fetchrow_hashref;
1454 return $irule if defined($irule) ;
1455
1456 $sth->execute( $borrowertype, $itemtype, "*" );
1457 $irule = $sth->fetchrow_hashref;
1458 return $irule if defined($irule) ;
1459
1460 $sth->execute( $borrowertype, "*", "*" );
1461 $irule = $sth->fetchrow_hashref;
1462 return $irule if defined($irule) ;
1463
1464 $sth->execute( "*", $itemtype, "*" );
1465 $irule = $sth->fetchrow_hashref;
1466 return $irule if defined($irule) ;
1467
1468 $sth->execute( "*", "*", "*" );
1469 $irule = $sth->fetchrow_hashref;
1470 return $irule if defined($irule) ;
1471
1472 # if no rule matches,
1473 return;
1474}
1475
1476=head2 GetBranchBorrowerCircRule
1477
- -
1508sub GetBranchBorrowerCircRule {
1509 my $branchcode = shift;
1510 my $categorycode = shift;
1511
1512 my $branch_cat_query = "SELECT maxissueqty
1513 FROM branch_borrower_circ_rules
1514 WHERE branchcode = ?
1515 AND categorycode = ?";
1516 my $dbh = C4::Context->dbh();
1517 my $sth = $dbh->prepare($branch_cat_query);
1518 $sth->execute($branchcode, $categorycode);
1519 my $result;
1520 if ($result = $sth->fetchrow_hashref()) {
1521 return $result;
1522 }
1523
1524 # try same branch, default borrower category
1525 my $branch_query = "SELECT maxissueqty
1526 FROM default_branch_circ_rules
1527 WHERE branchcode = ?";
1528 $sth = $dbh->prepare($branch_query);
1529 $sth->execute($branchcode);
1530 if ($result = $sth->fetchrow_hashref()) {
1531 return $result;
1532 }
1533
1534 # try default branch, same borrower category
1535 my $category_query = "SELECT maxissueqty
1536 FROM default_borrower_circ_rules
1537 WHERE categorycode = ?";
1538 $sth = $dbh->prepare($category_query);
1539 $sth->execute($categorycode);
1540 if ($result = $sth->fetchrow_hashref()) {
1541 return $result;
1542 }
1543
1544 # try default branch, default borrower category
1545 my $default_query = "SELECT maxissueqty
1546 FROM default_circ_rules";
1547 $sth = $dbh->prepare($default_query);
1548 $sth->execute();
1549 if ($result = $sth->fetchrow_hashref()) {
1550 return $result;
1551 }
1552
1553 # built-in default circulation rule
1554 return {
1555 maxissueqty => undef,
1556 };
1557}
1558
1559=head2 GetBranchItemRule
1560
- -
1588sub GetBranchItemRule {
1589 my ( $branchcode, $itemtype ) = @_;
1590 my $dbh = C4::Context->dbh();
1591 my $result = {};
1592
1593 my @attempts = (
1594 ['SELECT holdallowed, returnbranch
1595 FROM branch_item_rules
1596 WHERE branchcode = ?
1597 AND itemtype = ?', $branchcode, $itemtype],
1598 ['SELECT holdallowed, returnbranch
1599 FROM default_branch_circ_rules
1600 WHERE branchcode = ?', $branchcode],
1601 ['SELECT holdallowed, returnbranch
1602 FROM default_branch_item_rules
1603 WHERE itemtype = ?', $itemtype],
1604 ['SELECT holdallowed, returnbranch
1605 FROM default_circ_rules'],
1606 );
1607
1608 foreach my $attempt (@attempts) {
1609 my ($query, @bind_params) = @{$attempt};
1610 my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1611 or next;
1612
1613 # Since branch/category and branch/itemtype use the same per-branch
1614 # defaults tables, we have to check that the key we want is set, not
1615 # just that a row was returned
1616 $result->{'holdallowed'} = $search_result->{'holdallowed'} unless ( defined $result->{'holdallowed'} );
1617 $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1618 }
1619
1620 # built-in default circulation rule
1621 $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1622 $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1623
1624 return $result;
1625}
1626
1627=head2 AddReturn
1628
- -
1701sub AddReturn {
1702 my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1703
1704 if ($branch and not GetBranchDetail($branch)) {
1705 warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1706 undef $branch;
1707 }
1708 $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1709 my $messages;
1710 my $borrower;
1711 my $biblio;
1712 my $doreturn = 1;
1713 my $validTransfert = 0;
1714 my $stat_type = 'return';
1715
1716 # get information on item
1717 my $itemnumber = GetItemnumberFromBarcode( $barcode );
1718 unless ($itemnumber) {
1719 return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out.
1720 }
1721 my $issue = GetItemIssue($itemnumber);
1722# warn Dumper($iteminformation);
1723 if ($issue and $issue->{borrowernumber}) {
1724 $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1725 or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existant borrowernumber '$issue->{borrowernumber}'\n"
1726 . Dumper($issue) . "\n";
1727 } else {
1728 $messages->{'NotIssued'} = $barcode;
1729 # even though item is not on loan, it may still be transferred; therefore, get current branch info
1730 $doreturn = 0;
1731 # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1732 # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1733 if (C4::Context->preference("RecordLocalUseOnReturn")) {
1734 $messages->{'LocalUse'} = 1;
1735 $stat_type = 'localuse';
1736 }
1737 }
1738
1739 my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1740 # full item data, but no borrowernumber or checkout info (no issue)
1741 # we know GetItem should work because GetItemnumberFromBarcode worked
1742 my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1743 # get the proper branch to which to return the item
1744 $hbr = $item->{$hbr} || $branch ;
1745 # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1746
1747 my $borrowernumber = $borrower->{'borrowernumber'} || undef; # we don't know if we had a borrower or not
1748
1749 # check if the book is in a permanent collection....
1750 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1751 if ( $hbr ) {
1752 my $branches = GetBranches(); # a potentially expensive call for a non-feature.
1753 $branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr;
1754 }
1755
1756 # check if the return is allowed at this branch
1757 my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1758 unless ($returnallowed){
1759 $messages->{'Wrongbranch'} = {
1760 Wrongbranch => $branch,
1761 Rightbranch => $message
1762 };
1763 $doreturn = 0;
1764 return ( $doreturn, $messages, $issue, $borrower );
1765 }
1766
1767 if ( $item->{'wthdrawn'} ) { # book has been cancelled
1768 $messages->{'wthdrawn'} = 1;
1769 $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1770 }
1771
1772 # case of a return of document (deal with issues and holdingbranch)
1773 my $today = DateTime->now( time_zone => C4::Context->tz() );
1774 if ($doreturn) {
1775 my $datedue = $issue->{date_due};
1776 $borrower or warn "AddReturn without current borrower";
1777 my $circControlBranch;
1778 if ($dropbox) {
1779 # define circControlBranch only if dropbox mode is set
1780 # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1781 # FIXME: check issuedate > returndate, factoring in holidays
1782 #$circControlBranch = _GetCircControlBranch($item,$borrower) unless ( $item->{'issuedate'} eq C4::Dates->today('iso') );;
1783 $circControlBranch = _GetCircControlBranch($item,$borrower);
1784 $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $today ) == -1 ? 1 : 0;
1785 }
1786
1787 if ($borrowernumber) {
1788 if( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'}){
1789 # we only need to calculate and change the fines if we want to do that on return
1790 # Should be on for hourly loans
1791 my $control = C4::Context->preference('CircControl');
1792 my $control_branchcode =
1793 ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
1794 : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode}
1795 : $issue->{branchcode};
1796
1797 my ( $amount, $type, $unitcounttotal ) =
1798 C4::Overdues::CalcFine( $item, $borrower->{categorycode},
1799 $control_branchcode, $datedue, $today );
1800
1801 $type ||= q{};
1802
1803 if ( $amount > 0
1804 && C4::Context->preference('finesMode') eq 'production' )
1805 {
1806 C4::Overdues::UpdateFine( $issue->{itemnumber},
1807 $issue->{borrowernumber},
1808 $amount, $type, output_pref($datedue) );
1809 }
1810 }
1811
1812 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
1813 $circControlBranch, '', $borrower->{'privacy'} );
1814
1815 # FIXME is the "= 1" right? This could be the borrower hash.
1816 $messages->{'WasReturned'} = 1;
1817
1818 }
1819
1820 ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1821 }
1822
1823 # the holdingbranch is updated if the document is returned to another location.
1824 # this is always done regardless of whether the item was on loan or not
1825 if ($item->{'holdingbranch'} ne $branch) {
1826 UpdateHoldingbranch($branch, $item->{'itemnumber'});
1827 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1828 }
1829 ModDateLastSeen( $item->{'itemnumber'} );
1830
1831 # check if we have a transfer for this document
1832 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1833
1834 # if we have a transfer to do, we update the line of transfers with the datearrived
1835 if ($datesent) {
1836 if ( $tobranch eq $branch ) {
1837 my $sth = C4::Context->dbh->prepare(
1838 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1839 );
1840 $sth->execute( $item->{'itemnumber'} );
1841 # if we have a reservation with valid transfer, we can set it's status to 'W'
1842 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1843 C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1844 } else {
1845 $messages->{'WrongTransfer'} = $tobranch;
1846 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1847 }
1848 $validTransfert = 1;
1849 } else {
1850 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1851 }
1852
1853 # fix up the accounts.....
1854 if ( $item->{'itemlost'} ) {
1855 $messages->{'WasLost'} = 1;
1856
1857 if ( C4::Context->preference('RefundLostItemFeeOnReturn' ) ) {
1858 _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode); # can tolerate undef $borrowernumber
1859 $messages->{'LostItemFeeRefunded'} = 1;
1860 }
1861 }
1862
1863 # fix up the overdues in accounts...
1864 if ($borrowernumber) {
1865 my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1866 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
1867
1868 if ( $issue->{overdue} && $issue->{date_due} ) {
1869# fix fine days
1870 my $debardate =
1871 _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
1872 $messages->{Debarred} = $debardate if ($debardate);
1873 }
1874 }
1875
1876 # find reserves.....
1877 # if we don't have a reserve with the status W, we launch the Checkreserves routine
1878 my ($resfound, $resrec);
1879 ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'} ) unless ( $item->{'wthdrawn'} );
1880 if ($resfound) {
1881 $resrec->{'ResFound'} = $resfound;
1882 $messages->{'ResFound'} = $resrec;
1883 }
1884
1885 # update stats?
1886 # Record the fact that this book was returned.
1887 UpdateStats(
1888 $branch, $stat_type, '0', '',
1889 $item->{'itemnumber'},
1890 $biblio->{'itemtype'},
1891 $borrowernumber, undef, $item->{'ccode'}
1892 );
1893
1894 # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
1895 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1896 my %conditions = (
1897 branchcode => $branch,
1898 categorycode => $borrower->{categorycode},
1899 item_type => $item->{itype},
1900 notification => 'CHECKIN',
1901 );
1902 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
1903 SendCirculationAlert({
1904 type => 'CHECKIN',
1905 item => $item,
1906 borrower => $borrower,
1907 branch => $branch,
1908 });
1909 }
1910
1911 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
1912 if C4::Context->preference("ReturnLog");
1913
1914 # FIXME: make this comment intelligible.
1915 #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1916 #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1917
1918 if (($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $hbr) and not $messages->{'WrongTransfer'}){
1919 if ( C4::Context->preference("AutomaticItemReturn" ) or
1920 (C4::Context->preference("UseBranchTransferLimits") and
1921 ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} )
1922 )) {
1923 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
1924 $debug and warn "item: " . Dumper($item);
1925 ModItemTransfer($item->{'itemnumber'}, $branch, $hbr);
1926 $messages->{'WasTransfered'} = 1;
1927 } else {
1928 $messages->{'NeedsTransfer'} = 1; # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
1929 }
1930 }
1931 return ( $doreturn, $messages, $issue, $borrower );
1932}
1933
1934=head2 MarkIssueReturned
1935
- -
1957sub MarkIssueReturned {
1958 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
1959
1960 my $dbh = C4::Context->dbh;
1961 my $query = 'UPDATE issues SET returndate=';
1962 my @bind;
1963 if ($dropbox_branch) {
1964 my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
1965 my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
1966 $query .= ' ? ';
1967 push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
1968 } elsif ($returndate) {
1969 $query .= ' ? ';
1970 push @bind, $returndate;
1971 } else {
1972 $query .= ' now() ';
1973 }
1974 $query .= ' WHERE borrowernumber = ? AND itemnumber = ?';
1975 push @bind, $borrowernumber, $itemnumber;
1976 # FIXME transaction
1977 my $sth_upd = $dbh->prepare($query);
1978 $sth_upd->execute(@bind);
1979 my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
1980 WHERE borrowernumber = ?
1981 AND itemnumber = ?');
1982 $sth_copy->execute($borrowernumber, $itemnumber);
1983 # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
1984 if ( $privacy == 2) {
1985 # The default of 0 does not work due to foreign key constraints
1986 # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
1987 # FIXME the above is unacceptable - bug 9942 relates
1988 my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
1989 my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
1990 WHERE borrowernumber = ?
1991 AND itemnumber = ?");
1992 $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
1993 }
1994 my $sth_del = $dbh->prepare("DELETE FROM issues
1995 WHERE borrowernumber = ?
1996 AND itemnumber = ?");
1997 $sth_del->execute($borrowernumber, $itemnumber);
1998}
1999
2000=head2 _debar_user_on_return
2001
- -
2019sub _debar_user_on_return {
2020 my ( $borrower, $item, $dt_due, $dt_today ) = @_;
2021
2022 my $branchcode = _GetCircControlBranch( $item, $borrower );
2023 my $calendar = Koha::Calendar->new( branchcode => $branchcode );
2024
2025 # $deltadays is a DateTime::Duration object
2026 my $deltadays = $calendar->days_between( $dt_due, $dt_today );
2027
2028 my $circcontrol = C4::Context->preference('CircControl');
2029 my $issuingrule =
2030 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2031 my $finedays = $issuingrule->{finedays};
2032 my $unit = $issuingrule->{lengthunit};
2033
2034 if ($finedays) {
2035
2036 # finedays is in days, so hourly loans must multiply by 24
2037 # thus 1 hour late equals 1 day suspension * finedays rate
2038 $finedays = $finedays * 24 if ( $unit eq 'hours' );
2039
2040 # grace period is measured in the same units as the loan
2041 my $grace =
2042 DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
2043 if ( $deltadays->subtract($grace)->is_positive() ) {
2044
2045 my $new_debar_dt =
2046 $dt_today->clone()->add_duration( $deltadays * $finedays );
2047 if ( $borrower->{debarred} ) {
2048 my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2049
2050 # Update patron only if new date > old
2051 if ( DateTime->compare( $borrower_debar_dt, $new_debar_dt ) !=
2052 -1 )
2053 {
2054 return;
2055 }
2056
2057 }
2058 C4::Members::DebarMember( $borrower->{borrowernumber},
2059 $new_debar_dt->ymd() );
2060 return $new_debar_dt->ymd();
2061 }
2062 }
2063 return;
2064}
2065
2066=head2 _FixOverduesOnReturn
2067
- -
2081sub _FixOverduesOnReturn {
2082 my ($borrowernumber, $item);
2083 unless ($borrowernumber = shift) {
2084 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2085 return;
2086 }
2087 unless ($item = shift) {
2088 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2089 return;
2090 }
2091 my ($exemptfine, $dropbox) = @_;
2092 my $dbh = C4::Context->dbh;
2093
2094 # check for overdue fine
2095 my $sth = $dbh->prepare(
2096"SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2097 );
2098 $sth->execute( $borrowernumber, $item );
2099
2100 # alter fine to show that the book has been returned
2101 my $data = $sth->fetchrow_hashref;
2102 return 0 unless $data; # no warning, there's just nothing to fix
2103
2104 my $uquery;
2105 my @bind = ($data->{'accountlines_id'});
2106 if ($exemptfine) {
2107 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2108 if (C4::Context->preference("FinesLog")) {
2109 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2110 }
2111 } elsif ($dropbox && $data->{lastincrement}) {
2112 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2113 my $amt = $data->{amount} - $data->{lastincrement} ;
2114 if (C4::Context->preference("FinesLog")) {
2115 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2116 }
2117 $uquery = "update accountlines set accounttype='F' ";
2118 if($outstanding >= 0 && $amt >=0) {
2119 $uquery .= ", amount = ? , amountoutstanding=? ";
2120 unshift @bind, ($amt, $outstanding) ;
2121 }
2122 } else {
2123 $uquery = "update accountlines set accounttype='F' ";
2124 }
2125 $uquery .= " where (accountlines_id = ?)";
2126 my $usth = $dbh->prepare($uquery);
2127 return $usth->execute(@bind);
2128}
2129
2130=head2 _FixAccountForLostAndReturned
2131
- -
2143sub _FixAccountForLostAndReturned {
2144 my $itemnumber = shift or return;
2145 my $borrowernumber = @_ ? shift : undef;
2146 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
2147 my $dbh = C4::Context->dbh;
2148 # check for charge made for lost book
2149 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2150 $sth->execute($itemnumber);
2151 my $data = $sth->fetchrow_hashref;
2152 $data or return; # bail if there is nothing to do
2153 $data->{accounttype} eq 'W' and return; # Written off
2154
2155 # writeoff this amount
2156 my $offset;
2157 my $amount = $data->{'amount'};
2158 my $acctno = $data->{'accountno'};
2159 my $amountleft; # Starts off undef/zero.
2160 if ($data->{'amountoutstanding'} == $amount) {
2161 $offset = $data->{'amount'};
2162 $amountleft = 0; # Hey, it's zero here, too.
2163 } else {
2164 $offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are ==
2165 $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are ==
2166 }
2167 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2168 WHERE (accountlines_id = ?)");
2169 $usth->execute($data->{'accountlines_id'}); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in.
2170 #check if any credit is left if so writeoff other accounts
2171 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2172 $amountleft *= -1 if ($amountleft < 0);
2173 if ($amountleft > 0) {
2174 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2175 AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first)
2176 $msth->execute($data->{'borrowernumber'});
2177 # offset transactions
2178 my $newamtos;
2179 my $accdata;
2180 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2181 if ($accdata->{'amountoutstanding'} < $amountleft) {
2182 $newamtos = 0;
2183 $amountleft -= $accdata->{'amountoutstanding'};
2184 } else {
2185 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2186 $amountleft = 0;
2187 }
2188 my $thisacct = $accdata->{'accountlines_id'};
2189 # FIXME: move prepares outside while loop!
2190 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2191 WHERE (accountlines_id = ?)");
2192 $usth->execute($newamtos,$thisacct);
2193 $usth = $dbh->prepare("INSERT INTO accountoffsets
2194 (borrowernumber, accountno, offsetaccount, offsetamount)
2195 VALUES
2196 (?,?,?,?)");
2197 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2198 }
2199 $msth->finish; # $msth might actually have data left
2200 }
2201 $amountleft *= -1 if ($amountleft > 0);
2202 my $desc = "Item Returned " . $item_id;
2203 $usth = $dbh->prepare("INSERT INTO accountlines
2204 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2205 VALUES (?,?,now(),?,?,'CR',?)");
2206 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2207 if ($borrowernumber) {
2208 # FIXME: same as query above. use 1 sth for both
2209 $usth = $dbh->prepare("INSERT INTO accountoffsets
2210 (borrowernumber, accountno, offsetaccount, offsetamount)
2211 VALUES (?,?,?,?)");
2212 $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2213 }
2214 ModItem({ paidfor => '' }, undef, $itemnumber);
2215 return;
2216}
2217
2218=head2 _GetCircControlBranch
2219
- -
2234sub _GetCircControlBranch {
2235 my ($item, $borrower) = @_;
2236 my $circcontrol = C4::Context->preference('CircControl');
2237 my $branch;
2238
2239 if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2240 $branch= C4::Context->userenv->{'branch'};
2241 } elsif ($circcontrol eq 'PatronLibrary') {
2242 $branch=$borrower->{branchcode};
2243 } else {
2244 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2245 $branch = $item->{$branchfield};
2246 # default to item home branch if holdingbranch is used
2247 # and is not defined
2248 if (!defined($branch) && $branchfield eq 'holdingbranch') {
2249 $branch = $item->{homebranch};
2250 }
2251 }
2252 return $branch;
2253}
2254
- -
2260=head2 GetItemIssue
2261
- -
2272sub GetItemIssue {
2273 my ($itemnumber) = @_;
2274 return unless $itemnumber;
2275 my $sth = C4::Context->dbh->prepare(
2276 "SELECT items.*, issues.*
2277 FROM issues
2278 LEFT JOIN items ON issues.itemnumber=items.itemnumber
2279 WHERE issues.itemnumber=?");
2280 $sth->execute($itemnumber);
2281 my $data = $sth->fetchrow_hashref;
2282 return unless $data;
2283 $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2284 $data->{issuedate}->truncate(to => 'minute');
2285 $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2286 $data->{date_due}->truncate(to => 'minute');
2287 my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2288 $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2289 return $data;
2290}
2291
2292=head2 GetOpenIssue
2293
- -
2304sub GetOpenIssue {
2305 my ( $itemnumber ) = @_;
2306
2307 my $dbh = C4::Context->dbh;
2308 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2309 $sth->execute( $itemnumber );
2310 my $issue = $sth->fetchrow_hashref();
2311 return $issue;
2312}
2313
2314=head2 GetItemIssues
2315
- -
2328sub GetItemIssues {
2329 my ( $itemnumber, $history ) = @_;
2330
2331 my $today = DateTime->now( time_zome => C4::Context->tz); # get today date
2332 $today->truncate( to => 'minute' );
2333 my $sql = "SELECT * FROM issues
2334 JOIN borrowers USING (borrowernumber)
2335 JOIN items USING (itemnumber)
2336 WHERE issues.itemnumber = ? ";
2337 if ($history) {
2338 $sql .= "UNION ALL
2339 SELECT * FROM old_issues
2340 LEFT JOIN borrowers USING (borrowernumber)
2341 JOIN items USING (itemnumber)
2342 WHERE old_issues.itemnumber = ? ";
2343 }
2344 $sql .= "ORDER BY date_due DESC";
2345 my $sth = C4::Context->dbh->prepare($sql);
2346 if ($history) {
2347 $sth->execute($itemnumber, $itemnumber);
2348 } else {
2349 $sth->execute($itemnumber);
2350 }
2351 my $results = $sth->fetchall_arrayref({});
2352 foreach (@$results) {
2353 my $date_due = dt_from_string($_->{date_due},'sql');
2354 $date_due->truncate( to => 'minute' );
2355
2356 $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2357 }
2358 return $results;
2359}
2360
2361=head2 GetBiblioIssues
2362
- -
2373sub GetBiblioIssues {
2374 my $biblionumber = shift;
2375 return unless $biblionumber;
2376 my $dbh = C4::Context->dbh;
2377 my $query = "
2378 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2379 FROM issues
2380 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2381 LEFT JOIN items ON issues.itemnumber = items.itemnumber
2382 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2383 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2384 WHERE biblio.biblionumber = ?
2385 UNION ALL
2386 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2387 FROM old_issues
2388 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2389 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2390 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2391 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2392 WHERE biblio.biblionumber = ?
2393 ORDER BY timestamp
2394 ";
2395 my $sth = $dbh->prepare($query);
2396 $sth->execute($biblionumber, $biblionumber);
2397
2398 my @issues;
2399 while ( my $data = $sth->fetchrow_hashref ) {
2400 push @issues, $data;
2401 }
2402 return \@issues;
2403}
2404
2405=head2 GetUpcomingDueIssues
2406
- -
2411sub GetUpcomingDueIssues {
2412 my $params = shift;
2413
2414 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2415 my $dbh = C4::Context->dbh;
2416
2417 my $statement = <<END_SQL;
2418SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2419FROM issues
2420LEFT JOIN items USING (itemnumber)
2421LEFT OUTER JOIN branches USING (branchcode)
2422WhERE returndate is NULL
2423AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
2424END_SQL
2425
2426 my @bind_parameters = ( $params->{'days_in_advance'} );
2427
2428 my $sth = $dbh->prepare( $statement );
2429 $sth->execute( @bind_parameters );
2430 my $upcoming_dues = $sth->fetchall_arrayref({});
2431 $sth->finish;
2432
2433 return $upcoming_dues;
2434}
2435
2436=head2 CanBookBeRenewed
2437
- -
2458sub CanBookBeRenewed {
2459
2460 # check renewal status
2461 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2462 my $dbh = C4::Context->dbh;
2463 my $renews = 1;
2464 my $renewokay = 0;
2465 my $error;
2466
2467 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return;
2468 my $item = GetItem($itemnumber) or return;
2469 my $itemissue = GetItemIssue($itemnumber) or return;
2470
2471 my $branchcode = _GetCircControlBranch($item, $borrower);
2472
2473 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2474
2475 if ( ( $issuingrule->{renewalsallowed} > $itemissue->{renewals} ) || $override_limit ) {
2476 $renewokay = 1;
2477 } else {
2478 $error = "too_many";
2479 }
2480
2481 my $resstatus = C4::Reserves::GetReserveStatus($itemnumber);
2482 if ( $resstatus eq "Waiting" or $resstatus eq "Reserved" ) {
2483 $renewokay = 0;
2484 $error = "on_reserve";
2485 }
2486
2487 return ( $renewokay, $error );
2488}
2489
2490=head2 AddRenewal
2491
- -
2514sub AddRenewal {
2515 my $borrowernumber = shift or return;
2516 my $itemnumber = shift or return;
2517 my $branch = shift;
2518 my $datedue = shift;
2519 my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2520 my $item = GetItem($itemnumber) or return;
2521 my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
2522
2523 my $dbh = C4::Context->dbh;
2524 # Find the issues record for this book
2525 my $sth =
2526 $dbh->prepare("SELECT * FROM issues
2527 WHERE borrowernumber=?
2528 AND itemnumber=?"
2529 );
2530 $sth->execute( $borrowernumber, $itemnumber );
2531 my $issuedata = $sth->fetchrow_hashref;
2532 $sth->finish;
2533 if(defined $datedue && ref $datedue ne 'DateTime' ) {
2534 carp 'Invalid date passed to AddRenewal.';
2535 return;
2536 }
2537 # If the due date wasn't specified, calculate it by adding the
2538 # book's loan length to today's date or the current due date
2539 # based on the value of the RenewalPeriodBase syspref.
2540 unless ($datedue) {
2541
2542 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
2543 my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2544
2545 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2546 dt_from_string( $issuedata->{date_due} ) :
2547 DateTime->now( time_zone => C4::Context->tz());
2548 $datedue = CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
2549 }
2550
2551 # Update the issues record to have the new due date, and a new count
2552 # of how many times it has been renewed.
2553 my $renews = $issuedata->{'renewals'} + 1;
2554 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2555 WHERE borrowernumber=?
2556 AND itemnumber=?"
2557 );
2558
2559 $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2560 $sth->finish;
2561
2562 # Update the renewal count on the item, and tell zebra to reindex
2563 $renews = $biblio->{'renewals'} + 1;
2564 ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2565
2566 # Charge a new rental fee, if applicable?
2567 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2568 if ( $charge > 0 ) {
2569 my $accountno = getnextacctno( $borrowernumber );
2570 my $item = GetBiblioFromItemNumber($itemnumber);
2571 my $manager_id = 0;
2572 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2573 $sth = $dbh->prepare(
2574 "INSERT INTO accountlines
2575 (date, borrowernumber, accountno, amount, manager_id,
2576 description,accounttype, amountoutstanding, itemnumber)
2577 VALUES (now(),?,?,?,?,?,?,?,?)"
2578 );
2579 $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2580 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2581 'Rent', $charge, $itemnumber );
2582 }
2583
2584 # Send a renewal slip according to checkout alert preferencei
2585 if ( C4::Context->preference('RenewalSendNotice') eq '1') {
2586 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
2587 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2588 my %conditions = (
2589 branchcode => $branch,
2590 categorycode => $borrower->{categorycode},
2591 item_type => $item->{itype},
2592 notification => 'CHECKOUT',
2593 );
2594 if ($circulation_alert->is_enabled_for(\%conditions)) {
2595 SendCirculationAlert({
2596 type => 'RENEWAL',
2597 item => $item,
2598 borrower => $borrower,
2599 branch => $branch,
2600 });
2601 }
2602 }
2603
2604 # Log the renewal
2605 UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'});
2606 return $datedue;
2607}
2608
2609sub GetRenewCount {
2610 # check renewal status
2611 my ( $bornum, $itemno ) = @_;
2612 my $dbh = C4::Context->dbh;
2613 my $renewcount = 0;
2614 my $renewsallowed = 0;
2615 my $renewsleft = 0;
2616
2617 my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
2618 my $item = GetItem($itemno);
2619
2620 # Look in the issues table for this item, lent to this borrower,
2621 # and not yet returned.
2622
2623 # FIXME - I think this function could be redone to use only one SQL call.
2624 my $sth = $dbh->prepare(
2625 "select * from issues
2626 where (borrowernumber = ?)
2627 and (itemnumber = ?)"
2628 );
2629 $sth->execute( $bornum, $itemno );
2630 my $data = $sth->fetchrow_hashref;
2631 $renewcount = $data->{'renewals'} if $data->{'renewals'};
2632 $sth->finish;
2633 # $item and $borrower should be calculated
2634 my $branchcode = _GetCircControlBranch($item, $borrower);
2635
2636 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2637
2638 $renewsallowed = $issuingrule->{'renewalsallowed'};
2639 $renewsleft = $renewsallowed - $renewcount;
2640 if($renewsleft < 0){ $renewsleft = 0; }
2641 return ( $renewcount, $renewsallowed, $renewsleft );
2642}
2643
2644=head2 GetIssuingCharges
2645
- -
2661sub GetIssuingCharges {
2662
2663 # calculate charges due
2664 my ( $itemnumber, $borrowernumber ) = @_;
2665 my $charge = 0;
2666 my $dbh = C4::Context->dbh;
2667 my $item_type;
2668
2669 # Get the book's item type and rental charge (via its biblioitem).
2670 my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
2671 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
2672 $charge_query .= (C4::Context->preference('item-level_itypes'))
2673 ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
2674 : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
2675
2676 $charge_query .= ' WHERE items.itemnumber =?';
2677
2678 my $sth = $dbh->prepare($charge_query);
2679 $sth->execute($itemnumber);
2680 if ( my $item_data = $sth->fetchrow_hashref ) {
2681 $item_type = $item_data->{itemtype};
2682 $charge = $item_data->{rentalcharge};
2683 my $branch = C4::Branch::mybranch();
2684 my $discount_query = q|SELECT rentaldiscount,
2685 issuingrules.itemtype, issuingrules.branchcode
2686 FROM borrowers
2687 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2688 WHERE borrowers.borrowernumber = ?
2689 AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
2690 AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
2691 my $discount_sth = $dbh->prepare($discount_query);
2692 $discount_sth->execute( $borrowernumber, $item_type, $branch );
2693 my $discount_rules = $discount_sth->fetchall_arrayref({});
2694 if (@{$discount_rules}) {
2695 # We may have multiple rules so get the most specific
2696 my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
2697 $charge = ( $charge * ( 100 - $discount ) ) / 100;
2698 }
2699 }
2700
2701 $sth->finish; # we havent _explicitly_ fetched all rows
2702 return ( $charge, $item_type );
2703}
2704
2705# Select most appropriate discount rule from those returned
2706sub _get_discount_from_rule {
2707 my ($rules_ref, $branch, $itemtype) = @_;
2708 my $discount;
2709
2710 if (@{$rules_ref} == 1) { # only 1 applicable rule use it
2711 $discount = $rules_ref->[0]->{rentaldiscount};
2712 return (defined $discount) ? $discount : 0;
2713 }
2714 # could have up to 4 does one match $branch and $itemtype
2715 my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
2716 if (@d) {
2717 $discount = $d[0]->{rentaldiscount};
2718 return (defined $discount) ? $discount : 0;
2719 }
2720 # do we have item type + all branches
2721 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
2722 if (@d) {
2723 $discount = $d[0]->{rentaldiscount};
2724 return (defined $discount) ? $discount : 0;
2725 }
2726 # do we all item types + this branch
2727 @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
2728 if (@d) {
2729 $discount = $d[0]->{rentaldiscount};
2730 return (defined $discount) ? $discount : 0;
2731 }
2732 # so all and all (surely we wont get here)
2733 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
2734 if (@d) {
2735 $discount = $d[0]->{rentaldiscount};
2736 return (defined $discount) ? $discount : 0;
2737 }
2738 # none of the above
2739 return 0;
2740}
2741
2742=head2 AddIssuingCharge
2743
- -
2748sub AddIssuingCharge {
2749 my ( $itemnumber, $borrowernumber, $charge ) = @_;
2750 my $dbh = C4::Context->dbh;
2751 my $nextaccntno = getnextacctno( $borrowernumber );
2752 my $manager_id = 0;
2753 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2754 my $query ="
2755 INSERT INTO accountlines
2756 (borrowernumber, itemnumber, accountno,
2757 date, amount, description, accounttype,
2758 amountoutstanding, manager_id)
2759 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
2760 ";
2761 my $sth = $dbh->prepare($query);
2762 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
2763 $sth->finish;
2764}
2765
2766=head2 GetTransfers
2767
- -
2772
# spent 146ms (4.91+141) within C4::Circulation::GetTransfers which was called 64 times, avg 2.28ms/call: # 32 times (2.49ms+73.6ms) by C4::Search::searchResults at line 1925 of /usr/share/koha/lib/C4/Search.pm, avg 2.38ms/call # 32 times (2.42ms+67.5ms) by C4::XSLT::buildKohaItemsNamespace at line 265 of /usr/share/koha/lib/C4/XSLT.pm, avg 2.18ms/call
sub GetTransfers {
277364130µs my ($itemnumber) = @_;
2774
277564353µs6459.9ms my $dbh = C4::Context->dbh;
# spent 59.9ms making 64 calls to C4::Context::dbh, avg 935µs/call
2776
27776476µs my $query = '
2778 SELECT datesent,
2779 frombranch,
2780 tobranch
2781 FROM branchtransfers
2782 WHERE itemnumber = ?
2783 AND datearrived IS NULL
2784 ';
2785641.25ms12812.9ms my $sth = $dbh->prepare($query);
# spent 6.91ms making 64 calls to DBI::db::prepare, avg 108µs/call # spent 5.97ms making 64 calls to DBD::mysql::db::prepare, avg 93µs/call
27866472.8ms6472.0ms $sth->execute($itemnumber);
# spent 72.0ms making 64 calls to DBI::st::execute, avg 1.12ms/call
2787641.80ms641.14ms my @row = $sth->fetchrow_array();
# spent 1.14ms making 64 calls to DBI::st::fetchrow_array, avg 18µs/call
278864723µs64366µs $sth->finish;
# spent 366µs making 64 calls to DBI::st::finish, avg 6µs/call
2789642.65ms return @row;
2790}
2791
2792=head2 GetTransfersFromTo
2793
- -
2800sub GetTransfersFromTo {
2801 my ( $frombranch, $tobranch ) = @_;
2802 return unless ( $frombranch && $tobranch );
2803 my $dbh = C4::Context->dbh;
2804 my $query = "
2805 SELECT itemnumber,datesent,frombranch
2806 FROM branchtransfers
2807 WHERE frombranch=?
2808 AND tobranch=?
2809 AND datearrived IS NULL
2810 ";
2811 my $sth = $dbh->prepare($query);
2812 $sth->execute( $frombranch, $tobranch );
2813 my @gettransfers;
2814
2815 while ( my $data = $sth->fetchrow_hashref ) {
2816 push @gettransfers, $data;
2817 }
2818 $sth->finish;
2819 return (@gettransfers);
2820}
2821
2822=head2 DeleteTransfer
2823
- -
2828sub DeleteTransfer {
2829 my ($itemnumber) = @_;
2830 my $dbh = C4::Context->dbh;
2831 my $sth = $dbh->prepare(
2832 "DELETE FROM branchtransfers
2833 WHERE itemnumber=?
2834 AND datearrived IS NULL "
2835 );
2836 $sth->execute($itemnumber);
2837 $sth->finish;
2838}
2839
2840=head2 AnonymiseIssueHistory
2841
- -
2854sub AnonymiseIssueHistory {
2855 my $date = shift;
2856 my $borrowernumber = shift;
2857 my $dbh = C4::Context->dbh;
2858 my $query = "
2859 UPDATE old_issues
2860 SET borrowernumber = ?
2861 WHERE returndate < ?
2862 AND borrowernumber IS NOT NULL
2863 ";
2864
2865 # The default of 0 does not work due to foreign key constraints
2866 # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
2867 my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
2868 my @bind_params = ($anonymouspatron, $date);
2869 if (defined $borrowernumber) {
2870 $query .= " AND borrowernumber = ?";
2871 push @bind_params, $borrowernumber;
2872 } else {
2873 $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
2874 }
2875 my $sth = $dbh->prepare($query);
2876 $sth->execute(@bind_params);
2877 my $anonymisation_err = $dbh->err;
2878 my $rows_affected = $sth->rows; ### doublecheck row count return function
2879 return ($rows_affected, $anonymisation_err);
2880}
2881
2882=head2 SendCirculationAlert
2883
- -
2919sub SendCirculationAlert {
2920 my ($opts) = @_;
2921 my ($type, $item, $borrower, $branch) =
2922 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
2923 my %message_name = (
2924 CHECKIN => 'Item_Check_in',
2925 CHECKOUT => 'Item_Checkout',
2926 RENEWAL => 'Item_Checkout',
2927 );
2928 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
2929 borrowernumber => $borrower->{borrowernumber},
2930 message_name => $message_name{$type},
2931 });
2932 my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
2933 my $letter = C4::Letters::GetPreparedLetter (
2934 module => 'circulation',
2935 letter_code => $type,
2936 branchcode => $branch,
2937 tables => {
2938 $issues_table => $item->{itemnumber},
2939 'items' => $item->{itemnumber},
2940 'biblio' => $item->{biblionumber},
2941 'biblioitems' => $item->{biblionumber},
2942 'borrowers' => $borrower,
2943 'branches' => $branch,
2944 }
2945 ) or return;
2946
2947 my @transports = keys %{ $borrower_preferences->{transports} };
2948 # warn "no transports" unless @transports;
2949 for (@transports) {
2950 # warn "transport: $_";
2951 my $message = C4::Message->find_last_message($borrower, $type, $_);
2952 if (!$message) {
2953 #warn "create new message";
2954 C4::Message->enqueue($letter, $borrower, $_);
2955 } else {
2956 #warn "append to old message";
2957 $message->append($letter);
2958 $message->update;
2959 }
2960 }
2961
2962 return $letter;
2963}
2964
2965=head2 updateWrongTransfer
2966
- -
2973sub updateWrongTransfer {
2974 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2975 my $dbh = C4::Context->dbh;
2976# first step validate the actual line of transfert .
2977 my $sth =
2978 $dbh->prepare(
2979 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2980 );
2981 $sth->execute($FromLibrary,$itemNumber);
2982 $sth->finish;
2983
2984# second step create a new line of branchtransfer to the right location .
2985 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2986
2987#third step changing holdingbranch of item
2988 UpdateHoldingbranch($FromLibrary,$itemNumber);
2989}
2990
2991=head2 UpdateHoldingbranch
2992
- -
2999sub UpdateHoldingbranch {
3000 my ( $branch,$itemnumber ) = @_;
3001 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3002}
3003
3004=head2 CalcDateDue
3005
- -
3018sub CalcDateDue {
3019 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3020
3021 $isrenewal ||= 0;
3022
3023 # loanlength now a href
3024 my $loanlength =
3025 GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3026
3027 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3028 ? qq{renewalperiod}
3029 : qq{issuelength};
3030
3031 my $datedue;
3032 if ( $startdate ) {
3033 if (ref $startdate ne 'DateTime' ) {
3034 $datedue = dt_from_string($datedue);
3035 } else {
3036 $datedue = $startdate->clone;
3037 }
3038 } else {
3039 $datedue =
3040 DateTime->now( time_zone => C4::Context->tz() )
3041 ->truncate( to => 'minute' );
3042 }
3043
3044
3045 # calculate the datedue as normal
3046 if ( C4::Context->preference('useDaysMode') eq 'Days' )
3047 { # ignoring calendar
3048 if ( $loanlength->{lengthunit} eq 'hours' ) {
3049 $datedue->add( hours => $loanlength->{$length_key} );
3050 } else { # days
3051 $datedue->add( days => $loanlength->{$length_key} );
3052 $datedue->set_hour(23);
3053 $datedue->set_minute(59);
3054 }
3055 } else {
3056 my $dur;
3057 if ($loanlength->{lengthunit} eq 'hours') {
3058 $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3059 }
3060 else { # days
3061 $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3062 }
3063 my $calendar = Koha::Calendar->new( branchcode => $branch );
3064 $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3065 if ($loanlength->{lengthunit} eq 'days') {
3066 $datedue->set_hour(23);
3067 $datedue->set_minute(59);
3068 }
3069 }
3070
3071 # if Hard Due Dates are used, retreive them and apply as necessary
3072 my ( $hardduedate, $hardduedatecompare ) =
3073 GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3074 if ($hardduedate) { # hardduedates are currently dates
3075 $hardduedate->truncate( to => 'minute' );
3076 $hardduedate->set_hour(23);
3077 $hardduedate->set_minute(59);
3078 my $cmp = DateTime->compare( $hardduedate, $datedue );
3079
3080# if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3081# if the calculated date is before the 'after' Hard Due Date (floor), override
3082# if the hard due date is set to 'exactly', overrride
3083 if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3084 $datedue = $hardduedate->clone;
3085 }
3086
3087 # in all other cases, keep the date due as it is
3088
3089 }
3090
3091 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3092 if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3093 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso' );
3094 $expiry_dt->set( hour => 23, minute => 59);
3095 if ( DateTime->compare( $datedue, $expiry_dt ) == 1 ) {
3096 $datedue = $expiry_dt->clone;
3097 }
3098 }
3099
3100 return $datedue;
3101}
3102
3103
3104=head2 CheckRepeatableHolidays
3105
- -
3116sub CheckRepeatableHolidays{
3117my($itemnumber,$week_day,$branchcode)=@_;
3118my $dbh = C4::Context->dbh;
3119my $query = qq|SELECT count(*)
3120 FROM repeatable_holidays
3121 WHERE branchcode=?
3122 AND weekday=?|;
3123my $sth = $dbh->prepare($query);
3124$sth->execute($branchcode,$week_day);
3125my $result=$sth->fetchrow;
3126$sth->finish;
3127return $result;
3128}
3129
3130
3131=head2 CheckSpecialHolidays
3132
- -
3145sub CheckSpecialHolidays{
3146my ($years,$month,$day,$itemnumber,$branchcode) = @_;
3147my $dbh = C4::Context->dbh;
3148my $query=qq|SELECT count(*)
3149 FROM `special_holidays`
3150 WHERE year=?
3151 AND month=?
3152 AND day=?
3153 AND branchcode=?
3154 |;
3155my $sth = $dbh->prepare($query);
3156$sth->execute($years,$month,$day,$branchcode);
3157my $countspecial=$sth->fetchrow ;
3158$sth->finish;
3159return $countspecial;
3160}
3161
3162=head2 CheckRepeatableSpecialHolidays
3163
- -
3175sub CheckRepeatableSpecialHolidays{
3176my ($month,$day,$itemnumber,$branchcode) = @_;
3177my $dbh = C4::Context->dbh;
3178my $query=qq|SELECT count(*)
3179 FROM `repeatable_holidays`
3180 WHERE month=?
3181 AND day=?
3182 AND branchcode=?
3183 |;
3184my $sth = $dbh->prepare($query);
3185$sth->execute($month,$day,$branchcode);
3186my $countspecial=$sth->fetchrow ;
3187$sth->finish;
3188return $countspecial;
3189}
3190
- -
3193sub CheckValidBarcode{
3194my ($barcode) = @_;
3195my $dbh = C4::Context->dbh;
3196my $query=qq|SELECT count(*)
3197 FROM items
3198 WHERE barcode=?
3199 |;
3200my $sth = $dbh->prepare($query);
3201$sth->execute($barcode);
3202my $exist=$sth->fetchrow ;
3203$sth->finish;
3204return $exist;
3205}
3206
3207=head2 IsBranchTransferAllowed
3208
- -
3215sub IsBranchTransferAllowed {
3216 my ( $toBranch, $fromBranch, $code ) = @_;
3217
3218 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3219
3220 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3221 my $dbh = C4::Context->dbh;
3222
3223 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3224 $sth->execute( $toBranch, $fromBranch, $code );
3225 my $limit = $sth->fetchrow_hashref();
3226
3227 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3228 if ( $limit->{'limitId'} ) {
3229 return 0;
3230 } else {
3231 return 1;
3232 }
3233}
3234
3235=head2 CreateBranchTransferLimit
3236
- -
3243sub CreateBranchTransferLimit {
3244 my ( $toBranch, $fromBranch, $code ) = @_;
3245
3246 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3247
3248 my $dbh = C4::Context->dbh;
3249
3250 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3251 $sth->execute( $code, $toBranch, $fromBranch );
3252}
3253
3254=head2 DeleteBranchTransferLimits
3255
- -
3262sub DeleteBranchTransferLimits {
3263 my $branch = shift;
3264 my $dbh = C4::Context->dbh;
3265 my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3266 $sth->execute($branch);
3267}
3268
3269sub ReturnLostItem{
3270 my ( $borrowernumber, $itemnum ) = @_;
3271
3272 MarkIssueReturned( $borrowernumber, $itemnum );
3273 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3274 my $item = C4::Items::GetItem( $itemnum );
3275 my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3276 my @datearr = localtime(time);
3277 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3278 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3279 ModItem({ paidfor => $old_note."Paid for by $bor $date" }, undef, $itemnum);
3280}
3281
3282
3283sub LostItem{
3284 my ($itemnumber, $mark_returned, $charge_fee) = @_;
3285
3286 my $dbh = C4::Context->dbh();
3287 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3288 FROM issues
3289 JOIN items USING (itemnumber)
3290 JOIN biblio USING (biblionumber)
3291 WHERE issues.itemnumber=?");
3292 $sth->execute($itemnumber);
3293 my $issues=$sth->fetchrow_hashref();
3294 $sth->finish;
3295
3296 # if a borrower lost the item, add a replacement cost to the their record
3297 if ( my $borrowernumber = $issues->{borrowernumber} ){
3298 my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3299
3300 C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}")
3301 if $charge_fee;
3302 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3303 #warn " $issues->{'borrowernumber'} / $itemnumber ";
3304 MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3305 }
3306}
3307
3308sub GetOfflineOperations {
3309 my $dbh = C4::Context->dbh;
3310 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3311 $sth->execute(C4::Context->userenv->{'branch'});
3312 my $results = $sth->fetchall_arrayref({});
3313 $sth->finish;
3314 return $results;
3315}
3316
3317sub GetOfflineOperation {
3318 my $dbh = C4::Context->dbh;
3319 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3320 $sth->execute( shift );
3321 my $result = $sth->fetchrow_hashref;
3322 $sth->finish;
3323 return $result;
3324}
3325
3326sub AddOfflineOperation {
3327 my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3328 my $dbh = C4::Context->dbh;
3329 my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3330 $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3331 return "Added.";
3332}
3333
3334sub DeleteOfflineOperation {
3335 my $dbh = C4::Context->dbh;
3336 my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3337 $sth->execute( shift );
3338 return "Deleted.";
3339}
3340
3341sub ProcessOfflineOperation {
3342 my $operation = shift;
3343
3344 my $report;
3345 if ( $operation->{action} eq 'return' ) {
3346 $report = ProcessOfflineReturn( $operation );
3347 } elsif ( $operation->{action} eq 'issue' ) {
3348 $report = ProcessOfflineIssue( $operation );
3349 } elsif ( $operation->{action} eq 'payment' ) {
3350 $report = ProcessOfflinePayment( $operation );
3351 }
3352
3353 DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3354
3355 return $report;
3356}
3357
3358sub ProcessOfflineReturn {
3359 my $operation = shift;
3360
3361 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3362
3363 if ( $itemnumber ) {
3364 my $issue = GetOpenIssue( $itemnumber );
3365 if ( $issue ) {
3366 MarkIssueReturned(
3367 $issue->{borrowernumber},
3368 $itemnumber,
3369 undef,
3370 $operation->{timestamp},
3371 );
3372 ModItem(
3373 { renewals => 0, onloan => undef },
3374 $issue->{'biblionumber'},
3375 $itemnumber
3376 );
3377 return "Success.";
3378 } else {
3379 return "Item not issued.";
3380 }
3381 } else {
3382 return "Item not found.";
3383 }
3384}
3385
3386sub ProcessOfflineIssue {
3387 my $operation = shift;
3388
3389 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3390
3391 if ( $borrower->{borrowernumber} ) {
3392 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3393 unless ($itemnumber) {
3394 return "Barcode not found.";
3395 }
3396 my $issue = GetOpenIssue( $itemnumber );
3397
3398 if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3399 MarkIssueReturned(
3400 $issue->{borrowernumber},
3401 $itemnumber,
3402 undef,
3403 $operation->{timestamp},
3404 );
3405 }
3406 AddIssue(
3407 $borrower,
3408 $operation->{'barcode'},
3409 undef,
3410 1,
3411 $operation->{timestamp},
3412 undef,
3413 );
3414 return "Success.";
3415 } else {
3416 return "Borrower not found.";
3417 }
3418}
3419
3420sub ProcessOfflinePayment {
3421 my $operation = shift;
3422
3423 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3424 my $amount = $operation->{amount};
3425
3426 recordpayment( $borrower->{borrowernumber}, $amount );
3427
3428 return "Success."
3429}
3430
3431
3432=head2 TransferSlip
3433
- -
3440sub TransferSlip {
3441 my ($branch, $itemnumber, $to_branch) = @_;
3442
3443 my $item = GetItem( $itemnumber )
3444 or return;
3445
3446 my $pulldate = C4::Dates->new();
3447
3448 return C4::Letters::GetPreparedLetter (
3449 module => 'circulation',
3450 letter_code => 'TRANSFERSLIP',
3451 branchcode => $branch,
3452 tables => {
3453 'branches' => $to_branch,
3454 'biblio' => $item->{biblionumber},
3455 'items' => $item,
3456 },
3457 );
3458}
3459
3460=head2 CheckIfIssuedToPatron
3461
- -
3468sub CheckIfIssuedToPatron {
3469 my ($borrowernumber, $biblionumber) = @_;
3470
3471 my $items = GetItemsByBiblioitemnumber($biblionumber);
3472
3473 foreach my $item (@{$items}) {
3474 return 1 if ($item->{borrowernumber} && $item->{borrowernumber} eq $borrowernumber);
3475 }
3476
3477 return;
3478}
3479
3480
348115µs1;
3482
3483__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.