Koha/C4/OAI/Sets.pm
Jonathan Druart 82716a0172
Bug 23084: Replace grep {^$var$} with grep {$_ eq $var}
We certainly faced 3 similar bugs due to this syntax: bug 23006, bug
22941 and bug 17526.

To prevent other issues related to this syntax this patch suggests to
replace them all in one go.

Test plan:
Confirm that the 2 syntaxes are similar
Eyeball the patch and confirm that there is no typo!

Signed-off-by: Bernardo Gonzalez Kriegel <bgkriegel@gmail.com>
Signed-off-by: Katrin Fischer <katrin.fischer.83@web.de>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>
2020-02-17 10:44:45 +00:00

653 lines
16 KiB
Perl

package C4::OAI::Sets;
# Copyright 2011 BibLibre
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY 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, see <http://www.gnu.org/licenses>.
=head1 NAME
C4::OAI::Sets - OAI Sets management functions
=head1 DESCRIPTION
C4::OAI::Sets contains functions for managing storage and editing of OAI Sets.
OAI Set description can be found L<here|http://www.openarchives.org/OAI/openarchivesprotocol.html#Set>
=cut
use Modern::Perl;
use C4::Context;
use vars qw(@ISA @EXPORT);
BEGIN {
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
&GetOAISets &GetOAISet &GetOAISetBySpec &ModOAISet &DelOAISet &AddOAISet
&GetOAISetsMappings &GetOAISetMappings &ModOAISetMappings
&GetOAISetsBiblio &ModOAISetsBiblios &AddOAISetsBiblios
&CalcOAISetsBiblio &UpdateOAISetsBiblio &DelOAISetsBiblio
);
}
=head1 FUNCTIONS
=head2 GetOAISets
$oai_sets = GetOAISets;
GetOAISets return a array reference of hash references describing the sets.
The hash references looks like this:
{
'name' => 'set name',
'spec' => 'set spec',
'descriptions' => [
'description 1',
'description 2',
...
]
}
=cut
sub GetOAISets {
my $dbh = C4::Context->dbh;
my $query = qq{
SELECT * FROM oai_sets
};
my $sth = $dbh->prepare($query);
$sth->execute;
my $results = $sth->fetchall_arrayref({});
$query = qq{
SELECT description
FROM oai_sets_descriptions
WHERE set_id = ?
};
$sth = $dbh->prepare($query);
foreach my $set (@$results) {
$sth->execute($set->{'id'});
my $desc = $sth->fetchall_arrayref({});
foreach (@$desc) {
push @{$set->{'descriptions'}}, $_->{'description'};
}
}
return $results;
}
=head2 GetOAISet
$set = GetOAISet($set_id);
GetOAISet returns a hash reference describing the set with the given set_id.
See GetOAISets to see what the hash looks like.
=cut
sub GetOAISet {
my ($set_id) = @_;
return unless $set_id;
my $dbh = C4::Context->dbh;
my $query = qq{
SELECT *
FROM oai_sets
WHERE id = ?
};
my $sth = $dbh->prepare($query);
$sth->execute($set_id);
my $set = $sth->fetchrow_hashref;
$query = qq{
SELECT description
FROM oai_sets_descriptions
WHERE set_id = ?
};
$sth = $dbh->prepare($query);
$sth->execute($set->{'id'});
my $desc = $sth->fetchall_arrayref({});
foreach (@$desc) {
push @{$set->{'descriptions'}}, $_->{'description'};
}
return $set;
}
=head2 GetOAISetBySpec
my $set = GetOAISetBySpec($setSpec);
Returns a hash describing the set whose spec is $setSpec
=cut
sub GetOAISetBySpec {
my $setSpec = shift;
return unless defined $setSpec;
my $dbh = C4::Context->dbh;
my $query = qq{
SELECT *
FROM oai_sets
WHERE spec = ?
LIMIT 1
};
my $sth = $dbh->prepare($query);
$sth->execute($setSpec);
return $sth->fetchrow_hashref;
}
=head2 ModOAISet
my $set = {
'id' => $set_id, # mandatory
'spec' => $spec, # mandatory
'name' => $name, # mandatory
'descriptions => \@descriptions, # optional, [] to remove descriptions
};
ModOAISet($set);
ModOAISet modify a set in the database.
=cut
sub ModOAISet {
my ($set) = @_;
return unless($set && $set->{'spec'} && $set->{'name'});
if(!defined $set->{'id'}) {
warn "Set ID not defined, can't modify the set";
return;
}
my $dbh = C4::Context->dbh;
my $query = qq{
UPDATE oai_sets
SET spec = ?,
name = ?
WHERE id = ?
};
my $sth = $dbh->prepare($query);
$sth->execute($set->{'spec'}, $set->{'name'}, $set->{'id'});
if($set->{'descriptions'}) {
$query = qq{
DELETE FROM oai_sets_descriptions
WHERE set_id = ?
};
$sth = $dbh->prepare($query);
$sth->execute($set->{'id'});
if(scalar @{$set->{'descriptions'}} > 0) {
$query = qq{
INSERT INTO oai_sets_descriptions (set_id, description)
VALUES (?,?)
};
$sth = $dbh->prepare($query);
foreach (@{ $set->{'descriptions'} }) {
$sth->execute($set->{'id'}, $_) if $_;
}
}
}
}
=head2 DelOAISet
DelOAISet($set_id);
DelOAISet remove the set with the given set_id
=cut
sub DelOAISet {
my ($set_id) = @_;
return unless $set_id;
my $dbh = C4::Context->dbh;
my $query = qq{
DELETE oai_sets, oai_sets_descriptions, oai_sets_mappings
FROM oai_sets
LEFT JOIN oai_sets_descriptions ON oai_sets_descriptions.set_id = oai_sets.id
LEFT JOIN oai_sets_mappings ON oai_sets_mappings.set_id = oai_sets.id
WHERE oai_sets.id = ?
};
my $sth = $dbh->prepare($query);
$sth->execute($set_id);
}
=head2 AddOAISet
my $set = {
'id' => $set_id, # mandatory
'spec' => $spec, # mandatory
'name' => $name, # mandatory
'descriptions => \@descriptions, # optional
};
my $set_id = AddOAISet($set);
AddOAISet adds a new set and returns its id, or undef if something went wrong.
=cut
sub AddOAISet {
my ($set) = @_;
return unless($set && $set->{'spec'} && $set->{'name'});
my $set_id;
my $dbh = C4::Context->dbh;
my $query = qq{
INSERT INTO oai_sets (spec, name)
VALUES (?,?)
};
my $sth = $dbh->prepare($query);
if( $sth->execute($set->{'spec'}, $set->{'name'}) ) {
$set_id = $dbh->last_insert_id(undef, undef, 'oai_sets', undef);
if($set->{'descriptions'}) {
$query = qq{
INSERT INTO oai_sets_descriptions (set_id, description)
VALUES (?,?)
};
$sth = $dbh->prepare($query);
foreach( @{ $set->{'descriptions'} } ) {
$sth->execute($set_id, $_) if $_;
}
}
} else {
warn "AddOAISet failed";
}
return $set_id;
}
=head2 GetOAISetsMappings
my $mappings = GetOAISetsMappings;
GetOAISetsMappings returns mappings for all OAI Sets.
Mappings define how biblios are categorized in sets.
A mapping is defined by six properties:
{
marcfield => 'XXX', # the MARC field to check
marcsubfield => 'Y', # the MARC subfield to check
operator => 'A', # the operator 'equal' or 'notequal'; 'equal' if ''
marcvalue => 'zzzz', # the value to check
rule_operator => 'and|or|undef', # the operator between the rules
rule_order => 'n' # the order of the rule for the mapping
}
If defined in a set mapping, a biblio which have at least one 'Y' subfield of
one 'XXX' field equal to 'zzzz' will belong to this set.
GetOAISetsMappings returns a hashref of arrayrefs of hashrefs.
The first hashref keys are the sets IDs, so it looks like this:
$mappings = {
'1' => [
{
marcfield => 'XXX',
marcsubfield => 'Y',
operator => 'A',
marcvalue => 'zzzz',
rule_operator => 'and|or|undef',
rule_order => 'n'
},
{
...
},
...
],
'2' => [...],
...
};
=cut
sub GetOAISetsMappings {
my $dbh = C4::Context->dbh;
my $query = qq{
SELECT * FROM oai_sets_mappings ORDER BY set_id, rule_order
};
my $sth = $dbh->prepare($query);
$sth->execute;
my $mappings = {};
while(my $result = $sth->fetchrow_hashref) {
push @{ $mappings->{$result->{'set_id'}} }, {
marcfield => $result->{'marcfield'},
marcsubfield => $result->{'marcsubfield'},
operator => $result->{'operator'},
marcvalue => $result->{'marcvalue'},
rule_operator => $result->{'rule_operator'},
rule_order => $result->{'rule_order'}
};
}
return $mappings;
}
=head2 GetOAISetMappings
my $set_mappings = GetOAISetMappings($set_id);
Return mappings for the set with given set_id. It's an arrayref of hashrefs
=cut
sub GetOAISetMappings {
my ($set_id) = @_;
return unless $set_id;
my $dbh = C4::Context->dbh;
my $query = qq{
SELECT *
FROM oai_sets_mappings
WHERE set_id = ?
ORDER BY rule_order
};
my $sth = $dbh->prepare($query);
$sth->execute($set_id);
my @mappings;
while(my $result = $sth->fetchrow_hashref) {
push @mappings, {
marcfield => $result->{'marcfield'},
marcsubfield => $result->{'marcsubfield'},
operator => $result->{'operator'},
marcvalue => $result->{'marcvalue'},
rule_operator => $result->{'rule_operator'},
rule_order => $result->{'rule_order'}
};
}
return \@mappings;
}
=head2 ModOAISetMappings {
my $mappings = [
{
marcfield => 'XXX',
marcsubfield => 'Y',
operator => 'A',
marcvalue => 'zzzz'
},
...
];
ModOAISetMappings($set_id, $mappings);
ModOAISetMappings modifies mappings of a given set.
=cut
sub ModOAISetMappings {
my ($set_id, $mappings) = @_;
return unless $set_id;
my $dbh = C4::Context->dbh;
my $query = qq{
DELETE FROM oai_sets_mappings
WHERE set_id = ?
};
my $sth = $dbh->prepare($query);
$sth->execute($set_id);
if(scalar @$mappings > 0) {
$query = qq{
INSERT INTO oai_sets_mappings (set_id, marcfield, marcsubfield, operator, marcvalue, rule_operator, rule_order)
VALUES (?,?,?,?,?,?,?)
};
$sth = $dbh->prepare($query);
foreach (@$mappings) {
$sth->execute($set_id, $_->{'marcfield'}, $_->{'marcsubfield'}, $_->{'operator'}, $_->{'marcvalue'}, $_->{'rule_operator'}, $_->{'rule_order'});
}
}
}
=head2 GetOAISetsBiblio
$oai_sets = GetOAISetsBiblio($biblionumber);
Return the OAI sets where biblio appears.
Return value is an arrayref of hashref where each element of the array is a set.
Keys of hash are id, spec and name
=cut
sub GetOAISetsBiblio {
my ($biblionumber) = @_;
my $dbh = C4::Context->dbh;
my $query = qq{
SELECT oai_sets.*
FROM oai_sets
LEFT JOIN oai_sets_biblios ON oai_sets_biblios.set_id = oai_sets.id
WHERE biblionumber = ?
};
my $sth = $dbh->prepare($query);
$sth->execute($biblionumber);
return $sth->fetchall_arrayref({});
}
=head2 DelOAISetsBiblio
DelOAISetsBiblio($biblionumber);
Remove a biblio from all sets
=cut
sub DelOAISetsBiblio {
my ($biblionumber) = @_;
return unless $biblionumber;
my $dbh = C4::Context->dbh;
my $query = qq{
DELETE FROM oai_sets_biblios
WHERE biblionumber = ?
};
my $sth = $dbh->prepare($query);
return $sth->execute($biblionumber);
}
=head2 CalcOAISetsBiblio
my @sets = CalcOAISetsBiblio($record, $oai_sets_mappings);
Return a list of set ids the record belongs to. $record must be a MARC::Record
and $oai_sets_mappings (optional) must be a hashref returned by
GetOAISetsMappings
=cut
sub CalcOAISetsBiblio {
my ($record, $oai_sets_mappings) = @_;
return unless $record;
$oai_sets_mappings ||= GetOAISetsMappings;
my @biblio_sets;
foreach my $set_id (keys %$oai_sets_mappings) {
my $rules = [];
foreach my $mapping (@{ $oai_sets_mappings->{$set_id} }) {
next if not $mapping;
my $rule_operator = $mapping->{'rule_operator'};
my $result = _evalRule($record, $mapping);
# First rule or 'or' rule is always pushed
if (!@$rules || $rule_operator eq 'or') {
push @$rules, [$result];
next;
}
# 'and' rule is pushed in the last 'or' rule
push @{$rules->[-1]}, $result;
}
my @evaluated_and;
foreach my $ruleset (@$rules) {
if (0 < grep /0/, @{$ruleset}) {
push @evaluated_and, 0;
} else {
push @evaluated_and, 1;
}
}
if (grep /1/, @evaluated_and) {
push @biblio_sets, $set_id;
}
}
return @biblio_sets;
}
# Does the record match a given mapping rule?
sub _evalRule {
my $record = shift;
my $mapping = shift;
my $field = $mapping->{'marcfield'};
my $subfield = $mapping->{'marcsubfield'};
my $operator = $mapping->{'operator'};
my $value = $mapping->{'marcvalue'};
my @all_subfield_values;
# Get all the fields with the given tag
my @fields = $record->field($field);
# Iterate over all the fields
foreach my $field ( @fields ) {
# Get the values from all the subfields with the given subfield code
if ( my @subfield_values = $field->subfield($subfield) ) {
push @all_subfield_values, @subfield_values;
}
}
if ($operator eq 'notequal') {
if(0 == grep { $_ eq $value } @all_subfield_values) {
return 1;
}
}
else {
if(0 < grep { $_ eq $value } @all_subfield_values) {
return 1;
}
}
return 0;
}
=head2 ModOAISetsBiblios
my $oai_sets_biblios = {
'1' => [1, 3, 4], # key is the set_id, and value is an array ref of biblionumbers
'2' => [],
...
};
ModOAISetsBiblios($oai_sets_biblios);
ModOAISetsBiblios deletes all records from oai_sets_biblios table and calls AddOAISetsBiblios.
This table is then used in opac/oai.pl.
=cut
sub ModOAISetsBiblios {
my $oai_sets_biblios = shift;
return unless ref($oai_sets_biblios) eq "HASH";
my $dbh = C4::Context->dbh;
my $query = qq{
DELETE FROM oai_sets_biblios
};
my $sth = $dbh->prepare($query);
$sth->execute;
AddOAISetsBiblios($oai_sets_biblios);
}
=head2 UpdateOAISetsBiblio
UpdateOAISetsBiblio($biblionumber, $record);
Update OAI sets for one biblio. The two parameters are mandatory.
$record is a MARC::Record.
=cut
sub UpdateOAISetsBiblio {
my ($biblionumber, $record) = @_;
return unless($biblionumber and $record);
my $sets_biblios;
my @sets = CalcOAISetsBiblio($record);
foreach (@sets) {
push @{ $sets_biblios->{$_} }, $biblionumber;
}
DelOAISetsBiblio($biblionumber);
AddOAISetsBiblios($sets_biblios);
}
=head2 AddOAISetsBiblios
my $oai_sets_biblios = {
'1' => [1, 3, 4], # key is the set_id, and value is an array ref of biblionumbers
'2' => [],
...
};
ModOAISetsBiblios($oai_sets_biblios);
AddOAISetsBiblios insert given infos in oai_sets_biblios table.
This table is then used in opac/oai.pl.
=cut
sub AddOAISetsBiblios {
my $oai_sets_biblios = shift;
return unless ref($oai_sets_biblios) eq "HASH";
my $dbh = C4::Context->dbh;
my $query = qq{
INSERT INTO oai_sets_biblios (set_id, biblionumber)
VALUES (?,?)
};
my $sth = $dbh->prepare($query);
foreach my $set_id (keys %$oai_sets_biblios) {
foreach my $biblionumber (@{$oai_sets_biblios->{$set_id}}) {
$sth->execute($set_id, $biblionumber);
}
}
}
1;