package C4::AuthoritiesMarc;
+
# 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 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.
+# 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.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
use strict;
use warnings;
use C4::AuthoritiesMarc::UNIMARC;
use C4::Charset;
use C4::Log;
+use Koha::MetadataRecord::Authority;
+use Koha::Authorities;
+use Koha::Authority::MergeRequest;
+use Koha::Authority::Types;
use Koha::Authority;
+use Koha::Libraries;
+use Koha::SearchEngine;
+use Koha::SearchEngine::Search;
-use vars qw($VERSION @ISA @EXPORT);
+use vars qw(@ISA @EXPORT);
BEGIN {
- # set the version for version checking
- $VERSION = 3.07.00.049;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
&GetTagsLabels
- &GetAuthType
- &GetAuthTypeCode
&GetAuthMARCFromKohaField
&AddAuthority
&GetAuthority
&GetAuthorityXML
- &CountUsage
- &CountUsageChildren
&SearchAuthorities
&BuildSummary
my $dbh=C4::Context->dbh;
return 0, 0 unless $kohafield;
$authtypecode="" unless $authtypecode;
- my $marcfromkohafield;
my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where kohafield= ? and authtypecode=? ");
$sth->execute($kohafield,$authtypecode);
my ($tagfield,$tagsubfield) = $sth->fetchrow;
my ($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby,$skipmetadata) = @_;
# warn Dumper($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby);
my $dbh=C4::Context->dbh;
+ $sortby="" unless $sortby;
my $query;
my $qpquery = '';
my $QParser;
my $and=" \@and " ;
my $q2;
my $attr_cnt = 0;
- for(my $i = 0 ; $i <= $#{$value} ; $i++)
- {
- if (@$value[$i]){
- if ( @$tags[$i] eq "mainmainentry" ) {
- $attr = " \@attr 1=Heading-Main ";
- }
- elsif ( @$tags[$i] eq "mainentry" ) {
- $attr = " \@attr 1=Heading ";
- }
- elsif ( @$tags[$i] eq "match" ) {
- $attr = " \@attr 1=Match ";
- }
- elsif ( @$tags[$i] eq "match-heading" ) {
- $attr = " \@attr 1=Match-heading ";
- }
- elsif ( @$tags[$i] eq "see-from" ) {
- $attr = " \@attr 1=Match-heading-see-from ";
- }
- elsif ( @$tags[$i] eq "thesaurus" ) {
- $attr = " \@attr 1=Subject-heading-thesaurus ";
- }
- else { # Assume any if no index was specified
+ for ( my $i = 0 ; $i <= $#{$value} ; $i++ ) {
+ if ( @$value[$i] ) {
+ if ( @$tags[$i] ) {
+ if ( @$tags[$i] eq "mainmainentry" ) {
+ $attr = " \@attr 1=Heading-Main ";
+ }
+ elsif ( @$tags[$i] eq "mainentry" ) {
+ $attr = " \@attr 1=Heading ";
+ }
+ elsif ( @$tags[$i] eq "match" ) {
+ $attr = " \@attr 1=Match ";
+ }
+ elsif ( @$tags[$i] eq "match-heading" ) {
+ $attr = " \@attr 1=Match-heading ";
+ }
+ elsif ( @$tags[$i] eq "see-from" ) {
+ $attr = " \@attr 1=Match-heading-see-from ";
+ }
+ elsif ( @$tags[$i] eq "thesaurus" ) {
+ $attr = " \@attr 1=Subject-heading-thesaurus ";
+ }
+ 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 ";
}
- if ( @$operator[$i] eq 'is' ) {
+
+ my $operator = @$operator[$i];
+ if ( $operator and $operator eq 'is' ) {
$attr .= " \@attr 4=1 \@attr 5=100 "
- ; ##Phrase, No truncation,all of subfield field must match
+ ; ##Phrase, No truncation,all of subfield field must match
}
- elsif ( @$operator[$i] eq "=" ) {
+ elsif ( $operator and $operator eq "=" ) {
$attr .= " \@attr 4=107 "; #Number Exact match
}
- elsif ( @$operator[$i] eq "start" ) {
+ elsif ( $operator and $operator eq "start" ) {
$attr .= " \@attr 3=2 \@attr 4=1 \@attr 5=1 "
; #Firstinfield Phrase, Right truncated
}
- elsif ( @$operator[$i] eq "exact" ) {
+ elsif ( $operator and $operator eq "exact" ) {
$attr .= " \@attr 4=1 \@attr 5=100 \@attr 6=3 "
- ; ##Phrase, No truncation,all of subfield field must match
+ ; ##Phrase, No truncation,all of subfield field must match
}
else {
$attr .= " \@attr 5=1 \@attr 4=6 "
; ## Word list, right truncated, anywhere
- if ($sortby eq 'Relevance') {
- $attr .= "\@attr 2=102 ";
- }
+ if ( $sortby eq 'Relevance' ) {
+ $attr .= "\@attr 2=102 ";
+ }
}
- @$value[$i] =~ s/"/\\"/g; # Escape the double-quotes in the search value
- $attr =$attr."\"".@$value[$i]."\"";
- $q2 .=$attr;
- $dosearch=1;
+ @$value[$i] =~
+ s/"/\\"/g; # Escape the double-quotes in the search value
+ $attr = $attr . "\"" . @$value[$i] . "\"";
+ $q2 .= $attr;
+ $dosearch = 1;
++$attr_cnt;
if ($QParser) {
$qpquery .= " $tags->[$i]:\"$value->[$i]\"";
}
- }#if value
+ } #if value
}
##Add how many queries generated
if (defined $query && $query=~/\S+/){
$qpquery = $1;
}
- $qpquery .= " #$sortby";
+ $qpquery .= " #$sortby" unless $sortby eq '';
$QParser->parse( $qpquery );
$query = $QParser->target_syntax('authorityserver');
$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;
##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES
my $rec=$oAResult->record($counter);
- my $marcdata=$rec->raw();
- my $authrecord;
- my $separator=C4::Context->preference('authoritysep');
- $authrecord = MARC::File::USMARC::decode($marcdata);
+ my $separator=C4::Context->preference('AuthoritySeparator');
+ my $authrecord = C4::Search::new_record_from_zebra(
+ 'authorityserver',
+ $rec->raw()
+ );
+
+ if ( !defined $authrecord or !defined $authrecord->field('001') ) {
+ $counter++;
+ next;
+ }
+
+ SetUTF8Flag( $authrecord );
+
my $authid=$authrecord->field('001')->data();
my %newline;
$newline{authid} = $authid;
if ( !$skipmetadata ) {
- my $summary =
- BuildSummary( $authrecord, $authid, $authtypecode );
- my $query_auth_tag =
-"SELECT auth_tag_to_report FROM auth_types WHERE authtypecode=?";
- my $sth = $dbh->prepare($query_auth_tag);
- $sth->execute($authtypecode);
- my $auth_tag_to_report = $sth->fetchrow;
+ my $auth_tag_to_report;
+ $auth_tag_to_report = Koha::Authority::Types->find($authtypecode)->auth_tag_to_report
+ if $authtypecode;
my $reported_tag;
my $mainentry = $authrecord->field($auth_tag_to_report);
if ($mainentry) {
-
foreach ( $mainentry->subfields() ) {
$reported_tag .= '$' . $_->[0] . $_->[1];
}
}
- my $thisauthtype = GetAuthType(GetAuthTypeCode($authid));
+
+ my ( $thisauthtype, $thisauthtypecode );
+ if ( my $authority = Koha::Authorities->find($authid) ) {
+ $thisauthtypecode = $authority->authtypecode;
+ $thisauthtype = Koha::Authority::Types->find($thisauthtypecode);
+ }
unless (defined $thisauthtype) {
- $thisauthtype = GetAuthType($authtypecode) if $authtypecode;
+ $thisauthtypecode = $authtypecode;
+ $thisauthtype = Koha::Authority::Types->find($thisauthtypecode);
}
+ my $summary = BuildSummary( $authrecord, $authid, $thisauthtypecode );
+
$newline{authtype} = defined($thisauthtype) ?
- $thisauthtype->{'authtypetext'} : '';
+ $thisauthtype->authtypetext : '';
$newline{summary} = $summary;
$newline{even} = $counter % 2;
$newline{reported_tag} = $reported_tag;
###
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;
- my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10);
- 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 GetAuthTypeCode
-
- $authtypecode= &GetAuthTypeCode($authid)
-
-returns authtypecode of an authid
-
-=cut
-
-sub GetAuthTypeCode {
-#AUTHfind_authtypecode
- my ($authid) = @_;
- my $dbh=C4::Context->dbh;
- my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?");
- $sth->execute($authid);
- my $authtypecode = $sth->fetchrow;
- return $authtypecode;
-}
-
=head2 GuessAuthTypeCode
my $authtypecode = GuessAuthTypeCode($record);
$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
+"SELECT tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,frameworkcode as authtypecode,value_builder,kohafield,seealso,hidden,isurl,defaultvalue
FROM auth_subfield_structure
WHERE authtypecode=?
ORDER BY tagfield,tagsubfield"
my $hidden;
my $isurl;
my $link;
+ my $defaultvalue;
while (
( $tag, $subfield, $liblibrarian, , $libopac, $tab,
$mandatory, $repeatable, $authorised_value, $authtypecode,
$value_builder, $kohafield, $seealso, $hidden,
- $isurl, $link )
+ $isurl, $defaultvalue, $link )
= $sth->fetchrow
)
{
$res->{$tag}->{$subfield}->{hidden} = $hidden;
$res->{$tag}->{$subfield}->{isurl} = $isurl;
$res->{$tag}->{$subfield}->{link} = $link;
+ $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
}
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'} );
+ $marcorgcode = $library->get_effective_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->add_fields($auth_type_tag,'','', $auth_type_subfield=>$authtypecode);
}
- my $auth_exists=0;
- my $oldRecord;
- if (!$authid) {
- my $sth=$dbh->prepare("select max(authid) from auth_header");
- $sth->execute;
- ($authid)=$sth->fetchrow;
- $authid=$authid+1;
- ##Insert the recordID in MARC record
- unless ($record->field('001') && $record->field('001')->data() eq $authid){
- $record->delete_field($record->field('001'));
- $record->insert_fields_ordered(MARC::Field->new('001',$authid));
+ # Save record into auth_header, update 001
+ if (!$authid ) {
+ # Save a blank record, get authid
+ $dbh->do( "INSERT INTO auth_header (datecreated,marcxml) values (NOW(),?)", undef, '' );
+ $authid = $dbh->last_insert_id( undef, undef, 'auth_header', 'authid' );
+ logaction( "AUTHORITIES", "ADD", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
}
- } else {
- $auth_exists=$dbh->do(qq(select authid from auth_header where authid=?),undef,$authid);
-# warn "auth_exists = $auth_exists";
- }
- if ($auth_exists>0){
- $oldRecord=GetAuthority($authid);
- $record->add_fields('001',$authid) unless ($record->field('001'));
-# warn "\n\n\n enregistrement".$record->as_formatted;
- my $sth=$dbh->prepare("update auth_header set authtypecode=?,marc=?,marcxml=? where authid=?");
- $sth->execute($authtypecode,$record->as_usmarc,$record->as_xml_record($format),$authid) or die $sth->errstr;
- $sth->finish;
- }
- else {
- my $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc,marcxml) values (?,now(),?,?,?)");
- $sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record($format));
- $sth->finish;
- logaction( "AUTHORITIES", "ADD", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
- }
- ModZebra($authid,'specialUpdate',"authorityserver",$oldRecord,$record);
- return ($authid);
+ # Insert/update the recordID in MARC record
+ $record->delete_field( $record->field('001') );
+ $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 );
+
+ 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;
+ 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);
+ ModZebra( $authid, "recordDelete", "authorityserver", undef);
}
=head2 ModAuthority
=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, "BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
- return $authid;
+ my ( $authid, $record, $authtypecode ) = @_;
+ 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 });
+ logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
+ return $authid;
}
=head2 GetAuthorityXML
sub GetAuthority {
my ($authid)=@_;
- my $authority = Koha::Authority->get_from_authid($authid);
+ my $authority = Koha::MetadataRecord::Authority->get_from_authid($authid);
return unless $authority;
return ($authority->record);
}
-=head2 GetAuthType
-
- $result = &GetAuthType($authtypecode)
-
-If the authority type specified by C<$authtypecode> exists,
-returns a hashref of the type's fields. If the type
-does not exist, returns undef.
-
-=cut
-
-sub GetAuthType {
- my ($authtypecode) = @_;
- my $dbh=C4::Context->dbh;
- my $sth;
- if (defined $authtypecode){ # NOTE - in MARC21 framework, '' is a valid authority
- # type (FIXME but why?)
- $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
- $sth->execute($authtypecode);
- if (my $res = $sth->fetchrow_hashref) {
- return $res;
- }
- }
- return;
-}
-
-
=head2 FindDuplicateAuthority
$record= &FindDuplicateAuthority( $record, $authtypecode)
# warn "IN for ".$record->as_formatted;
my $dbh = C4::Context->dbh;
# warn "".$record->as_formatted;
- my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
- $sth->execute($authtypecode);
- my ($auth_tag_to_report) = $sth->fetchrow;
- $sth->finish;
+ 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;
if ($QParser) {
$op = '&&';
} else {
- $op = 'and';
+ $op = 'AND';
}
my $query='at:'.$authtypecode.' ';
- my $filtervalues=qr([\001-\040\!\'\"\`\#\$\%\&\*\+,\-\./:;<=>\?\@\(\)\{\[\]\}_\|\~]);
+ my $filtervalues=qr([\001-\040\Q!'"`#$%&*+,-./:;<=>?@(){[}_|~\E\]]);
if ($record->field($auth_tag_to_report)) {
- foreach ($record->field($auth_tag_to_report)->subfields()) {
- $_->[1]=~s/$filtervalues/ /g; $query.= " $op he:\"".$_->[1]."\"" if ($_->[0]=~/[A-z]/);
- }
+ foreach ($record->field($auth_tag_to_report)->subfields()) {
+ $_->[1]=~s/$filtervalues/ /g; $query.= " $op he:\"".$_->[1]."\"" if ($_->[0]=~/[A-z]/);
+ }
}
- my ($error, $results, $total_hits) = C4::Search::SimpleSearch( $query, 0, 1, [ "authorityserver" ] );
+ my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::AUTHORITIES_INDEX});
+ 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 = MARC::File::USMARC::decode($results->[0]);
- return $marcrecord->field('001')->data,BuildSummary($marcrecord,$marcrecord->field('001')->data,$authtypecode);
+ my $marcrecord = C4::Search::new_record_from_zebra(
+ 'authorityserver',
+ $results->[0]
+ );
+ return $marcrecord->field('001')->data,BuildSummary($marcrecord,$marcrecord->field('001')->data,$authtypecode);
}
# no result, returns nothing
return;
Returns a hashref with a summary of the specified record.
-Comment : authtypecode can be infered from both record and authid.
+Comment : authtypecode can be inferred from both record and authid.
Moreover, authid can also be inferred from $record.
Would it be interesting to delete those things.
my ($record,$authid,$authtypecode)=@_;
my $dbh=C4::Context->dbh;
my %summary;
+ my $summary_template;
# handle $authtypecode is NULL or eq ""
if ($authtypecode) {
- my $authref = GetAuthType($authtypecode);
- $summary{authtypecode} = $authref->{authtypecode};
- $summary{type} = $authref->{authtypetext};
- $summary{summary} = $authref->{summary};
+ my $authref = Koha::Authority::Types->find($authtypecode);
+ if ( $authref ) {
+ $summary{authtypecode} = $authref->authtypecode;
+ $summary{type} = $authref->authtypetext;
+ $summary_template = $authref->summary;
+ # for MARC21, the authority type summary displays a label meant for
+ # display
+ if (C4::Context->preference('marcflavour') ne 'UNIMARC') {
+ $summary{label} = $authref->summary;
+ } else {
+ $summary{summary} = $authref->summary;
+ }
+ }
}
my $marc21subfields = 'abcdfghjklmnopqrstuvxyz68';
my %marc21controlrefs = ( 'a' => 'earlier',
# feature will be enabled only for UNIMARC for backwards
# compatibility.
if ($summary{summary} and C4::Context->preference('marcflavour') eq 'UNIMARC') {
- my @fields = $record->fields();
-# $reported_tag = '$9'.$result[$counter];
- my @stringssummary;
- foreach my $field (@fields) {
- my $tag = $field->tag();
- my $tagvalue = $field->as_string();
- my $localsummary= $summary{summary};
- $localsummary =~ s/\[(.?.?.?.?)$tag\*(.*?)\]/$1$tagvalue$2\[$1$tag$2\]/g;
- if ($tag<10) {
- if ($tag eq '001') {
- $reported_tag.='$3'.$field->data();
- }
- } else {
- my @subf = $field->subfields;
- for my $i (0..$#subf) {
- my $subfieldcode = $subf[$i][0];
- my $subfieldvalue = $subf[$i][1];
- my $tagsubf = $tag.$subfieldcode;
- $localsummary =~ s/\[(.?.?.?.?)$tagsubf(.*?)\]/$1$subfieldvalue$2\[$1$tagsubf$2\]/g;
+ my @matches = ($summary{summary} =~ m/\[(.*?)(\d{3})([\*a-z0-9])(.*?)\]/g);
+ my (@textbefore, @tag, @subtag, @textafter);
+ for(my $i = 0; $i < scalar @matches; $i++){
+ push @textbefore, $matches[$i] if($i%4 == 0);
+ push @tag, $matches[$i] if($i%4 == 1);
+ push @subtag, $matches[$i] if($i%4 == 2);
+ push @textafter, $matches[$i] if($i%4 == 3);
+ }
+ for(my $i = scalar @tag; $i >= 0; $i--){
+ my $textbefore = $textbefore[$i] || '';
+ my $tag = $tag[$i] || '';
+ my $subtag = $subtag[$i] || '';
+ my $textafter = $textafter[$i] || '';
+ my $value = '';
+ my $field = $record->field($tag);
+ if ( $field ) {
+ if($subtag eq '*') {
+ if($tag < 10) {
+ $value = $textbefore . $field->data() . $textafter;
+ }
+ } else {
+ my @subfields = $field->subfield($subtag);
+ if(@subfields > 0) {
+ $value = $textbefore . join (" - ", @subfields) . $textafter;
+ }
}
}
- push @stringssummary, $localsummary if ($localsummary ne $summary{summary});
+ $summary{summary} =~ s/\[\Q$textbefore$tag$subtag$textafter\E\]/$value/;
}
- my $resultstring;
- $resultstring = join(" -- ",@stringssummary);
- $resultstring =~ s/\[(.*?)\]//g;
- $resultstring =~ s/\n/<br>/g;
- $summary{summary} = $resultstring;
+ $summary{summary} =~ s/\\n/<br \/>/g;
}
my @authorized;
my @notes;
foreach my $field ($record->field('2..')) {
push @authorized, {
heading => $field->as_string('abcdefghijlmnopqrstuvwxyz'),
- hemain => $field->subfield('a'),
+ hemain => ( $field->subfield('a') // undef ),
field => $field->tag(),
};
}
my $thesaurus = $field->subfield('2') ? "thes. : ".$thesaurus{"$field->subfield('2')"}." : " : '';
push @seefrom, {
heading => $thesaurus . $field->as_string('abcdefghijlmnopqrstuvwxyz'),
- hemain => $field->subfield('a'),
+ hemain => ( $field->subfield('a') // undef ),
type => 'seefrom',
field => $field->tag(),
};
field => $_->tag,
type => $type,
heading => $heading,
- hemain => $_->subfield('a'),
+ hemain => ( $_->subfield('a') // undef ),
search => $heading,
- authid => $_->subfield('9'),
+ authid => ( $_->subfield('9') // undef ),
}
} $record->field('5..');
if ($subfields_to_report) {
push @authorized, {
heading => $field->as_string($subfields_to_report),
- hemain => $field->subfield( substr($subfields_to_report, 0, 1) ),
+ hemain => ( $field->subfield( substr($subfields_to_report, 0, 1) ) // undef ),
field => $tag,
};
} else {
push @authorized, {
heading => $field->as_string(),
- hemain => $field->subfield('a'),
+ hemain => ( $field->subfield( 'a' ) // undef ),
field => $tag,
};
}
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).
+
+Normally all biblio records linked to $mergefrom, will be considered. But
+you can pass specific numbers via the biblionumbers parameter.
-Could add some feature : Migrating from a typecode to an other for instance.
-Then we should add some new parameter : bibliotargettag, authtargettag
+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 $authtypecodefrom = GetAuthTypeCode($mergefrom);
- my $authtypecodeto = GetAuthTypeCode($mergeto);
-# warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
- # return if authority does not exist
- 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 $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
- $sth->execute($authtypecodefrom);
- my ($auth_tag_to_report_from) = $sth->fetchrow;
- $sth->execute($authtypecodeto);
- my ($auth_tag_to_report_to) = $sth->fetchrow;
-
+ 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 = $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 $rec;
- $rec=$oResult->record($z);
- my $marcdata = $rec->raw();
- my $marcrecordzebra= MARC::Record->new_from_usmarc($marcdata);
- 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();
- #warn scalar(@reccache)." biblios to update";
- # Get All candidate Tags for the change
+
+ # Get all candidate tags for the change
# (This will reduce the search scope in marc records).
- $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
- $sth->execute($authtypecodefrom);
- my @tags_using_authtype;
- while (my ($tagfield) = $sth->fetchrow) {
- push @tags_using_authtype,$tagfield ;
- }
- my $tag_to=0;
- if ($authtypecodeto ne $authtypecodefrom){
- # If many tags, take the first
- $sth->execute($authtypecodeto);
- $tag_to=$sth->fetchrow;
- #warn $tag_to;
+ # 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 = $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 && ( !$authtypefrom || $authtypeto->authtypecode ne $authtypefrom->authtypecode )) {
+ $tags_new = $dbh->selectcol_arrayref( $sql, undef, ( $authtypeto->authtypecode ));
}
- # BulkEdit marc records
- # May be used as a template for a bulkedit field
- foreach my $marcrecord(@reccache){
- my $update;
- foreach my $tagfield (@tags_using_authtype){
-# warn "tagfield : $tagfield ";
- foreach my $field ($marcrecord->field($tagfield)){
- # biblio is linked to authority with $9 subfield containing authid
- my $auth_number=$field->subfield("9");
- my $tag=$field->tag();
- if ($auth_number==$mergefrom) {
- my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto);
- my $exclude='9';
- foreach my $subfield (grep {$_->[0] ne '9'} @record_to) {
- $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
- $exclude.= $subfield->[0];
+
+ my $overwrite = C4::Context->preference( 'AuthorityMergeMode' ) eq 'strict';
+ my $skip_subfields = $overwrite
+ # This hash contains all subfields from the authority report fields
+ # Including $MARCfrom as well as $MARCto
+ # We only need it in loose merge mode; replaces the former $exclude
+ ? {}
+ : { map { ( $_->[0], 1 ); } ( @record_from, @record_to ) };
+
+ 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
+ foreach my $field ( $marcrecord->field($tagfield) ) {
+ my $auth_number = $field->subfield("9"); # link to authority
+ my $tag = $field->tag();
+ next if !defined($auth_number) || $auth_number ne $mergefrom;
+ $countfrom++;
+ 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;
}
- $exclude='['.$exclude.']';
-# add subfields in $field not included in @record_to
- my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
- foreach my $subfield (@restore) {
- $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
- }
- $marcrecord->delete_field($field);
- $marcrecord->insert_grouped_field($field_to);
- $update=1;
+ 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,
+ $controlled_ind->{ind1} // $field->indicator(1),
+ $controlled_ind->{ind2} // $field->indicator(2),
+ 9 => $mergeto, # Needed to create field, will be moved
+ );
+ 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 $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] ];
+ }
+ }
}
- }#for each tag
- }#foreach tagfield
- 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;
+ 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 {
+ $field->replace_with($field_to);
+ }
+ $update = 1;
+ }
}
- if ($update==1){
- &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
- $counteditedbiblio++;
- warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
- }
- }#foreach $marc
- return $counteditedbiblio;
- # now, find every other authority linked with this authority
- # now, find every other authority linked with this authority
-# my $oConnection=C4::Context->Zconn("authorityserver");
-# my $query;
-# # att 9210 Auth-Internal-authtype
-# # att 9220 Auth-Internal-LN
-# # ccl.properties to add for authorities
-# $query= "= ".$mergefrom;
-# my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
-# my $count=$oResult->size() if ($oResult);
-# my @reccache;
-# my $z=0;
-# while ( $z<$count ) {
-# my $rec;
-# $rec=$oResult->record($z);
-# my $marcdata = $rec->raw();
-# push @reccache, $marcdata;
-# $z++;
-# }
-# $oResult->destroy();
-# foreach my $marc(@reccache){
-# my $update;
-# my $marcrecord;
-# $marcrecord = MARC::File::USMARC::decode($marc);
-# foreach my $tagfield (@tags_using_authtype){
-# $tagfield=substr($tagfield,0,3);
-# my @tags = $marcrecord->field($tagfield);
-# foreach my $tag (@tags){
-# my $tagsubs=$tag->subfield("9");
-# #warn "$tagfield:$tagsubs:$mergefrom";
-# if ($tagsubs== $mergefrom) {
-# $tag->update("9" =>$mergeto);
-# foreach my $subfield (@record_to) {
-# # warn "$subfield,$subfield->[0],$subfield->[1]";
-# $tag->update($subfield->[0] =>$subfield->[1]);
-# }#for $subfield
-# }
-# $marcrecord->delete_field($tag);
-# $marcrecord->add_fields($tag);
-# $update=1;
-# }#for each tag
-# }#foreach tagfield
-# my $authoritynumber = TransformMarcToKoha($dbh,$marcrecord,"") ;
-# if ($update==1){
-# &ModAuthority($marcrecord,$authoritynumber,GetAuthTypeCode($authoritynumber)) ;
-# }
-#
-# }#foreach $marc
-}#sub
+ next if !$update;
+ ModBiblio($marcrecord, $biblionumber, GetFrameworkCode($biblionumber));
+ $counteditedbiblio++;
+ }
+ return $counteditedbiblio;
+}
+
+sub _merge_newtag {
+# Routine is only called for an (exceptional) authtypecode change
+# Fixes old behavior of returning the first tag found
+ my ( $oldtag, $new_tags ) = @_;
+
+ # If we e.g. have 650 and 151,651,751 try 651 and check presence
+ my $prefix = substr( $oldtag, 0, 1 );
+ my $guess = $prefix . substr( $new_tags->[0], -2 );
+ if( grep { $_ eq $guess } @$new_tags ) {
+ return $guess;
+ }
+ # Otherwise return one from the same block e.g. 6XX for 650
+ # If not there too, fall back to first new tag (old behavior!)
+ my @same_block = grep { /^$prefix/ } @$new_tags;
+ return @same_block ? $same_block[0] : $new_tags->[0];
+}
+
+sub append_fields_ordered {
+# while we lack this function in MARC::Record
+# we do not want insert_fields_ordered since it inserts before
+ my ( $record, $field ) = @_;
+ if( my @flds = $record->field( $field->tag ) ) {
+ $record->insert_fields_after( pop @flds, $field );
+ } else { # now fallback to insert_fields_ordered
+ $record->insert_fields_ordered( $field );
+ }
+}
=head2 get_auth_type_location
projects / koha.git / blobdiff