|
Lines 27-32
use C4::Charset;
Link Here
|
| 27 |
use MARC::File::USMARC; |
27 |
use MARC::File::USMARC; |
| 28 |
use C4::ImportBatch; |
28 |
use C4::ImportBatch; |
| 29 |
use C4::AuthoritiesMarc; #GuessAuthTypeCode, FindDuplicateAuthority |
29 |
use C4::AuthoritiesMarc; #GuessAuthTypeCode, FindDuplicateAuthority |
|
|
30 |
use Koha::Database; |
| 30 |
|
31 |
|
| 31 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
32 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
| 32 |
|
33 |
|
|
Lines 135-243
sub Z3950Search {
Link Here
|
| 135 |
my @id= @{$pars->{id}}; |
136 |
my @id= @{$pars->{id}}; |
| 136 |
my $page= $pars->{page}; |
137 |
my $page= $pars->{page}; |
| 137 |
my $biblionumber= $pars->{biblionumber}; |
138 |
my $biblionumber= $pars->{biblionumber}; |
| 138 |
my $isbn= $pars->{isbn}; |
|
|
| 139 |
my $issn= $pars->{issn}; |
| 140 |
my $title= $pars->{title}; |
| 141 |
my $author= $pars->{author}; |
| 142 |
my $dewey= $pars->{dewey}; |
| 143 |
my $subject= $pars->{subject}; |
| 144 |
my $lccn= $pars->{lccn}; |
| 145 |
my $lccall= $pars->{lccall}; |
| 146 |
my $controlnumber= $pars->{controlnumber}; |
| 147 |
my $srchany= $pars->{srchany}; |
| 148 |
my $stdid= $pars->{stdid}; |
| 149 |
|
139 |
|
| 150 |
my $show_next = 0; |
140 |
my $show_next = 0; |
| 151 |
my $total_pages = 0; |
141 |
my $total_pages = 0; |
| 152 |
my $term; |
|
|
| 153 |
my @results; |
142 |
my @results; |
| 154 |
my @breeding_loop = (); |
143 |
my @breeding_loop = (); |
| 155 |
my @oConnection; |
144 |
my @oConnection; |
| 156 |
my @oResult; |
145 |
my @oResult; |
| 157 |
my @errconn; |
146 |
my @errconn; |
| 158 |
my $s = 0; |
147 |
my $s = 0; |
| 159 |
my $query; |
|
|
| 160 |
my $nterms=0; |
| 161 |
my $imported=0; |
148 |
my $imported=0; |
| 162 |
my @serverinfo; #replaces former serverhost, servername, encoding |
|
|
| 163 |
|
149 |
|
| 164 |
if ($isbn) { |
150 |
my ( $zquery, $squery ) = _build_query( $pars ); |
| 165 |
$term=$isbn; |
|
|
| 166 |
$query .= " \@attr 1=7 \@attr 5=1 \"$term\" "; |
| 167 |
$nterms++; |
| 168 |
} |
| 169 |
if ($issn) { |
| 170 |
$term=$issn; |
| 171 |
$query .= " \@attr 1=8 \@attr 5=1 \"$term\" "; |
| 172 |
$nterms++; |
| 173 |
} |
| 174 |
if ($title) { |
| 175 |
$query .= " \@attr 1=4 \"$title\" "; |
| 176 |
$nterms++; |
| 177 |
} |
| 178 |
if ($author) { |
| 179 |
$query .= " \@attr 1=1003 \"$author\" "; |
| 180 |
$nterms++; |
| 181 |
} |
| 182 |
if ($dewey) { |
| 183 |
$query .= " \@attr 1=16 \"$dewey\" "; |
| 184 |
$nterms++; |
| 185 |
} |
| 186 |
if ($subject) { |
| 187 |
$query .= " \@attr 1=21 \"$subject\" "; |
| 188 |
$nterms++; |
| 189 |
} |
| 190 |
if ($lccn) { |
| 191 |
$query .= " \@attr 1=9 $lccn "; |
| 192 |
$nterms++; |
| 193 |
} |
| 194 |
if ($lccall) { |
| 195 |
$query .= " \@attr 1=16 \@attr 2=3 \@attr 3=1 \@attr 4=1 \@attr 5=1 \@attr 6=1 \"$lccall\" "; |
| 196 |
$nterms++; |
| 197 |
} |
| 198 |
if ($controlnumber) { |
| 199 |
$query .= " \@attr 1=12 \"$controlnumber\" "; |
| 200 |
$nterms++; |
| 201 |
} |
| 202 |
if($srchany) { |
| 203 |
$query .= " \@attr 1=1016 \"$srchany\" "; |
| 204 |
$nterms++; |
| 205 |
} |
| 206 |
if($stdid) { |
| 207 |
$query .= " \@attr 1=1007 \"$stdid\" "; |
| 208 |
$nterms++; |
| 209 |
} |
| 210 |
for my $i (1..$nterms-1) { |
| 211 |
$query = "\@and " . $query; |
| 212 |
} |
| 213 |
|
| 214 |
my $dbh = C4::Context->dbh; |
| 215 |
foreach my $servid (@id) { |
| 216 |
my $sth = $dbh->prepare("select * from z3950servers where id=?"); |
| 217 |
$sth->execute($servid); |
| 218 |
while (my $server = $sth->fetchrow_hashref) { |
| 219 |
my $option1= new ZOOM::Options(); |
| 220 |
$option1->option( 'async' => 1 ); |
| 221 |
$option1->option( 'elementSetName', 'F' ); |
| 222 |
$option1->option( 'databaseName', $server->{db} ); |
| 223 |
$option1->option( 'user', $server->{userid} ) if $server->{userid}; |
| 224 |
$option1->option( 'password', $server->{password} ) if $server->{password}; |
| 225 |
$option1->option( 'preferredRecordSyntax', $server->{syntax} ); |
| 226 |
$option1->option( 'timeout', $server->{timeout} ) if $server->{timeout}; |
| 227 |
$oConnection[$s]= create ZOOM::Connection($option1); |
| 228 |
$oConnection[$s]->connect( $server->{host}, $server->{port} ); |
| 229 |
$serverinfo[$s]->{host}= $server->{host}; |
| 230 |
$serverinfo[$s]->{name}= $server->{servername}; |
| 231 |
$serverinfo[$s]->{encd}= $server->{encoding} // "iso-5426"; |
| 232 |
$s++; |
| 233 |
} ## while fetch |
| 234 |
} # foreach |
| 235 |
my $nremaining = $s; |
| 236 |
|
| 237 |
for ( my $z = 0 ; $z < $s ; $z++ ) { |
| 238 |
$oResult[$z] = $oConnection[$z]->search_pqf($query); |
| 239 |
} |
| 240 |
|
151 |
|
|
|
152 |
my $schema = Koha::Database->new()->schema(); |
| 153 |
my $rs = $schema->resultset('Z3950server')->search( |
| 154 |
{ id => [ @id ] }, |
| 155 |
{ result_class => 'DBIx::Class::ResultClass::HashRefInflator' }, |
| 156 |
); |
| 157 |
my @servers = $rs->all; |
| 158 |
foreach my $server ( @servers ) { |
| 159 |
$oConnection[$s] = _create_connection( $server ); |
| 160 |
$oResult[$s] = |
| 161 |
$server->{servertype} eq 'zed'? |
| 162 |
$oConnection[$s]->search_pqf( $zquery ): |
| 163 |
$oConnection[$s]->search(new ZOOM::Query::CQL( |
| 164 |
_translate_query( $server, $squery ))); |
| 165 |
$s++; |
| 166 |
} |
| 167 |
|
| 168 |
my $nremaining = $s; |
| 241 |
while ( $nremaining-- ) { |
169 |
while ( $nremaining-- ) { |
| 242 |
my $k; |
170 |
my $k; |
| 243 |
my $event; |
171 |
my $event; |
|
Lines 251-257
sub Z3950Search {
Link Here
|
| 251 |
my ($error)= $oConnection[$k]->error_x(); #ignores errmsg, addinfo, diagset |
179 |
my ($error)= $oConnection[$k]->error_x(); #ignores errmsg, addinfo, diagset |
| 252 |
if ($error) { |
180 |
if ($error) { |
| 253 |
if ($error =~ m/^(10000|10007)$/ ) { |
181 |
if ($error =~ m/^(10000|10007)$/ ) { |
| 254 |
push(@errconn, { server => $serverinfo[$k]->{host}, error => $error } ); |
182 |
push(@errconn, { server => $servers[$k]->{host}, error => $error } ); |
| 255 |
} |
183 |
} |
| 256 |
} |
184 |
} |
| 257 |
else { |
185 |
else { |
|
Lines 263-273
sub Z3950Search {
Link Here
|
| 263 |
$total_pages = int($numresults/20)+1 if $total_pages < ($numresults/20); |
191 |
$total_pages = int($numresults/20)+1 if $total_pages < ($numresults/20); |
| 264 |
for ($i = ($page-1)*20; $i < (($numresults < ($page*20)) ? $numresults : ($page*20)); $i++) { |
192 |
for ($i = ($page-1)*20; $i < (($numresults < ($page*20)) ? $numresults : ($page*20)); $i++) { |
| 265 |
if($oResult[$k]->record($i)) { |
193 |
if($oResult[$k]->record($i)) { |
| 266 |
my $res=_handle_one_result($oResult[$k]->record($i), $serverinfo[$k], ++$imported, $biblionumber); #ignores error in sequence numbering |
194 |
my $res=_handle_one_result($oResult[$k]->record($i), $servers[$k], ++$imported, $biblionumber); #ignores error in sequence numbering |
| 267 |
push @breeding_loop, $res if $res; |
195 |
push @breeding_loop, $res if $res; |
| 268 |
} |
196 |
} |
| 269 |
else { |
197 |
else { |
| 270 |
push(@breeding_loop,{'server'=>$serverinfo[$k]->{name},'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'biblionumber'=>-1}); |
198 |
push(@breeding_loop,{'server'=>$servers[$k]->{servername},'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'biblionumber'=>-1}); |
| 271 |
} |
199 |
} |
| 272 |
} |
200 |
} |
| 273 |
} #if $numresults |
201 |
} #if $numresults |
|
Lines 289-298
sub Z3950Search {
Link Here
|
| 289 |
$oConnection[$_]->destroy(); |
217 |
$oConnection[$_]->destroy(); |
| 290 |
} |
218 |
} |
| 291 |
|
219 |
|
| 292 |
my @servers = (); |
|
|
| 293 |
foreach my $id (@id) { |
| 294 |
push @servers, {id => $id}; |
| 295 |
} |
| 296 |
$template->param( |
220 |
$template->param( |
| 297 |
breeding_loop => \@breeding_loop, |
221 |
breeding_loop => \@breeding_loop, |
| 298 |
servers => \@servers, |
222 |
servers => \@servers, |
|
Lines 300-313
sub Z3950Search {
Link Here
|
| 300 |
); |
224 |
); |
| 301 |
} |
225 |
} |
| 302 |
|
226 |
|
|
|
227 |
sub _build_query { |
| 228 |
my ( $pars ) = @_; |
| 229 |
|
| 230 |
my $qry_build = { |
| 231 |
isbn => '@attr 1=7 @attr 5=1 "#term" ', |
| 232 |
issn => '@attr 1=8 @attr 5=1 "#term" ', |
| 233 |
title => '@attr 1=4 #term ', |
| 234 |
author => '@attr 1=1003 "#term" ', |
| 235 |
dewey => '@attr 1=16 "#term" ', |
| 236 |
subject => '@attr 1=21 "#term" ', |
| 237 |
lccall => '@attr 1=16 @attr 2=3 @attr 3=1 @attr 4=1 @attr 5=1 '. |
| 238 |
'@attr 6=1 "#term" ', |
| 239 |
controlnumber => '@attr 1=12 "#term" ', |
| 240 |
srchany => '@attr 1=1016 "#term" ', |
| 241 |
stdid => '@attr 1=1007 "#term" ', |
| 242 |
}; |
| 243 |
|
| 244 |
my $zquery=''; |
| 245 |
my $squery=''; |
| 246 |
my $nterms=0; |
| 247 |
foreach my $k ( keys %$pars ) { |
| 248 |
if( ( my $val=$pars->{$k} ) && $qry_build->{$k} ) { |
| 249 |
$qry_build->{$k} =~ s/#term/$val/g; |
| 250 |
$zquery .= $qry_build->{$k}; |
| 251 |
$squery .= "[$k]=\"$val\" and "; |
| 252 |
$nterms++; |
| 253 |
} |
| 254 |
} |
| 255 |
$zquery = "\@and " . $zquery for 2..$nterms; |
| 256 |
$squery =~ s/ and $//; |
| 257 |
return ( $zquery, $squery ); |
| 258 |
} |
| 259 |
|
| 303 |
sub _handle_one_result { |
260 |
sub _handle_one_result { |
| 304 |
my ($zoomrec, $servhref, $seq, $bib)= @_; |
261 |
my ($zoomrec, $servhref, $seq, $bib)= @_; |
| 305 |
|
262 |
|
| 306 |
my $raw= $zoomrec->raw(); |
263 |
my $raw= $zoomrec->raw(); |
| 307 |
my ($marcrecord) = MarcToUTF8Record($raw, C4::Context->preference('marcflavour'), $servhref->{encd}); #ignores charset return values |
264 |
my $marcrecord; |
|
|
265 |
if( $servhref->{servertype} eq 'sru' ) { |
| 266 |
$marcrecord= MARC::Record->new_from_xml( $raw, 'UTF-8', |
| 267 |
$servhref->{syntax} ); |
| 268 |
} else { |
| 269 |
($marcrecord) = MarcToUTF8Record($raw, C4::Context->preference('marcflavour'), $servhref->{encoding} // "iso-5426" ); #ignores charset return values |
| 270 |
} |
| 308 |
SetUTF8Flag($marcrecord); |
271 |
SetUTF8Flag($marcrecord); |
| 309 |
|
272 |
|
| 310 |
my $batch_id = GetZ3950BatchId($servhref->{name}); |
273 |
my $batch_id = GetZ3950BatchId($servhref->{servername}); |
| 311 |
my $breedingid = AddBiblioToBatch($batch_id, $seq, $marcrecord, 'UTF-8', 0, 0); |
274 |
my $breedingid = AddBiblioToBatch($batch_id, $seq, $marcrecord, 'UTF-8', 0, 0); |
| 312 |
#FIXME passing 0 for z3950random |
275 |
#FIXME passing 0 for z3950random |
| 313 |
#Will eliminate this unused field in a followup report |
276 |
#Will eliminate this unused field in a followup report |
|
Lines 319-325
sub _handle_one_result {
Link Here
|
| 319 |
return _add_rowdata( |
282 |
return _add_rowdata( |
| 320 |
{ |
283 |
{ |
| 321 |
biblionumber => $bib, |
284 |
biblionumber => $bib, |
| 322 |
server => $servhref->{name}, |
285 |
server => $servhref->{servername}, |
| 323 |
breedingid => $breedingid, |
286 |
breedingid => $breedingid, |
| 324 |
}, $marcrecord) if $breedingid; |
287 |
}, $marcrecord) if $breedingid; |
| 325 |
} |
288 |
} |
|
Lines 354-359
sub _isbn_replace {
Link Here
|
| 354 |
return $isbn; |
317 |
return $isbn; |
| 355 |
} |
318 |
} |
| 356 |
|
319 |
|
|
|
320 |
sub _create_connection { |
| 321 |
my ( $server ) = @_; |
| 322 |
my $option1= new ZOOM::Options(); |
| 323 |
$option1->option( 'async' => 1 ); |
| 324 |
$option1->option( 'elementSetName', 'F' ); |
| 325 |
$option1->option( 'preferredRecordSyntax', $server->{syntax} ); |
| 326 |
$option1->option( 'timeout', $server->{timeout} ) if $server->{timeout}; |
| 327 |
|
| 328 |
if( $server->{servertype} eq 'sru' ) { |
| 329 |
foreach( split ',', $server->{sru_options}//'' ) { |
| 330 |
my @temp= split '='; |
| 331 |
$option1->option( $temp[0] => $temp[1] ) if @temp; |
| 332 |
} |
| 333 |
} elsif( $server->{servertype} eq 'zed' ) { |
| 334 |
$option1->option( 'databaseName', $server->{db} ); |
| 335 |
$option1->option( 'user', $server->{userid} ) if $server->{userid}; |
| 336 |
$option1->option( 'password', $server->{password} ) if $server->{password}; |
| 337 |
} |
| 338 |
|
| 339 |
my $obj= ZOOM::Connection->create($option1); |
| 340 |
if( $server->{servertype} eq 'sru' ) { |
| 341 |
my $host= $server->{host}; |
| 342 |
if( $host !~ /^https?:\/\// ) { |
| 343 |
#Normally, host will not be prefixed by protocol. |
| 344 |
#In that case we can (safely) assume http. |
| 345 |
#In case someone prefixed with https, give it a try.. |
| 346 |
$host = 'http://' . $host; |
| 347 |
} |
| 348 |
$obj->connect( $host.':'.$server->{port}.'/'.$server->{db} ); |
| 349 |
} else { |
| 350 |
$obj->connect( $server->{host}, $server->{port} ); |
| 351 |
} |
| 352 |
return $obj; |
| 353 |
} |
| 354 |
|
| 355 |
sub _translate_query { #SRU query adjusted per server cf. srufields column |
| 356 |
my ($server, $query) = @_; |
| 357 |
|
| 358 |
#sru_fields is in format title=field,isbn=field,... |
| 359 |
#if a field doesn't exist, try anywhere or remove [field]= |
| 360 |
my @parts= split(',', $server->{sru_fields} ); |
| 361 |
my %trans= map { if( /=/ ) { ( $`,$' ) } else { () } } @parts; |
| 362 |
my $any= $trans{srchany}?$trans{srchany}.'=':''; |
| 363 |
|
| 364 |
my $q=$query; |
| 365 |
foreach my $key (keys %trans) { |
| 366 |
my $f=$trans{$key}; |
| 367 |
if( $f ) { |
| 368 |
$q=~s/\[$key\]/$f/g; |
| 369 |
} else { |
| 370 |
$q=~s/\[$key\]=/$any/g; |
| 371 |
} |
| 372 |
} |
| 373 |
$q=~s/\[\w+\]=/$any/g; # remove remaining fields (not found in field list) |
| 374 |
return $q; |
| 375 |
} |
| 376 |
|
| 357 |
=head2 ImportBreedingAuth |
377 |
=head2 ImportBreedingAuth |
| 358 |
|
378 |
|
| 359 |
ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random,$batch_type); |
379 |
ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random,$batch_type); |