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
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.
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.
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>.
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(@ISA @EXPORT_OK @EXPORT %EXPORT_TAGS);
28 our ($csv, $AttributeTypes);
32 @EXPORT_OK = qw(CheckUniqueness SetBorrowerAttributes
33 UpdateBorrowerAttribute
34 extended_attributes_code_value_arrayref extended_attributes_merge
35 SearchIdMatchingAttribute);
36 %EXPORT_TAGS = ( all => \@EXPORT_OK );
41 C4::Members::Attributes - manage extend patron attributes
45 use C4::Members::Attributes;
49 =head2 SearchIdMatchingAttribute
51 my $matching_borrowernumbers = C4::Members::Attributes::SearchIdMatchingAttribute($filter);
55 sub SearchIdMatchingAttribute{
57 $filter = [$filter] unless ref $filter;
59 my $dbh = C4::Context->dbh();
61 SELECT DISTINCT borrowernumber
62 FROM borrower_attributes
63 JOIN borrower_attribute_types USING (code)
64 WHERE staff_searchable = 1
65 AND (} . join (" OR ", map "attribute like ?", @$filter) .qq{)};
66 my $sth = $dbh->prepare_cached($query);
67 $sth->execute(map "%$_%", @$filter);
68 return [map $_->[0], @{ $sth->fetchall_arrayref }];
71 =head2 CheckUniqueness
73 my $ok = CheckUniqueness($code, $value[, $borrowernumber]);
75 Given an attribute type and value, verify if would violate
76 a unique_id restriction if added to the patron. The
77 optional C<$borrowernumber> is the patron that the attribute
78 value would be added to, if known.
80 Returns false if the C<$code> is not valid or the
81 value would violate the uniqueness constraint.
88 my $borrowernumber = @_ ? shift : undef;
90 my $attr_type = C4::Members::AttributeTypes->fetch($code);
92 return 0 unless defined $attr_type;
93 return 1 unless $attr_type->unique_id();
95 my $dbh = C4::Context->dbh;
97 if (defined($borrowernumber)) {
98 $sth = $dbh->prepare("SELECT COUNT(*)
99 FROM borrower_attributes
102 AND borrowernumber <> ?");
103 $sth->execute($code, $value, $borrowernumber);
105 $sth = $dbh->prepare("SELECT COUNT(*)
106 FROM borrower_attributes
109 $sth->execute($code, $value);
111 my ($count) = $sth->fetchrow_array;
112 return ($count == 0);
115 =head2 SetBorrowerAttributes
117 SetBorrowerAttributes($borrowernumber, [ { code => 'CODE', value => 'value' }, ... ] );
119 Set patron attributes for the patron identified by C<$borrowernumber>,
120 replacing any that existed previously.
124 sub SetBorrowerAttributes {
125 my $borrowernumber = shift;
126 my $attr_list = shift;
127 my $no_branch_limit = shift // 0;
129 my $dbh = C4::Context->dbh;
131 my $attributes = Koha::Patrons->find($borrowernumber)->get_extended_attributes;
133 unless ( $no_branch_limit ) {
134 $attributes = $attributes->filter_by_branch_limitations;
138 my $sth = $dbh->prepare("INSERT INTO borrower_attributes (borrowernumber, code, attribute)
140 foreach my $attr (@$attr_list) {
141 $sth->execute($borrowernumber, $attr->{code}, $attr->{value});
143 warn sprintf('Database returned the following error: %s', $sth->errstr);
144 return; # bail immediately on errors
147 return 1; # borrower attributes successfully set
150 =head2 UpdateBorrowerAttribute
152 UpdateBorrowerAttribute($borrowernumber, $attribute );
154 Update a borrower attribute C<$attribute> for the patron identified by C<$borrowernumber>,
158 sub UpdateBorrowerAttribute {
159 my ( $borrowernumber, $attribute ) = @_;
161 Koha::Patrons->find($borrowernumber)->get_extended_attributes->search({ 'me.code' => $attribute->{code} })->filter_by_branch_limitations->delete;
163 my $dbh = C4::Context->dbh;
164 my $query = "INSERT INTO borrower_attributes SET attribute = ?, code = ?, borrowernumber = ?";
165 my @params = ( $attribute->{attribute}, $attribute->{code}, $borrowernumber );
166 my $sth = $dbh->prepare( $query );
168 $sth->execute( @params );
172 =head2 extended_attributes_code_value_arrayref
174 my $patron_attributes = "homeroom:1150605,grade:01,extradata:foobar";
175 my $aref = extended_attributes_code_value_arrayref($patron_attributes);
177 Takes a comma-delimited CSV-style string argument and returns the kind of data structure that SetBorrowerAttributes wants,
178 namely a reference to array of hashrefs like:
179 [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
181 Caches Text::CSV parser object for efficiency.
185 sub extended_attributes_code_value_arrayref {
186 my $string = shift or return;
187 $csv or $csv = Text::CSV->new({binary => 1}); # binary needed for non-ASCII Unicode
188 my $ok = $csv->parse($string); # parse field again to get subfields!
189 my @list = $csv->fields();
190 # TODO: error handling (check $ok)
192 sort {&_sort_by_code($a,$b)}
193 map { map { my @arr = split /:/, $_, 2; { code => $arr[0], value => $arr[1] } } $_ }
196 # nested map because of split
199 =head2 extended_attributes_merge
201 my $old_attributes = extended_attributes_code_value_arrayref("homeroom:224,grade:04,deanslist:2007,deanslist:2008,somedata:xxx");
202 my $new_attributes = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2009,extradata:foobar");
203 my $merged = extended_attributes_merge($patron_attributes, $new_attributes, 1);
205 # assuming deanslist is a repeatable code, value same as:
206 # $merged = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2007,deanslist:2008,deanslist:2009,extradata:foobar,somedata:xxx");
208 Takes three arguments. The first two are references to array of hashrefs, each like:
209 [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
211 The third option specifies whether repeatable codes are clobbered or collected. True for non-clobber.
213 Returns one reference to (merged) array of hashref.
215 Caches results of C4::Members::AttributeTypes::GetAttributeTypes_hashref(1) for efficiency.
219 sub extended_attributes_merge {
220 my $old = shift or return;
221 my $new = shift or return $old;
222 my $keep = @_ ? shift : 0;
223 $AttributeTypes or $AttributeTypes = C4::Members::AttributeTypes::GetAttributeTypes_hashref(1);
225 foreach my $att (@$new) {
226 unless ($att->{code}) {
227 warn "Cannot merge element: no 'code' defined";
230 unless ($AttributeTypes->{$att->{code}}) {
231 warn "Cannot merge element: unrecognized code = '$att->{code}'";
234 unless ($AttributeTypes->{$att->{code}}->{repeatable} and $keep) {
235 @merged = grep {$att->{code} ne $_->{code}} @merged; # filter out any existing attributes of the same code
239 return [( sort {&_sort_by_code($a,$b)} @merged )];
244 defined ($x->{code}) or return -1;
245 defined ($y->{code}) or return 1;
246 return $x->{code} cmp $y->{code} || $x->{value} cmp $y->{value};
251 Koha Development Team <http://koha-community.org/>
253 Galen Charlton <galen.charlton@liblime.com>