use Koha::MetadataRecord::Authority;
use Koha::Authorities;
use Koha::Authority::Types;
+use Koha::Authority;
+use Koha::SearchEngine;
+use Koha::SearchEngine::Search;
use vars qw(@ISA @EXPORT);
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;
### ZOOM search here
my $query;
$query= "an:".$authid;
- my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10);
+ # Should really be replaced with a real count call, this is a
+ # bad way.
+ my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::BIBLIOS_INDEX});
+ my ($err,$res,$result) = $searcher->simple_search_compat($query,0,1);
if ($err) {
warn "Error: $err from search $query";
$result = 0;
$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 )
-Deletes $authid
+Deletes $authid and calls merge to cleanup in linked biblio records
=cut
my ($authid) = @_;
my $dbh=C4::Context->dbh;
+ unless( C4::Context->preference('dontmerge') eq '1' ) {
+ &merge( $authid, GetAuthority($authid) );
+ } 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 );
+ }
+ $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
$_->[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 );
# there is at least 1 result => return the 1st one
if (!defined $error && @{$results} ) {
my $marcrecord = C4::Search::new_record_from_zebra(
my ($field)=@_;
return $field->subfield('9')||$field->subfield('3');
}
+
=head2 GetHeaderAuthority
$ref= &GetHeaderAuthority( $authid)
=head2 merge
- $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
+ $count = merge ( mergefrom, $MARCfrom, [$mergeto, $MARCto] )
+
+Merge biblios linked to authority $mergefrom.
+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
+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) = @_;
+ return 0 unless $mergefrom > 0; # prevent abuse
my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);
my $dbh=C4::Context->dbh;
my $authfrom = Koha::Authorities->find($mergefrom);
my $authto = Koha::Authorities->find($mergeto);
- my $authtypefrom = Koha::Authority::Types->find($authfrom->authtypecode);
- my $authtypeto = Koha::Authority::Types->find($authto->authtypecode);
+ my $authtypefrom = $authfrom ? Koha::Authority::Types->find($authfrom->authtypecode) : undef;
+ my $authtypeto = $authto ? Koha::Authority::Types->find($authto->authtypecode) : undef;
- return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0;
- return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0;
# search the tag to report
- my $auth_tag_to_report_from = $authtypefrom->auth_tag_to_report;
- my $auth_tag_to_report_to = $authtypeto->auth_tag_to_report;
+ my $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);
my @record_from;
- @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
+ @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $auth_tag_to_report_from && $MARCfrom && $MARCfrom->field($auth_tag_to_report_from);
my @reccache;
# search all biblio tags using this authority.
$z++;
}
$oResult->destroy();
- #warn scalar(@reccache)." biblios to update";
# Get All candidate Tags for the change
# (This will reduce the search scope in marc records).
- my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
- $sth->execute($authtypefrom->authtypecode);
- my @tags_using_authtype;
- while (my ($tagfield) = $sth->fetchrow) {
- push @tags_using_authtype,$tagfield ;
- }
- my $tag_to=0;
- if ($authtypeto->authtypecode ne $authtypefrom->authtypecode){
- # If many tags, take the first
- $sth->execute($authtypeto->authtypecode);
- $tag_to=$sth->fetchrow;
- #warn $tag_to;
+ # For a deleted authority record, we scan all auth controlled fields
+ my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?";
+ my $tags_using_authtype = $authtypefrom ? $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( $authtypefrom && $authtypeto && $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
+
+ 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 ) };
+ # And we need to add $9 in order not to duplicate
+ $skip_subfields->{9} = 1 if !$overwrite;
+
foreach my $marcrecord(@reccache){
my $update = 0;
- 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];
+ 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 || ( $overwrite && $countfrom > 1 ) ) {
+ # if mergeto is missing, this indicates a delete
+ # Or: 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
+ ? _merge_newtag( $tag, $tags_new )
+ : $tag;
+ my $field_to = MARC::Field->new(
+ $newtag,
+ $field->indicator(1),
+ $field->indicator(2),
+ "9" => $mergeto,
+ );
+ foreach my $subfield ( grep { $_->[0] ne '9' } @record_to ) {
+ $field_to->add_subfields( $subfield->[0] => $subfield->[1] );
}
- }#for each tag
- }#foreach tagfield
+ if ( !$overwrite ) {
+ # add subfields back in loose mode, check skip_subfields
+ foreach my $subfield ( $field->subfields ) {
+ next if $skip_subfields->{ $subfield->[0] };
+ $field_to->add_subfields( $subfield->[0], $subfield->[1] );
+ }
+ }
+ if ($tags_new) {
+ $marcrecord->delete_field($field);
+ append_fields_ordered( $marcrecord, $field_to );
+ } else {
+ $field->replace_with($field_to);
+ }
+ $update = 1;
+ }
+ }
my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
my $biblionumber;
if ($bibliotag<10){
$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($marcrecord,"") ;
-# if ($update==1){
-# &ModAuthority($marcrecord,$authoritynumber,GetAuthTypeCode($authoritynumber)) ;
-# }
-#
-# }#foreach $marc
-}#sub
+}
+
+sub _merge_newtag {
+# Routine is only called for an (exceptional) authtypecode change
+# Fixes old behavior of returning the first tag found
+ my ( $oldtag, $new_tags ) = @_;
+
+ # If we e.g. have 650 and 151,651,751 try 651 and check presence
+ my $prefix = substr( $oldtag, 0, 1 );
+ my $guess = $prefix . substr( $new_tags->[0], -2 );
+ if( grep { $_ eq $guess } @$new_tags ) {
+ return $guess;
+ }
+ # Otherwise return one from the same block e.g. 6XX for 650
+ # If not there too, fall back to first new tag (old behavior!)
+ my @same_block = grep { /^$prefix/ } @$new_tags;
+ return @same_block ? $same_block[0] : $new_tags->[0];
+}
+
+sub append_fields_ordered {
+# while we lack this function in MARC::Record
+# we do not want insert_fields_ordered since it inserts before
+ my ( $record, $field ) = @_;
+ if( my @flds = $record->field( $field->tag ) ) {
+ $record->insert_fields_after( pop @flds, $field );
+ } else { # now fallback to insert_fields_ordered
+ $record->insert_fields_ordered( $field );
+ }
+}
=head2 get_auth_type_location
projects / koha.git / blobdiff