|
Lines 603-671
sub Z3950SearchAuth {
Link Here
|
| 603 |
my $record; |
603 |
my $record; |
| 604 |
my @serverhost; |
604 |
my @serverhost; |
| 605 |
my @servername; |
605 |
my @servername; |
|
|
606 |
my @serverquery; |
| 606 |
my @breeding_loop = (); |
607 |
my @breeding_loop = (); |
| 607 |
|
608 |
|
| 608 |
my @oConnection; |
609 |
my @oConnection; |
| 609 |
my @oResult; |
610 |
my @oResult; |
| 610 |
my @errconn; |
611 |
my @errconn; |
| 611 |
my $s = 0; |
612 |
my $s = 0; |
| 612 |
my $query; |
613 |
my @query = ''; |
| 613 |
my $nterms=0; |
614 |
my $nterms=0; |
| 614 |
|
615 |
|
| 615 |
if ($nameany) { |
616 |
if ($nameany) { |
| 616 |
$query .= " \@attr 1=1002 \"$nameany\" "; #Any name (this includes personal, corporate, meeting/conference authors, and author names in subject headings) |
617 |
push @query, "\@attr 1=1002 \"$nameany\""; #Any name (this includes personal, corporate, meeting/conference authors, and author names in subject headings) |
| 617 |
#This attribute is supported by both the Library of Congress and Libraries Australia 08/05/2013 |
618 |
#This attribute is supported by both the Library of Congress and Libraries Australia 08/05/2013 |
| 618 |
$nterms++; |
619 |
$nterms++; |
| 619 |
} |
620 |
} |
| 620 |
|
621 |
|
| 621 |
if ($authorany) { |
622 |
if ($authorany) { |
| 622 |
$query .= " \@attr 1=1003 \"$authorany\" "; #Author-name (this includes personal, corporate, meeting/conference authors, but not author names in subject headings) |
623 |
push @query, "\@attr 1=1003 \"$authorany\""; #Author-name (this includes personal, corporate, meeting/conference authors, but not author names in subject headings) |
| 623 |
#This attribute is not supported by the Library of Congress, but is supported by Libraries Australia 08/05/2013 |
624 |
#This attribute is not supported by the Library of Congress, but is supported by Libraries Australia 08/05/2013 |
| 624 |
$nterms++; |
625 |
$nterms++; |
| 625 |
} |
626 |
} |
| 626 |
|
627 |
|
| 627 |
if ($authorcorp) { |
628 |
if ($authorcorp) { |
| 628 |
$query .= " \@attr 1=2 \"$authorcorp\" "; #1005 is another valid corporate author attribute... |
629 |
push @query, "\@attr 1=2 \"$authorcorp\""; #1005 is another valid corporate author attribute... |
| 629 |
$nterms++; |
630 |
$nterms++; |
| 630 |
} |
631 |
} |
| 631 |
|
632 |
|
| 632 |
if ($authorpersonal) { |
633 |
if ($authorpersonal) { |
| 633 |
$query .= " \@attr 1=1 \"$authorpersonal\" "; #1004 is another valid personal name attribute... |
634 |
push @query, "\@attr 1=1 \"$authorpersonal\""; #1004 is another valid personal name attribute... |
| 634 |
$nterms++; |
635 |
$nterms++; |
| 635 |
} |
636 |
} |
| 636 |
|
637 |
|
| 637 |
if ($authormeetingcon) { |
638 |
if ($authormeetingcon) { |
| 638 |
$query .= " \@attr 1=3 \"$authormeetingcon\" "; #1006 is another valid meeting/conference name attribute... |
639 |
push @query, "\@attr 1=3 \"$authormeetingcon\""; #1006 is another valid meeting/conference name attribute... |
| 639 |
$nterms++; |
640 |
$nterms++; |
| 640 |
} |
641 |
} |
| 641 |
|
642 |
|
| 642 |
if ($subject) { |
643 |
if ($subject) { |
| 643 |
$query .= " \@attr 1=21 \"$subject\" "; |
644 |
push @query, "\@attr 1=21 \"$subject\""; |
| 644 |
$nterms++; |
645 |
$nterms++; |
| 645 |
} |
646 |
} |
| 646 |
|
647 |
|
| 647 |
if ($subjectsubdiv) { |
648 |
if ($subjectsubdiv) { |
| 648 |
$query .= " \@attr 1=47 \"$subjectsubdiv\" "; |
649 |
push @query, "\@attr 1=47 \"$subjectsubdiv\""; |
| 649 |
$nterms++; |
650 |
$nterms++; |
| 650 |
} |
651 |
} |
| 651 |
|
652 |
|
| 652 |
if ($title) { |
653 |
if ($title) { |
| 653 |
$query .= " \@attr 1=4 \"$title\" "; #This is a regular title search. 1=6 will give just uniform titles |
654 |
push @query, "\@attr 1=4 \"$title\""; #This is a regular title search. 1=6 will give just uniform titles |
| 654 |
$nterms++; |
655 |
$nterms++; |
| 655 |
} |
656 |
} |
| 656 |
|
657 |
|
| 657 |
if ($uniformtitle) { |
658 |
if ($uniformtitle) { |
| 658 |
$query .= " \@attr 1=6 \"$uniformtitle\" "; #This is the uniform title search |
659 |
push @query, "\@attr 1=6 \"$uniformtitle\""; #This is the uniform title search |
| 659 |
$nterms++; |
660 |
$nterms++; |
| 660 |
} |
661 |
} |
| 661 |
|
662 |
|
| 662 |
if($srchany) { |
663 |
if($srchany) { |
| 663 |
$query .= " \@attr 1=1016 \"$srchany\" "; |
664 |
push @query, "\@attr 1=1016 \"$srchany\""; |
| 664 |
$nterms++; |
665 |
$nterms++; |
| 665 |
} |
666 |
} |
| 666 |
|
667 |
|
| 667 |
for my $i (1..$nterms-1) { |
668 |
for my $i (1..$nterms-1) { |
| 668 |
$query = "\@and " . $query; |
669 |
$query[0] = "\@and " . $query[0]; |
| 669 |
} |
670 |
} |
| 670 |
|
671 |
|
| 671 |
foreach my $servid (@id) { |
672 |
foreach my $servid (@id) { |
|
Lines 684-689
sub Z3950SearchAuth {
Link Here
|
| 684 |
$oConnection[$s]->connect( $server->{host}, $server->{port} ); |
685 |
$oConnection[$s]->connect( $server->{host}, $server->{port} ); |
| 685 |
$serverhost[$s] = $server->{host}; |
686 |
$serverhost[$s] = $server->{host}; |
| 686 |
$servername[$s] = $server->{name}; |
687 |
$servername[$s] = $server->{name}; |
|
|
688 |
# Add additional attributes if some specified |
| 689 |
if($server->{attributes}) { |
| 690 |
# Extract all additional server attributes |
| 691 |
my %additional_attributes; |
| 692 |
my @split_attributes = split(/\s+/, $server->{attributes}); |
| 693 |
for(my $i=0; $i<=$#split_attributes; $i++) { |
| 694 |
if($split_attributes[$i] eq "\@attr" and $split_attributes[$i+1] =~ /^(\d+)=\d+$/) { |
| 695 |
$additional_attributes{$1} = $split_attributes[$i] . ' ' . $split_attributes[$i+1]; |
| 696 |
$i++; |
| 697 |
} |
| 698 |
} |
| 699 |
|
| 700 |
# Clone the query and modify it |
| 701 |
$serverquery[$s] = [@query]; |
| 702 |
foreach my $querypart (@{$serverquery[$s]}) { |
| 703 |
# Ignore parts without attributes |
| 704 |
next if $querypart !~ /\@attr/; |
| 705 |
# Only add additional attributes if they don't already exist in the query part |
| 706 |
foreach my $attr_type (keys %additional_attributes) { |
| 707 |
if($querypart !~ /\@attr $attr_type=/) { |
| 708 |
$querypart = $additional_attributes{$attr_type} . ' ' . $querypart; |
| 709 |
} |
| 710 |
} |
| 711 |
} |
| 712 |
} |
| 713 |
else { |
| 714 |
# Use a reference to the original query |
| 715 |
$serverquery[$s] = \@query; |
| 716 |
} |
| 687 |
$encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); |
717 |
$encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); |
| 688 |
$s++; |
718 |
$s++; |
| 689 |
} ## while fetch |
719 |
} ## while fetch |
|
Lines 691-697
sub Z3950SearchAuth {
Link Here
|
| 691 |
my $nremaining = $s; |
721 |
my $nremaining = $s; |
| 692 |
|
722 |
|
| 693 |
for ( my $z = 0 ; $z < $s ; $z++ ) { |
723 |
for ( my $z = 0 ; $z < $s ; $z++ ) { |
| 694 |
$oResult[$z] = $oConnection[$z]->search_pqf($query); |
724 |
$oResult[$z] = $oConnection[$z]->search_pqf( join(' ', @{$serverquery[$z]}) ) |
| 695 |
} |
725 |
} |
| 696 |
|
726 |
|
| 697 |
while ( $nremaining-- ) { |
727 |
while ( $nremaining-- ) { |
| 698 |
- |
|
|