|
Lines 227-232
sub Z3950Search {
Link Here
|
| 227 |
); |
227 |
); |
| 228 |
} |
228 |
} |
| 229 |
|
229 |
|
|
|
230 |
sub _auth_build_query { |
| 231 |
my ( $pars ) = @_; |
| 232 |
|
| 233 |
my $nameany= $pars->{nameany}; |
| 234 |
my $authorany= $pars->{authorany}; |
| 235 |
my $authorpersonal= $pars->{authorpersonal}; |
| 236 |
my $authorcorp= $pars->{authorcorp}; |
| 237 |
my $authormeetingcon= $pars->{authormeetingcon}; |
| 238 |
my $title= $pars->{title}; |
| 239 |
my $uniformtitle= $pars->{uniformtitle}; |
| 240 |
my $subject= $pars->{subject}; |
| 241 |
my $subjectsubdiv= $pars->{subjectsubdiv}; |
| 242 |
my $srchany= $pars->{srchany}; |
| 243 |
my $authid= $pars->{authid}; |
| 244 |
|
| 245 |
my $qry_build = { |
| 246 |
nameany => '@attr 1=1002 "#term" ', |
| 247 |
authorany => '@attr 1=1003 "#term" ', |
| 248 |
authorcorp => '@attr 1=2 "#term" ', |
| 249 |
authorpersonal => '@attr 1=1 "#term" ', |
| 250 |
authormeetingcon => '@attr 1=3 "#term" ', |
| 251 |
subject => '@attr 1=21 "#term" ', |
| 252 |
subjectsubdiv => '@attr 1=47 "#term" ', |
| 253 |
title => '@attr 1=4 "#term" ', |
| 254 |
uniformtitle => '@attr 1=6 "#term" ', |
| 255 |
srchany => '@attr 1=1016 "#term" ', |
| 256 |
}; |
| 257 |
|
| 258 |
my $zquery=''; |
| 259 |
my $squery=''; |
| 260 |
my $nterms=0; |
| 261 |
foreach my $k ( sort keys %$pars ) { |
| 262 |
#note that the sort keys forces an identical result under Perl 5.18 |
| 263 |
#one of the unit tests is based on that assumption |
| 264 |
if( ( my $val=$pars->{$k} ) && $qry_build->{$k} ) { |
| 265 |
$qry_build->{$k} =~ s/#term/$val/g; |
| 266 |
$zquery .= $qry_build->{$k}; |
| 267 |
$squery .= "[$k]=\"$val\" and "; |
| 268 |
$nterms++; |
| 269 |
} |
| 270 |
} |
| 271 |
$zquery = "\@and " . $zquery for 2..$nterms; |
| 272 |
$squery =~ s/ and $//; |
| 273 |
return ( $zquery, $squery ); |
| 274 |
|
| 275 |
} |
| 276 |
|
| 230 |
sub _build_query { |
277 |
sub _build_query { |
| 231 |
my ( $pars ) = @_; |
278 |
my ( $pars ) = @_; |
| 232 |
|
279 |
|
|
Lines 268-278
sub _handle_one_result {
Link Here
|
| 268 |
my $raw= $zoomrec->raw(); |
315 |
my $raw= $zoomrec->raw(); |
| 269 |
my $marcrecord; |
316 |
my $marcrecord; |
| 270 |
if( $servhref->{servertype} eq 'sru' ) { |
317 |
if( $servhref->{servertype} eq 'sru' ) { |
| 271 |
$marcrecord= MARC::Record->new_from_xml( $raw, 'UTF-8', |
318 |
$raw= MARC::Record->new_from_xml( $raw, $servhref->{encoding}, $servhref->{syntax} ); |
| 272 |
$servhref->{syntax} ); |
|
|
| 273 |
} else { |
| 274 |
($marcrecord) = MarcToUTF8Record($raw, C4::Context->preference('marcflavour'), $servhref->{encoding} // "iso-5426" ); #ignores charset return values |
| 275 |
} |
319 |
} |
|
|
320 |
($marcrecord) = MarcToUTF8Record($raw, C4::Context->preference('marcflavour'), $servhref->{encoding} // "iso-5426" ); #ignores charset return values |
| 276 |
SetUTF8Flag($marcrecord); |
321 |
SetUTF8Flag($marcrecord); |
| 277 |
my $error; |
322 |
my $error; |
| 278 |
( $marcrecord, $error ) = _do_xslt_proc($marcrecord, $servhref, $xslh); |
323 |
( $marcrecord, $error ) = _do_xslt_proc($marcrecord, $servhref, $xslh); |
|
Lines 369-375
sub _create_connection {
Link Here
|
| 369 |
$option1->option( 'user', $server->{userid} ) if $server->{userid}; |
414 |
$option1->option( 'user', $server->{userid} ) if $server->{userid}; |
| 370 |
$option1->option( 'password', $server->{password} ) if $server->{password}; |
415 |
$option1->option( 'password', $server->{password} ) if $server->{password}; |
| 371 |
} |
416 |
} |
| 372 |
|
|
|
| 373 |
my $obj= ZOOM::Connection->create($option1); |
417 |
my $obj= ZOOM::Connection->create($option1); |
| 374 |
if( $server->{servertype} eq 'sru' ) { |
418 |
if( $server->{servertype} eq 'sru' ) { |
| 375 |
my $host= $server->{host}; |
419 |
my $host= $server->{host}; |
|
Lines 410-416
sub _translate_query { #SRU query adjusted per server cf. srufields column
Link Here
|
| 410 |
|
454 |
|
| 411 |
=head2 ImportBreedingAuth |
455 |
=head2 ImportBreedingAuth |
| 412 |
|
456 |
|
| 413 |
ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random,$batch_type); |
457 |
ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random); |
| 414 |
|
458 |
|
| 415 |
ImportBreedingAuth imports MARC records in the reservoir (import_records table). |
459 |
ImportBreedingAuth imports MARC records in the reservoir (import_records table). |
| 416 |
ImportBreedingAuth is based on the ImportBreeding subroutine. |
460 |
ImportBreedingAuth is based on the ImportBreeding subroutine. |
|
Lines 418-426
ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random
Link Here
|
| 418 |
=cut |
462 |
=cut |
| 419 |
|
463 |
|
| 420 |
sub ImportBreedingAuth { |
464 |
sub ImportBreedingAuth { |
| 421 |
my ($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random,$batch_type) = @_; |
465 |
my ($marcrecord,$overwrite_auth,$filename,$encoding,$z3950random) = @_; |
| 422 |
my @marcarray = split /\x1D/, $marcrecords; |
|
|
| 423 |
|
| 424 |
my $dbh = C4::Context->dbh; |
466 |
my $dbh = C4::Context->dbh; |
| 425 |
|
467 |
|
| 426 |
my $batch_id = GetZ3950BatchId($filename); |
468 |
my $batch_id = GetZ3950BatchId($filename); |
|
Lines 435-444
sub ImportBreedingAuth {
Link Here
|
| 435 |
my $alreadyinfarm = 0; |
477 |
my $alreadyinfarm = 0; |
| 436 |
my $notmarcrecord = 0; |
478 |
my $notmarcrecord = 0; |
| 437 |
my $breedingid; |
479 |
my $breedingid; |
| 438 |
for (my $i=0;$i<=$#marcarray;$i++) { |
|
|
| 439 |
my ($marcrecord, $charset_result, $charset_errors); |
| 440 |
($marcrecord, $charset_result, $charset_errors) = |
| 441 |
MarcToUTF8Record($marcarray[$i]."\x1D", $marc_type, $encoding); |
| 442 |
|
480 |
|
| 443 |
# Normalize the record so it doesn't have separated diacritics |
481 |
# Normalize the record so it doesn't have separated diacritics |
| 444 |
SetUTF8Flag($marcrecord); |
482 |
SetUTF8Flag($marcrecord); |
|
Lines 482-488
sub ImportBreedingAuth {
Link Here
|
| 482 |
} |
520 |
} |
| 483 |
} |
521 |
} |
| 484 |
} |
522 |
} |
| 485 |
} |
|
|
| 486 |
return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid); |
523 |
return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid); |
| 487 |
} |
524 |
} |
| 488 |
|
525 |
|
|
Lines 506-523
sub Z3950SearchAuth {
Link Here
|
| 506 |
my $random= $pars->{random}; |
543 |
my $random= $pars->{random}; |
| 507 |
my $page= $pars->{page}; |
544 |
my $page= $pars->{page}; |
| 508 |
|
545 |
|
| 509 |
my $nameany= $pars->{nameany}; |
546 |
|
| 510 |
my $authorany= $pars->{authorany}; |
|
|
| 511 |
my $authorpersonal= $pars->{authorpersonal}; |
| 512 |
my $authorcorp= $pars->{authorcorp}; |
| 513 |
my $authormeetingcon= $pars->{authormeetingcon}; |
| 514 |
my $title= $pars->{title}; |
| 515 |
my $uniformtitle= $pars->{uniformtitle}; |
| 516 |
my $subject= $pars->{subject}; |
| 517 |
my $subjectsubdiv= $pars->{subjectsubdiv}; |
| 518 |
my $srchany= $pars->{srchany}; |
| 519 |
my $authid= $pars->{authid}; |
| 520 |
|
| 521 |
my $show_next = 0; |
547 |
my $show_next = 0; |
| 522 |
my $total_pages = 0; |
548 |
my $total_pages = 0; |
| 523 |
my $attr = ''; |
549 |
my $attr = ''; |
|
Lines 531-631
sub Z3950SearchAuth {
Link Here
|
| 531 |
my $count; |
557 |
my $count; |
| 532 |
my $record; |
558 |
my $record; |
| 533 |
my @serverhost; |
559 |
my @serverhost; |
| 534 |
my @servername; |
|
|
| 535 |
my @breeding_loop = (); |
560 |
my @breeding_loop = (); |
| 536 |
|
561 |
|
| 537 |
my @oConnection; |
562 |
my @oConnection; |
| 538 |
my @oResult; |
563 |
my @oResult; |
| 539 |
my @errconn; |
564 |
my @errconn; |
|
|
565 |
my @servers; |
| 540 |
my $s = 0; |
566 |
my $s = 0; |
| 541 |
my $query; |
567 |
my $query; |
| 542 |
my $nterms=0; |
568 |
my $nterms=0; |
| 543 |
|
569 |
|
| 544 |
my $marcflavour = C4::Context->preference('marcflavour'); |
570 |
my $marcflavour = C4::Context->preference('marcflavour'); |
| 545 |
my $marc_type = $marcflavour eq 'UNIMARC' ? 'UNIMARCAUTH' : $marcflavour; |
571 |
my $marc_type = $marcflavour eq 'UNIMARC' ? 'UNIMARCAUTH' : $marcflavour; |
| 546 |
|
572 |
my $authid= $pars->{authid}; |
| 547 |
if ($nameany) { |
573 |
my ( $zquery, $squery ) = _auth_build_query( $pars ); |
| 548 |
$query .= " \@attr 1=1002 \"$nameany\" "; #Any name (this includes personal, corporate, meeting/conference authors, and author names in subject headings) |
|
|
| 549 |
#This attribute is supported by both the Library of Congress and Libraries Australia 08/05/2013 |
| 550 |
$nterms++; |
| 551 |
} |
| 552 |
|
| 553 |
if ($authorany) { |
| 554 |
$query .= " \@attr 1=1003 \"$authorany\" "; #Author-name (this includes personal, corporate, meeting/conference authors, but not author names in subject headings) |
| 555 |
#This attribute is not supported by the Library of Congress, but is supported by Libraries Australia 08/05/2013 |
| 556 |
$nterms++; |
| 557 |
} |
| 558 |
|
| 559 |
if ($authorcorp) { |
| 560 |
$query .= " \@attr 1=2 \"$authorcorp\" "; #1005 is another valid corporate author attribute... |
| 561 |
$nterms++; |
| 562 |
} |
| 563 |
|
| 564 |
if ($authorpersonal) { |
| 565 |
$query .= " \@attr 1=1 \"$authorpersonal\" "; #1004 is another valid personal name attribute... |
| 566 |
$nterms++; |
| 567 |
} |
| 568 |
|
| 569 |
if ($authormeetingcon) { |
| 570 |
$query .= " \@attr 1=3 \"$authormeetingcon\" "; #1006 is another valid meeting/conference name attribute... |
| 571 |
$nterms++; |
| 572 |
} |
| 573 |
|
| 574 |
if ($subject) { |
| 575 |
$query .= " \@attr 1=21 \"$subject\" "; |
| 576 |
$nterms++; |
| 577 |
} |
| 578 |
|
| 579 |
if ($subjectsubdiv) { |
| 580 |
$query .= " \@attr 1=47 \"$subjectsubdiv\" "; |
| 581 |
$nterms++; |
| 582 |
} |
| 583 |
|
| 584 |
if ($title) { |
| 585 |
$query .= " \@attr 1=4 \"$title\" "; #This is a regular title search. 1=6 will give just uniform titles |
| 586 |
$nterms++; |
| 587 |
} |
| 588 |
|
| 589 |
if ($uniformtitle) { |
| 590 |
$query .= " \@attr 1=6 \"$uniformtitle\" "; #This is the uniform title search |
| 591 |
$nterms++; |
| 592 |
} |
| 593 |
|
| 594 |
if($srchany) { |
| 595 |
$query .= " \@attr 1=1016 \"$srchany\" "; |
| 596 |
$nterms++; |
| 597 |
} |
| 598 |
|
| 599 |
for my $i (1..$nterms-1) { |
| 600 |
$query = "\@and " . $query; |
| 601 |
} |
| 602 |
|
| 603 |
foreach my $servid (@id) { |
574 |
foreach my $servid (@id) { |
| 604 |
my $sth = $dbh->prepare("select * from z3950servers where id=?"); |
575 |
my $sth = $dbh->prepare("select * from z3950servers where id=?"); |
| 605 |
$sth->execute($servid); |
576 |
$sth->execute($servid); |
| 606 |
while ( $server = $sth->fetchrow_hashref ) { |
577 |
while ( $server = $sth->fetchrow_hashref ) { |
| 607 |
my $option1 = new ZOOM::Options(); |
578 |
$oConnection[$s] = _create_connection( $server ); |
| 608 |
$option1->option( 'async' => 1 ); |
579 |
|
| 609 |
$option1->option( 'elementSetName', 'F' ); |
580 |
$oResult[$s] = |
| 610 |
$option1->option( 'databaseName', $server->{db} ); |
581 |
$server->{servertype} eq 'zed'? |
| 611 |
$option1->option( 'user', $server->{userid} ) if $server->{userid}; |
582 |
$oConnection[$s]->search_pqf( $zquery ): |
| 612 |
$option1->option( 'password', $server->{password} ) if $server->{password}; |
583 |
$oConnection[$s]->search(new ZOOM::Query::CQL( |
| 613 |
$option1->option( 'preferredRecordSyntax', $server->{syntax} ); |
584 |
_translate_query( $server, $squery ))); |
| 614 |
$option1->option( 'timeout', $server->{timeout} ) if $server->{timeout}; |
|
|
| 615 |
$oConnection[$s] = create ZOOM::Connection($option1); |
| 616 |
$oConnection[$s]->connect( $server->{host}, $server->{port} ); |
| 617 |
$serverhost[$s] = $server->{host}; |
| 618 |
$servername[$s] = $server->{servername}; |
| 619 |
$encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); |
585 |
$encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); |
|
|
586 |
$servers[$s] = $server; |
| 620 |
$s++; |
587 |
$s++; |
| 621 |
} ## while fetch |
588 |
} ## while fetch |
| 622 |
} # foreach |
589 |
} # foreach |
| 623 |
my $nremaining = $s; |
590 |
my $nremaining = $s; |
| 624 |
|
591 |
|
| 625 |
for ( my $z = 0 ; $z < $s ; $z++ ) { |
|
|
| 626 |
$oResult[$z] = $oConnection[$z]->search_pqf($query); |
| 627 |
} |
| 628 |
|
| 629 |
while ( $nremaining-- ) { |
592 |
while ( $nremaining-- ) { |
| 630 |
my $k; |
593 |
my $k; |
| 631 |
my $event; |
594 |
my $event; |
|
Lines 657-672
sub Z3950SearchAuth {
Link Here
|
| 657 |
$marcdata = $rec->raw(); |
620 |
$marcdata = $rec->raw(); |
| 658 |
|
621 |
|
| 659 |
my ($charset_result, $charset_errors); |
622 |
my ($charset_result, $charset_errors); |
|
|
623 |
if( $servers[$k]->{servertype} eq 'sru' ) { |
| 624 |
$marcdata = MARC::Record->new_from_xml( $marcdata, $encoding[$k], $servers[$k]->{syntax} ); |
| 625 |
} |
| 660 |
($marcrecord, $charset_result, $charset_errors)= MarcToUTF8Record($marcdata, $marc_type, $encoding[$k]); |
626 |
($marcrecord, $charset_result, $charset_errors)= MarcToUTF8Record($marcdata, $marc_type, $encoding[$k]); |
| 661 |
|
|
|
| 662 |
my $heading; |
627 |
my $heading; |
| 663 |
my $heading_authtype_code; |
628 |
my $heading_authtype_code; |
| 664 |
$heading_authtype_code = GuessAuthTypeCode($marcrecord); |
629 |
$heading_authtype_code = GuessAuthTypeCode($marcrecord); |
| 665 |
$heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord }); |
630 |
$heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord }); |
| 666 |
|
631 |
|
| 667 |
my ($notmarcrecord, $alreadyindb, $alreadyinfarm, $imported, $breedingid)= ImportBreedingAuth( $marcdata, 2, $serverhost[$k], $encoding[$k], $random, 'z3950' ); |
632 |
my ($notmarcrecord, $alreadyindb, $alreadyinfarm, $imported, $breedingid)= ImportBreedingAuth( $marcrecord, 2, $serverhost[$k], $encoding[$k], $random); |
| 668 |
my %row_data; |
633 |
my %row_data; |
| 669 |
$row_data{server} = $servername[$k]; |
634 |
$row_data{server} = $servers[$k]->{'servername'}; |
| 670 |
$row_data{breedingid} = $breedingid; |
635 |
$row_data{breedingid} = $breedingid; |
| 671 |
$row_data{heading} = $heading; |
636 |
$row_data{heading} = $heading; |
| 672 |
$row_data{authid} = $authid; |
637 |
$row_data{authid} = $authid; |
|
Lines 674-680
sub Z3950SearchAuth {
Link Here
|
| 674 |
push( @breeding_loop, \%row_data ); |
639 |
push( @breeding_loop, \%row_data ); |
| 675 |
} |
640 |
} |
| 676 |
else { |
641 |
else { |
| 677 |
push(@breeding_loop,{'server'=>$servername[$k],'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'authid'=>-1}); |
642 |
push(@breeding_loop,{'server'=>$servers[$k]->{'servername'},'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'authid'=>-1}); |
| 678 |
} |
643 |
} |
| 679 |
} |
644 |
} |
| 680 |
} #if $numresults |
645 |
} #if $numresults |
|
Lines 696-702
sub Z3950SearchAuth {
Link Here
|
| 696 |
$oConnection[$_]->destroy(); |
661 |
$oConnection[$_]->destroy(); |
| 697 |
} |
662 |
} |
| 698 |
|
663 |
|
| 699 |
my @servers = (); |
664 |
@servers = (); |
| 700 |
foreach my $id (@id) { |
665 |
foreach my $id (@id) { |
| 701 |
push @servers, {id => $id}; |
666 |
push @servers, {id => $id}; |
| 702 |
} |
667 |
} |