|
Lines 245-272
sub Z3950Search {
Link Here
|
| 245 |
my $controlnumber= $pars->{controlnumber}; |
245 |
my $controlnumber= $pars->{controlnumber}; |
| 246 |
|
246 |
|
| 247 |
|
247 |
|
| 248 |
my $show_next = 0; |
248 |
my $show_next = 0; |
| 249 |
my $total_pages = 0; |
249 |
my $total_pages = 0; |
| 250 |
|
250 |
|
| 251 |
my $noconnection; |
251 |
my $noconnection; |
| 252 |
my $attr = ''; |
252 |
my $attr = ''; |
| 253 |
my $term; |
253 |
my $term; |
| 254 |
my $host; |
254 |
my $host; |
| 255 |
my $server; |
255 |
my $server; |
| 256 |
my $database; |
256 |
my $database; |
| 257 |
my $port; |
257 |
my $port; |
| 258 |
my $marcdata; |
258 |
my $marcdata; |
| 259 |
my @encoding; |
259 |
my @encoding; |
| 260 |
my @results; |
260 |
my @results; |
| 261 |
my $count; |
261 |
my $count; |
| 262 |
my $toggle; |
262 |
my $toggle; |
| 263 |
my $record; |
263 |
my $record; |
| 264 |
my $oldbiblio; |
264 |
my $oldbiblio; |
| 265 |
my $errmsg; |
265 |
my @serverhost; |
| 266 |
my @serverhost; |
266 |
my @servername; |
| 267 |
my @servername; |
267 |
my @breeding_loop = (); |
| 268 |
my @breeding_loop = (); |
|
|
| 269 |
|
| 270 |
|
268 |
|
| 271 |
my @oConnection; |
269 |
my @oConnection; |
| 272 |
my @oResult; |
270 |
my @oResult; |
|
Lines 315-330
my @breeding_loop = ();
Link Here
|
| 315 |
$query .= " \@attr 1=12 \"$controlnumber\" "; |
313 |
$query .= " \@attr 1=12 \"$controlnumber\" "; |
| 316 |
$nterms++; |
314 |
$nterms++; |
| 317 |
} |
315 |
} |
| 318 |
for my $i (1..$nterms-1) { |
316 |
for my $i (1..$nterms-1) { |
| 319 |
$query = "\@and " . $query; |
317 |
$query = "\@and " . $query; |
| 320 |
} |
318 |
} |
| 321 |
warn "query ".$query if $DEBUG; |
|
|
| 322 |
|
319 |
|
| 323 |
foreach my $servid (@id) { |
320 |
foreach my $servid (@id) { |
| 324 |
my $sth = $dbh->prepare("select * from z3950servers where id=?"); |
321 |
my $sth = $dbh->prepare("select * from z3950servers where id=?"); |
| 325 |
$sth->execute($servid); |
322 |
$sth->execute($servid); |
| 326 |
while ( $server = $sth->fetchrow_hashref ) { |
323 |
while ( $server = $sth->fetchrow_hashref ) { |
| 327 |
warn "serverinfo ".join(':',%$server) if $DEBUG; |
|
|
| 328 |
my $option1 = new ZOOM::Options(); |
324 |
my $option1 = new ZOOM::Options(); |
| 329 |
$option1->option( 'async' => 1 ); |
325 |
$option1->option( 'async' => 1 ); |
| 330 |
$option1->option( 'elementSetName', 'F' ); |
326 |
$option1->option( 'elementSetName', 'F' ); |
|
Lines 333-345
warn "query ".$query if $DEBUG;
Link Here
|
| 333 |
$option1->option( 'password', $server->{password} ) |
329 |
$option1->option( 'password', $server->{password} ) |
| 334 |
if $server->{password}; |
330 |
if $server->{password}; |
| 335 |
$option1->option( 'preferredRecordSyntax', $server->{syntax} ); |
331 |
$option1->option( 'preferredRecordSyntax', $server->{syntax} ); |
| 336 |
$oConnection[$s] = create ZOOM::Connection($option1) |
332 |
$oConnection[$s] = create ZOOM::Connection($option1); |
| 337 |
|| $DEBUG |
333 |
$oConnection[$s]->connect( $server->{host}, $server->{port} ); |
| 338 |
&& warn( "" . $oConnection[$s]->errmsg() ); |
|
|
| 339 |
warn( "server data", $server->{name}, $server->{port} ) if $DEBUG; |
| 340 |
$oConnection[$s]->connect( $server->{host}, $server->{port} ) |
| 341 |
|| $DEBUG |
| 342 |
&& warn( "" . $oConnection[$s]->errmsg() ); |
| 343 |
$serverhost[$s] = $server->{host}; |
334 |
$serverhost[$s] = $server->{host}; |
| 344 |
$servername[$s] = $server->{name}; |
335 |
$servername[$s] = $server->{name}; |
| 345 |
$encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); |
336 |
$encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); |
|
Lines 350-475
warn "query ".$query if $DEBUG;
Link Here
|
| 350 |
my $firstresult = 1; |
341 |
my $firstresult = 1; |
| 351 |
|
342 |
|
| 352 |
for ( my $z = 0 ; $z < $s ; $z++ ) { |
343 |
for ( my $z = 0 ; $z < $s ; $z++ ) { |
| 353 |
warn "doing the search" if $DEBUG; |
344 |
$oResult[$z] = $oConnection[$z]->search_pqf($query); |
| 354 |
$oResult[$z] = $oConnection[$z]->search_pqf($query) |
|
|
| 355 |
|| $DEBUG |
| 356 |
&& warn( "somthing went wrong: " . $oConnection[$s]->errmsg() ); |
| 357 |
|
| 358 |
# $oResult[$z] = $oConnection[$z]->search_pqf($query); |
| 359 |
} |
345 |
} |
| 360 |
|
346 |
|
| 361 |
warn "# nremaining = $nremaining\n" if $DEBUG; |
347 |
while ( $nremaining-- ) { |
| 362 |
|
348 |
my $k; |
| 363 |
while ( $nremaining-- ) { |
349 |
my $event; |
| 364 |
|
350 |
while ( ( $k = ZOOM::event( \@oConnection ) ) != 0 ) { |
| 365 |
my $k; |
351 |
$event = $oConnection[ $k - 1 ]->last_event(); |
| 366 |
my $event; |
352 |
last if $event == ZOOM::Event::ZEND; |
| 367 |
while ( ( $k = ZOOM::event( \@oConnection ) ) != 0 ) { |
353 |
} |
| 368 |
$event = $oConnection[ $k - 1 ]->last_event(); |
|
|
| 369 |
warn( "connection ", $k - 1, ": event $event (", |
| 370 |
ZOOM::event_str($event), ")\n" ) |
| 371 |
if $DEBUG; |
| 372 |
last if $event == ZOOM::Event::ZEND; |
| 373 |
} |
| 374 |
|
354 |
|
| 375 |
if ( $k != 0 ) { |
355 |
if ( $k != 0 ) { |
| 376 |
$k--; |
356 |
$k--; |
| 377 |
warn "event from $k server = ",$serverhost[$k] if $DEBUG; |
357 |
my ($error, $errmsg, $addinfo, $diagset)= $oConnection[$k]->error_x(); |
| 378 |
my ( $error, $errmsg, $addinfo, $diagset ) = |
358 |
if ($error) { |
| 379 |
$oConnection[$k]->error_x(); |
359 |
if ($error =~ m/^(10000|10007)$/ ) { |
| 380 |
if ($error) { |
360 |
push(@errconn, {'server' => $serverhost[$k]}); |
| 381 |
if ($error =~ m/^(10000|10007)$/ ) { |
361 |
} |
| 382 |
push(@errconn, {'server' => $serverhost[$k]}); |
|
|
| 383 |
} |
362 |
} |
| 384 |
$DEBUG and warn "$k $serverhost[$k] error $query: $errmsg ($error) $addinfo\n"; |
363 |
else { |
| 385 |
} |
364 |
my $numresults = $oResult[$k]->size(); |
| 386 |
else { |
365 |
my $i; |
| 387 |
my $numresults = $oResult[$k]->size(); |
366 |
my $result = ''; |
| 388 |
warn "numresults = $numresults" if $DEBUG; |
367 |
if ( $numresults > 0 and $numresults >= (($page-1)*20)) { |
| 389 |
my $i; |
368 |
$show_next = 1 if $numresults >= ($page*20); |
| 390 |
my $result = ''; |
369 |
$total_pages = int($numresults/20)+1 if $total_pages < ($numresults/20); |
| 391 |
if ( $numresults > 0 and $numresults >= (($page-1)*20)) { |
370 |
for ($i = ($page-1)*20; $i < (($numresults < ($page*20)) ? $numresults : ($page*20)); $i++) { |
| 392 |
$show_next = 1 if $numresults >= ($page*20); |
371 |
my $rec = $oResult[$k]->record($i); |
| 393 |
$total_pages = int($numresults/20)+1 if $total_pages < ($numresults/20); |
372 |
if ($rec) { |
| 394 |
for ($i = ($page-1)*20; $i < (($numresults < ($page*20)) ? $numresults : ($page*20)); $i++) { |
373 |
my $marcrecord; |
| 395 |
my $rec = $oResult[$k]->record($i); |
374 |
$marcdata = $rec->raw(); |
| 396 |
if ($rec) { |
375 |
my ($charset_result, $charset_errors); |
| 397 |
my $marcrecord; |
376 |
($marcrecord, $charset_result, $charset_errors)= MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]); |
| 398 |
$marcdata = $rec->raw(); |
377 |
# Normalize the record so it doesn't have separated diacritics |
| 399 |
|
378 |
SetUTF8Flag($marcrecord); |
| 400 |
my ($charset_result, $charset_errors); |
379 |
my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, "" ); |
| 401 |
($marcrecord, $charset_result, $charset_errors) = |
380 |
$oldbiblio->{isbn} =~ s/ |-|\.//g if $oldbiblio->{isbn}; |
| 402 |
MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]); |
381 |
# pad | and ( with spaces to allow line breaks in the HTML |
| 403 |
####WARNING records coming from Z3950 clients are in various character sets MARC8,UTF8,UNIMARC etc |
382 |
$oldbiblio->{isbn} =~ s/\|/ \| /g if $oldbiblio->{isbn}; |
| 404 |
## In HEAD i change everything to UTF-8 |
383 |
$oldbiblio->{isbn} =~ s/\(/ \(/g if $oldbiblio->{isbn}; |
| 405 |
# In rel2_2 i am not sure what encoding is so no character conversion is done here |
384 |
$oldbiblio->{issn} =~ s/ |-|\.//g if $oldbiblio->{issn}; |
| 406 |
##Add necessary encoding changes to here -TG |
385 |
# pad | and ( with spaces to allow line breaks in the HTML |
| 407 |
|
386 |
$oldbiblio->{issn} =~ s/\|/ \| /g if $oldbiblio->{issn}; |
| 408 |
# Normalize the record so it doesn't have separated diacritics |
387 |
$oldbiblio->{issn} =~ s/\(/ \(/g if $oldbiblio->{issn}; |
| 409 |
SetUTF8Flag($marcrecord); |
388 |
my ($notmarcrecord, $alreadyindb, $alreadyinfarm, $imported, $breedingid)= ImportBreeding( $marcdata, 2, $serverhost[$k], $encoding[$k], $random, 'z3950' ); |
| 410 |
|
389 |
my %row_data; |
| 411 |
my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, "" ); |
390 |
$row_data{server} = $servername[$k]; |
| 412 |
$oldbiblio->{isbn} =~ s/ |-|\.//g if $oldbiblio->{isbn}; |
391 |
$row_data{isbn} = $oldbiblio->{isbn}; |
| 413 |
# pad | and ( with spaces to allow line breaks in the HTML |
392 |
$row_data{lccn} = $oldbiblio->{lccn}; |
| 414 |
$oldbiblio->{isbn} =~ s/\|/ \| /g if $oldbiblio->{isbn}; |
393 |
$row_data{title} = $oldbiblio->{title}; |
| 415 |
$oldbiblio->{isbn} =~ s/\(/ \(/g if $oldbiblio->{isbn}; |
394 |
$row_data{author} = $oldbiblio->{author}; |
| 416 |
|
395 |
$row_data{breedingid} = $breedingid; |
| 417 |
$oldbiblio->{issn} =~ s/ |-|\.//g if $oldbiblio->{issn}; |
396 |
$row_data{biblionumber} = $biblionumber; |
| 418 |
# pad | and ( with spaces to allow line breaks in the HTML |
397 |
push( @breeding_loop, \%row_data ); |
| 419 |
$oldbiblio->{issn} =~ s/\|/ \| /g if $oldbiblio->{issn}; |
398 |
} |
| 420 |
$oldbiblio->{issn} =~ s/\(/ \(/g if $oldbiblio->{issn}; |
399 |
else { |
| 421 |
my ( |
400 |
push(@breeding_loop,{'server'=>$servername[$k],'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'biblionumber'=>-1}); |
| 422 |
$notmarcrecord, $alreadyindb, $alreadyinfarm, |
401 |
} |
| 423 |
$imported, $breedingid |
402 |
} |
| 424 |
) |
403 |
} #if $numresults |
| 425 |
= ImportBreeding( $marcdata, 2, $serverhost[$k], $encoding[$k], $random, 'z3950' ); |
404 |
} |
| 426 |
my %row_data; |
405 |
} # if $k !=0 |
| 427 |
$row_data{server} = $servername[$k]; |
406 |
my $numberpending = $nremaining - 1; |
| 428 |
$row_data{isbn} = $oldbiblio->{isbn}; |
|
|
| 429 |
$row_data{lccn} = $oldbiblio->{lccn}; |
| 430 |
$row_data{title} = $oldbiblio->{title}; |
| 431 |
$row_data{author} = $oldbiblio->{author}; |
| 432 |
$row_data{breedingid} = $breedingid; |
| 433 |
$row_data{biblionumber} = $biblionumber; |
| 434 |
push( @breeding_loop, \%row_data ); |
| 435 |
|
407 |
|
| 436 |
} else { |
408 |
my @servers = (); |
| 437 |
push(@breeding_loop,{'server'=>$servername[$k],'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'biblionumber'=>-1}); |
409 |
foreach my $id (@id) { |
| 438 |
} # $rec |
410 |
push(@servers,{id => $id}); |
| 439 |
} # upto 5 results |
|
|
| 440 |
} #$numresults |
| 441 |
} |
411 |
} |
| 442 |
} # if $k !=0 |
|
|
| 443 |
my $numberpending = $nremaining - 1; |
| 444 |
|
412 |
|
| 445 |
my @servers = (); |
413 |
$template->param( |
| 446 |
foreach my $id (@id) { |
414 |
breeding_loop => \@breeding_loop, |
| 447 |
push(@servers,{id => $id}); |
415 |
server => $servername[$k], |
| 448 |
} |
416 |
numberpending => $numberpending, |
|
|
417 |
current_page => $page, |
| 418 |
servers => \@servers, |
| 419 |
total_pages => $total_pages, |
| 420 |
show_nextbutton => $show_next?1:0, |
| 421 |
show_prevbutton => $page!=1, |
| 422 |
); |
| 423 |
$firstresult++; |
| 424 |
} # while nremaining |
| 449 |
|
425 |
|
| 450 |
$template->param( |
426 |
$template->param( |
| 451 |
breeding_loop => \@breeding_loop, |
427 |
breeding_loop => \@breeding_loop, |
| 452 |
server => $servername[$k], |
|
|
| 453 |
numberpending => $numberpending, |
| 454 |
current_page => $page, |
| 455 |
servers => \@servers, |
| 456 |
total_pages => $total_pages, |
| 457 |
); |
| 458 |
$template->param(show_nextbutton=>1) if $show_next; |
| 459 |
$template->param(show_prevbutton=>1) if $page != 1; |
| 460 |
|
| 461 |
# print $template->output if $firstresult !=1; |
| 462 |
$firstresult++; |
| 463 |
|
| 464 |
} # while nremaining |
| 465 |
|
| 466 |
$template->param( |
| 467 |
breeding_loop => \@breeding_loop, |
| 468 |
#server => $servername[$k], |
| 469 |
numberpending => $nremaining > 0 ? $nremaining : 0, |
428 |
numberpending => $nremaining > 0 ? $nremaining : 0, |
| 470 |
errconn => \@errconn |
429 |
errconn => \@errconn |
| 471 |
); |
430 |
); |
| 472 |
|
|
|
| 473 |
} |
431 |
} |
| 474 |
|
432 |
|
| 475 |
1; |
433 |
1; |