1 package C4::Members::Attributes;
3 # Copyright (C) 2008 LibLime
5 # This file is part of Koha.
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
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.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
23 use Text::CSV; # Don't be tempted to use Text::CSV::Unicode -- even in binary mode it fails.
25 use C4::Members::AttributeTypes;
27 use vars qw($VERSION @ISA @EXPORT_OK @EXPORT %EXPORT_TAGS);
28 our ($csv, $AttributeTypes);
31 # set the version for version checking
34 @EXPORT_OK = qw(GetBorrowerAttributes CheckUniqueness SetBorrowerAttributes
35 extended_attributes_code_value_arrayref extended_attributes_merge
36 SearchIdMatchingAttribute);
37 %EXPORT_TAGS = ( all => \@EXPORT_OK );
42 C4::Members::Attributes - manage extend patron attributes
48 use C4::Members::Attributes;
49 my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber);
55 =head2 GetBorrowerAttributes
59 my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber[, $opac_only]);
63 Retrieve an arrayref of extended attributes associated with the
64 patron specified by C<$borrowernumber>. Each entry in the arrayref
65 is a hashref containing the following keys:
67 code (attribute type code)
68 description (attribute type description)
69 value (attribute value)
70 value_description (attribute value description (if associated with an authorised value))
71 password (password, if any, associated with attribute
73 If the C<$opac_only> parameter is present and has a true value, only the attributes
74 marked for OPAC display are returned.
78 sub GetBorrowerAttributes {
79 my $borrowernumber = shift;
80 my $opac_only = @_ ? shift : 0;
82 my $dbh = C4::Context->dbh();
83 my $query = "SELECT code, description, attribute, lib, password
84 FROM borrower_attributes
85 JOIN borrower_attribute_types USING (code)
86 LEFT JOIN authorised_values ON (category = authorised_value_category AND attribute = authorised_value)
87 WHERE borrowernumber = ?";
88 $query .= "\nAND opac_display = 1" if $opac_only;
89 $query .= "\nORDER BY code, attribute";
90 my $sth = $dbh->prepare_cached($query);
91 $sth->execute($borrowernumber);
93 while (my $row = $sth->fetchrow_hashref()) {
95 code => $row->{'code'},
96 description => $row->{'description'},
97 value => $row->{'attribute'},
98 value_description => $row->{'lib'},
99 password => $row->{'password'},
105 =head2 SearchIdMatchingAttribute
109 my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($filter);
116 sub SearchIdMatchingAttribute{
119 my $dbh = C4::Context->dbh();
121 SELECT borrowernumber
122 FROM borrower_attributes
123 JOIN borrower_attribute_types USING (code)
124 WHERE staff_searchable = 1
125 AND attribute like ?};
126 my $sth = $dbh->prepare_cached($query);
127 $sth->execute($filter);
128 return $sth->fetchall_arrayref;
131 =head2 CheckUniqueness
135 my $ok = CheckUniqueness($code, $value[, $borrowernumber]);
139 Given an attribute type and value, verify if would violate
140 a unique_id restriction if added to the patron. The
141 optional C<$borrowernumber> is the patron that the attribute
142 value would be added to, if known.
144 Returns false if the C<$code> is not valid or the
145 value would violate the uniqueness constraint.
149 sub CheckUniqueness {
152 my $borrowernumber = @_ ? shift : undef;
154 my $attr_type = C4::Members::AttributeTypes->fetch($code);
156 return 0 unless defined $attr_type;
157 return 1 unless $attr_type->unique_id();
159 my $dbh = C4::Context->dbh;
161 if (defined($borrowernumber)) {
162 $sth = $dbh->prepare("SELECT COUNT(*)
163 FROM borrower_attributes
166 AND borrowernumber <> ?");
167 $sth->execute($code, $value, $borrowernumber);
169 $sth = $dbh->prepare("SELECT COUNT(*)
170 FROM borrower_attributes
173 $sth->execute($code, $value);
175 my ($count) = $sth->fetchrow_array;
176 return ($count == 0);
179 =head2 SetBorrowerAttributes
183 SetBorrowerAttributes($borrowernumber, [ { code => 'CODE', value => 'value', password => 'password' }, ... ] );
187 Set patron attributes for the patron identified by C<$borrowernumber>,
188 replacing any that existed previously.
192 sub SetBorrowerAttributes {
193 my $borrowernumber = shift;
194 my $attr_list = shift;
196 my $dbh = C4::Context->dbh;
197 my $delsth = $dbh->prepare("DELETE FROM borrower_attributes WHERE borrowernumber = ?");
198 $delsth->execute($borrowernumber);
200 my $sth = $dbh->prepare("INSERT INTO borrower_attributes (borrowernumber, code, attribute, password)
201 VALUES (?, ?, ?, ?)");
202 foreach my $attr (@$attr_list) {
203 $attr->{password} = undef unless exists $attr->{password};
204 $sth->execute($borrowernumber, $attr->{code}, $attr->{value}, $attr->{password});
208 =head2 extended_attributes_code_value_arrayref
212 my $patron_attributes = "homeroom:1150605,grade:01,extradata:foobar";
213 my $aref = extended_attributes_code_value_arrayref($patron_attributes);
217 Takes a comma-delimited CSV-style string argument and returns the kind of data structure that SetBorrowerAttributes wants,
218 namely a reference to array of hashrefs like:
219 [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
221 Caches Text::CSV parser object for efficiency.
225 sub extended_attributes_code_value_arrayref {
226 my $string = shift or return;
227 $csv or $csv = Text::CSV->new({binary => 1}); # binary needed for non-ASCII Unicode
228 my $ok = $csv->parse($string); # parse field again to get subfields!
229 my @list = $csv->fields();
230 # TODO: error handling (check $ok)
232 sort {&_sort_by_code($a,$b)}
233 map { map { my @arr = split /:/, $_, 2; { code => $arr[0], value => $arr[1] } } $_ }
236 # nested map because of split
239 =head2 extended_attributes_merge
243 my $old_attributes = extended_attributes_code_value_arrayref("homeroom:224,grade:04,deanslist:2007,deanslist:2008,somedata:xxx");
244 my $new_attributes = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2009,extradata:foobar");
245 my $merged = extended_attributes_merge($patron_attributes, $new_attributes, 1);
247 # assuming deanslist is a repeatable code, value same as:
248 # $merged = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2007,deanslist:2008,deanslist:2009,extradata:foobar,somedata:xxx");
252 Takes three arguments. The first two are references to array of hashrefs, each like:
253 [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
255 The third option specifies whether repeatable codes are clobbered or collected. True for non-clobber.
257 Returns one reference to (merged) array of hashref.
259 Caches results of C4::Members::AttributeTypes::GetAttributeTypes_hashref(1) for efficiency.
263 sub extended_attributes_merge {
264 my $old = shift or return;
265 my $new = shift or return $old;
266 my $keep = @_ ? shift : 0;
267 $AttributeTypes or $AttributeTypes = C4::Members::AttributeTypes::GetAttributeTypes_hashref(1);
269 foreach my $att (@$new) {
270 unless ($att->{code}) {
271 warn "Cannot merge element: no 'code' defined";
274 unless ($AttributeTypes->{$att->{code}}) {
275 warn "Cannot merge element: unrecognized code = '$att->{code}'";
278 unless ($AttributeTypes->{$att->{code}}->{repeatable} and $keep) {
279 @merged = grep {$att->{code} ne $_->{code}} @merged; # filter out any existing attributes of the same code
283 return [( sort {&_sort_by_code($a,$b)} @merged )];
288 defined ($x->{code}) or return -1;
289 defined ($y->{code}) or return 1;
290 return $x->{code} cmp $y->{code} || $x->{value} cmp $y->{value};
295 Koha Development Team <info@koha.org>
297 Galen Charlton <galen.charlton@liblime.com>