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(
  33                     extended_attributes_code_value_arrayref extended_attributes_merge
  34                     SearchIdMatchingAttribute);
  35     %EXPORT_TAGS = ( all => \@EXPORT_OK );
  36 }
  37
  38 =head1 NAME
  39
  40 C4::Members::Attributes - manage extend patron attributes
  41
  42 =head1 SYNOPSIS
  43
  44   use C4::Members::Attributes;
  45
  46 =head1 FUNCTIONS
  47
  48 =head2 SearchIdMatchingAttribute
  49
  50   my $matching_borrowernumbers = C4::Members::Attributes::SearchIdMatchingAttribute($filter);
  51
  52 =cut
  53
  54 sub SearchIdMatchingAttribute{
  55     my $filter = shift;
  56     $filter = [$filter] unless ref $filter;
  57
  58     my $dbh   = C4::Context->dbh();
  59     my $query = qq{
  60 SELECT DISTINCT borrowernumber
  61 FROM borrower_attributes
  62 JOIN borrower_attribute_types USING (code)
  63 WHERE staff_searchable = 1
  64 AND (} . join (" OR ", map "attribute like ?", @$filter) .qq{)};
  65     my $sth = $dbh->prepare_cached($query);
  66     $sth->execute(map "%$_%", @$filter);
  67     return [map $_->[0], @{ $sth->fetchall_arrayref }];
  68 }
  69
  70 =head2 extended_attributes_code_value_arrayref
  71
  72    my $patron_attributes = "homeroom:1150605,grade:01,extradata:foobar";
  73    my $aref = extended_attributes_code_value_arrayref($patron_attributes);
  74
  75 Takes a comma-delimited CSV-style string argument and returns the kind of data structure that Koha::Patron->extended_attributes wants,
  76 namely a reference to array of hashrefs like:
  77  [ { code => 'CODE', attribute => 'value' }, { code => 'CODE2', attribute => 'othervalue' } ... ]
  78
  79 Caches Text::CSV parser object for efficiency.
  80
  81 =cut
  82
  83 sub extended_attributes_code_value_arrayref {
  84     my $string = shift or return;
  85     $csv or $csv = Text::CSV->new({binary => 1});  # binary needed for non-ASCII Unicode
  86     my $ok   = $csv->parse($string);  # parse field again to get subfields!
  87     my @list = $csv->fields();
  88     # TODO: error handling (check $ok)
  89     return [
  90         sort {&_sort_by_code($a,$b)}
  91         map { map { my @arr = split /:/, $_, 2; { code => $arr[0], attribute => $arr[1] } } $_ }
  92         @list
  93     ];
  94     # nested map because of split
  95 }
  96
  97 =head2 extended_attributes_merge
  98
  99   my $old_attributes = extended_attributes_code_value_arrayref("homeroom:224,grade:04,deanslist:2007,deanslist:2008,somedata:xxx");
 100   my $new_attributes = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2009,extradata:foobar");
 101   my $merged = extended_attributes_merge($patron_attributes, $new_attributes, 1);
 102
 103   # assuming deanslist is a repeatable code, value same as:
 104   # $merged = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2007,deanslist:2008,deanslist:2009,extradata:foobar,somedata:xxx");
 105
 106 Takes three arguments.  The first two are references to array of hashrefs, each like:
 107  [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
 108
 109 The third option specifies whether repeatable codes are clobbered or collected.  True for non-clobber.
 110
 111 Returns one reference to (merged) array of hashref.
 112
 113 Caches results of C4::Members::AttributeTypes::GetAttributeTypes_hashref(1) for efficiency.
 114
 115 =cut
 116
 117 sub extended_attributes_merge {
 118     my $old = shift or return;
 119     my $new = shift or return $old;
 120     my $keep = @_ ? shift : 0;
 121     $AttributeTypes or $AttributeTypes = C4::Members::AttributeTypes::GetAttributeTypes_hashref(1);
 122     my @merged = @$old;
 123     foreach my $att (@$new) {
 124         unless ($att->{code}) {
 125             warn "Cannot merge element: no 'code' defined";
 126             next;
 127         }
 128         unless ($AttributeTypes->{$att->{code}}) {
 129             warn "Cannot merge element: unrecognized code = '$att->{code}'";
 130             next;
 131         }
 132         unless ($AttributeTypes->{$att->{code}}->{repeatable} and $keep) {
 133             @merged = grep {$att->{code} ne $_->{code}} @merged;    # filter out any existing attributes of the same code
 134         }
 135         push @merged, $att;
 136     }
 137     return [( sort {&_sort_by_code($a,$b)} @merged )];
 138 }
 139
 140 sub _sort_by_code {
 141     my ($x, $y) = @_;
 142     defined ($x->{code}) or return -1;
 143     defined ($y->{code}) or return 1;
 144     return $x->{code} cmp $y->{code} || $x->{value} cmp $y->{value};
 145 }
 146
 147 =head1 AUTHOR
 148
 149 Koha Development Team <http://koha-community.org/>
 150
 151 Galen Charlton <galen.charlton@liblime.com>
 152
 153 =cut
 154
 155 1;