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

Filename/mnt/catalyst/koha/Koha/Borrower/Debarments.pm
StatementsExecuted 8 statements in 1.04ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111574µs676µsKoha::Borrower::Debarments::::BEGIN@20Koha::Borrower::Debarments::BEGIN@20
1119µs11µsKoha::Borrower::Debarments::::BEGIN@22Koha::Borrower::Debarments::BEGIN@22
1119µs39µsKoha::Borrower::Debarments::::BEGIN@24Koha::Borrower::Debarments::BEGIN@24
0000s0sKoha::Borrower::Debarments::::AddDebarmentKoha::Borrower::Debarments::AddDebarment
0000s0sKoha::Borrower::Debarments::::AddUniqueDebarmentKoha::Borrower::Debarments::AddUniqueDebarment
0000s0sKoha::Borrower::Debarments::::DelDebarmentKoha::Borrower::Debarments::DelDebarment
0000s0sKoha::Borrower::Debarments::::DelUniqueDebarmentKoha::Borrower::Debarments::DelUniqueDebarment
0000s0sKoha::Borrower::Debarments::::GetDebarmentsKoha::Borrower::Debarments::GetDebarments
0000s0sKoha::Borrower::Debarments::::IsDebarredKoha::Borrower::Debarments::IsDebarred
0000s0sKoha::Borrower::Debarments::::ModDebarmentKoha::Borrower::Debarments::ModDebarment
0000s0sKoha::Borrower::Debarments::::_GetBorrowernumberByDebarmentIdKoha::Borrower::Debarments::_GetBorrowernumberByDebarmentId
0000s0sKoha::Borrower::Debarments::::_UpdateBorrowerDebarmentFlagsKoha::Borrower::Debarments::_UpdateBorrowerDebarmentFlags
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Koha::Borrower::Debarments;
2
3# This file is part of Koha.
4#
5# Copyright 2013 ByWater Solutions
6#
7# Koha is free software; you can redistribute it and/or modify it
8# under the terms of the GNU General Public License as published by
9# the Free Software Foundation; either version 3 of the License, or
10# (at your option) any later version.
11#
12# Koha is distributed in the hope that it will be useful, but
13# WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20236µs2778µs
# spent 676µs (574+102) within Koha::Borrower::Debarments::BEGIN@20 which was called: # once (574µs+102µs) by C4::Circulation::BEGIN@50 at line 20
use Modern::Perl;
# spent 676µs making 1 call to Koha::Borrower::Debarments::BEGIN@20 # spent 102µs making 1 call to Modern::Perl::import
21
22225µs214µs
# spent 11µs (9+2) within Koha::Borrower::Debarments::BEGIN@22 which was called: # once (9µs+2µs) by C4::Circulation::BEGIN@50 at line 22
use C4::Context;
# spent 11µs making 1 call to Koha::Borrower::Debarments::BEGIN@22 # spent 2µs making 1 call to C4::Context::import
23
242980µs269µs
# spent 39µs (9+30) within Koha::Borrower::Debarments::BEGIN@24 which was called: # once (9µs+30µs) by C4::Circulation::BEGIN@50 at line 24
use parent qw( Exporter );
# spent 39µs making 1 call to Koha::Borrower::Debarments::BEGIN@24 # spent 30µs making 1 call to parent::import
25
2612µsour @EXPORT = qw(
27 GetDebarments
28
29 AddDebarment
30 DelDebarment
31 ModDebarment
32
33 AddUniqueDebarment
34 DelUniqueDebarment
35
36 IsDebarred
37);
38
39=head1 Koha::Borrower::Debarments
40
41Koha::Borrower::Debarments - Module for managing borrower debarments
42
43=cut
44
45=head2 GetDebarments
46
47my $arrayref = GetDebarments( $borrowernumber, { key => $value } );
48
49=cut
50
51sub GetDebarments {
52 my ($params) = @_;
53
54 return unless ( $params->{'borrowernumber'} );
55
56 my @keys = keys %$params;
57 my @values = values %$params;
58
59 my $where = join( ' AND ', map { "$_ = ?" } @keys );
60 my $sql = "SELECT * FROM borrower_debarments WHERE $where";
61 my $sth = C4::Context->dbh->prepare($sql);
62 $sth->execute(@values);
63
64 return $sth->fetchall_arrayref( {} );
65}
66
67=head2 AddDebarment
68
69my $success = AddDebarment({
70 borrowernumber => $borrowernumber,
71 expiration => $expiration,
72 type => $type, ## enum('FINES','OVERDUES','MANUAL')
73 comment => $comment,
74});
75
76Creates a new debarment.
77
78Required keys: borrowernumber, type
79
80=cut
81
82sub AddDebarment {
83 my ($params) = @_;
84
85 my $borrowernumber = $params->{'borrowernumber'};
86 my $expiration = $params->{'expiration'} || undef;
87 my $type = $params->{'type'} || 'MANUAL';
88 my $comment = $params->{'comment'} || undef;
89
90 return unless ( $borrowernumber && $type );
91
92 my $manager_id;
93 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
94
95 my $sql = "
96 INSERT INTO borrower_debarments ( borrowernumber, expiration, type, comment, manager_id, created )
97 VALUES ( ?, ?, ?, ?, ?, NOW() )
98 ";
99
100 my $r = C4::Context->dbh->do( $sql, {}, ( $borrowernumber, $expiration, $type, $comment, $manager_id ) );
101
102 _UpdateBorrowerDebarmentFlags($borrowernumber);
103
104 return $r;
105}
106
107=head2 DelDebarment
108
109my $success = DelDebarment( $borrower_debarment_id );
110
111Deletes a debarment.
112
113=cut
114
115sub DelDebarment {
116 my ($id) = @_;
117
118 my $borrowernumber = _GetBorrowernumberByDebarmentId($id);
119
120 my $sql = "DELETE FROM borrower_debarments WHERE borrower_debarment_id = ?";
121
122 my $r = C4::Context->dbh->do( $sql, {}, ($id) );
123
124 _UpdateBorrowerDebarmentFlags($borrowernumber);
125
126 return $r;
127}
128
129=head2 ModDebarment
130
131my $success = ModDebarment({
132 borrower_debarment_id => $borrower_debarment_id,
133 expiration => $expiration,
134 type => $type, ## enum('FINES','OVERDUES','MANUAL')
135 comment => $comment,
136});
137
138Updates an existing debarment.
139
140Required keys: borrower_debarment_id
141
142=cut
143
144sub ModDebarment {
145 my ($params) = @_;
146
147 my $borrower_debarment_id = $params->{'borrower_debarment_id'};
148
149 return unless ($borrower_debarment_id);
150
151 delete( $params->{'borrower_debarment_id'} );
152
153 delete( $params->{'created'} );
154 delete( $params->{'updated'} );
155
156 $params->{'manager_id'} = C4::Context->userenv->{'number'} if C4::Context->userenv;
157
158 my @keys = keys %$params;
159 my @values = values %$params;
160
161 my $sql = join( ',', map { "$_ = ?" } @keys );
162
163 $sql = "UPDATE borrower_debarments SET $sql, updated = NOW() WHERE borrower_debarment_id = ?";
164
165 my $r = C4::Context->dbh->do( $sql, {}, ( @values, $borrower_debarment_id ) );
166
167 _UpdateBorrowerDebarmentFlags( _GetBorrowernumberByDebarmentId($borrower_debarment_id) );
168
169 return $r;
170}
171
172=head2 IsDebarred
173
174my $debarment_expiration = IsDebarred( $borrowernumber );
175
176Returns the date a borrowers debarment will expire, or
177undef if the borrower is not debarred
178
179=cut
180
181sub IsDebarred {
182 my ($borrowernumber) = @_;
183
184 return unless ($borrowernumber);
185
186 my $sql = "SELECT debarred FROM borrowers WHERE borrowernumber = ? AND debarred > CURRENT_DATE()";
187 my $sth = C4::Context->dbh->prepare($sql);
188 $sth->execute($borrowernumber);
189 my ($debarred) = $sth->fetchrow_array();
190
191 return $debarred;
192}
193
194=head2 AddUniqueDebarment
195
196my $success = AddUniqueDebarment({
197 borrowernumber => $borrowernumber,
198 type => $type,
199 expiration => $expiration,
200 comment => $comment,
201});
202
203Creates a new debarment of the type defined by the key type.
204If a unique debarment already exists of the given type, it is updated instead.
205The current unique debarment types are OVERDUES, and SUSPENSION
206
207Required keys: borrowernumber, type
208
209=cut
210
211sub AddUniqueDebarment {
212 my ($params) = @_;
213
214 my $borrowernumber = $params->{'borrowernumber'};
215 my $type = $params->{'type'};
216
217 return unless ( $borrowernumber && $type );
218
219 my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0];
220
221 my $r;
222 if ($debarment) {
223
224 # We don't want to shorten a unique debarment's period, so if this 'update' would do so, just keep the current expiration date instead
225 $params->{'expiration'} = $debarment->{'expiration'}
226 if ( $debarment->{'expiration'}
227 && $debarment->{'expiration'} gt $params->{'expiration'} );
228
229 $params->{'borrower_debarment_id'} =
230 $debarment->{'borrower_debarment_id'};
231 $r = ModDebarment($params);
232 } else {
233
234 $r = AddDebarment($params);
235 }
236
237 _UpdateBorrowerDebarmentFlags($borrowernumber);
238
239 return $r;
240}
241
242=head2 DelUniqueDebarment
243
244my $success = _DelUniqueDebarment({
245 borrowernumber => $borrowernumber,
246 type => $type,
247});
248
249Deletes a unique debarment of the type defined by the key type.
250The current unique debarment types are OVERDUES, and SUSPENSION
251
252Required keys: borrowernumber, type
253
254=cut
255
256sub DelUniqueDebarment {
257 my ($params) = @_;
258
259 my $borrowernumber = $params->{'borrowernumber'};
260 my $type = $params->{'type'};
261
262 return unless ( $borrowernumber && $type );
263
264 my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0];
265
266 return unless ( $debarment );
267
268 return DelDebarment( $debarment->{'borrower_debarment_id'} );
269}
270
271=head2 _UpdateBorrowerDebarmentFlags
272
273my $success = _UpdateBorrowerDebarmentFlags( $borrowernumber );
274
275So as not to create additional latency, the fields borrowers.debarred
276and borrowers.debarredcomment remain in the borrowers table. Whenever
277the a borrowers debarrments are modified, this subroutine is run to
278decide if the borrower is currently debarred and update the 'quick flags'
279in the borrowers table accordingly.
280
281=cut
282
283sub _UpdateBorrowerDebarmentFlags {
284 my ($borrowernumber) = @_;
285
286 return unless ($borrowernumber);
287
288 my $dbh = C4::Context->dbh;
289
290 my $sql = q{
291 SELECT COUNT(*), COUNT(*) - COUNT(expiration), MAX(expiration), GROUP_CONCAT(comment SEPARATOR '\n') FROM borrower_debarments
292 WHERE ( expiration > CURRENT_DATE() OR expiration IS NULL ) AND borrowernumber = ?
293 };
294 my $sth = $dbh->prepare($sql);
295 $sth->execute($borrowernumber);
296 my ( $count, $indefinite_expiration, $expiration, $comment ) = $sth->fetchrow_array();
297
298 if ($count) {
299 $expiration = "9999-12-31" if ($indefinite_expiration);
300 } else {
301 $expiration = undef;
302 $comment = undef;
303 }
304
305 return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) );
306}
307
308=head2 _GetBorrowernumberByDebarmentId
309
310my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id );
311
312=cut
313
314sub _GetBorrowernumberByDebarmentId {
315 my ($borrower_debarment_id) = @_;
316
317 return unless ($borrower_debarment_id);
318
319 my $sql = "SELECT borrowernumber FROM borrower_debarments WHERE borrower_debarment_id = ?";
320 my $sth = C4::Context->dbh->prepare($sql);
321 $sth->execute($borrower_debarment_id);
322 my ($borrowernumber) = $sth->fetchrow_array();
323
324 return $borrowernumber;
325}
326
32713µs1;
328
329=head2 AUTHOR
330
331Kyle M Hall <kyle@bywatersoltuions.com>
332
333=cut
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.