C4/Members/Attributes.pm

   1 package 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
  20 use strict;
  21 use warnings;
  22
  23 use Text::CSV;      # Don't be tempted to use Text::CSV::Unicode -- even in binary mode it fails.
  24 use C4::Context;
  25 use C4::Members::AttributeTypes;
  26
  27 use vars qw($VERSION @ISA @EXPORT_OK @EXPORT %EXPORT_TAGS);
  28 our ($csv, $AttributeTypes);
  29
  30 BEGIN {
  31     # set the version for version checking
  32     $VERSION = 3.01;
  33     @ISA = qw(Exporter);
  34     @EXPORT_OK = qw(GetBorrowerAttributes GetBorrowerAttributeValue CheckUniqueness SetBorrowerAttributes
  35                     extended_attributes_code_value_arrayref extended_attributes_merge
  36                                         SearchIdMatchingAttribute);
  37     %EXPORT_TAGS = ( all => \@EXPORT_OK );
  38 }
  39
  40 =head1 NAME
  41
  42 C4::Members::Attributes - manage extend patron attributes
  43
  44 =head1 SYNOPSIS
  45
  46   use C4::Members::Attributes;
  47   my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber);
  48
  49 =head1 FUNCTIONS
  50
  51 =head2 GetBorrowerAttributes
  52
  53   my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber[, $opac_only]);
  54
  55 Retrieve an arrayref of extended attributes associated with the
  56 patron specified by C<$borrowernumber>.  Each entry in the arrayref
  57 is a hashref containing the following keys:
  58
  59 code (attribute type code)
  60 description (attribute type description)
  61 value (attribute value)
  62 value_description (attribute value description (if associated with an authorised value))
  63 password (password, if any, associated with attribute
  64
  65 If the C<$opac_only> parameter is present and has a true value, only the attributes
  66 marked for OPAC display are returned.
  67
  68 =cut
  69
  70 sub GetBorrowerAttributes {
  71     my $borrowernumber = shift;
  72     my $opac_only = @_ ? shift : 0;
  73
  74     my $dbh = C4::Context->dbh();
  75     my $query = "SELECT code, description, attribute, lib, password, display_checkout
  76                  FROM borrower_attributes
  77                  JOIN borrower_attribute_types USING (code)
  78                  LEFT JOIN authorised_values ON (category = authorised_value_category AND attribute = authorised_value)
  79                  WHERE borrowernumber = ?";
  80     $query .= "\nAND opac_display = 1" if $opac_only;
  81     $query .= "\nORDER BY code, attribute";
  82     my $sth = $dbh->prepare_cached($query);
  83     $sth->execute($borrowernumber);
  84     my @results = ();
  85     while (my $row = $sth->fetchrow_hashref()) {
  86         push @results, {
  87             code              => $row->{'code'},
  88             description       => $row->{'description'},
  89             value             => $row->{'attribute'},
  90             value_description => $row->{'lib'},
  91             password          => $row->{'password'},
  92             display_checkout  => $row->{'display_checkout'},
  93         }
  94     }
  95     return \@results;
  96 }
  97
  98 =head2 GetBorrowerAttributeValue
  99
 100   my $value = C4::Members::Attributes::GetBorrowerAttributeValue($borrowernumber, $attribute_code);
 101
 102 Retrieve the value of an extended attribute C<$attribute_code> associated with the
 103 patron specified by C<$borrowernumber>.
 104
 105 =cut
 106
 107 sub GetBorrowerAttributeValue {
 108     my $borrowernumber = shift;
 109     my $code = shift;
 110
 111     my $dbh = C4::Context->dbh();
 112     my $query = "SELECT attribute
 113                  FROM borrower_attributes
 114                  WHERE borrowernumber = ?
 115                  AND code = ?";
 116     my $value = $dbh->selectrow_array($query, undef, $borrowernumber, $code);
 117     return $value;
 118 }
 119
 120 =head2 SearchIdMatchingAttribute
 121
 122   my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($filter);
 123
 124 =cut
 125
 126 sub SearchIdMatchingAttribute{
 127     my $filter = shift;
 128     my $finalfilter=$filter->[0];
 129     my $dbh   = C4::Context->dbh();
 130     my $query = qq{
 131 SELECT borrowernumber
 132 FROM borrower_attributes
 133 JOIN borrower_attribute_types USING (code)
 134 WHERE staff_searchable = 1
 135 AND attribute like ?};
 136     my $sth = $dbh->prepare_cached($query);
 137     $sth->execute("%$finalfilter%");
 138     return $sth->fetchall_arrayref;
 139 }
 140
 141 =head2 CheckUniqueness
 142
 143   my $ok = CheckUniqueness($code, $value[, $borrowernumber]);
 144
 145 Given an attribute type and value, verify if would violate
 146 a unique_id restriction if added to the patron.  The
 147 optional C<$borrowernumber> is the patron that the attribute
 148 value would be added to, if known.
 149
 150 Returns false if the C<$code> is not valid or the
 151 value would violate the uniqueness constraint.
 152
 153 =cut
 154
 155 sub CheckUniqueness {
 156     my $code = shift;
 157     my $value = shift;
 158     my $borrowernumber = @_ ? shift : undef;
 159
 160     my $attr_type = C4::Members::AttributeTypes->fetch($code);
 161
 162     return 0 unless defined $attr_type;
 163     return 1 unless $attr_type->unique_id();
 164
 165     my $dbh = C4::Context->dbh;
 166     my $sth;
 167     if (defined($borrowernumber)) {
 168         $sth = $dbh->prepare("SELECT COUNT(*)
 169                               FROM borrower_attributes
 170                               WHERE code = ?
 171                               AND attribute = ?
 172                               AND borrowernumber <> ?");
 173         $sth->execute($code, $value, $borrowernumber);
 174     } else {
 175         $sth = $dbh->prepare("SELECT COUNT(*)
 176                               FROM borrower_attributes
 177                               WHERE code = ?
 178                               AND attribute = ?");
 179         $sth->execute($code, $value);
 180     }
 181     my ($count) = $sth->fetchrow_array;
 182     return ($count == 0);
 183 }
 184
 185 =head2 SetBorrowerAttributes
 186
 187   SetBorrowerAttributes($borrowernumber, [ { code => 'CODE', value => 'value', password => 'password' }, ... ] );
 188
 189 Set patron attributes for the patron identified by C<$borrowernumber>,
 190 replacing any that existed previously.
 191
 192 =cut
 193
 194 sub SetBorrowerAttributes {
 195     my $borrowernumber = shift;
 196     my $attr_list = shift;
 197
 198     my $dbh = C4::Context->dbh;
 199     my $delsth = $dbh->prepare("DELETE FROM borrower_attributes WHERE borrowernumber = ?");
 200     $delsth->execute($borrowernumber);
 201
 202     my $sth = $dbh->prepare("INSERT INTO borrower_attributes (borrowernumber, code, attribute, password)
 203                              VALUES (?, ?, ?, ?)");
 204     foreach my $attr (@$attr_list) {
 205         $attr->{password} = undef unless exists $attr->{password};
 206         $sth->execute($borrowernumber, $attr->{code}, $attr->{value}, $attr->{password});
 207         if ($sth->err) {
 208             warn sprintf('Database returned the following error: %s', $sth->errstr);
 209             return; # bail immediately on errors
 210         }
 211     }
 212     return 1; # borower attributes successfully set
 213 }
 214
 215 =head2 extended_attributes_code_value_arrayref
 216
 217    my $patron_attributes = "homeroom:1150605,grade:01,extradata:foobar";
 218    my $aref = extended_attributes_code_value_arrayref($patron_attributes);
 219
 220 Takes a comma-delimited CSV-style string argument and returns the kind of data structure that SetBorrowerAttributes wants,
 221 namely a reference to array of hashrefs like:
 222  [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
 223
 224 Caches Text::CSV parser object for efficiency.
 225
 226 =cut
 227
 228 sub extended_attributes_code_value_arrayref {
 229     my $string = shift or return;
 230     $csv or $csv = Text::CSV->new({binary => 1});  # binary needed for non-ASCII Unicode
 231     my $ok   = $csv->parse($string);  # parse field again to get subfields!
 232     my @list = $csv->fields();
 233     # TODO: error handling (check $ok)
 234     return [
 235         sort {&_sort_by_code($a,$b)}
 236         map { map { my @arr = split /:/, $_, 2; { code => $arr[0], value => $arr[1] } } $_ }
 237         @list
 238     ];
 239     # nested map because of split
 240 }
 241
 242 =head2 extended_attributes_merge
 243
 244   my $old_attributes = extended_attributes_code_value_arrayref("homeroom:224,grade:04,deanslist:2007,deanslist:2008,somedata:xxx");
 245   my $new_attributes = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2009,extradata:foobar");
 246   my $merged = extended_attributes_merge($patron_attributes, $new_attributes, 1);
 247
 248   # assuming deanslist is a repeatable code, value same as:
 249   # $merged = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2007,deanslist:2008,deanslist:2009,extradata:foobar,somedata:xxx");
 250
 251 Takes three arguments.  The first two are references to array of hashrefs, each like:
 252  [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
 253
 254 The third option specifies whether repeatable codes are clobbered or collected.  True for non-clobber.
 255
 256 Returns one reference to (merged) array of hashref.
 257
 258 Caches results of C4::Members::AttributeTypes::GetAttributeTypes_hashref(1) for efficiency.
 259
 260 =cut
 261
 262 sub extended_attributes_merge {
 263     my $old = shift or return;
 264     my $new = shift or return $old;
 265     my $keep = @_ ? shift : 0;
 266     $AttributeTypes or $AttributeTypes = C4::Members::AttributeTypes::GetAttributeTypes_hashref(1);
 267     my @merged = @$old;
 268     foreach my $att (@$new) {
 269         unless ($att->{code}) {
 270             warn "Cannot merge element: no 'code' defined";
 271             next;
 272         }
 273         unless ($AttributeTypes->{$att->{code}}) {
 274             warn "Cannot merge element: unrecognized code = '$att->{code}'";
 275             next;
 276         }
 277         unless ($AttributeTypes->{$att->{code}}->{repeatable} and $keep) {
 278             @merged = grep {$att->{code} ne $_->{code}} @merged;    # filter out any existing attributes of the same code
 279         }
 280         push @merged, $att;
 281     }
 282     return [( sort {&_sort_by_code($a,$b)} @merged )];
 283 }
 284
 285 sub _sort_by_code {
 286     my ($x, $y) = @_;
 287     defined ($x->{code}) or return -1;
 288     defined ($y->{code}) or return 1;
 289     return $x->{code} cmp $y->{code} || $x->{value} cmp $y->{value};
 290 }
 291
 292 =head1 AUTHOR
 293
 294 Koha Development Team <http://koha-community.org/>
 295
 296 Galen Charlton <galen.charlton@liblime.com>
 297
 298 =cut
 299
 300 1;