X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FAuthoritiesMarc.pm;h=10c67fc9ff614d3f3b9a63f8fcc988255dcea992;hb=refs%2Fheads%2Fkoha_ffzg;hp=b6e3690bbfbb01a62e92ca09aa4ab36072e1913b;hpb=3b3a54e147bc07e7cb37e7430e3d10f3486db120;p=koha.git diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index b6e3690bbf..10c67fc9ff 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -1,20 +1,21 @@ 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 . use strict; use warnings; @@ -26,20 +27,23 @@ use C4::AuthoritiesMarc::MARC21; 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 @@ -48,8 +52,6 @@ BEGIN { &GetAuthority &GetAuthorityXML - &CountUsage - &CountUsageChildren &SearchAuthorities &BuildSummary @@ -87,7 +89,6 @@ sub GetAuthMARCFromKohaField { 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; @@ -109,125 +110,41 @@ sub SearchAuthorities { 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; - if (C4::Context->preference('NoZebra')) { - - # - # build the query - # - my $query; + $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; + my @authtypecode; my @auths=split / /,$authtypecode ; foreach my $auth (@auths){ - $query .="AND auth_type= $auth "; + $query .=" \@attr 1=authtype \@attr 5=100 ".$auth; ##No truncation on authtype + push @authtypecode ,$auth; + $n++; } - $query =~ s/^AND //; - my $dosearch; - for(my $i = 0 ; $i <= $#{$value} ; $i++) - { - if (@$value[$i]){ - if (@$tags[$i] =~/mainentry|mainmainentry/) { - $query .= qq( AND @$tags[$i] ); - } else { - $query .=" AND "; - } - if (@$operator[$i] eq 'is') { - $query.=(@$tags[$i]?"=":""). '"'.@$value[$i].'"'; - }elsif (@$operator[$i] eq "="){ - $query.=(@$tags[$i]?"=":""). '"'.@$value[$i].'"'; - }elsif (@$operator[$i] eq "start"){ - $query.=(@$tags[$i]?"=":"").'"'.@$value[$i].'%"'; - } else { - $query.=(@$tags[$i]?"=":"").'"'.@$value[$i].'%"'; - } - $dosearch=1; - }#if value - } - # - # do the query (if we had some search term - # - if ($dosearch) { -# warn "QUERY : $query"; - my $result = C4::Search::NZanalyse($query,'authorityserver'); -# warn "result : $result"; - my %result; - foreach (split /;/,$result) { - my ($authid,$title) = split /,/,$_; - # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title - # and we don't want to get only 1 result for each of them !!! - # hint & speed improvement : we can order without reading the record - # so order, and read records only for the requested page ! - $result{$title.$authid}=$authid; - } - # sort the hash and return the same structure as GetRecords (Zebra querying) - my @listresult = (); - my $numbers=0; - if ($sortby eq 'HeadingDsc') { # sort by mainmainentry desc - foreach my $key (sort {$b cmp $a} (keys %result)) { - push @listresult, $result{$key}; -# warn "push..."$#finalresult; - $numbers++; - } - } else { # sort by mainmainentry ASC - foreach my $key (sort (keys %result)) { - push @listresult, $result{$key}; -# warn "push..."$#finalresult; - $numbers++; - } - } - # limit the $results_per_page to result size if it's more - $length = $numbers-$offset if $numbers < ($offset+$length); - # for the requested page, replace authid by the complete record - # speed improvement : avoid reading too much things - my @finalresult; - for (my $counter=$offset;$counter<=$offset+$length-1;$counter++) { -# $finalresult[$counter] = GetAuthority($finalresult[$counter])->as_usmarc; - my $separator=C4::Context->preference('authoritysep'); - my $authrecord =GetAuthority($listresult[$counter]); - my $authid=$listresult[$counter]; - 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 %newline; - $newline{used}=CountUsage($authid); - $newline{summary} = $summary; - $newline{authid} = $authid; - $newline{even} = $counter % 2; - push @finalresult, \%newline; - } - return (\@finalresult, $numbers); - } else { - return; + if ($n>1){ + while ($n>1){$query= "\@or ".$query;$n--;} } - } else { - my $query; - 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; - my @authtypecode; - my @auths=split / /,$authtypecode ; - foreach my $auth (@auths){ - $query .=" \@attr 1=authtype \@attr 5=100 ".$auth; ##No truncation on authtype - push @authtypecode ,$auth; - $n++; - } - if ($n>1){ - while ($n>1){$query= "\@or ".$query;$n--;} - } + if ($QParser) { + $qpquery .= '(authtype:' . join('|| authtype:', @auths) . ')'; } - - my $dosearch; - my $and=" \@and " ; - my $q2; - my $attr_cnt = 0; - for(my $i = 0 ; $i <= $#{$value} ; $i++) - { - if (@$value[$i]){ + } + + my $dosearch; + my $and=" \@and " ; + my $q2; + my $attr_cnt = 0; + for ( my $i = 0 ; $i <= $#{$value} ; $i++ ) { + if ( @$value[$i] ) { + if ( @$tags[$i] ) { if ( @$tags[$i] eq "mainmainentry" ) { $attr = " \@attr 1=Heading-Main "; } @@ -246,207 +163,185 @@ sub SearchAuthorities { 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 "; } - if ( @$operator[$i] eq 'is' ) { - $attr .= " \@attr 4=1 \@attr 5=100 " - ; ##Phrase, No truncation,all of subfield field must match - } - elsif ( @$operator[$i] eq "=" ) { - $attr .= " \@attr 4=107 "; #Number Exact match - } - elsif ( @$operator[$i] eq "start" ) { - $attr .= " \@attr 3=2 \@attr 4=1 \@attr 5=1 " - ; #Firstinfield Phrase, Right truncated + else { # Use the index passed in params + $attr = " \@attr 1=" . @$tags[$i] . " "; } - elsif ( @$operator[$i] eq "exact" ) { - $attr .= " \@attr 4=1 \@attr 5=100 \@attr 6=3 " - ; ##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 "; - } - } - @$value[$i] =~ s/"/\\"/g; # Escape the double-quotes in the search value - $attr =$attr."\"".@$value[$i]."\""; - $q2 .=$attr; - $dosearch=1; - ++$attr_cnt; - }#if value - } - ##Add how many queries generated - if (defined $query && $query=~/\S+/){ - $query= $and x $attr_cnt . $query . (defined $q2 ? $q2 : ''); - } else { - $query= $q2; - } - ## Adding order - #$query=' @or @attr 7=2 @attr 1=Heading 0 @or @attr 7=1 @attr 1=Heading 1'.$query if ($sortby eq "HeadingDsc"); - my $orderstring; - if ($sortby eq 'HeadingAsc') { - $orderstring = '@attr 7=1 @attr 1=Heading 0'; - } elsif ($sortby eq 'HeadingDsc') { - $orderstring = '@attr 7=2 @attr 1=Heading 0'; - } elsif ($sortby eq 'AuthidAsc') { - $orderstring = '@attr 7=1 @attr 4=109 @attr 1=Local-Number 0'; - } elsif ($sortby eq 'AuthidDsc') { - $orderstring = '@attr 7=2 @attr 4=109 @attr 1=Local-Number 0'; - } - $query=($query?$query:"\@attr 1=_ALLRECORDS \@attr 2=103 ''"); - $query="\@or $orderstring $query" if $orderstring; + } #if @$tags[$i] + else { # Assume any if no index was specified + $attr = " \@attr 1=Any "; + } - $offset=0 unless $offset; - 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 $oAResult; - $oAResult= $oAuth[0]->search($Anewq) ; - while (($i = ZOOM::event(\@oAuth)) != 0) { - my $ev = $oAuth[$i-1]->last_event(); - last if $ev == ZOOM::Event::ZEND; - } - my($error, $errmsg, $addinfo, $diagset) = $oAuth[0]->error_x(); - if ($error) { - warn "oAuth error: $errmsg ($error) $addinfo $diagset\n"; - goto NOLUCK; - } - - my $nbresults; - $nbresults=$oAResult->size(); - my $nremains=$nbresults; - my @result = (); - my @finalresult = (); - - if ($nbresults>0){ - - ##Find authid and linkid fields - ##we may be searching multiple authoritytypes. - ## FIXME this assumes that all authid and linkid fields are the same for all authority types - # my ($authidfield,$authidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.authid",$authtypecode[0]); - # my ($linkidfield,$linkidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.linkid",$authtypecode[0]); - while (($counter < $nbresults) && ($counter < ($offset + $length))) { - - ##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 $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 $reported_tag; - my $mainentry = $authrecord->field($auth_tag_to_report); - if ($mainentry) { - - foreach ( $mainentry->subfields() ) { - $reported_tag .= '$' . $_->[0] . $_->[1]; - } - } - my $thisauthtype = GetAuthType(GetAuthTypeCode($authid)); - unless (defined $thisauthtype) { - $thisauthtype = GetAuthType($authtypecode) if $authtypecode; + 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 + } + elsif ( $operator and $operator eq "=" ) { + $attr .= " \@attr 4=107 "; #Number Exact match + } + elsif ( $operator and $operator eq "start" ) { + $attr .= " \@attr 3=2 \@attr 4=1 \@attr 5=1 " + ; #Firstinfield Phrase, Right truncated + } + 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 + } + else { + $attr .= " \@attr 5=1 \@attr 4=6 " + ; ## Word list, right truncated, anywhere + if ( $sortby eq 'Relevance' ) { + $attr .= "\@attr 2=102 "; } - $newline{authtype} = defined($thisauthtype) ? - $thisauthtype->{'authtypetext'} : ''; - $newline{summary} = $summary; - $newline{even} = $counter % 2; - $newline{reported_tag} = $reported_tag; } - $counter++; - push @finalresult, \%newline; - }## while counter - ### - if (! $skipmetadata) { - for (my $z=0; $z<@finalresult; $z++){ - my $count=CountUsage($finalresult[$z]{authid}); - $finalresult[$z]{used}=$count; - }# all $z's + @$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 nbresult - NOLUCK: - $oAResult->destroy(); - # $oAuth[0]->destroy(); - - return (\@finalresult, $nbresults); + } #if value } -} - -=head2 CountUsage - - $count= &CountUsage($authid) + ##Add how many queries generated + if (defined $query && $query=~/\S+/){ + $query= $and x $attr_cnt . $query . (defined $q2 ? $q2 : ''); + } else { + $query= $q2; + } + ## Adding order + #$query=' @or @attr 7=2 @attr 1=Heading 0 @or @attr 7=1 @attr 1=Heading 1'.$query if ($sortby eq "HeadingDsc"); + my $orderstring; + if ($sortby eq 'HeadingAsc') { + $orderstring = '@attr 7=1 @attr 1=Heading 0'; + } elsif ($sortby eq 'HeadingDsc') { + $orderstring = '@attr 7=2 @attr 1=Heading 0'; + } elsif ($sortby eq 'AuthidAsc') { + $orderstring = '@attr 7=1 @attr 4=109 @attr 1=Local-Number 0'; + } elsif ($sortby eq 'AuthidDsc') { + $orderstring = '@attr 7=2 @attr 4=109 @attr 1=Local-Number 0'; + } + if ($QParser) { + $qpquery .= ' all:all' unless $value->[0]; -counts Usage of Authid in bibliorecords. + if ( $value->[0] =~ m/^qp=(.*)$/ ) { + $qpquery = $1; + } -=cut + $qpquery .= " #$sortby" unless $sortby eq ''; -sub CountUsage { - my ($authid) = @_; - if (C4::Context->preference('NoZebra')) { - # Read the index Koha-Auth-Number for this authid and count the lines - my $result = C4::Search::NZanalyse("an=$authid"); - my @tab = split /;/,$result; - return scalar @tab; + $QParser->parse( $qpquery ); + $query = $QParser->target_syntax('authorityserver'); } else { - ### 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; + $query=($query?$query:"\@attr 1=_ALLRECORDS \@attr 2=103 ''"); + $query="\@or $orderstring $query" if $orderstring; } -} -=head2 CountUsageChildren + $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 $oAResult; + $oAResult= $oAuth[0]->search($Anewq) ; + while (($i = ZOOM::event(\@oAuth)) != 0) { + my $ev = $oAuth[$i-1]->last_event(); + last if $ev == ZOOM::Event::ZEND; + } + my($error, $errmsg, $addinfo, $diagset) = $oAuth[0]->error_x(); + if ($error) { + warn "oAuth error: $errmsg ($error) $addinfo $diagset\n"; + goto NOLUCK; + } - $count= &CountUsageChildren($authid) + my $nbresults; + $nbresults=$oAResult->size(); + my $nremains=$nbresults; + my @result = (); + my @finalresult = (); -counts Usage of narrower terms of Authid in bibliorecords. + if ($nbresults>0){ -=cut + ##Find authid and linkid fields + ##we may be searching multiple authoritytypes. + ## FIXME this assumes that all authid and linkid fields are the same for all authority types + # my ($authidfield,$authidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.authid",$authtypecode[0]); + # my ($linkidfield,$linkidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.linkid",$authtypecode[0]); + while (($counter < $nbresults) && ($counter < ($offset + $length))) { + + ##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES + my $rec=$oAResult->record($counter); + my $separator=C4::Context->preference('AuthoritySeparator'); + my $authrecord = C4::Search::new_record_from_zebra( + 'authorityserver', + $rec->raw() + ); -sub CountUsageChildren { - my ($authid) = @_; -} + if ( !defined $authrecord or !defined $authrecord->field('001') ) { + $counter++; + next; + } -=head2 GetAuthTypeCode + SetUTF8Flag( $authrecord ); + + my $authid=$authrecord->field('001')->data(); + my %newline; + $newline{authid} = $authid; + if ( !$skipmetadata ) { + 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]; + } + } - $authtypecode= &GetAuthTypeCode($authid) + my ( $thisauthtype, $thisauthtypecode ); + if ( my $authority = Koha::Authorities->find($authid) ) { + $thisauthtypecode = $authority->authtypecode; + $thisauthtype = Koha::Authority::Types->find($thisauthtypecode); + } + unless (defined $thisauthtype) { + $thisauthtypecode = $authtypecode; + $thisauthtype = Koha::Authority::Types->find($thisauthtypecode); + } + my $summary = BuildSummary( $authrecord, $authid, $thisauthtypecode ); -returns authtypecode of an authid + $newline{authtype} = defined($thisauthtype) ? + $thisauthtype->authtypetext : ''; + $newline{summary} = $summary; + $newline{even} = $counter % 2; + $newline{reported_tag} = $reported_tag; + } + $counter++; + push @finalresult, \%newline; + }## while counter + ### + if (! $skipmetadata) { + for (my $z=0; $z<@finalresult; $z++){ + my $count = Koha::Authorities->get_usage_count({ authid => $finalresult[$z]{authid} }); + $finalresult[$z]{used}=$count; + }# all $z's + } -=cut + }## if nbresult + NOLUCK: + $oAResult->destroy(); + # $oAuth[0]->destroy(); -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; + return (\@finalresult, $nbresults); } - + =head2 GuessAuthTypeCode my $authtypecode = GuessAuthTypeCode($record); @@ -456,9 +351,9 @@ Get the record and tries to guess the adequate authtypecode from its content. =cut sub GuessAuthTypeCode { - my ($record) = @_; + my ($record, $heading_fields) = @_; return unless defined $record; -my $heading_fields = { + $heading_fields //= { "MARC21"=>{ '100'=>{authtypecode=>'PERSO_NAME'}, '110'=>{authtypecode=>'CORPO_NAME'}, @@ -597,7 +492,7 @@ sub GetTagsLabels { $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" @@ -612,12 +507,13 @@ 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 ) { @@ -633,6 +529,7 @@ ORDER BY tagfield,tagsubfield" $res->{$tag}->{$subfield}->{hidden} = $hidden; $res->{$tag}->{$subfield}->{isurl} = $isurl; $res->{$tag}->{$subfield}->{link} = $link; + $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue; } return $res; } @@ -673,12 +570,19 @@ sub AddAuthority { 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); @@ -697,8 +601,8 @@ sub AddAuthority { 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, ) ); } @@ -733,57 +637,42 @@ sub AddAuthority { $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 @@ -795,27 +684,13 @@ Modifies authority record, optionally updates attached biblios. =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 @@ -858,37 +733,11 @@ Returns MARC::Record of the authority passed in parameter. 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) @@ -905,24 +754,33 @@ sub FindDuplicateAuthority { # 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 $query='at='.$authtypecode.' '; - my $filtervalues=qr([\001-\040\!\'\"\`\#\$\%\&\*\+,\-\./:;<=>\?\@\(\)\{\[\]\}_\|\~]); + my $QParser; + $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser')); + my $op; + if ($QParser) { + $op = '&&'; + } else { + $op = 'AND'; + } + my $query='at:'.$authtypecode.' '; + 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.= " and he,wrdl=\"".$_->[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; @@ -934,7 +792,7 @@ sub FindDuplicateAuthority { 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. @@ -945,12 +803,22 @@ sub BuildSummary { 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', @@ -984,34 +852,36 @@ sub BuildSummary { # 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/
/g; - $summary{summary} = $resultstring; + $summary{summary} =~ s/\\n/
/g; } my @authorized; my @notes; @@ -1022,7 +892,11 @@ sub BuildSummary { # construct UNIMARC summary, that is quite different from MARC21 one # accepted form foreach my $field ($record->field('2..')) { - push @authorized, { heading => $field->as_string('abcdefghijlmnopqrstuvwxyz'), field => $field->tag() }; + push @authorized, { + heading => $field->as_string('abcdefghijlmnopqrstuvwxyz'), + hemain => ( $field->subfield('a') // undef ), + field => $field->tag(), + }; } # rejected form(s) foreach my $field ($record->field('3..')) { @@ -1030,7 +904,12 @@ sub BuildSummary { } foreach my $field ($record->field('4..')) { my $thesaurus = $field->subfield('2') ? "thes. : ".$thesaurus{"$field->subfield('2')"}." : " : ''; - push @seefrom, { heading => $thesaurus . $field->as_string('abcdefghijlmnopqrstuvwxyz'), type => 'seefrom', field => $field->tag() }; + push @seefrom, { + heading => $thesaurus . $field->as_string('abcdefghijlmnopqrstuvwxyz'), + hemain => ( $field->subfield('a') // undef ), + type => 'seefrom', + field => $field->tag(), + }; } # see : @@ -1041,15 +920,16 @@ sub BuildSummary { field => $_->tag, type => $type, heading => $heading, + hemain => ( $_->subfield('a') // undef ), search => $heading, - authid => $_->subfield('9'), + authid => ( $_->subfield('9') // undef ), } } $record->field('5..'); # Other forms @otherscript = map { { - lang => $_->subfield('8') || '', - term => $_->subfield('a'), + lang => length ($_->subfield('8')) == 6 ? substr ($_->subfield('8'), 3, 3) : $_->subfield('8') || '', + term => $_->subfield('a') . ($_->subfield('b') ? ', ' . $_->subfield('b') : ''), direction => 'ltr', field => $_->tag, } } $record->field('7..'); @@ -1091,9 +971,17 @@ sub BuildSummary { $subfields_to_report = 'vxyz'; } if ($subfields_to_report) { - push @authorized, { heading => $field->as_string($subfields_to_report), field => $tag }; + push @authorized, { + heading => $field->as_string($subfields_to_report), + hemain => ( $field->subfield( substr($subfields_to_report, 0, 1) ) // undef ), + field => $tag, + }; } else { - push @authorized, { heading => $field->as_string(), field => $tag }; + push @authorized, { + heading => $field->as_string(), + hemain => ( $field->subfield( 'a' ) // undef ), + field => $tag, + }; } } foreach my $field ($record->field('4..')) { #See From @@ -1104,9 +992,19 @@ sub BuildSummary { $type = 'earlier' if $type && $type ne 'n'; } if ($type eq 'subfi') { - push @seefrom, { heading => $field->as_string($marc21subfields), type => ($field->subfield('i') || ''), field => $field->tag() }; + push @seefrom, { + heading => $field->as_string($marc21subfields), + hemain => $field->subfield( substr($marc21subfields, 0, 1) ), + type => ($field->subfield('i') || ''), + field => $field->tag(), + }; } else { - push @seefrom, { heading => $field->as_string($marc21subfields), type => $type, field => $field->tag() }; + push @seefrom, { + heading => $field->as_string($marc21subfields), + hemain => $field->subfield( substr($marc21subfields, 0, 1) ), + type => $type, + field => $field->tag(), + }; } } foreach my $field ($record->field('5..')) { #See Also @@ -1119,18 +1017,20 @@ sub BuildSummary { if ($type eq 'subfi') { push @seealso, { heading => $field->as_string($marc21subfields), - type => $field->subfield('i'), - field => $field->tag(), - search => $field->as_string($marc21subfields) || '', - authid => $field->subfield('9') || '' + hemain => $field->subfield( substr($marc21subfields, 0, 1) ), + type => $field->subfield('i'), + field => $field->tag(), + search => $field->as_string($marc21subfields) || '', + authid => $field->subfield('9') || '' }; } else { push @seealso, { heading => $field->as_string($marc21subfields), - type => $type, - field => $field->tag(), - search => $field->as_string($marc21subfields) || '', - authid => $field->subfield('9') || '' + hemain => $field->subfield( substr($marc21subfields, 0, 1) ), + type => $type, + field => $field->tag(), + search => $field->as_string($marc21subfields) || '', + authid => $field->subfield('9') || '' }; } } @@ -1158,6 +1058,7 @@ sub BuildSummary { } } $summary{mainentry} = $authorized[0]->{heading}; + $summary{mainmainentry} = $authorized[0]->{hemain}; $summary{authorized} = \@authorized; $summary{notes} = \@notes; $summary{seefrom} = \@seefrom; @@ -1184,6 +1085,7 @@ sub GetAuthorizedHeading { return unless $args->{authid}; $record = GetAuthority($args->{authid}); } + return unless (ref $record eq 'MARC::Record'); if (C4::Context->preference('marcflavour') eq 'UNIMARC') { # construct UNIMARC summary, that is quite different from MARC21 one # accepted form @@ -1405,6 +1307,7 @@ sub _get_authid_subfield{ my ($field)=@_; return $field->subfield('9')||$field->subfield('3'); } + =head2 GetHeaderAuthority $ref= &GetHeaderAuthority( $authid) @@ -1442,191 +1345,221 @@ sub AddAuthorityTrees{ =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 $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); + @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 @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. - if (C4::Context->preference('NoZebra')) { - #nozebra way - my $dbh=C4::Context->dbh; - my $rq=$dbh->prepare(qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" )); - $rq->execute; - while (my $biblionumbers=$rq->fetchrow){ - my @biblionumbers=split /;/,$biblionumbers; - foreach (@biblionumbers) { - if ($_=~/(\d+),.*/) { - my $marc=GetMarcBiblio($1); - push @reccache,$marc; - } - } - } - } else { - #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 $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++; - } - $oResult->destroy(); + 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; } - #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