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
   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.
  11 #
  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.
  16 #
  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>.
  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(@ISA @EXPORT_OK @EXPORT %EXPORT_TAGS);
  28 our ($csv, $AttributeTypes);
  29
  30 BEGIN {
  31     @ISA = qw(Exporter);
  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 );
  37 }
  38
  39 =head1 NAME
  40
  41 C4::Members::Attributes - manage extend patron attributes
  42
  43 =head1 SYNOPSIS
  44
  45   use C4::Members::Attributes;
  46
  47 =head1 FUNCTIONS
  48
  49 =head2 SearchIdMatchingAttribute
  50
  51   my $matching_borrowernumbers = C4::Members::Attributes::SearchIdMatchingAttribute($filter);
  52
  53 =cut
  54
  55 sub SearchIdMatchingAttribute{
  56     my $filter = shift;
  57     $filter = [$filter] unless ref $filter;
  58
  59     my $dbh   = C4::Context->dbh();
  60     my $query = qq{
  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 }];
  69 }
  70
  71 =head2 CheckUniqueness
  72
  73   my $ok = CheckUniqueness($code, $value[, $borrowernumber]);
  74
  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.
  79
  80 Returns false if the C<$code> is not valid or the
  81 value would violate the uniqueness constraint.
  82
  83 =cut
  84
  85 sub CheckUniqueness {
  86     my $code = shift;
  87     my $value = shift;
  88     my $borrowernumber = @_ ? shift : undef;
  89
  90     my $attr_type = C4::Members::AttributeTypes->fetch($code);
  91
  92     return 0 unless defined $attr_type;
  93     return 1 unless $attr_type->unique_id();
  94
  95     my $dbh = C4::Context->dbh;
  96     my $sth;
  97     if (defined($borrowernumber)) {
  98         $sth = $dbh->prepare("SELECT COUNT(*)
  99                               FROM borrower_attributes
 100                               WHERE code = ?
 101                               AND attribute = ?
 102                               AND borrowernumber <> ?");
 103         $sth->execute($code, $value, $borrowernumber);
 104     } else {
 105         $sth = $dbh->prepare("SELECT COUNT(*)
 106                               FROM borrower_attributes
 107                               WHERE code = ?
 108                               AND attribute = ?");
 109         $sth->execute($code, $value);
 110     }
 111     my ($count) = $sth->fetchrow_array;
 112     return ($count == 0);
 113 }
 114
 115 =head2 SetBorrowerAttributes
 116
 117   SetBorrowerAttributes($borrowernumber, [ { code => 'CODE', value => 'value' }, ... ] );
 118
 119 Set patron attributes for the patron identified by C<$borrowernumber>,
 120 replacing any that existed previously.
 121
 122 =cut
 123
 124 sub SetBorrowerAttributes {
 125     my $borrowernumber = shift;
 126     my $attr_list = shift;
 127     my $no_branch_limit = shift // 0;
 128
 129     my $dbh = C4::Context->dbh;
 130
 131     my $attributes = Koha::Patrons->find($borrowernumber)->get_extended_attributes;
 132
 133     unless ( $no_branch_limit ) {
 134         $attributes = $attributes->filter_by_branch_limitations;
 135     }
 136     $attributes->delete;
 137
 138     my $sth = $dbh->prepare("INSERT INTO borrower_attributes (borrowernumber, code, attribute)
 139                              VALUES (?, ?, ?)");
 140     foreach my $attr (@$attr_list) {
 141         $sth->execute($borrowernumber, $attr->{code}, $attr->{value});
 142         if ($sth->err) {
 143             warn sprintf('Database returned the following error: %s', $sth->errstr);
 144             return; # bail immediately on errors
 145         }
 146     }
 147     return 1; # borrower attributes successfully set
 148 }
 149
 150 =head2 UpdateBorrowerAttribute
 151
 152   UpdateBorrowerAttribute($borrowernumber, $attribute );
 153
 154 Update a borrower attribute C<$attribute> for the patron identified by C<$borrowernumber>,
 155
 156 =cut
 157
 158 sub UpdateBorrowerAttribute {
 159     my ( $borrowernumber, $attribute ) = @_;
 160
 161     Koha::Patrons->find($borrowernumber)->get_extended_attributes->search({ 'me.code' => $attribute->{code} })->filter_by_branch_limitations->delete;
 162
 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 );
 167
 168     $sth->execute( @params );
 169 }
 170
 171
 172 =head2 extended_attributes_code_value_arrayref
 173
 174    my $patron_attributes = "homeroom:1150605,grade:01,extradata:foobar";
 175    my $aref = extended_attributes_code_value_arrayref($patron_attributes);
 176
 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' } ... ]
 180
 181 Caches Text::CSV parser object for efficiency.
 182
 183 =cut
 184
 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)
 191     return [
 192         sort {&_sort_by_code($a,$b)}
 193         map { map { my @arr = split /:/, $_, 2; { code => $arr[0], value => $arr[1] } } $_ }
 194         @list
 195     ];
 196     # nested map because of split
 197 }
 198
 199 =head2 extended_attributes_merge
 200
 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);
 204
 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");
 207
 208 Takes three arguments.  The first two are references to array of hashrefs, each like:
 209  [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
 210
 211 The third option specifies whether repeatable codes are clobbered or collected.  True for non-clobber.
 212
 213 Returns one reference to (merged) array of hashref.
 214
 215 Caches results of C4::Members::AttributeTypes::GetAttributeTypes_hashref(1) for efficiency.
 216
 217 =cut
 218
 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);
 224     my @merged = @$old;
 225     foreach my $att (@$new) {
 226         unless ($att->{code}) {
 227             warn "Cannot merge element: no 'code' defined";
 228             next;
 229         }
 230         unless ($AttributeTypes->{$att->{code}}) {
 231             warn "Cannot merge element: unrecognized code = '$att->{code}'";
 232             next;
 233         }
 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
 236         }
 237         push @merged, $att;
 238     }
 239     return [( sort {&_sort_by_code($a,$b)} @merged )];
 240 }
 241
 242 sub _sort_by_code {
 243     my ($x, $y) = @_;
 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};
 247 }
 248
 249 =head1 AUTHOR
 250
 251 Koha Development Team <http://koha-community.org/>
 252
 253 Galen Charlton <galen.charlton@liblime.com>
 254
 255 =cut
 256
 257 1;