|
Lines 15-22
package C4::Linker::Z3950Server;
Link Here
|
| 15 |
# You should have received a copy of the GNU General Public License |
15 |
# You should have received a copy of the GNU General Public License |
| 16 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
16 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
| 17 |
|
17 |
|
| 18 |
use strict; |
18 |
use Modern::Perl; |
| 19 |
use warnings; |
|
|
| 20 |
use Carp; |
19 |
use Carp; |
| 21 |
use MARC::Field; |
20 |
use MARC::Field; |
| 22 |
use MARC::Record; |
21 |
use MARC::Record; |
|
Lines 135-144
sub flip_heading {
Link Here
|
| 135 |
|
134 |
|
| 136 |
=cut |
135 |
=cut |
| 137 |
|
136 |
|
|
|
137 |
sub GetMandatoryFieldZ3950 { |
| 138 |
my $authtypecode = shift; |
| 139 |
if ( C4::Context->preference('marcflavour') eq 'MARC21' ){ |
| 140 |
return { |
| 141 |
'PERSO_NAME' =>'authorpersonal', |
| 142 |
'CORPO_NAME' => 'authorcorp', |
| 143 |
'MEETI_NAME' => 'authormeetingcon', |
| 144 |
'UNIF_TITLE' => 'uniformtitle', |
| 145 |
'TOPIC_TERM' =>'subject', |
| 146 |
}; |
| 147 |
} |
| 148 |
else{ |
| 149 |
return { |
| 150 |
'NP' => 'authorpersonal', |
| 151 |
'CO' => 'authorcorp', |
| 152 |
'TU'=> 'uniformtitle', |
| 153 |
} |
| 154 |
} |
| 155 |
} |
| 156 |
|
| 157 |
sub _auth_build_query { |
| 158 |
my $attr = shift; |
| 159 |
|
| 160 |
my $qry_build = { |
| 161 |
authorcorp => '@attr 1=2 "#term" ', |
| 162 |
authorpersonal => '@attr 1=1 "#term" ', |
| 163 |
authormeetingcon => '@attr 1=3 "#term" ', |
| 164 |
subject => '@attr 1=21 "#term" ', |
| 165 |
uniformtitle => '@attr 1=6 "#term" ', |
| 166 |
}; |
| 167 |
return $qry_build->{$attr}; |
| 168 |
} |
| 169 |
|
| 138 |
sub getZ3950Authority { |
170 |
sub getZ3950Authority { |
| 139 |
my $self = shift; |
171 |
my $self = shift; |
| 140 |
my $heading = shift; |
172 |
my $heading = shift; |
|
|
173 |
my @connexion; |
| 174 |
my $record; |
| 175 |
my $result; |
| 176 |
my $dbh = C4::Context->dbh; |
| 177 |
my $authtypecode = $heading->{'auth_type'}; |
| 141 |
|
178 |
|
|
|
179 |
my $mandatory_z3950 = $self->GetMandatoryFieldZ3950($authtypecode); |
| 180 |
return ( undef, undef, 'Z3950_SEARCH_ERROR' ) if ( !exists $mandatory_z3950->{$authtypecode} ); |
| 181 |
my $attr = $mandatory_z3950->{$authtypecode}; |
| 142 |
# Try to find a match on the Z39.50 server if LinkerZ3950Server is set |
182 |
# Try to find a match on the Z39.50 server if LinkerZ3950Server is set |
| 143 |
if(C4::Context->preference('LinkerZ3950Server')) { |
183 |
if(C4::Context->preference('LinkerZ3950Server')) { |
| 144 |
unless($self->{'conn'}) { |
184 |
unless($self->{'conn'}) { |
|
Lines 149-166
sub getZ3950Authority {
Link Here
|
| 149 |
|
189 |
|
| 150 |
if($server) { |
190 |
if($server) { |
| 151 |
my $options = ZOOM::Options->new(); |
191 |
my $options = ZOOM::Options->new(); |
| 152 |
$options->option('cclfile' => C4::Context->new()->{"serverinfo"}->{"authorityserver"}->{"ccl2rpn"}); |
|
|
| 153 |
$options->option('elementSetName', 'F'); |
192 |
$options->option('elementSetName', 'F'); |
| 154 |
$options->option('async', 0); |
193 |
$options->option('async', 0); |
| 155 |
$options->option('databaseName', $server->{db}); |
194 |
$options->option('databaseName', $server->{db}); |
| 156 |
$options->option('user', $server->{userid} ) if $server->{userid}; |
195 |
$options->option('user', $server->{userid} ) if $server->{userid}; |
| 157 |
$options->option('password', $server->{password}) if $server->{password}; |
196 |
$options->option('password', $server->{password}) if $server->{password}; |
| 158 |
$options->option('preferredRecordSyntax', $server->{syntax}); |
197 |
$options->option('preferredRecordSyntax', $server->{syntax}); |
| 159 |
$self->{'conn'} = create ZOOM::Connection($options); |
198 |
if( $server->{servertype} eq 'sru' ) { |
| 160 |
eval{ $self->{'conn'}->connect( $server->{host}, $server->{port} ) }; |
199 |
foreach( split ',', $server->{sru_options}//'' ) { |
| 161 |
if($@) { |
200 |
#first remove surrounding spaces at comma and equals-sign |
| 162 |
return (undef, undef, 'NO_CONNECTION'); |
201 |
s/^\s+|\s+$//g; |
| 163 |
}} |
202 |
my @temp= split '=', $_, 2; |
|
|
203 |
@temp= map { my $c=$_; $c=~s/^\s+|\s+$//g; $c; } @temp; |
| 204 |
$options->option( $temp[0] => $temp[1] ) if @temp; |
| 205 |
} |
| 206 |
} elsif( $server->{servertype} eq 'zed' ) { |
| 207 |
$options->option( 'databaseName', $server->{db} ); |
| 208 |
$options->option( 'user', $server->{userid} ) if $server->{userid}; |
| 209 |
$options->option( 'password', $server->{password} ) if $server->{password}; |
| 210 |
} |
| 211 |
$connexion[0]= ZOOM::Connection->create($options); |
| 212 |
if( $server->{servertype} eq 'sru' ) { |
| 213 |
my $host= $server->{host}; |
| 214 |
if( $host !~ /^https?:\/\// ) { |
| 215 |
$host = 'http://' . $host; |
| 216 |
} |
| 217 |
eval{ $connexion[0]->connect( $host.':'.$server->{port}.'/'.$server->{db} ); }; |
| 218 |
if($@) { |
| 219 |
return (undef, undef, 'NO_CONNECTION'); |
| 220 |
} |
| 221 |
} else { |
| 222 |
eval{ $connexion[0]->connect( $server->{host}, $server->{port} ); }; |
| 223 |
if($@) { |
| 224 |
return (undef, undef, 'NO_CONNECTION'); |
| 225 |
} |
| 226 |
} |
| 227 |
my $qry_build->{$attr} = _auth_build_query($attr); |
| 228 |
my $zqueryq=''; |
| 229 |
my $squery=''; |
| 230 |
if( $heading->{'search_form'} && $qry_build->{$attr} ) { |
| 231 |
$qry_build->{$attr} =~ s/#term/$heading->{'search_form'}/g; |
| 232 |
$zqueryq = $qry_build->{$attr}; |
| 233 |
$squery = "[".$attr."]=\"$heading->{'search_form'}\""; |
| 234 |
|
| 235 |
} |
| 236 |
if ( $server->{servertype} eq 'zed' ) { |
| 237 |
my $server_zquery = $zqueryq; |
| 238 |
if ( my $attributes = $server->{attributes} ) { |
| 239 |
$server_zquery = "$attributes $zqueryq"; |
| 240 |
} |
| 241 |
$result = $connexion[0]->search_pqf( $server_zquery ); |
| 242 |
} |
| 243 |
else { |
| 244 |
$result = $connexion[0]->search( |
| 245 |
ZOOM::Query::CQL->new(_translate_query( $server, $squery )) |
| 246 |
); |
| 247 |
} |
| 248 |
if ( ZOOM::event( \@connexion ) != 0 ) { |
| 249 |
$connexion[0]->last_event(); |
| 250 |
} |
| 251 |
if( $result->size() > 0 ) { |
| 252 |
$record = MARC::Record::new_from_usmarc($result->record(0)->raw()); |
| 253 |
} |
| 254 |
else{ |
| 255 |
return (undef, undef, 'Z3950_SEARCH_ERROR'); |
| 256 |
} |
| 257 |
} |
| 164 |
else { |
258 |
else { |
| 165 |
return (undef, undef, 'SERVER_NOT_FOUND'); |
259 |
return (undef, undef, 'SERVER_NOT_FOUND'); |
| 166 |
} |
260 |
} |
|
Lines 169-197
sub getZ3950Authority {
Link Here
|
| 169 |
else { |
263 |
else { |
| 170 |
return; |
264 |
return; |
| 171 |
} |
265 |
} |
| 172 |
my $query =qq(Match-Heading,do-not-truncate,ext="$heading->{'search_form'}"); |
|
|
| 173 |
my $zquery = eval{ ZOOM::Query::CCL2RPN->new($query, $self->{'conn'}) }; |
| 174 |
if($@) { |
| 175 |
warn $query . "\n" . $@; |
| 176 |
return (undef, undef, 'Z3950_QUERY_ERROR'); |
| 177 |
} |
| 178 |
|
| 179 |
# Try to send the search query to the server. |
| 180 |
my $rs = eval{ $self->{'conn'}->search($zquery) }; |
| 181 |
if($@){ |
| 182 |
warn $query . "\n" . $@; |
| 183 |
return (undef, undef, 'Z3950_SEARCH_EMPTY'); |
| 184 |
} |
| 185 |
|
| 186 |
# If authorities are found, select the first valid one for addition in the local authority table. |
| 187 |
my $record; |
| 188 |
if($rs->size() != 0) { |
| 189 |
$record = MARC::Record::new_from_usmarc($rs->record(0)->raw()); |
| 190 |
}else{ |
| 191 |
return (undef, undef, 'Z3950_SEARCH_ERROR'); |
| 192 |
} |
| 193 |
$rs->destroy(); |
| 194 |
$zquery->destroy(); |
| 195 |
|
266 |
|
| 196 |
# If a valid authority was found, add it in the local authority database. |
267 |
# If a valid authority was found, add it in the local authority database. |
| 197 |
if($record) { |
268 |
if($record) { |
|
Lines 201-207
sub getZ3950Authority {
Link Here
|
| 201 |
my $authId; |
272 |
my $authId; |
| 202 |
|
273 |
|
| 203 |
# Use the control number to prevent the creation of duplicate authorities. |
274 |
# Use the control number to prevent the creation of duplicate authorities. |
| 204 |
my $controlNumber = $record->field('970')->subfield('0'); |
275 |
my $controlNumber = $record->field('001')->data; |
| 205 |
my $sthExist=$dbh->prepare("SELECT authid FROM auth_header WHERE origincode =?"); |
276 |
my $sthExist=$dbh->prepare("SELECT authid FROM auth_header WHERE origincode =?"); |
| 206 |
$sthExist->execute($controlNumber) or die $sthExist->errstr; |
277 |
$sthExist->execute($controlNumber) or die $sthExist->errstr; |
| 207 |
($authId) = $sthExist->fetchrow; |
278 |
($authId) = $sthExist->fetchrow; |
|
Lines 313-316
sub getZ3950Authority {
Link Here
|
| 313 |
return ; |
384 |
return ; |
| 314 |
} |
385 |
} |
| 315 |
|
386 |
|
|
|
387 |
sub _translate_query { #SRU query adjusted per server cf. srufields column |
| 388 |
my ($server, $query) = @_; |
| 389 |
|
| 390 |
#sru_fields is in format title=field,isbn=field,... |
| 391 |
#if a field doesn't exist, try anywhere or remove [field]= |
| 392 |
my @parts= split(',', $server->{sru_fields} ); |
| 393 |
my %trans= map { if( /=/ ) { ( $`,$' ) } else { () } } @parts; |
| 394 |
my $any= $trans{srchany}?$trans{srchany}.'=':''; |
| 395 |
|
| 396 |
my $q=$query; |
| 397 |
foreach my $key (keys %trans) { |
| 398 |
my $f=$trans{$key}; |
| 399 |
if( $f ) { |
| 400 |
$q=~s/\[$key\]/$f/g; |
| 401 |
} else { |
| 402 |
$q=~s/\[$key\]=/$any/g; |
| 403 |
} |
| 404 |
} |
| 405 |
$q=~s/\[\w+\]=/$any/g; # remove remaining fields (not found in field list) |
| 406 |
return $q; |
| 407 |
} |
| 408 |
|
| 316 |
1; |
409 |
1; |
| 317 |
- |
|
|