package C4::AuthoritiesMarc;
+
# Copyright 2000-2002 Katipo Communications
+# Copyright 2018 The National Library of Finland, University of Helsinki
#
# This file is part of Koha.
#
use strict;
use warnings;
use C4::Context;
-use MARC::Record;
-use C4::Biblio;
-use C4::Search;
+use C4::Biblio qw( GetFrameworkCode GetMarcBiblio ModBiblio );
+use C4::Search qw( FindDuplicate new_record_from_zebra );
use C4::AuthoritiesMarc::MARC21;
use C4::AuthoritiesMarc::UNIMARC;
-use C4::Charset;
-use C4::Log;
+use C4::Charset qw( SetUTF8Flag );
+use C4::Log qw( logaction );
use Koha::MetadataRecord::Authority;
use Koha::Authorities;
+use Koha::Authority::MergeRequests;
use Koha::Authority::Types;
use Koha::Authority;
+use Koha::Libraries;
use Koha::SearchEngine;
+use Koha::SearchEngine::Indexer;
use Koha::SearchEngine::Search;
-use vars qw(@ISA @EXPORT);
-
+our (@ISA, @EXPORT_OK);
BEGIN {
- require Exporter;
- @ISA = qw(Exporter);
- @EXPORT = qw(
- &GetTagsLabels
- &GetAuthMARCFromKohaField
-
- &AddAuthority
- &ModAuthority
- &DelAuthority
- &GetAuthority
- &GetAuthorityXML
-
- &CountUsage
- &CountUsageChildren
- &SearchAuthorities
-
- &BuildSummary
- &BuildAuthHierarchies
- &BuildAuthHierarchy
- &GenerateHierarchy
-
- &merge
- &FindDuplicateAuthority
-
- &GuessAuthTypeCode
- &GuessAuthId
- );
+ require Exporter;
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(
+ GetTagsLabels
+ GetAuthMARCFromKohaField
+
+ AddAuthority
+ ModAuthority
+ DelAuthority
+ GetAuthority
+ GetAuthorityXML
+
+ SearchAuthorities
+
+ BuildSummary
+ BuildAuthHierarchies
+ BuildAuthHierarchy
+ GenerateHierarchy
+ GetHeaderAuthority
+ AddAuthorityTrees
+ CompareFieldWithAuthority
+
+ merge
+ FindDuplicateAuthority
+
+ GuessAuthTypeCode
+ GuessAuthId
+ compare_fields
+ );
}
$sortby="" unless $sortby;
my $query;
my $qpquery = '';
- my $QParser;
- $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser'));
my $attr = '';
# the marclist may contain "mainentry". In this case, search the tag_to_report, that depends on
# the authtypecode. Then, search on $a of this tag_to_report
# also store main entry MARC tag, to extract it at end of search
- my $mainentrytag;
##first set the authtype search and may be multiple authorities
if ($authtypecode) {
my $n=0;
if ($n>1){
while ($n>1){$query= "\@or ".$query;$n--;}
}
- if ($QParser) {
- $qpquery .= '(authtype:' . join('|| authtype:', @auths) . ')';
- }
}
my $dosearch;
elsif ( @$tags[$i] eq "thesaurus" ) {
$attr = " \@attr 1=Subject-heading-thesaurus ";
}
- else { # Assume any if no index was specified
+ elsif ( @$tags[$i] eq "all" ) {
$attr = " \@attr 1=Any ";
}
+ else { # Use the index passed in params
+ $attr = " \@attr 1=" . @$tags[$i] . " ";
+ }
} #if @$tags[$i]
else { # Assume any if no index was specified
$attr = " \@attr 1=Any ";
$q2 .= $attr;
$dosearch = 1;
++$attr_cnt;
- if ($QParser) {
- $qpquery .= " $tags->[$i]:\"$value->[$i]\"";
- }
} #if value
}
##Add how many queries generated
} elsif ($sortby eq 'AuthidDsc') {
$orderstring = '@attr 7=2 @attr 4=109 @attr 1=Local-Number 0';
}
- if ($QParser) {
- $qpquery .= ' all:all' unless $value->[0];
-
- if ( $value->[0] =~ m/^qp=(.*)$/ ) {
- $qpquery = $1;
- }
-
- $qpquery .= " #$sortby" unless $sortby eq '';
-
- $QParser->parse( $qpquery );
- $query = $QParser->target_syntax('authorityserver');
- } else {
- $query=($query?$query:"\@attr 1=_ALLRECORDS \@attr 2=103 ''");
- $query="\@or $orderstring $query" if $orderstring;
- }
+ $query=($query?$query:"\@attr 1=_ALLRECORDS \@attr 2=103 ''");
+ $query="\@or $orderstring $query" if $orderstring;
- $offset=0 unless $offset;
+ $offset = 0 if not defined $offset or $offset < 0;
my $counter = $offset;
$length=10 unless $length;
my @oAuth;
my $i;
$oAuth[0]=C4::Context->Zconn("authorityserver" , 1);
- my $Anewq= new ZOOM::Query::PQF($query,$oAuth[0]);
+ my $Anewq= ZOOM::Query::PQF->new($query,$oAuth[0]);
my $oAResult;
$oAResult= $oAuth[0]->search($Anewq) ;
while (($i = ZOOM::event(\@oAuth)) != 0) {
###
if (! $skipmetadata) {
for (my $z=0; $z<@finalresult; $z++){
- my $count=CountUsage($finalresult[$z]{authid});
+ my $count = Koha::Authorities->get_usage_count({ authid => $finalresult[$z]{authid} });
$finalresult[$z]{used}=$count;
}# all $z's
}
return (\@finalresult, $nbresults);
}
-=head2 CountUsage
-
- $count= &CountUsage($authid)
-
-counts Usage of Authid in bibliorecords.
-
-=cut
-
-sub CountUsage {
- my ($authid) = @_;
- ### ZOOM search here
- my $query;
- $query= "an:".$authid;
- # Should really be replaced with a real count call, this is a
- # bad way.
- my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::BIBLIOS_INDEX});
- my ($err,$res,$result) = $searcher->simple_search_compat($query,0,1);
- if ($err) {
- warn "Error: $err from search $query";
- $result = 0;
- }
-
- return $result;
-}
-
-=head2 CountUsageChildren
-
- $count= &CountUsageChildren($authid)
-
-counts Usage of narrower terms of Authid in bibliorecords.
-
-=cut
-
-sub CountUsageChildren {
- my ($authid) = @_;
-}
-
=head2 GuessAuthTypeCode
my $authtypecode = GuessAuthTypeCode($record);
'110'=>{authtypecode=>'CORPO_NAME'},
'111'=>{authtypecode=>'MEETI_NAME'},
'130'=>{authtypecode=>'UNIF_TITLE'},
+ '147'=>{authtypecode=>'NAME_EVENT'},
'148'=>{authtypecode=>'CHRON_TERM'},
'150'=>{authtypecode=>'TOPIC_TERM'},
'151'=>{authtypecode=>'GEOGR_NAME'},
'155'=>{authtypecode=>'GENRE/FORM'},
+ '162'=>{authtypecode=>'MED_PERFRM'},
'180'=>{authtypecode=>'GEN_SUBDIV'},
'181'=>{authtypecode=>'GEO_SUBDIV'},
'182'=>{authtypecode=>'CHRON_SUBD'},
$res->{$tag}->{repeatable} = $repeatable;
}
$sth= $dbh->prepare(
-"SELECT tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,frameworkcode as authtypecode,value_builder,kohafield,seealso,hidden,isurl,defaultvalue
+"SELECT tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,frameworkcode as authtypecode,value_builder,kohafield,seealso,hidden,isurl,defaultvalue, display_order
FROM auth_subfield_structure
WHERE authtypecode=?
-ORDER BY tagfield,tagsubfield"
+ORDER BY tagfield, display_order, tagsubfield"
);
$sth->execute($authtypecode);
my $seealso;
my $hidden;
my $isurl;
- my $link;
my $defaultvalue;
+ my $display_order;
while (
( $tag, $subfield, $liblibrarian, , $libopac, $tab,
$mandatory, $repeatable, $authorised_value, $authtypecode,
$value_builder, $kohafield, $seealso, $hidden,
- $isurl, $defaultvalue, $link )
+ $isurl, $defaultvalue, $display_order )
= $sth->fetchrow
)
{
+ $res->{$tag}->{$subfield}->{subfield} = $subfield;
$res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
$res->{$tag}->{$subfield}->{tab} = $tab;
$res->{$tag}->{$subfield}->{mandatory} = $mandatory;
$res->{$tag}->{$subfield}->{seealso} = $seealso;
$res->{$tag}->{$subfield}->{hidden} = $hidden;
$res->{$tag}->{$subfield}->{isurl} = $isurl;
- $res->{$tag}->{$subfield}->{link} = $link;
$res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
+ $res->{$tag}->{$subfield}->{display_order} = $display_order;
}
+
return $res;
}
SetUTF8Flag($record);
if ($format eq "MARC21") {
+ my $userenv = C4::Context->userenv;
+ my $library;
+ my $marcorgcode = C4::Context->preference('MARCOrgCode');
+ if ( $userenv && $userenv->{'branch'} ) {
+ $library = Koha::Libraries->find( $userenv->{'branch'} );
+ # userenv's library could not exist because of a trick in misc/commit_file.pl (see FIXME and set_userenv statement)
+ $marcorgcode = $library ? $library->get_effective_marcorgcode : $marcorgcode;
+ }
if (!$record->leader) {
$record->leader($leader);
}
if (!$record->field('003')) {
$record->insert_fields_ordered(
- MARC::Field->new('003',C4::Context->preference('MARCOrgCode'))
+ MARC::Field->new('003', $marcorgcode),
);
}
my $date=POSIX::strftime("%y%m%d",localtime);
if (!$record->field('040')) {
$record->insert_fields_ordered(
MARC::Field->new('040','','',
- 'a' => C4::Context->preference('MARCOrgCode'),
- 'c' => C4::Context->preference('MARCOrgCode')
+ 'a' => $marcorgcode,
+ 'c' => $marcorgcode,
)
);
}
$record->insert_fields_ordered( MARC::Field->new( '001', $authid ) );
# Update
$dbh->do( "UPDATE auth_header SET authtypecode=?, marc=?, marcxml=? WHERE authid=?", undef, $authtypecode, $record->as_usmarc, $record->as_xml_record($format), $authid ) or die $DBI::errstr;
- ModZebra( $authid, 'specialUpdate', 'authorityserver', $record );
+ my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::AUTHORITIES_INDEX });
+ $indexer->index_records( $authid, "specialUpdate", "authorityserver", $record );
return ( $authid );
}
-
=head2 DelAuthority
- $authid= &DelAuthority($authid)
+ DelAuthority({ authid => $authid, [ skip_merge => 1 ] });
-Deletes $authid
+Deletes $authid and calls merge to cleanup linked biblio records.
+Parameter skip_merge is used in authorities/merge.pl. You should normally not
+use it.
=cut
sub DelAuthority {
- my ($authid) = @_;
- my $dbh=C4::Context->dbh;
+ my ( $params ) = @_;
+ my $authid = $params->{authid} || return;
+ my $skip_merge = $params->{skip_merge};
+ my $dbh = C4::Context->dbh;
+
+ # Remove older pending merge requests for $authid to itself. (See bug 22437)
+ my $condition = { authid => $authid, authid_new => [undef, 0, $authid], done => 0 };
+ Koha::Authority::MergeRequests->search($condition)->delete;
+ merge({ mergefrom => $authid }) if !$skip_merge;
+ $dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid );
logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
- ModZebra($authid,"recordDelete","authorityserver",GetAuthority($authid),undef);
- my $sth = $dbh->prepare("DELETE FROM auth_header WHERE authid=?");
- $sth->execute($authid);
+ my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::AUTHORITIES_INDEX });
+ $indexer->index_records( $authid, "recordDelete", "authorityserver", undef );
}
=head2 ModAuthority
- $authid= &ModAuthority($authid,$record,$authtypecode)
+ $authid= &ModAuthority($authid,$record,$authtypecode, [ { skip_merge => 1 ] )
Modifies authority record, optionally updates attached biblios.
+The parameter skip_merge is optional and should be used with care.
=cut
sub ModAuthority {
- my ($authid,$record,$authtypecode)=@_; # deprecated $merge parameter removed
-
- my $dbh=C4::Context->dbh;
- #Now rewrite the $record to table with an add
- my $oldrecord=GetAuthority($authid);
- $authid=AddAuthority($record,$authid,$authtypecode);
-
- # If a library thinks that updating all biblios is a long process and wishes
- # to leave that to a cron job, use misc/migration_tools/merge_authority.pl.
- # In that case set system preference "dontmerge" to 1. Otherwise biblios will
- # be updated.
- unless(C4::Context->preference('dontmerge') eq '1'){
- &merge($authid,$oldrecord,$authid,$record);
- } else {
- # save a record in need_merge_authorities table
- my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ".
- "VALUES (?,?)";
- $dbh->do($sqlinsert,undef,($authid,0));
- }
- logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
- return $authid;
+ my ( $authid, $record, $authtypecode, $params ) = @_;
+ my $oldrecord = GetAuthority($authid);
+ #Now rewrite the $record to table with an add
+ $authid = AddAuthority($record, $authid, $authtypecode);
+ merge({ mergefrom => $authid, MARCfrom => $oldrecord, mergeto => $authid, MARCto => $record }) if !$params->{skip_merge};
+ logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
+ return $authid;
}
=head2 GetAuthorityXML
my $auth_tag_to_report = Koha::Authority::Types->find($authtypecode)->auth_tag_to_report;
# warn "record :".$record->as_formatted." auth_tag_to_report :$auth_tag_to_report";
# build a request for SearchAuthorities
- my $QParser;
- $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser'));
- my $op;
- if ($QParser) {
- $op = '&&';
- } else {
- $op = 'and';
- }
+ my $op = 'AND';
+ $authtypecode =~ s#/#\\/#; # GENRE/FORM contains forward slash which is a reserved character
my $query='at:'.$authtypecode.' ';
my $filtervalues=qr([\001-\040\Q!'"`#$%&*+,-./:;<=>?@(){[}_|~\E\]]);
if ($record->field($auth_tag_to_report)) {
}
}
my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::AUTHORITIES_INDEX});
- my ($error, $results, $total_hits) = $searcher->simple_search_compat( $query, 0, 1 );
+ my ($error, $results, $total_hits) = $searcher->simple_search_compat( $query, 0, 1, [ 'authorityserver' ] );
# there is at least 1 result => return the 1st one
if (!defined $error && @{$results} ) {
my $marcrecord = C4::Search::new_record_from_zebra(
# construct MARC21 summary
# FIXME - looping over 1XX is questionable
# since MARC21 authority should have only one 1XX
+ use C4::Heading::MARC21;
+ my $handler = C4::Heading::MARC21->new();
my $subfields_to_report;
foreach my $field ($record->field('1..')) {
my $tag = $field->tag();
# FIXME - 152 is not a good tag to use
# in MARC21 -- purely local tags really ought to be
# 9XX
- if ($tag eq '100') {
- $subfields_to_report = 'abcdefghjklmnopqrstvxyz';
- } elsif ($tag eq '110') {
- $subfields_to_report = 'abcdefghklmnoprstvxyz';
- } elsif ($tag eq '111') {
- $subfields_to_report = 'acdefghklnpqstvxyz';
- } elsif ($tag eq '130') {
- $subfields_to_report = 'adfghklmnoprstvxyz';
- } elsif ($tag eq '148') {
- $subfields_to_report = 'abvxyz';
- } elsif ($tag eq '150') {
- $subfields_to_report = 'abvxyz';
- } elsif ($tag eq '151') {
- $subfields_to_report = 'avxyz';
- } elsif ($tag eq '155') {
- $subfields_to_report = 'abvxyz';
- } elsif ($tag eq '180') {
- $subfields_to_report = 'vxyz';
- } elsif ($tag eq '181') {
- $subfields_to_report = 'vxyz';
- } elsif ($tag eq '182') {
- $subfields_to_report = 'vxyz';
- } elsif ($tag eq '185') {
- $subfields_to_report = 'vxyz';
- }
+
+ $subfields_to_report = $handler->get_auth_heading_subfields_to_report($tag);
+
if ($subfields_to_report) {
push @authorized, {
heading => $field->as_string($subfields_to_report),
if ($type eq 'subfi') {
push @seefrom, {
heading => $field->as_string($marc21subfields),
- hemain => $field->subfield( substr($marc21subfields, 0, 1) ),
+ hemain => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
type => ($field->subfield('i') || ''),
field => $field->tag(),
};
} else {
push @seefrom, {
heading => $field->as_string($marc21subfields),
- hemain => $field->subfield( substr($marc21subfields, 0, 1) ),
+ hemain => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
type => $type,
field => $field->tag(),
};
if ($type eq 'subfi') {
push @seealso, {
heading => $field->as_string($marc21subfields),
- hemain => $field->subfield( substr($marc21subfields, 0, 1) ),
- type => $field->subfield('i'),
+ hemain => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
+ type => scalar $field->subfield('i'),
field => $field->tag(),
search => $field->as_string($marc21subfields) || '',
authid => $field->subfield('9') || ''
} else {
push @seealso, {
heading => $field->as_string($marc21subfields),
- hemain => $field->subfield( substr($marc21subfields, 0, 1) ),
+ hemain => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
type => $type,
field => $field->tag(),
search => $field->as_string($marc21subfields) || '',
return $field->as_string('abcdefghijlmnopqrstuvwxyz');
}
} else {
+ use C4::Heading::MARC21;
+ my $handler = C4::Heading::MARC21->new();
+
foreach my $field ($record->field('1..')) {
- my $tag = $field->tag();
- next if "152" eq $tag;
-# FIXME - 152 is not a good tag to use
-# in MARC21 -- purely local tags really ought to be
-# 9XX
- if ($tag eq '100') {
- return $field->as_string('abcdefghjklmnopqrstvxyz68');
- } elsif ($tag eq '110') {
- return $field->as_string('abcdefghklmnoprstvxyz68');
- } elsif ($tag eq '111') {
- return $field->as_string('acdefghklnpqstvxyz68');
- } elsif ($tag eq '130') {
- return $field->as_string('adfghklmnoprstvxyz68');
- } elsif ($tag eq '148') {
- return $field->as_string('abvxyz68');
- } elsif ($tag eq '150') {
- return $field->as_string('abvxyz68');
- } elsif ($tag eq '151') {
- return $field->as_string('avxyz68');
- } elsif ($tag eq '155') {
- return $field->as_string('abvxyz68');
- } elsif ($tag eq '180') {
- return $field->as_string('vxyz68');
- } elsif ($tag eq '181') {
- return $field->as_string('vxyz68');
- } elsif ($tag eq '182') {
- return $field->as_string('vxyz68');
- } elsif ($tag eq '185') {
- return $field->as_string('vxyz68');
- } else {
- return $field->as_string();
- }
+ my $subfields = $handler->get_valid_bib_heading_subfields($field->tag());
+ return $field->as_string($subfields) if ($subfields);
}
}
return;
}
+=head2 CompareFieldWithAuthority
+
+ $match = &CompareFieldWithAuthority({ field => $field, authid => $authid })
+
+Takes a MARC::Field from a bibliographic record and an authid, and returns true if they match.
+
+=cut
+
+sub CompareFieldWithAuthority {
+ my $args = shift;
+
+ my $record = GetAuthority($args->{authid});
+ return unless (ref $record eq 'MARC::Record');
+ if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
+ # UNIMARC has same subfields for bibs and authorities
+ foreach my $field ($record->field('2..')) {
+ return compare_fields($field, $args->{field}, 'abcdefghijlmnopqrstuvwxyz');
+ }
+ } else {
+ use C4::Heading::MARC21;
+ my $handler = C4::Heading::MARC21->new();
+
+ foreach my $field ($record->field('1..')) {
+ my $subfields = $handler->get_valid_bib_heading_subfields($field->tag());
+ return compare_fields($field, $args->{field}, $subfields) if ($subfields);
+ }
+ }
+ return 0;
+}
+
=head2 BuildAuthHierarchies
$text= &BuildAuthHierarchies( $authid, $force)
my ($field)=@_;
return $field->subfield('9')||$field->subfield('3');
}
+
=head2 GetHeaderAuthority
$ref= &GetHeaderAuthority( $authid)
=head2 merge
- $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
+ $count = merge({
+ mergefrom => $mergefrom,
+ [ MARCfrom => $MARCfrom, ]
+ [ mergeto => $mergeto, ]
+ [ MARCto => $MARCto, ]
+ [ biblionumbers => [ $a, $b, $c ], ]
+ [ override_limit => 1, ]
+ });
+
+Merge biblios linked to authority $mergefrom (mandatory parameter).
+If $mergeto equals mergefrom, the linked biblio field is updated.
+If $mergeto is different, the biblio field will be linked to $mergeto.
+If $mergeto is missing, the biblio field is deleted.
+
+MARCfrom is used to determine if a cleared subfield in the authority record
+should be removed from a biblio. MARCto is used to populate the biblio
+record with the updated values; if you do not pass it, the biblio field
+will be deleted (same as missing mergeto).
-Could add some feature : Migrating from a typecode to an other for instance.
-Then we should add some new parameter : bibliotargettag, authtargettag
+Normally all biblio records linked to $mergefrom, will be considered. But
+you can pass specific numbers via the biblionumbers parameter.
+
+The parameter override_limit is used by the cron job to force larger
+postponed merges.
+
+Note: Although $mergefrom and $mergeto will normally be of the same
+authority type, merge also supports moving to another authority type.
=cut
sub merge {
- my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
- my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);
- my $dbh=C4::Context->dbh;
+ my ( $params ) = @_;
+ my $mergefrom = $params->{mergefrom} || return;
+ my $MARCfrom = $params->{MARCfrom};
+ my $mergeto = $params->{mergeto};
+ my $MARCto = $params->{MARCto};
+ my $override_limit = $params->{override_limit};
+
+ # If we do not have biblionumbers, we get all linked biblios if the
+ # number of linked records does not exceed the limit UNLESS we override.
+ my @biblionumbers;
+ if( $params->{biblionumbers} ) {
+ @biblionumbers = @{ $params->{biblionumbers} };
+ } elsif( $override_limit ) {
+ @biblionumbers = Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
+ } else { # now first check number of linked records
+ my $max = C4::Context->preference('AuthorityMergeLimit') // 0;
+ my $hits = Koha::Authorities->get_usage_count({ authid => $mergefrom });
+ if( $hits > 0 && $hits <= $max ) {
+ @biblionumbers = Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
+ } elsif( $hits > $max ) { #postpone this merge to the cron job
+ Koha::Authority::MergeRequest->new({
+ authid => $mergefrom,
+ oldrecord => $MARCfrom,
+ authid_new => $mergeto,
+ })->store;
+ }
+ }
+ return 0 if !@biblionumbers;
+
+ # Search authtypes and reporting tags
my $authfrom = Koha::Authorities->find($mergefrom);
my $authto = Koha::Authorities->find($mergeto);
- my $authtypefrom = Koha::Authority::Types->find($authfrom->authtypecode);
- my $authtypeto = Koha::Authority::Types->find($authto->authtypecode);
-
- return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0;
- return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0;
- # search the tag to report
- my $auth_tag_to_report_from = $authtypefrom->auth_tag_to_report;
- my $auth_tag_to_report_to = $authtypeto->auth_tag_to_report;
+ my $authtypefrom = $authfrom ? Koha::Authority::Types->find($authfrom->authtypecode) : undef;
+ my $authtypeto = $authto ? Koha::Authority::Types->find($authto->authtypecode) : undef;
+ my $auth_tag_to_report_from = $authtypefrom ? $authtypefrom->auth_tag_to_report : '';
+ my $auth_tag_to_report_to = $authtypeto ? $authtypeto->auth_tag_to_report : '';
my @record_to;
- @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
- my @record_from;
- @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();
+ @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $auth_tag_to_report_to && $MARCto && $MARCto->field($auth_tag_to_report_to);
+ # Exceptional: If MARCto and authtypeto exist but $auth_tag_to_report_to
+ # is empty, make sure that $9 and $a remain (instead of clearing the
+ # reference) in order to allow for data recovery.
+ # Note: We need $a too, since a single $9 does not pass ModBiblio.
+ if( $MARCto && $authtypeto && !@record_to ) {
+ push @record_to, [ 'a', ' ' ]; # do not remove the space
}
- 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++;
+
+ my @record_from;
+ if( !$authfrom && $MARCfrom && $MARCfrom->field('1..','2..') ) {
+ # postponed merge, authfrom was deleted and MARCfrom only contains the old reporting tag (and possibly a 100 for UNIMARC)
+ # 2XX is for UNIMARC; we use -1 in order to skip 100 in UNIMARC; this will not impact MARC21, since there is only one tag
+ @record_from = ( $MARCfrom->field('1..','2..') )[-1]->subfields;
+ } elsif( $auth_tag_to_report_from && $MARCfrom && $MARCfrom->field($auth_tag_to_report_from) ) {
+ @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields;
}
- $oResult->destroy();
- # Get All candidate Tags for the change
+
+ # Get all candidate tags for the change
# (This will reduce the search scope in marc records).
+ # For a deleted authority record, we scan all auth controlled fields
+ my $dbh = C4::Context->dbh;
my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?";
- my $tags_using_authtype = $dbh->selectcol_arrayref( $sql, undef, ( $authtypefrom->authtypecode ));
+ my $tags_using_authtype = $authtypefrom && $authtypefrom->authtypecode ? $dbh->selectcol_arrayref( $sql, undef, ( $authtypefrom->authtypecode )) : $dbh->selectcol_arrayref( "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode IS NOT NULL AND authtypecode<>''" );
my $tags_new;
- if ($authtypeto->authtypecode ne $authtypefrom->authtypecode){
+ if( $authtypeto && ( !$authtypefrom || $authtypeto->authtypecode ne $authtypefrom->authtypecode )) {
$tags_new = $dbh->selectcol_arrayref( $sql, undef, ( $authtypeto->authtypecode ));
}
# We only need it in loose merge mode; replaces the former $exclude
? {}
: { map { ( $_->[0], 1 ); } ( @record_from, @record_to ) };
- # And we need to add $9 in order not to duplicate
- $skip_subfields->{9} = 1 if !$overwrite;
- foreach my $marcrecord(@reccache){
+ my $counteditedbiblio = 0;
+ foreach my $biblionumber ( @biblionumbers ) {
+ my $marcrecord = GetMarcBiblio({ biblionumber => $biblionumber });
+ next if !$marcrecord;
my $update = 0;
foreach my $tagfield (@$tags_using_authtype) {
my $countfrom = 0; # used in strict mode to remove duplicates
my $tag = $field->tag();
next if !defined($auth_number) || $auth_number ne $mergefrom;
$countfrom++;
- if ( $overwrite && $countfrom > 1 ) {
- # remove this duplicate in strict mode
+ if ( !$mergeto || !@record_to ||
+ ( $overwrite && $countfrom > 1 ) ) {
+ # !mergeto or !record_to indicates a delete
+ # Other condition: remove this duplicate in strict mode
$marcrecord->delete_field($field);
$update = 1;
next;
}
- my $newtag = $tags_new
+ my $newtag = $tags_new && @$tags_new
? _merge_newtag( $tag, $tags_new )
: $tag;
+ my $controlled_ind = $authto->controlled_indicators({ record => $MARCto, biblio_tag => $newtag });
my $field_to = MARC::Field->new(
$newtag,
- $field->indicator(1),
- $field->indicator(2),
- "9" => $mergeto,
+ $controlled_ind->{ind1} // $field->indicator(1),
+ $controlled_ind->{ind2} // $field->indicator(2),
+ 9 => $mergeto, # Needed to create field, will be moved
);
- foreach my $subfield ( grep { $_->[0] ne '9' } @record_to ) {
- $field_to->add_subfields( $subfield->[0] => $subfield->[1] );
- }
+ my ( @prefix, @postfix );
if ( !$overwrite ) {
# add subfields back in loose mode, check skip_subfields
+ # The first extra subfields will be in front of the
+ # controlled block, the rest at the end.
+ my $prefix_flag = 1;
foreach my $subfield ( $field->subfields ) {
- next if $skip_subfields->{ $subfield->[0] };
- $field_to->add_subfields( $subfield->[0], $subfield->[1] );
+ next if $subfield->[0] eq '9'; # skip but leave flag
+ if ( $skip_subfields->{ $subfield->[0] } ) {
+ # This marks the beginning of the controlled block
+ $prefix_flag = 0;
+ next;
+ }
+ if ($prefix_flag) {
+ push @prefix, [ $subfield->[0], $subfield->[1] ];
+ } else {
+ push @postfix, [ $subfield->[0], $subfield->[1] ];
+ }
}
}
- if ($tags_new) {
+ foreach my $subfield ( @prefix, @record_to, @postfix ) {
+ $field_to->add_subfields($subfield->[0] => $subfield->[1]);
+ }
+ if( exists $controlled_ind->{sub2} ) { # thesaurus info
+ if( defined $controlled_ind->{sub2} ) {
+ # Add or replace
+ $field_to->update( 2 => $controlled_ind->{sub2} );
+ } else {
+ # Key alerts us here to remove $2
+ $field_to->delete_subfield( code => '2' );
+ }
+ }
+ # Move $9 to the end
+ $field_to->delete_subfield( code => '9' );
+ $field_to->add_subfields( 9 => $mergeto );
+
+ if ($tags_new && @$tags_new) {
$marcrecord->delete_field($field);
append_fields_ordered( $marcrecord, $field_to );
} else {
$update = 1;
}
}
- my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
- my $biblionumber;
- if ($bibliotag<10){
- $biblionumber=$marcrecord->field($bibliotag)->data;
- }
- else {
- $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf);
- }
- unless ($biblionumber){
- warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;
- next;
- }
- if ($update==1){
- &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
- $counteditedbiblio++;
- warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
- }
+ next if !$update;
+ ModBiblio($marcrecord, $biblionumber, GetFrameworkCode($biblionumber));
+ $counteditedbiblio++;
}
- return $counteditedbiblio;
+ return $counteditedbiblio;
}
sub _merge_newtag {
}
}
+=head2 compare_fields
+
+ my match = compare_fields($field1, $field2, 'abcde');
+
+Compares the listed subfields of both fields and return true if they all match
+
+=cut
+
+sub compare_fields {
+ my ($field1, $field2, $subfields) = @_;
+
+ foreach my $subfield (split(//, $subfields)) {
+ my $subfield1 = $field1->subfield($subfield) // '';
+ my $subfield2 = $field2->subfield($subfield) // '';
+ return 0 unless $subfield1 eq $subfield2;
+ }
+ return 1;
+}
+
+
END { } # module clean-up code here (global destructor)
1;
Koha Development Team <http://koha-community.org/>
Paul POULAIN paul.poulain@free.fr
+Ere Maijala ere.maijala@helsinki.fi
=cut
projects / srvgit / blobdiff