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
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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
32 $VERSION = 3.07.00.049;
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 );
43 C4::Members::Attributes - manage extend patron attributes
47 use C4::Members::Attributes;
48 my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber);
52 =head2 GetBorrowerAttributes
54 my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber[, $opac_only]);
56 Retrieve an arrayref of extended attributes associated with the
57 patron specified by C<$borrowernumber>. Each entry in the arrayref
58 is a hashref containing the following keys:
60 code (attribute type code)
61 description (attribute type description)
62 value (attribute value)
63 value_description (attribute value description (if associated with an authorised value))
64 password (password, if any, associated with attribute
66 If the C<$opac_only> parameter is present and has a true value, only the attributes
67 marked for OPAC display are returned.
71 sub GetBorrowerAttributes
{
72 my $borrowernumber = shift;
73 my $opac_only = @_ ?
shift : 0;
74 my $branch_limit = @_ ?
shift : 0;
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);
87 while (my $row = $sth->fetchrow_hashref()) {
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'},
105 my $attributes = C4::Members::Attributes::GetAttributes([$opac_only]);
107 Retrieve an arrayref of extended attribute codes
112 my ($opac_only) = @_;
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);
121 =head2 GetBorrowerAttributeValue
123 my $value = C4::Members::Attributes::GetBorrowerAttributeValue($borrowernumber, $attribute_code);
125 Retrieve the value of an extended attribute C<$attribute_code> associated with the
126 patron specified by C<$borrowernumber>.
130 sub GetBorrowerAttributeValue
{
131 my $borrowernumber = shift;
134 my $dbh = C4
::Context
->dbh();
135 my $query = "SELECT attribute
136 FROM borrower_attributes
137 WHERE borrowernumber = ?
139 my $value = $dbh->selectrow_array($query, undef, $borrowernumber, $code);
143 =head2 SearchIdMatchingAttribute
145 my $matching_borrowernumbers = C4::Members::Attributes::SearchIdMatchingAttribute($filter);
149 sub SearchIdMatchingAttribute
{
151 $filter = [$filter] unless ref $filter;
153 my $dbh = C4
::Context
->dbh();
155 SELECT DISTINCT borrowernumber
156 FROM borrower_attributes
157 JOIN borrower_attribute_types USING
(code
)
158 WHERE staff_searchable
= 1
159 AND
(} . 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 }];
165 =head2 CheckUniqueness
167 my $ok = CheckUniqueness($code, $value[, $borrowernumber]);
169 Given an attribute type and value, verify if would violate
170 a unique_id restriction if added to the patron. The
171 optional C<$borrowernumber> is the patron that the attribute
172 value would be added to, if known.
174 Returns false if the C<$code> is not valid or the
175 value would violate the uniqueness constraint.
179 sub CheckUniqueness
{
182 my $borrowernumber = @_ ?
shift : undef;
184 my $attr_type = C4
::Members
::AttributeTypes
->fetch($code);
186 return 0 unless defined $attr_type;
187 return 1 unless $attr_type->unique_id();
189 my $dbh = C4
::Context
->dbh;
191 if (defined($borrowernumber)) {
192 $sth = $dbh->prepare("SELECT COUNT(*)
193 FROM borrower_attributes
196 AND borrowernumber <> ?");
197 $sth->execute($code, $value, $borrowernumber);
199 $sth = $dbh->prepare("SELECT COUNT(*)
200 FROM borrower_attributes
203 $sth->execute($code, $value);
205 my ($count) = $sth->fetchrow_array;
206 return ($count == 0);
209 =head2 SetBorrowerAttributes
211 SetBorrowerAttributes($borrowernumber, [ { code => 'CODE', value => 'value', password => 'password' }, ... ] );
213 Set patron attributes for the patron identified by C<$borrowernumber>,
214 replacing any that existed previously.
218 sub SetBorrowerAttributes
{
219 my $borrowernumber = shift;
220 my $attr_list = shift;
222 my $dbh = C4
::Context
->dbh;
223 my $delsth = $dbh->prepare("DELETE FROM borrower_attributes WHERE borrowernumber = ?");
224 $delsth->execute($borrowernumber);
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
});
232 warn sprintf('Database returned the following error: %s', $sth->errstr);
233 return; # bail immediately on errors
236 return 1; # borower attributes successfully set
239 =head2 DeleteBorrowerAttribute
241 DeleteBorrowerAttribute($borrowernumber, $attribute);
243 Delete a borrower attribute for the patron identified by C<$borrowernumber> and the attribute code of C<$attribute>
246 sub DeleteBorrowerAttribute
{
247 my ( $borrowernumber, $attribute ) = @_;
249 my $dbh = C4
::Context
->dbh;
250 my $sth = $dbh->prepare(qq{
251 DELETE FROM borrower_attributes
252 WHERE borrowernumber
= ?
255 $sth->execute( $borrowernumber, $attribute->{code
} );
258 =head2 UpdateBorrowerAttribute
260 UpdateBorrowerAttribute($borrowernumber, $attribute );
262 Update a borrower attribute C<$attribute> for the patron identified by C<$borrowernumber>,
265 sub UpdateBorrowerAttribute
{
266 my ( $borrowernumber, $attribute ) = @_;
268 DeleteBorrowerAttribute
$borrowernumber, $attribute;
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
};
277 my $sth = $dbh->prepare( $query );
279 $sth->execute( @params );
283 =head2 extended_attributes_code_value_arrayref
285 my $patron_attributes = "homeroom:1150605,grade:01,extradata:foobar";
286 my $aref = extended_attributes_code_value_arrayref($patron_attributes);
288 Takes a comma-delimited CSV-style string argument and returns the kind of data structure that SetBorrowerAttributes wants,
289 namely a reference to array of hashrefs like:
290 [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
292 Caches Text::CSV parser object for efficiency.
296 sub 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)
303 sort {&_sort_by_code
($a,$b)}
304 map { map { my @arr = split /:/, $_, 2; { code
=> $arr[0], value
=> $arr[1] } } $_ }
307 # nested map because of split
310 =head2 extended_attributes_merge
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);
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");
319 Takes three arguments. The first two are references to array of hashrefs, each like:
320 [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
322 The third option specifies whether repeatable codes are clobbered or collected. True for non-clobber.
324 Returns one reference to (merged) array of hashref.
326 Caches results of C4::Members::AttributeTypes::GetAttributeTypes_hashref(1) for efficiency.
330 sub 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);
336 foreach my $att (@
$new) {
337 unless ($att->{code
}) {
338 warn "Cannot merge element: no 'code' defined";
341 unless ($AttributeTypes->{$att->{code
}}) {
342 warn "Cannot merge element: unrecognized code = '$att->{code}'";
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
350 return [( sort {&_sort_by_code
($a,$b)} @merged )];
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
};
362 Koha Development Team <http://koha-community.org/>
364 Galen Charlton <galen.charlton@liblime.com>