From 9f3ffa42ba21129d3412e204e56d228b3c077b6a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fr=C3=A9d=C3=A9rick?= Date: Mon, 25 Nov 2013 11:02:49 -0500 Subject: [PATCH 2/2] Add support for custom Z39.50 attributes to authority searches. --- C4/Breeding.pm | 56 +++++++++++++++++++++++++++++++++++++++++++------------- 1 files changed, 43 insertions(+), 13 deletions(-) diff --git a/C4/Breeding.pm b/C4/Breeding.pm index 1d20f4a..716f834 100644 --- a/C4/Breeding.pm +++ b/C4/Breeding.pm @@ -603,69 +603,70 @@ sub Z3950SearchAuth { my $record; my @serverhost; my @servername; + my @serverquery; my @breeding_loop = (); my @oConnection; my @oResult; my @errconn; my $s = 0; - my $query; + my @query = ''; my $nterms=0; if ($nameany) { - $query .= " \@attr 1=1002 \"$nameany\" "; #Any name (this includes personal, corporate, meeting/conference authors, and author names in subject headings) + push @query, "\@attr 1=1002 \"$nameany\""; #Any name (this includes personal, corporate, meeting/conference authors, and author names in subject headings) #This attribute is supported by both the Library of Congress and Libraries Australia 08/05/2013 $nterms++; } if ($authorany) { - $query .= " \@attr 1=1003 \"$authorany\" "; #Author-name (this includes personal, corporate, meeting/conference authors, but not author names in subject headings) + push @query, "\@attr 1=1003 \"$authorany\""; #Author-name (this includes personal, corporate, meeting/conference authors, but not author names in subject headings) #This attribute is not supported by the Library of Congress, but is supported by Libraries Australia 08/05/2013 $nterms++; } if ($authorcorp) { - $query .= " \@attr 1=2 \"$authorcorp\" "; #1005 is another valid corporate author attribute... + push @query, "\@attr 1=2 \"$authorcorp\""; #1005 is another valid corporate author attribute... $nterms++; } if ($authorpersonal) { - $query .= " \@attr 1=1 \"$authorpersonal\" "; #1004 is another valid personal name attribute... + push @query, "\@attr 1=1 \"$authorpersonal\""; #1004 is another valid personal name attribute... $nterms++; } if ($authormeetingcon) { - $query .= " \@attr 1=3 \"$authormeetingcon\" "; #1006 is another valid meeting/conference name attribute... + push @query, "\@attr 1=3 \"$authormeetingcon\""; #1006 is another valid meeting/conference name attribute... $nterms++; } if ($subject) { - $query .= " \@attr 1=21 \"$subject\" "; + push @query, "\@attr 1=21 \"$subject\""; $nterms++; } if ($subjectsubdiv) { - $query .= " \@attr 1=47 \"$subjectsubdiv\" "; + push @query, "\@attr 1=47 \"$subjectsubdiv\""; $nterms++; } if ($title) { - $query .= " \@attr 1=4 \"$title\" "; #This is a regular title search. 1=6 will give just uniform titles + push @query, "\@attr 1=4 \"$title\""; #This is a regular title search. 1=6 will give just uniform titles $nterms++; } if ($uniformtitle) { - $query .= " \@attr 1=6 \"$uniformtitle\" "; #This is the uniform title search + push @query, "\@attr 1=6 \"$uniformtitle\""; #This is the uniform title search $nterms++; } if($srchany) { - $query .= " \@attr 1=1016 \"$srchany\" "; + push @query, "\@attr 1=1016 \"$srchany\""; $nterms++; } for my $i (1..$nterms-1) { - $query = "\@and " . $query; + $query[0] = "\@and " . $query[0]; } foreach my $servid (@id) { @@ -684,6 +685,35 @@ sub Z3950SearchAuth { $oConnection[$s]->connect( $server->{host}, $server->{port} ); $serverhost[$s] = $server->{host}; $servername[$s] = $server->{name}; + # Add additional attributes if some specified + if($server->{attributes}) { + # Extract all additional server attributes + my %additional_attributes; + my @split_attributes = split(/\s+/, $server->{attributes}); + for(my $i=0; $i<=$#split_attributes; $i++) { + if($split_attributes[$i] eq "\@attr" and $split_attributes[$i+1] =~ /^(\d+)=\d+$/) { + $additional_attributes{$1} = $split_attributes[$i] . ' ' . $split_attributes[$i+1]; + $i++; + } + } + + # Clone the query and modify it + $serverquery[$s] = [@query]; + foreach my $querypart (@{$serverquery[$s]}) { + # Ignore parts without attributes + next if $querypart !~ /\@attr/; + # Only add additional attributes if they don't already exist in the query part + foreach my $attr_type (keys %additional_attributes) { + if($querypart !~ /\@attr $attr_type=/) { + $querypart = $additional_attributes{$attr_type} . ' ' . $querypart; + } + } + } + } + else { + # Use a reference to the original query + $serverquery[$s] = \@query; + } $encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); $s++; } ## while fetch @@ -691,7 +721,7 @@ sub Z3950SearchAuth { my $nremaining = $s; for ( my $z = 0 ; $z < $s ; $z++ ) { - $oResult[$z] = $oConnection[$z]->search_pqf($query); + $oResult[$z] = $oConnection[$z]->search_pqf( join(' ', @{$serverquery[$z]}) ) } while ( $nremaining-- ) { -- 1.7.2.5