← 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/C4/Members/Attributes.pm
StatementsExecuted 18 statements in 4.65ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1113.41ms4.04msC4::Members::Attributes::::BEGIN@25C4::Members::Attributes::BEGIN@25
1112.00ms9.34msC4::Members::Attributes::::BEGIN@23C4::Members::Attributes::BEGIN@23
111580µs592µsC4::Members::Attributes::::BEGIN@20C4::Members::Attributes::BEGIN@20
11116µs19µsC4::Members::Attributes::::BEGIN@24C4::Members::Attributes::BEGIN@24
11112µs12µsC4::Members::Attributes::::BEGIN@30C4::Members::Attributes::BEGIN@30
11110µs17µsC4::Members::Attributes::::BEGIN@21C4::Members::Attributes::BEGIN@21
1118µs60µsC4::Members::Attributes::::BEGIN@27C4::Members::Attributes::BEGIN@27
0000s0sC4::Members::Attributes::::CheckUniquenessC4::Members::Attributes::CheckUniqueness
0000s0sC4::Members::Attributes::::DeleteBorrowerAttributeC4::Members::Attributes::DeleteBorrowerAttribute
0000s0sC4::Members::Attributes::::GetAttributesC4::Members::Attributes::GetAttributes
0000s0sC4::Members::Attributes::::GetBorrowerAttributeValueC4::Members::Attributes::GetBorrowerAttributeValue
0000s0sC4::Members::Attributes::::GetBorrowerAttributesC4::Members::Attributes::GetBorrowerAttributes
0000s0sC4::Members::Attributes::::SearchIdMatchingAttributeC4::Members::Attributes::SearchIdMatchingAttribute
0000s0sC4::Members::Attributes::::SetBorrowerAttributesC4::Members::Attributes::SetBorrowerAttributes
0000s0sC4::Members::Attributes::::UpdateBorrowerAttributeC4::Members::Attributes::UpdateBorrowerAttribute
0000s0sC4::Members::Attributes::::_sort_by_codeC4::Members::Attributes::_sort_by_code
0000s0sC4::Members::Attributes::::extended_attributes_code_value_arrayrefC4::Members::Attributes::extended_attributes_code_value_arrayref
0000s0sC4::Members::Attributes::::extended_attributes_mergeC4::Members::Attributes::extended_attributes_merge
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package C4::Members::Attributes;
2
3# Copyright (C) 2008 LibLime
4#
5# This file is part of Koha.
6#
7# Koha is free software; you can redistribute it and/or modify it under the
8# terms of the GNU General Public License as published by the Free Software
9# Foundation; either version 2 of the License, or (at your option) any later
10# version.
11#
12# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License along
17# with Koha; if not, write to the Free Software Foundation, Inc.,
18# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20231µs2603µs
# spent 592µs (580+12) within C4::Members::Attributes::BEGIN@20 which was called: # once (580µs+12µs) by C4::Letters::BEGIN@28 at line 20
use strict;
# spent 592µs making 1 call to C4::Members::Attributes::BEGIN@20 # spent 12µs making 1 call to strict::import
21224µs225µs
# spent 17µs (10+8) within C4::Members::Attributes::BEGIN@21 which was called: # once (10µs+8µs) by C4::Letters::BEGIN@28 at line 21
use warnings;
# spent 17µs making 1 call to C4::Members::Attributes::BEGIN@21 # spent 8µs making 1 call to warnings::import
22
232730µs29.34ms
# spent 9.34ms (2.00+7.33) within C4::Members::Attributes::BEGIN@23 which was called: # once (2.00ms+7.33ms) by C4::Letters::BEGIN@28 at line 23
use Text::CSV; # Don't be tempted to use Text::CSV::Unicode -- even in binary mode it fails.
# spent 9.34ms making 1 call to C4::Members::Attributes::BEGIN@23 # spent 2µs making 1 call to Text::CSV::import
24228µs222µs
# spent 19µs (16+3) within C4::Members::Attributes::BEGIN@24 which was called: # once (16µs+3µs) by C4::Letters::BEGIN@28 at line 24
use C4::Context;
# spent 19µs making 1 call to C4::Members::Attributes::BEGIN@24 # spent 3µs making 1 call to C4::Context::import
2522.79ms14.04ms
# spent 4.04ms (3.41+631µs) within C4::Members::Attributes::BEGIN@25 which was called: # once (3.41ms+631µs) by C4::Letters::BEGIN@28 at line 25
use C4::Members::AttributeTypes;
# spent 4.04ms making 1 call to C4::Members::Attributes::BEGIN@25
26
27264µs2113µs
# spent 60µs (8+53) within C4::Members::Attributes::BEGIN@27 which was called: # once (8µs+53µs) by C4::Letters::BEGIN@28 at line 27
use vars qw($VERSION @ISA @EXPORT_OK @EXPORT %EXPORT_TAGS);
# spent 60µs making 1 call to C4::Members::Attributes::BEGIN@27 # spent 53µs making 1 call to vars::import
281300nsour ($csv, $AttributeTypes);
29
30
# spent 12µs within C4::Members::Attributes::BEGIN@30 which was called: # once (12µs+0s) by C4::Letters::BEGIN@28 at line 39
BEGIN {
31 # set the version for version checking
3212µs $VERSION = 3.07.00.049;
3315µs @ISA = qw(Exporter);
3411µs @EXPORT_OK = qw(GetBorrowerAttributes GetBorrowerAttributeValue CheckUniqueness SetBorrowerAttributes
35 DeleteBorrowerAttribute UpdateBorrowerAttribute
36 extended_attributes_code_value_arrayref extended_attributes_merge
37 SearchIdMatchingAttribute);
3815µs %EXPORT_TAGS = ( all => \@EXPORT_OK );
391973µs112µs}
# spent 12µs making 1 call to C4::Members::Attributes::BEGIN@30
40
41=head1 NAME
42
43C4::Members::Attributes - manage extend patron attributes
44
45=head1 SYNOPSIS
46
47 use C4::Members::Attributes;
48 my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber);
49
50=head1 FUNCTIONS
51
52=head2 GetBorrowerAttributes
53
54 my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber[, $opac_only]);
55
56Retrieve an arrayref of extended attributes associated with the
57patron specified by C<$borrowernumber>. Each entry in the arrayref
58is a hashref containing the following keys:
59
60code (attribute type code)
61description (attribute type description)
62value (attribute value)
63value_description (attribute value description (if associated with an authorised value))
64password (password, if any, associated with attribute
65
66If the C<$opac_only> parameter is present and has a true value, only the attributes
67marked for OPAC display are returned.
68
69=cut
70
71sub GetBorrowerAttributes {
72 my $borrowernumber = shift;
73 my $opac_only = @_ ? shift : 0;
74 my $branch_limit = @_ ? shift : 0;
75
76 my $dbh = C4::Context->dbh();
77 my $query = "SELECT code, description, attribute, lib, password, display_checkout, category_code, class
78 FROM borrower_attributes
79 JOIN borrower_attribute_types USING (code)
80 LEFT JOIN authorised_values ON (category = authorised_value_category AND attribute = authorised_value)
81 WHERE borrowernumber = ?";
82 $query .= "\nAND opac_display = 1" if $opac_only;
83 $query .= "\nORDER BY code, attribute";
84 my $sth = $dbh->prepare_cached($query);
85 $sth->execute($borrowernumber);
86 my @results = ();
87 while (my $row = $sth->fetchrow_hashref()) {
88 push @results, {
89 code => $row->{'code'},
90 description => $row->{'description'},
91 value => $row->{'attribute'},
92 value_description => $row->{'lib'},
93 password => $row->{'password'},
94 display_checkout => $row->{'display_checkout'},
95 category_code => $row->{'category_code'},
96 class => $row->{'class'},
97 }
98 }
99 $sth->finish;
100 return \@results;
101}
102
103=head2 GetAttributes
104
105 my $attributes = C4::Members::Attributes::GetAttributes([$opac_only]);
106
107Retrieve an arrayref of extended attribute codes
108
109=cut
110
111sub GetAttributes {
112 my ($opac_only) = @_;
113
114 my $dbh = C4::Context->dbh();
115 my $query = "SELECT code FROM borrower_attribute_types";
116 $query .= "\nWHERE opac_display = 1" if $opac_only;
117 $query .= "\nORDER BY code";
118 return $dbh->selectcol_arrayref($query);
119}
120
121=head2 GetBorrowerAttributeValue
122
123 my $value = C4::Members::Attributes::GetBorrowerAttributeValue($borrowernumber, $attribute_code);
124
125Retrieve the value of an extended attribute C<$attribute_code> associated with the
126patron specified by C<$borrowernumber>.
127
128=cut
129
130sub GetBorrowerAttributeValue {
131 my $borrowernumber = shift;
132 my $code = shift;
133
134 my $dbh = C4::Context->dbh();
135 my $query = "SELECT attribute
136 FROM borrower_attributes
137 WHERE borrowernumber = ?
138 AND code = ?";
139 my $value = $dbh->selectrow_array($query, undef, $borrowernumber, $code);
140 return $value;
141}
142
143=head2 SearchIdMatchingAttribute
144
145 my $matching_borrowernumbers = C4::Members::Attributes::SearchIdMatchingAttribute($filter);
146
147=cut
148
149sub SearchIdMatchingAttribute{
150 my $filter = shift;
151 $filter = [$filter] unless ref $filter;
152
153 my $dbh = C4::Context->dbh();
154 my $query = qq{
155SELECT DISTINCT borrowernumber
156FROM borrower_attributes
157JOIN borrower_attribute_types USING (code)
158WHERE staff_searchable = 1
159AND (} . join (" OR ", map "attribute like ?", @$filter) .qq{)};
160 my $sth = $dbh->prepare_cached($query);
161 $sth->execute(map "%$_%", @$filter);
162 return [map $_->[0], @{ $sth->fetchall_arrayref }];
163}
164
165=head2 CheckUniqueness
166
167 my $ok = CheckUniqueness($code, $value[, $borrowernumber]);
168
169Given an attribute type and value, verify if would violate
170a unique_id restriction if added to the patron. The
171optional C<$borrowernumber> is the patron that the attribute
172value would be added to, if known.
173
174Returns false if the C<$code> is not valid or the
175value would violate the uniqueness constraint.
176
177=cut
178
179sub CheckUniqueness {
180 my $code = shift;
181 my $value = shift;
182 my $borrowernumber = @_ ? shift : undef;
183
184 my $attr_type = C4::Members::AttributeTypes->fetch($code);
185
186 return 0 unless defined $attr_type;
187 return 1 unless $attr_type->unique_id();
188
189 my $dbh = C4::Context->dbh;
190 my $sth;
191 if (defined($borrowernumber)) {
192 $sth = $dbh->prepare("SELECT COUNT(*)
193 FROM borrower_attributes
194 WHERE code = ?
195 AND attribute = ?
196 AND borrowernumber <> ?");
197 $sth->execute($code, $value, $borrowernumber);
198 } else {
199 $sth = $dbh->prepare("SELECT COUNT(*)
200 FROM borrower_attributes
201 WHERE code = ?
202 AND attribute = ?");
203 $sth->execute($code, $value);
204 }
205 my ($count) = $sth->fetchrow_array;
206 return ($count == 0);
207}
208
209=head2 SetBorrowerAttributes
210
211 SetBorrowerAttributes($borrowernumber, [ { code => 'CODE', value => 'value', password => 'password' }, ... ] );
212
213Set patron attributes for the patron identified by C<$borrowernumber>,
214replacing any that existed previously.
215
216=cut
217
218sub SetBorrowerAttributes {
219 my $borrowernumber = shift;
220 my $attr_list = shift;
221
222 my $dbh = C4::Context->dbh;
223 my $delsth = $dbh->prepare("DELETE FROM borrower_attributes WHERE borrowernumber = ?");
224 $delsth->execute($borrowernumber);
225
226 my $sth = $dbh->prepare("INSERT INTO borrower_attributes (borrowernumber, code, attribute, password)
227 VALUES (?, ?, ?, ?)");
228 foreach my $attr (@$attr_list) {
229 $attr->{password} = undef unless exists $attr->{password};
230 $sth->execute($borrowernumber, $attr->{code}, $attr->{value}, $attr->{password});
231 if ($sth->err) {
232 warn sprintf('Database returned the following error: %s', $sth->errstr);
233 return; # bail immediately on errors
234 }
235 }
236 return 1; # borower attributes successfully set
237}
238
239=head2 DeleteBorrowerAttribute
240
241 DeleteBorrowerAttribute($borrowernumber, $attribute);
242
243Delete a borrower attribute for the patron identified by C<$borrowernumber> and the attribute code of C<$attribute>
244
245=cut
246sub DeleteBorrowerAttribute {
247 my ( $borrowernumber, $attribute ) = @_;
248
249 my $dbh = C4::Context->dbh;
250 my $sth = $dbh->prepare(qq{
251 DELETE FROM borrower_attributes
252 WHERE borrowernumber = ?
253 AND code = ?
254 } );
255 $sth->execute( $borrowernumber, $attribute->{code} );
256}
257
258=head2 UpdateBorrowerAttribute
259
260 UpdateBorrowerAttribute($borrowernumber, $attribute );
261
262Update a borrower attribute C<$attribute> for the patron identified by C<$borrowernumber>,
263
264=cut
265sub UpdateBorrowerAttribute {
266 my ( $borrowernumber, $attribute ) = @_;
267
268 DeleteBorrowerAttribute $borrowernumber, $attribute;
269
270 my $dbh = C4::Context->dbh;
271 my $query = "INSERT INTO borrower_attributes SET attribute = ?, code = ?, borrowernumber = ?";
272 my @params = ( $attribute->{attribute}, $attribute->{code}, $borrowernumber );
273 if ( defined $attribute->{password} ) {
274 $query .= ", password = ?";
275 push @params, $attribute->{password};
276 }
277 my $sth = $dbh->prepare( $query );
278
279 $sth->execute( @params );
280}
281
282
283=head2 extended_attributes_code_value_arrayref
284
285 my $patron_attributes = "homeroom:1150605,grade:01,extradata:foobar";
286 my $aref = extended_attributes_code_value_arrayref($patron_attributes);
287
288Takes a comma-delimited CSV-style string argument and returns the kind of data structure that SetBorrowerAttributes wants,
289namely a reference to array of hashrefs like:
290 [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
291
292Caches Text::CSV parser object for efficiency.
293
294=cut
295
296sub extended_attributes_code_value_arrayref {
297 my $string = shift or return;
298 $csv or $csv = Text::CSV->new({binary => 1}); # binary needed for non-ASCII Unicode
299 my $ok = $csv->parse($string); # parse field again to get subfields!
300 my @list = $csv->fields();
301 # TODO: error handling (check $ok)
302 return [
303 sort {&_sort_by_code($a,$b)}
304 map { map { my @arr = split /:/, $_, 2; { code => $arr[0], value => $arr[1] } } $_ }
305 @list
306 ];
307 # nested map because of split
308}
309
310=head2 extended_attributes_merge
311
312 my $old_attributes = extended_attributes_code_value_arrayref("homeroom:224,grade:04,deanslist:2007,deanslist:2008,somedata:xxx");
313 my $new_attributes = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2009,extradata:foobar");
314 my $merged = extended_attributes_merge($patron_attributes, $new_attributes, 1);
315
316 # assuming deanslist is a repeatable code, value same as:
317 # $merged = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2007,deanslist:2008,deanslist:2009,extradata:foobar,somedata:xxx");
318
319Takes three arguments. The first two are references to array of hashrefs, each like:
320 [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
321
322The third option specifies whether repeatable codes are clobbered or collected. True for non-clobber.
323
324Returns one reference to (merged) array of hashref.
325
326Caches results of C4::Members::AttributeTypes::GetAttributeTypes_hashref(1) for efficiency.
327
328=cut
329
330sub extended_attributes_merge {
331 my $old = shift or return;
332 my $new = shift or return $old;
333 my $keep = @_ ? shift : 0;
334 $AttributeTypes or $AttributeTypes = C4::Members::AttributeTypes::GetAttributeTypes_hashref(1);
335 my @merged = @$old;
336 foreach my $att (@$new) {
337 unless ($att->{code}) {
338 warn "Cannot merge element: no 'code' defined";
339 next;
340 }
341 unless ($AttributeTypes->{$att->{code}}) {
342 warn "Cannot merge element: unrecognized code = '$att->{code}'";
343 next;
344 }
345 unless ($AttributeTypes->{$att->{code}}->{repeatable} and $keep) {
346 @merged = grep {$att->{code} ne $_->{code}} @merged; # filter out any existing attributes of the same code
347 }
348 push @merged, $att;
349 }
350 return [( sort {&_sort_by_code($a,$b)} @merged )];
351}
352
353sub _sort_by_code {
354 my ($x, $y) = @_;
355 defined ($x->{code}) or return -1;
356 defined ($y->{code}) or return 1;
357 return $x->{code} cmp $y->{code} || $x->{value} cmp $y->{value};
358}
359
360=head1 AUTHOR
361
362Koha Development Team <http://koha-community.org/>
363
364Galen Charlton <galen.charlton@liblime.com>
365
366=cut
367
36813µs1;
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.