← 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:11:59 2013

Filename/usr/share/koha/lib/C4/Members/Attributes.pm
StatementsExecuted 24 statements in 2.41ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1112.14ms2.23msC4::Members::Attributes::::BEGIN@25C4::Members::Attributes::BEGIN@25
1111.49ms5.62msC4::Members::Attributes::::BEGIN@23C4::Members::Attributes::BEGIN@23
11139µs39µsC4::Members::Attributes::::BEGIN@30C4::Members::Attributes::BEGIN@30
11129µs67µsC4::Members::Attributes::::BEGIN@21C4::Members::Attributes::BEGIN@21
11127µs34µsC4::Members::Attributes::::BEGIN@24C4::Members::Attributes::BEGIN@24
11123µs28µsC4::Members::Attributes::::BEGIN@20C4::Members::Attributes::BEGIN@20
11117µs222µ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
20356µs234µs
# spent 28µs (23+6) within C4::Members::Attributes::BEGIN@20 which was called: # once (23µs+6µs) by C4::Letters::BEGIN@27 at line 20
use strict;
# spent 28µs making 1 call to C4::Members::Attributes::BEGIN@20 # spent 6µs making 1 call to strict::import
21365µs2104µs
# spent 67µs (29+38) within C4::Members::Attributes::BEGIN@21 which was called: # once (29µs+38µs) by C4::Letters::BEGIN@27 at line 21
use warnings;
# spent 67µs making 1 call to C4::Members::Attributes::BEGIN@21 # spent 38µs making 1 call to warnings::import
22
233197µs25.63ms
# spent 5.62ms (1.49+4.13) within C4::Members::Attributes::BEGIN@23 which was called: # once (1.49ms+4.13ms) by C4::Letters::BEGIN@27 at line 23
use Text::CSV; # Don't be tempted to use Text::CSV::Unicode -- even in binary mode it fails.
# spent 5.62ms making 1 call to C4::Members::Attributes::BEGIN@23 # spent 3µs making 1 call to Text::CSV::import
24356µs241µs
# spent 34µs (27+7) within C4::Members::Attributes::BEGIN@24 which was called: # once (27µs+7µs) by C4::Letters::BEGIN@27 at line 24
use C4::Context;
# spent 34µs making 1 call to C4::Members::Attributes::BEGIN@24 # spent 7µs making 1 call to C4::Context::import
253170µs22.23ms
# spent 2.23ms (2.14+86µs) within C4::Members::Attributes::BEGIN@25 which was called: # once (2.14ms+86µs) by C4::Letters::BEGIN@27 at line 25
use C4::Members::AttributeTypes;
# spent 2.23ms making 1 call to C4::Members::Attributes::BEGIN@25 # spent 5µs making 1 call to UNIVERSAL::import
26
273147µs2427µs
# spent 222µs (17+205) within C4::Members::Attributes::BEGIN@27 which was called: # once (17µs+205µs) by C4::Letters::BEGIN@27 at line 27
use vars qw($VERSION @ISA @EXPORT_OK @EXPORT %EXPORT_TAGS);
# spent 222µs making 1 call to C4::Members::Attributes::BEGIN@27 # spent 205µs making 1 call to vars::import
281500nsour ($csv, $AttributeTypes);
29
30
# spent 39µs within C4::Members::Attributes::BEGIN@30 which was called: # once (39µs+0s) by C4::Letters::BEGIN@27 at line 39
BEGIN {
31 # set the version for version checking
32436µs $VERSION = 3.07.00.049;
33 @ISA = qw(Exporter);
34 @EXPORT_OK = qw(GetBorrowerAttributes GetBorrowerAttributeValue CheckUniqueness SetBorrowerAttributes
35 DeleteBorrowerAttribute UpdateBorrowerAttribute
36 extended_attributes_code_value_arrayref extended_attributes_merge
37 SearchIdMatchingAttribute);
38 %EXPORT_TAGS = ( all => \@EXPORT_OK );
3911.67ms139µs}
# spent 39µs making 1 call to C4::Members::Attributes::BEGIN@30
40
41=head1 NAME
42
- -
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
- -
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
- -
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
- -
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
- -
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
- -
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
- -
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
- -
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
- -
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
- -
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
- -
36814µs1;
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.