X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FMembers%2FAttributes.pm;h=33d2407602c317d7abc1943d0dced415cb2241e6;hb=f446b3d03d574e145bbc8f3e241ce2711c935643;hp=e01232024003fb2abfd2a1a90d79ba8cbcba1181;hpb=d75cc041f6be14314dd6233671bce9d0861894ad;p=koha_gimpoz diff --git a/C4/Members/Attributes.pm b/C4/Members/Attributes.pm index e012320240..33d2407602 100644 --- a/C4/Members/Attributes.pm +++ b/C4/Members/Attributes.pm @@ -13,42 +13,44 @@ package C4::Members::Attributes; # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR # A PARTICULAR PURPOSE. See the GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use strict; +use warnings; + +use Text::CSV; # Don't be tempted to use Text::CSV::Unicode -- even in binary mode it fails. use C4::Context; use C4::Members::AttributeTypes; -use vars qw($VERSION); +use vars qw($VERSION @ISA @EXPORT_OK @EXPORT %EXPORT_TAGS); +our ($csv, $AttributeTypes); BEGIN { # set the version for version checking - $VERSION = 3.00; + $VERSION = 3.01; + @ISA = qw(Exporter); + @EXPORT_OK = qw(GetBorrowerAttributes GetBorrowerAttributeValue CheckUniqueness SetBorrowerAttributes + extended_attributes_code_value_arrayref extended_attributes_merge + SearchIdMatchingAttribute); + %EXPORT_TAGS = ( all => \@EXPORT_OK ); } =head1 NAME -C4::Members::Attribute - manage extend patron attributes +C4::Members::Attributes - manage extend patron attributes =head1 SYNOPSIS -=over 4 - -my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber); - -=back + use C4::Members::Attributes; + my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber); =head1 FUNCTIONS =head2 GetBorrowerAttributes -=over 4 - -my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber[, $opac_only]); - -=back + my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber[, $opac_only]); Retrieve an arrayref of extended attributes associated with the patron specified by C<$borrowernumber>. Each entry in the arrayref @@ -70,7 +72,7 @@ sub GetBorrowerAttributes { my $opac_only = @_ ? shift : 0; my $dbh = C4::Context->dbh(); - my $query = "SELECT code, description, attribute, lib, password + my $query = "SELECT code, description, attribute, lib, password, display_checkout, category_code, class FROM borrower_attributes JOIN borrower_attribute_types USING (code) LEFT JOIN authorised_values ON (category = authorised_value_category AND attribute = authorised_value) @@ -87,18 +89,79 @@ sub GetBorrowerAttributes { value => $row->{'attribute'}, value_description => $row->{'lib'}, password => $row->{'password'}, + display_checkout => $row->{'display_checkout'}, + category_code => $row->{'category_code'}, + class => $row->{'class'}, } } return \@results; } -=head2 CheckUniqueness +=head2 GetAttributes + + my $attributes = C4::Members::Attributes::GetAttributes([$opac_only]); + +Retrieve an arrayref of extended attribute codes -=over 4 +=cut + +sub GetAttributes { + my ($opac_only) = @_; + + my $dbh = C4::Context->dbh(); + my $query = "SELECT code FROM borrower_attribute_types"; + $query .= "\nWHERE opac_display = 1" if $opac_only; + $query .= "\nORDER BY code"; + return $dbh->selectcol_arrayref($query); +} + +=head2 GetBorrowerAttributeValue -my $ok = CheckUniqueness($code, $value[, $borrowernumber]); + my $value = C4::Members::Attributes::GetBorrowerAttributeValue($borrowernumber, $attribute_code); -=back +Retrieve the value of an extended attribute C<$attribute_code> associated with the +patron specified by C<$borrowernumber>. + +=cut + +sub GetBorrowerAttributeValue { + my $borrowernumber = shift; + my $code = shift; + + my $dbh = C4::Context->dbh(); + my $query = "SELECT attribute + FROM borrower_attributes + WHERE borrowernumber = ? + AND code = ?"; + my $value = $dbh->selectrow_array($query, undef, $borrowernumber, $code); + return $value; +} + +=head2 SearchIdMatchingAttribute + + my $matching_borrowernumbers = C4::Members::Attributes::SearchIdMatchingAttribute($filter); + +=cut + +sub SearchIdMatchingAttribute{ + my $filter = shift; + $filter = [$filter] unless ref $filter; + + my $dbh = C4::Context->dbh(); + my $query = qq{ +SELECT DISTINCT borrowernumber +FROM borrower_attributes +JOIN borrower_attribute_types USING (code) +WHERE staff_searchable = 1 +AND (} . join (" OR ", map "attribute like ?", @$filter) .qq{)}; + my $sth = $dbh->prepare_cached($query); + $sth->execute(map "%$_%", @$filter); + return [map $_->[0], @{ $sth->fetchall_arrayref }]; +} + +=head2 CheckUniqueness + + my $ok = CheckUniqueness($code, $value[, $borrowernumber]); Given an attribute type and value, verify if would violate a unique_id restriction if added to the patron. The @@ -137,17 +200,12 @@ sub CheckUniqueness { $sth->execute($code, $value); } my ($count) = $sth->fetchrow_array; - $sth->finish(); return ($count == 0); } =head2 SetBorrowerAttributes -=over 4 - -SetBorrowerAttributes($borrowernumber, [ { code => 'CODE', value => 'value', password => 'password' }, ... ] ); - -=back + SetBorrowerAttributes($borrowernumber, [ { code => 'CODE', value => 'value', password => 'password' }, ... ] ); Set patron attributes for the patron identified by C<$borrowernumber>, replacing any that existed previously. @@ -167,12 +225,94 @@ sub SetBorrowerAttributes { foreach my $attr (@$attr_list) { $attr->{password} = undef unless exists $attr->{password}; $sth->execute($borrowernumber, $attr->{code}, $attr->{value}, $attr->{password}); + if ($sth->err) { + warn sprintf('Database returned the following error: %s', $sth->errstr); + return; # bail immediately on errors + } + } + return 1; # borower attributes successfully set +} + +=head2 extended_attributes_code_value_arrayref + + my $patron_attributes = "homeroom:1150605,grade:01,extradata:foobar"; + my $aref = extended_attributes_code_value_arrayref($patron_attributes); + +Takes a comma-delimited CSV-style string argument and returns the kind of data structure that SetBorrowerAttributes wants, +namely a reference to array of hashrefs like: + [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ] + +Caches Text::CSV parser object for efficiency. + +=cut + +sub extended_attributes_code_value_arrayref { + my $string = shift or return; + $csv or $csv = Text::CSV->new({binary => 1}); # binary needed for non-ASCII Unicode + my $ok = $csv->parse($string); # parse field again to get subfields! + my @list = $csv->fields(); + # TODO: error handling (check $ok) + return [ + sort {&_sort_by_code($a,$b)} + map { map { my @arr = split /:/, $_, 2; { code => $arr[0], value => $arr[1] } } $_ } + @list + ]; + # nested map because of split +} + +=head2 extended_attributes_merge + + my $old_attributes = extended_attributes_code_value_arrayref("homeroom:224,grade:04,deanslist:2007,deanslist:2008,somedata:xxx"); + my $new_attributes = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2009,extradata:foobar"); + my $merged = extended_attributes_merge($patron_attributes, $new_attributes, 1); + + # assuming deanslist is a repeatable code, value same as: + # $merged = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2007,deanslist:2008,deanslist:2009,extradata:foobar,somedata:xxx"); + +Takes three arguments. The first two are references to array of hashrefs, each like: + [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ] + +The third option specifies whether repeatable codes are clobbered or collected. True for non-clobber. + +Returns one reference to (merged) array of hashref. + +Caches results of C4::Members::AttributeTypes::GetAttributeTypes_hashref(1) for efficiency. + +=cut + +sub extended_attributes_merge { + my $old = shift or return; + my $new = shift or return $old; + my $keep = @_ ? shift : 0; + $AttributeTypes or $AttributeTypes = C4::Members::AttributeTypes::GetAttributeTypes_hashref(1); + my @merged = @$old; + foreach my $att (@$new) { + unless ($att->{code}) { + warn "Cannot merge element: no 'code' defined"; + next; + } + unless ($AttributeTypes->{$att->{code}}) { + warn "Cannot merge element: unrecognized code = '$att->{code}'"; + next; + } + unless ($AttributeTypes->{$att->{code}}->{repeatable} and $keep) { + @merged = grep {$att->{code} ne $_->{code}} @merged; # filter out any existing attributes of the same code + } + push @merged, $att; } + return [( sort {&_sort_by_code($a,$b)} @merged )]; +} + +sub _sort_by_code { + my ($x, $y) = @_; + defined ($x->{code}) or return -1; + defined ($y->{code}) or return 1; + return $x->{code} cmp $y->{code} || $x->{value} cmp $y->{value}; } =head1 AUTHOR -Koha Development Team +Koha Development Team Galen Charlton