From da2eee4a872b14d1e7f8d74236ff68d1af8f43fd Mon Sep 17 00:00:00 2001 From: Hammat Wele Date: Fri, 19 May 2023 13:20:12 +0000 Subject: [PATCH] Bug 11300: (Fix) Editing the way authority links is searched on a Z39.50 server. To test: 1. Apply the patch 2. Set the preference LinkerModule to Z39.50 Server 3. Set the preference LinkerZ3950Server to LIBRARY OF CONGRESS SUBJECTS 4. Set the preference LinkerOptions to local_first 5. Verify that your local authorities include "Perl (Computer program language)" but do not include "Scripting languages (Computer science)" 6. Cataloging > New record 7. In tab 6, field 650, paste Perl (Computer program language) in subfield a and click "Link authorities automatically" - you should be told "650 - A matching authority was found in the local database." which verifies that authority linking currently works at all. 8. Clear the 650 by clicking the "Delete this tag" icon with the red X at the end of the tag description, and paste "Scripting languages (Computer science)" in subfield a and click "Link authorities automatically" ---> you should be told "A matching authority record was found on the Z39.50 server and was imported locally." ---> you should also find the imported authority in your local authorities --- C4/Biblio.pm.rej | 20 ------- C4/Linker/Z3950Server.pm | 125 ++++++++++++++++++++++++++++----------- 2 files changed, 92 insertions(+), 53 deletions(-) delete mode 100644 C4/Biblio.pm.rej diff --git a/C4/Biblio.pm.rej b/C4/Biblio.pm.rej deleted file mode 100644 index dc41b7d742..0000000000 --- a/C4/Biblio.pm.rej +++ /dev/null @@ -1,20 +0,0 @@ -diff a/C4/Biblio.pm b/C4/Biblio.pm (rejected hunks) -@@ -461,7 +462,7 @@ sub BiblioAutoLink { - - =head2 LinkBibHeadingsToAuthorities - -- my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink, $verbose]); -+ my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink, $verbose, $dont_auto_create]); - - Links bib headings to authority records by checking - each authority-controlled field in the C -@@ -484,7 +485,9 @@ sub LinkBibHeadingsToAuthorities { - my $frameworkcode = shift; - my $allowrelink = shift; - my $verbose = shift; -+ my $dont_auto_create = shift; - my %results; -+ my $linker_default=C4::Linker::Default->new(); - if (!$bib) { - carp 'LinkBibHeadingsToAuthorities called on undefined bib record'; - return ( 0, {}); diff --git a/C4/Linker/Z3950Server.pm b/C4/Linker/Z3950Server.pm index 5c2074012e..6b583c6301 100644 --- a/C4/Linker/Z3950Server.pm +++ b/C4/Linker/Z3950Server.pm @@ -15,8 +15,7 @@ package C4::Linker::Z3950Server; # You should have received a copy of the GNU General Public License # along with Koha; if not, see . -use strict; -use warnings; +use Modern::Perl; use Carp; use MARC::Field; use MARC::Record; @@ -138,8 +137,10 @@ sub flip_heading { sub getZ3950Authority { my $self = shift; my $heading = shift; + my @connexion; + my $record; + my $result; - # Try to find a match on the Z39.50 server if LinkerZ3950Server is set if(C4::Context->preference('LinkerZ3950Server')) { unless($self->{'conn'}) { my $sth = C4::Context->dbh->prepare("select * from z3950servers where servername=?"); @@ -149,18 +150,77 @@ sub getZ3950Authority { if($server) { my $options = ZOOM::Options->new(); - $options->option('cclfile' => C4::Context->new()->{"serverinfo"}->{"authorityserver"}->{"ccl2rpn"}); $options->option('elementSetName', 'F'); $options->option('async', 0); $options->option('databaseName', $server->{db}); $options->option('user', $server->{userid} ) if $server->{userid}; $options->option('password', $server->{password}) if $server->{password}; $options->option('preferredRecordSyntax', $server->{syntax}); - $self->{'conn'} = create ZOOM::Connection($options); - eval{ $self->{'conn'}->connect( $server->{host}, $server->{port} ) }; - if($@) { - return (undef, undef, 'NO_CONNECTION'); - }} + if( $server->{servertype} eq 'sru' ) { + foreach( split ',', $server->{sru_options}//'' ) { + #first remove surrounding spaces at comma and equals-sign + s/^\s+|\s+$//g; + my @temp= split '=', $_, 2; + @temp= map { my $c=$_; $c=~s/^\s+|\s+$//g; $c; } @temp; + $options->option( $temp[0] => $temp[1] ) if @temp; + } + } elsif( $server->{servertype} eq 'zed' ) { + $options->option( 'databaseName', $server->{db} ); + $options->option( 'user', $server->{userid} ) if $server->{userid}; + $options->option( 'password', $server->{password} ) if $server->{password}; + } + $connexion[0]= ZOOM::Connection->create($options); + if( $server->{servertype} eq 'sru' ) { + my $host= $server->{host}; + if( $host !~ /^https?:\/\// ) { + $host = 'http://' . $host; + } + eval{ $connexion[0]->connect( $host.':'.$server->{port}.'/'.$server->{db} ); }; + if($@) { + return (undef, undef, 'NO_CONNECTION'); + } + } else { + eval{ $connexion[0]->connect( $server->{host}, $server->{port} ); }; + if($@) { + return (undef, undef, 'NO_CONNECTION'); + } + } + my $qry_build->{subject} = '@attr 1=21 "#term" '; + my $zqueryq=''; + my $squery=''; + if( $heading->{'search_form'} && $qry_build->{subject} ) { + $qry_build->{subject} =~ s/#term/$heading->{'search_form'}/g; + $zqueryq = $qry_build->{subject}; + $squery = "[subject]=\"$heading->{'search_form'}\""; + } + if ( $server->{servertype} eq 'zed' ) { + my $server_zquery = $zqueryq; + if ( my $attributes = $server->{attributes} ) { + $server_zquery = "$attributes $zqueryq"; + } + $result = $connexion[0]->search_pqf( $server_zquery ); + } + else { + $result = $connexion[0]->search( + ZOOM::Query::CQL->new(_translate_query( $server, $squery )) + ); + } + if ( ZOOM::event( \@connexion ) != 0 ) { + $connexion[0]->last_event(); + } + if( $result->size() > 0 ) { + for( my $i = 0; $i < $result->size();$i++){ + my $rec = MARC::Record->new_from_usmarc($result->record($i)->raw()); + if($rec->field('150')->subfield('a') eq $heading->{'display_form'}){ + $record = $rec; + $i = $result->size(); + } + } + } + else{ + return (undef, undef, 'Z3950_SEARCH_ERROR'); + } + } else { return (undef, undef, 'SERVER_NOT_FOUND'); } @@ -169,29 +229,6 @@ sub getZ3950Authority { else { return; } - my $query =qq(Match-Heading,do-not-truncate,ext="$heading->{'search_form'}"); - my $zquery = eval{ ZOOM::Query::CCL2RPN->new($query, $self->{'conn'}) }; - if($@) { - warn $query . "\n" . $@; - return (undef, undef, 'Z3950_QUERY_ERROR'); - } - - # Try to send the search query to the server. - my $rs = eval{ $self->{'conn'}->search($zquery) }; - if($@){ - warn $query . "\n" . $@; - return (undef, undef, 'Z3950_SEARCH_EMPTY'); - } - - # If authorities are found, select the first valid one for addition in the local authority table. - my $record; - if($rs->size() != 0) { - $record = MARC::Record::new_from_usmarc($rs->record(0)->raw()); - }else{ - return (undef, undef, 'Z3950_SEARCH_ERROR'); - } - $rs->destroy(); - $zquery->destroy(); # If a valid authority was found, add it in the local authority database. if($record) { @@ -201,7 +238,7 @@ sub getZ3950Authority { my $authId; # Use the control number to prevent the creation of duplicate authorities. - my $controlNumber = $record->field('970')->subfield('0'); + my $controlNumber = $record->field('001')->data; my $sthExist=$dbh->prepare("SELECT authid FROM auth_header WHERE origincode =?"); $sthExist->execute($controlNumber) or die $sthExist->errstr; ($authId) = $sthExist->fetchrow; @@ -313,4 +350,26 @@ sub getZ3950Authority { return ; } +sub _translate_query { #SRU query adjusted per server cf. srufields column + my ($server, $query) = @_; + + #sru_fields is in format title=field,isbn=field,... + #if a field doesn't exist, try anywhere or remove [field]= + my @parts= split(',', $server->{sru_fields} ); + my %trans= map { if( /=/ ) { ( $`,$' ) } else { () } } @parts; + my $any= $trans{srchany}?$trans{srchany}.'=':''; + + my $q=$query; + foreach my $key (keys %trans) { + my $f=$trans{$key}; + if( $f ) { + $q=~s/\[$key\]/$f/g; + } else { + $q=~s/\[$key\]=/$any/g; + } + } + $q=~s/\[\w+\]=/$any/g; # remove remaining fields (not found in field list) + return $q; +} + 1; -- 2.34.1