Attachment #23145 for bug #11297

View | Details | Raw Unified | Return to bug 11297
Collapse All | Expand All




    my $record;
    my @serverhost;
    my @servername;
    my @serverquery;
    my @breeding_loop = ();

    my @oConnection;
    my @oResult;
    my @errconn;
    my $s = 0;
    my @query = '';
    my $nterms=0;

    if ($nameany) {
        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) {
        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) {
        push @query, "\@attr 1=2 \"$authorcorp\""; #1005 is another valid corporate author attribute...
        $nterms++;
    }

    if ($authorpersonal) {
        push @query, "\@attr 1=1 \"$authorpersonal\""; #1004 is another valid personal name attribute...
        $nterms++;
    }

    if ($authormeetingcon) {
        push @query, "\@attr 1=3 \"$authormeetingcon\""; #1006 is another valid meeting/conference name attribute...
        $nterms++;
    }

    if ($subject) {
        push @query, "\@attr 1=21 \"$subject\"";
        $nterms++;
    }

    if ($subjectsubdiv) {
        push @query, "\@attr 1=47 \"$subjectsubdiv\"";
        $nterms++;
    }

    if ($title) {
        push @query, "\@attr 1=4 \"$title\""; #This is a regular title search. 1=6 will give just uniform titles
        $nterms++;
    }

     if ($uniformtitle) {
        push @query, "\@attr 1=6 \"$uniformtitle\""; #This is the uniform title search
        $nterms++;
    }

    if($srchany) {
        push @query, "\@attr 1=1016 \"$srchany\"";
        $nterms++;
    }

    for my $i (1..$nterms-1) {
        $query[0] = "\@and " . $query[0];
    }

    foreach my $servid (@id) {

            $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

    my $nremaining  = $s;

    for ( my $z = 0 ; $z < $s ; $z++ ) {
        $oResult[$z] = $oConnection[$z]->search_pqf( join(' ', @{$serverquery[$z]}) )
    }

    while ( $nremaining-- ) {
- 

Return to bug 11297

Lines 603-671 sub Z3950SearchAuth { Link Here

(-)a/C4/Breeding.pm (-14 / +43 lines)
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	-