X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FAuthoritiesMarc.pm;h=10c67fc9ff614d3f3b9a63f8fcc988255dcea992;hb=refs%2Fheads%2Fkoha_ffzg;hp=9ea3b2dbb9c4621406df0ed094e5b8fb64ab5651;hpb=cefa7c21e28b88351ee8ae0dfefb80a515323df9;p=koha.git diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 9ea3b2dbb9..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,6 +110,7 @@ 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; + $sortby="" unless $sortby; my $query; my $qpquery = ''; my $QParser; @@ -140,61 +142,71 @@ sub SearchAuthorities { 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+/){ @@ -221,7 +233,7 @@ sub SearchAuthorities { $qpquery = $1; } - $qpquery .= " #$sortby"; + $qpquery .= " #$sortby" unless $sortby eq ''; $QParser->parse( $qpquery ); $query = $QParser->target_syntax('authorityserver'); @@ -230,7 +242,7 @@ sub SearchAuthorities { $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; @@ -266,35 +278,47 @@ sub SearchAuthorities { ##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; @@ -305,7 +329,7 @@ sub SearchAuthorities { ### 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 } @@ -318,58 +342,6 @@ sub SearchAuthorities { 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); @@ -520,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" @@ -535,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 ) { @@ -556,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; } @@ -596,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); @@ -620,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, ) ); } @@ -656,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 @@ -718,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 @@ -781,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) @@ -828,10 +754,7 @@ 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 $QParser; @@ -840,20 +763,24 @@ sub FindDuplicateAuthority { 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; @@ -865,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. @@ -876,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', @@ -915,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; @@ -953,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..')) { @@ -961,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 : @@ -972,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..'); @@ -1022,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 @@ -1035,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 @@ -1050,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') || '' }; } } @@ -1089,6 +1058,7 @@ sub BuildSummary { } } $summary{mainentry} = $authorized[0]->{heading}; + $summary{mainmainentry} = $authorized[0]->{hemain}; $summary{authorized} = \@authorized; $summary{notes} = \@notes; $summary{seefrom} = \@seefrom; @@ -1337,6 +1307,7 @@ sub _get_authid_subfield{ my ($field)=@_; return $field->subfield('9')||$field->subfield('3'); } + =head2 GetHeaderAuthority $ref= &GetHeaderAuthority( $authid) @@ -1374,175 +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. -Could add some feature : Migrating from a typecode to an other for instance. -Then we should add some new parameter : bibliotargettag, authtargettag +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. + +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