From 142aa80f61e607cf0c4ff5f6fcae9d966885e350 Mon Sep 17 00:00:00 2001 From: Matthias Meusburger Date: Wed, 18 Feb 2015 14:46:37 +0100 Subject: [PATCH] Bug 14560: Rameau authorities The purpose of this patch is to give a clean support for merging composed Rameau authorities. Rameau authorities are composed authorities that look like this: 606 _311954119 _aGuerillas _311943195 _yBolivie _311976947 _z1945-1970 If processed correctly, the result after merge should be: 606 _311954119 _926311 _aGuerillas _311943195 _926312 _yBolivie _311976947 _926313 _z1945-1970 _2rameau Test plan --------- Make a call to the merge function like this: merge($mergefrom,$MARCfrom,$mergeto,$MARCto, $biblionumber); With $mergefrom and $mergeto being the same koha authid, $MARCfrom and $MARCto being the result of GetAuthority($authid), and $biblionumber the biblio you want to merge the authority in. --- C4/AuthoritiesMarc.pm | 69 +++++---- C4/AuthoritiesRameau.pm | 169 +++++++++++++++++++++ .../atomicupdate/Bug14560-Rameau_authorities.sql | 1 + .../en/modules/admin/preferences/authorities.pref | 11 ++ t/db_dependent/AuthoritiesRameau.t | 98 ++++++++++++ 5 files changed, 321 insertions(+), 27 deletions(-) create mode 100644 C4/AuthoritiesRameau.pm create mode 100644 installer/data/mysql/atomicupdate/Bug14560-Rameau_authorities.sql create mode 100755 t/db_dependent/AuthoritiesRameau.t diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index e14c85f..17cf4bb 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -24,6 +24,7 @@ use C4::Biblio; use C4::Search; use C4::AuthoritiesMarc::MARC21; use C4::AuthoritiesMarc::UNIMARC; +use C4::AuthoritiesRameau; use C4::Charset; use C4::Log; use Koha::MetadataRecord::Authority; @@ -1407,7 +1408,7 @@ Then we should add some new parameter : bibliotargettag, authtargettag =cut sub merge { - my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_; + my ($mergefrom,$MARCfrom,$mergeto,$MARCto, $biblionumber) = @_; my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0); my $dbh=C4::Context->dbh; my $authfrom = Koha::Authorities->find($mergefrom); @@ -1427,34 +1428,39 @@ sub merge { @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from); my @reccache; - # search all biblio tags using this authority. - #Getting marcbiblios impacted by the change. - #zebra connection - my $oConnection=C4::Context->Zconn("biblioserver",0); - # We used to use XML syntax here, but that no longer works. - # Thankfully, we don't need it. - my $query; - $query= "an=".$mergefrom; - my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); - my $count = 0; - if ($oResult) { - $count=$oResult->size(); - } - my $z=0; - while ( $z<$count ) { - my $marcrecordzebra = C4::Search::new_record_from_zebra( - 'biblioserver', - $oResult->record($z)->raw() - ); - my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' ); - my $i = ($biblionumbertagfield < 10) - ? $marcrecordzebra->field( $biblionumbertagfield )->data - : $marcrecordzebra->subfield( $biblionumbertagfield, $biblionumbertagsubfield ); - my $marcrecorddb = GetMarcBiblio($i); + if ($biblionumber) { + my $marcrecorddb = GetMarcBiblio($biblionumber); push @reccache, $marcrecorddb; - $z++; + } else { + # search all biblio tags using this authority. + #Getting marcbiblios impacted by the change. + #zebra connection + my $oConnection=C4::Context->Zconn("biblioserver",0); + # We used to use XML syntax here, but that no longer works. + # Thankfully, we don't need it. + my $query; + $query= "an=".$mergefrom; + my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); + my $count = 0; + if ($oResult) { + $count=$oResult->size(); + } + my $z=0; + while ( $z<$count ) { + my $marcrecordzebra = C4::Search::new_record_from_zebra( + 'biblioserver', + $oResult->record($z)->raw() + ); + my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' ); + my $i = ($biblionumbertagfield < 10) + ? $marcrecordzebra->field( $biblionumbertagfield )->data + : $marcrecordzebra->subfield( $biblionumbertagfield, $biblionumbertagsubfield ); + my $marcrecorddb = GetMarcBiblio($i); + push @reccache, $marcrecorddb; + $z++; + } + $oResult->destroy(); } - $oResult->destroy(); #warn scalar(@reccache)." biblios to update"; # Get All candidate Tags for the change # (This will reduce the search scope in marc records). @@ -1478,6 +1484,11 @@ sub merge { foreach my $tagfield (@tags_using_authtype){ # warn "tagfield : $tagfield "; foreach my $field ($marcrecord->field($tagfield)){ + + # If Rameau authorities are enabled and there are multiple $9's in the field, skip it. + my @internallinks = $field->subfield("9"); + next if (C4::Context->preference('useRameau') && scalar(@internallinks) > 1); + # biblio is linked to authority with $9 subfield containing authid my $auth_number=$field->subfield("9"); my $tag=$field->tag(); @@ -1512,6 +1523,10 @@ sub merge { warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted; next; } + if (C4::Context->preference('useRameau')) { + my $rameauUpdate = rameauProcessing($marcrecord); + $update = 1 if ($rameauUpdate == 1); + } if ($update==1){ &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ; $counteditedbiblio++; diff --git a/C4/AuthoritiesRameau.pm b/C4/AuthoritiesRameau.pm new file mode 100644 index 0000000..66c8272 --- /dev/null +++ b/C4/AuthoritiesRameau.pm @@ -0,0 +1,169 @@ +package C4::AuthoritiesRameau; +# Copyright 2000-2002 Katipo Communications +# +# 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 2 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; +use C4::Context; +use MARC::Record; +use MARC::Field; +use C4::Biblio; +use C4::Search; +use C4::AuthoritiesMarc::MARC21; +use C4::AuthoritiesMarc::UNIMARC; +use C4::Charset; +use C4::Log; +use Koha::Authority; + +use vars qw($VERSION @ISA @EXPORT); + +BEGIN { + + require Exporter; + @ISA = qw(Exporter); + @EXPORT = qw( + &rameauProcessing + ); +} + + +# Is this a Rameau field? +sub isRameau { + my $field = shift @_; + + # Is there a $2 with rameau value? + foreach my $subfield ($field->subfield('2')) { + return 1 if lc $subfield eq lc 'rameau'; + } + + # Or + # Are there multiple $a? + my $acount = 0; + foreach my $subfield ($field->subfield('a')) { + $acount++; + } + return 1 if ($acount >= 2); + + # Or + # Is there one of these subfields? ($jxyz) + my @rameauSubfields = qw/j x y z/; + foreach my $rameauSubfield (@rameauSubfields) { + return 1 if ($field->subfield($rameauSubfield)); + } + return 0; +} + +# Add $2rameau in a field if it is not already here. +sub addRameau { + my $field = shift @_; + foreach my $subfield ($field->subfield('2')) { + return if lc $subfield eq lc 'rameau'; + } + $field->add_subfields('2' => 'rameau'); +} + +# Find an auth in koha by its bnfid. +sub _findLocalAuth { + my $id = shift @_; + my $ctn = C4::Context->Zconn("authorityserver"); + my $rs; + eval { + $rs = $ctn->search(new ZOOM::Query::CCL2RPN(C4::Context->preference('rameauBnfIdIndex') . '=' . $id, $ctn)); + }; + if ($@) { + print "Error searching\n"; + return -1; + } + if ($rs && $rs->size() == 1) { + my $zoomauth = $rs->record(0); + my $kohaauth = new_from_usmarc MARC::Record ($zoomauth->raw()); + my $kohaauthid = $kohaauth->field('001')->data(); + $rs->destroy(); + return $kohaauthid; + + } + return -1; + +} + +# Add internal links to authorities in the rameau field. +sub addInternalLinks { + my $field = shift @_; + my $found_authid = 0; + my @newsubfields; + + foreach my $subfield ($field->subfields()) { + # Adding/updating $9 right after $3 if the auth was found + my $tag = $subfield->[0]; + my $value = $subfield->[1]; + if ($found_authid) { + if ($subfield->[0] eq '9') { + $value = $found_authid; + } else { + push @newsubfields, '9' => $found_authid; + } + } + + # This is needed for cleaning misplaced $9 that might have been here before. + if ($found_authid or $subfield->[0] ne '9') { + push @newsubfields, $tag => $value; + } + + $found_authid = 0; + + # Looking for an auth + if ($subfield->[0] eq 3) { + if (my $kohaauthid = _findLocalAuth($subfield->[1])) { + if ($kohaauthid != -1) { + $found_authid = $kohaauthid; + print "Adding authid $kohaauthid\n"; + } + } + } + } + + my $newfield = MARC::Field->new($field->tag(), $field->indicator(1), $field->indicator(2), @newsubfields); + $field->replace_with($newfield); + return $field; +} + +# Main function. Start rameau processing for a record. +sub rameauProcessing { + my $marcrecord = shift @_; + my $update = 0; + + my @rameauFields = (600, 601, 602, 606, 607); + foreach my $tag (@rameauFields) { + foreach my $field ($marcrecord->field($tag)) { + if (isRameau($field)) { + if ($marcrecord->field('001')) { + print "Merging Rameau for biblionumber " . $marcrecord->field('001')->data() . " field $tag\n"; + } else { + print "Merging Rameau for an unknown biblionumber field $tag\n"; + } + addRameau($field); + addInternalLinks($field); + $update = 1; + } + } + } + return $update; +} + +END { } # module clean-up code here (global destructor) + +1; diff --git a/installer/data/mysql/atomicupdate/Bug14560-Rameau_authorities.sql b/installer/data/mysql/atomicupdate/Bug14560-Rameau_authorities.sql new file mode 100644 index 0000000..43de1c8 --- /dev/null +++ b/installer/data/mysql/atomicupdate/Bug14560-Rameau_authorities.sql @@ -0,0 +1 @@ +INSERT INTO `systempreferences` (`variable`, `value`, `options`, `explanation`, `type`) VALUES ('useRameau', '0', '', 'use Rameau authorities processing', 'YesNo'), ('rameauBnfIdIndex', 'bnfid', '', 'The zebra index that contains BNF Id for Rameau processing', 'Free'); diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref index 2762411..d93b741 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref @@ -85,3 +85,14 @@ Authorities: yes: Do no: "Do not" - automatically relink headings that have previously been linked when saving records in the cataloging module. + - + - pref: useRameau + default: no + choices: + yes: Do + no: "Do not" + - use Rameau authorities processing. + - + - The zebra index that contains BNF Id's for Rameau processing + - pref: rameauBnfIdIndex + default: bnfid diff --git a/t/db_dependent/AuthoritiesRameau.t b/t/db_dependent/AuthoritiesRameau.t new file mode 100755 index 0000000..336164e --- /dev/null +++ b/t/db_dependent/AuthoritiesRameau.t @@ -0,0 +1,98 @@ +#!/usr/bin/perl + +use Modern::Perl; + +use C4::Context; + +use Test::More tests => 10; +use Test::MockModule; +use MARC::Record; +use C4::Biblio; +use C4::Items; +use C4::AuthoritiesMarc; +use C4::AuthoritiesRameau; +use Data::Dumper; + +BEGIN { + use FindBin; + use lib $FindBin::Bin; +} + +my $dbh = C4::Context->dbh; + +# Start transaction +$dbh->{AutoCommit} = 0; +$dbh->{RaiseError} = 1; + +# isRameau +my $noRameauField = MARC::Field->new('600', ' ', ' ', a => 'Whatever'); +ok( C4::AuthoritiesRameau::isRameau($noRameauField) eq 0, "Verify that the field is not a Rameau field." ); + +my $rameauField1 = MARC::Field->new('600', ' ', ' ', a => 'One $a', 'b' => 'Dontcare', 'a' => 'Another $a'); +ok( C4::AuthoritiesRameau::isRameau($rameauField1) eq 1, "Verify that the field is a Rameau field (multiple \$a's)." ); + +my $rameauField2 = MARC::Field->new('600', ' ', ' ', 2 => 'rameau'); +ok( C4::AuthoritiesRameau::isRameau($rameauField2) eq 1, "Verify that the field is a Rameau field (\$2 contains rameau)." ); + +my $rameauField3 = MARC::Field->new('600', ' ', ' ', 2 => 'Rameau'); +ok( C4::AuthoritiesRameau::isRameau($rameauField3) eq 1, "Verify that the field is a Rameau field (\$2 contains rameau, case-insensitive)." ); + +my $rameauField4 = MARC::Field->new('600', ' ', ' ', y => 'value'); +ok( C4::AuthoritiesRameau::isRameau($rameauField4) eq 1, "Verify that the field is a Rameau field (contains at least one of \$jxyz)." ); + +# Update +my $rameauRecord = MARC::Record->new(); +$rameauRecord->append_fields( + MARC::Field->new('600', ' ', ' ', y => 'value') +); + +is( C4::AuthoritiesRameau::rameauProcessing($rameauRecord), 1, "Verify that rameauProcessing returns that an update is needed." ); + +my $noRameauRecord = MARC::Record->new(); +$noRameauRecord->append_fields( + MARC::Field->new('600', ' ', ' ', a => 'Whatever') +); + +is( C4::AuthoritiesRameau::rameauProcessing($noRameauRecord), 0, "Verify that rameauProcessing returns that no update is needed." ); + + +# addInternalLinks +my $rameauFieldLinks = MARC::Field->new('600', ' ', ' ', '3' => '1', + 'a' => "toto", + '9' => 'misplaced$9', + '3' => '1231', + '9' => 'needsupdate', + 'x' => "titi", + '9' => 'doublemisplaced', + '9' => 'doublemisplaced', + 'y' => "tata", + '3' => '1', + 'k' => 'toto', + ); + +my $c4_authoritiesrameau_mock = new Test::MockModule('C4::AuthoritiesRameau'); +$c4_authoritiesrameau_mock->mock('_findLocalAuth', sub { + return $_[0] + 1; +}); + +# [ 3 => 'value, 9 => 'value', 'a' => 'value' ] => [3, 9, 'a'] +sub extract_subtags { + my @subfields = @_; + + my @return; + foreach my $subfield (@subfields) { + push @return, $subfield->[0]; + } + return @return; +} + +my @subfields = $rameauFieldLinks->subfields(); +my @subtags = extract_subtags(@subfields); +is_deeply( [@subtags], [3, 'a', 9, 3, 9, 'x', 9, 9, 'y', 3, 'k'], "Test extract_subtags test function" ); + +my $processedRameauField = C4::AuthoritiesRameau::addInternalLinks($rameauFieldLinks); +my @processedRameauSubfields = $processedRameauField->subfields(); + +is_deeply( [extract_subtags(@processedRameauSubfields)], [3, 9, 'a', 3, 9, 'x', 'y', 3, 9, 'k'], "Verify that subfield order is correct" ); + +is_deeply( [$processedRameauField->subfield('9')], ["2", "1232", "2"], "Verify that internal links are added" ); -- 2.1.4