670 lines
16 KiB
Perl
670 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 <https://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 Koha::Biblio::Metadata;
|
|
|
|
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 );
|
|
|
|
$record = $record->clone;
|
|
if ( C4::Context->preference('OAI-PMH:AutoUpdateSetsEmbedItemData') ) {
|
|
$record = Koha::Biblio::Metadata->record(
|
|
{
|
|
record => $record,
|
|
embed_items => 1,
|
|
biblionumber => $biblionumber,
|
|
}
|
|
);
|
|
}
|
|
|
|
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;
|