[Koha-cvs] koha/z3950 search.pl [rel_2_2]
Joshua Ferraro
jmf at liblime.com
Sat Feb 24 17:03:20 CET 2007
CVSROOT: /sources/koha
Module name: koha
Branch: rel_2_2
Changes by: Joshua Ferraro <kados> 07/02/24 16:03:20
Modified files:
z3950 : search.pl
Log message:
fix to z39.50 client for rel_2_2
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/z3950/search.pl?cvsroot=koha&only_with_tag=rel_2_2&r1=1.3.2.14&r2=1.3.2.15
Patches:
Index: search.pl
===================================================================
RCS file: /sources/koha/koha/z3950/search.pl,v
retrieving revision 1.3.2.14
retrieving revision 1.3.2.15
diff -u -b -r1.3.2.14 -r1.3.2.15
--- search.pl 16 Feb 2007 10:16:36 -0000 1.3.2.14
+++ search.pl 24 Feb 2007 16:03:19 -0000 1.3.2.15
@@ -32,10 +32,10 @@
my $input = new CGI;
my $dbh = C4::Context->dbh;
my $error = $input->param('error');
-my $oldbiblionumber=$input->param('oldbiblionumber');
-$oldbiblionumber=0 unless $oldbiblionumber;
+my $biblionumber=$input->param('oldbiblionumber');
+$biblionumber=0 unless $biblionumber;
+my $frameworkcode=$input->param('frameworkcode');
my $title = $input->param('title');
-warn "titre ;".$title;
my $author = $input->param('author');
my $isbn = $input->param('isbn');
my $issn = $input->param('issn');
@@ -62,7 +62,11 @@
my @serverhost;
my @breeding_loop = ();
+my $DEBUG = 0; # if set to 1, many debug message are send on syslog.
+unless ($random) { # this var is not useful anymore just kept to keep rel2_2 compatibility
+ $random =rand(1000000000);
+}
my ($template, $loggedinuser, $cookie)= get_template_and_user({
template_name => "z3950/searchresult.tmpl",
@@ -76,7 +80,9 @@
$template->param(
intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"));
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ frameworkcode => $frameworkcode,
+ );
if ($op ne "do_search"){
my $sth=$dbh->prepare("select id,host,checked from z3950servers order by host");
@@ -91,7 +97,7 @@
$template->param(isbn=>$isbn, issn=>$issn,title=>$title,author=>$author,
serverloop => \@serverloop,
opsearch => "search",
- oldbiblionumber => $oldbiblionumber,
+ oldbiblionumber => $biblionumber,
);
output_html_with_http_headers $input, $cookie, $template->output;
}else{
@@ -100,24 +106,21 @@
my @oResult;
my $s=0;
- my $query;
- if ($isbn || $issn) {
+ if ($isbn ne "/" || $issn ne "/") {
$attr='1=7';
# warn "isbn : $isbn";
- $term=$isbn if ($isbn);
- $term=$issn if ($issn);
- } elsif ($title) {
- $attr='1=4 ';
- $title=~tr/àâäéèêëîïôöùû/aaaeeeeiioouu/;
+ $term=$isbn if ($isbn ne "/");
+ $term=$issn if ($issn ne "/");
+ } elsif ($title ne "/") {
+ $attr='1=4 @attr 4=1 ';
$term=$title;
- } elsif ($author) {
+ } elsif ($author ne "/") {
$attr='1=1003';
- $author=~tr/àâäéèêëîïôöùû/aaaeeeeiioouu/;
$term=$author;
}
- $query="\@attr $attr \"$term\"";
- warn "query ".$query;
+ my $query="\@attr $attr \"$term\"";
+ warn "query ".$query if $DEBUG;
foreach my $servid (@id){
my $sth=$dbh->prepare("select * from z3950servers where id=?");
$sth->execute($servid);
@@ -130,46 +133,58 @@
$option1->option('user',$server->{userid}) if $server->{userid};
$option1->option('password',$server->{password}) if $server->{password};
$option1->option('preferredRecordSyntax', $server->{syntax});
- $oConnection[$s]=create ZOOM::Connection($option1) || warn ("something went wrong: ".$oConnection[$s]->errmsg());
-# warn ("server data",$server->{name}, $server->{port});
+ $oConnection[$s]=create ZOOM::Connection($option1) || $DEBUG && warn ("something went wrong: ".$oConnection[$s]->errmsg());
+ warn ("server data",$server->{name}, $server->{port}) if $DEBUG;
+ $oConnection[$s]->connect($server->{host}, $server->{port}) || $DEBUG && warn ("something went wrong: ".$oConnection[$s]->errmsg());
$serverhost[$s]=$server->{host};
$encoding[$s]=$server->{syntax};
- $oConnection[$s]->connect($server->{host}, $server->{port}) || warn ("Connection to $serverhost[$s]: ".$oConnection[$s]->errmsg());
- $oResult[$s] = $oConnection[$s]->search_pqf($query) || warn ("search $serverhost[$s]: " . $oConnection[$s]->errmsg());
$s++;
}## while fetch
}# foreach
my $nremaining = $s;
-# my $firstresult=1;
+ my $firstresult=1;
+
+ for (my $z=0 ;$z<$s;$z++){
+ warn "doing the search" if $DEBUG;
+ $oResult[$z] = $oConnection[$z]->search_pqf($query) || $DEBUG && warn ("somthing went wrong: " . $oConnection[$s]->errmsg());
+#$oResult[$z] = $oConnection[$z]->search_pqf($query);
+ }
+AGAIN:
my $k;
my $event;
while (($k = ZOOM::event(\@oConnection)) != 0) {
$event = $oConnection[$k-1]->last_event();
- warn ("connection ", $k-1, ": event $event (", ZOOM::event_str($event), ")\n");
- if ($event == ZOOM::Event::ZEND){
- my($error, $errmsg, $addinfo, $diagset) = $oConnection[$k-1]->error_x();
+ warn ("connection ", $k-1, ": event $event (", ZOOM::event_str($event), ")\n") if $DEBUG;
+ last if $event == ZOOM::Event::ZEND;
+ }
+
+ if ($k != 0) {
+ $k--;
+ warn $serverhost[$k] if $DEBUG;
+ my($error, $errmsg, $addinfo, $diagset) = $oConnection[$k]->error_x();
if ($error) {
- warn "$k $serverhost[$k - 1] error $query: $errmsg ($error) $addinfo\n";
+ warn "$k $serverhost[$k] error $query: $errmsg ($error) $addinfo\n" if $DEBUG;
+ goto MAYBE_AGAIN;
}
- my $numresults=$oResult[$k-1]->size() ;
+ my $numresults=$oResult[$k]->size() ;
my $i;
my $result='';
if ($numresults>0){
- for ($i=0; $i<$numresults ; $i++) {
- my $rec=$oResult[$k-1]->record($i);
+ for ($i=0; $i<(($numresults<5) ? ($numresults) : (5)) ; $i++) {
+ my $rec=$oResult[$k]->record($i);
my $marcrecord;
$marcdata = $rec->raw();
- $marcrecord= fixEncoding($marcdata);
- ####WARNING records coming from Z3950 clients are in various character sets MARC8,UTF8,UNIMARC etc
- ## In HEAD i change everything to UTF-8
- # In rel2_2 i am not sure what encoding is so no character conversion is done here
- ##Add necessary encoding changes to here -TG
+ $marcrecord = MARC::Record->new_from_usmarc($marcdata);#rec->raw();
+ #$marcrecord= FixEncoding($marcdata);
+####WARNING records coming from Z3950 clients are in various character sets MARC8,UTF8,UNIMARC etc
+## In HEAD i change everything to UTF-8
+# In rel2_2 i am not sure what encoding is so no character conversion is done here
+##Add necessary encoding changes to here -TG
my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,"");
$oldbiblio->{isbn} =~ s/ |-|\.//g,
$oldbiblio->{issn} =~ s/ |-|\.//g,
- my ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$bid)=ImportBreeding($marcdata,1,$serverhost[$k],$encoding[$k],$random);
-
+ my ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid)=ImportBreeding($marcdata,1,$serverhost[$k],$encoding[$k],$random);
my %row_data;
if ($i % 2) {
$toggle="#ffffcc";
@@ -177,29 +192,28 @@
$toggle="white";
}
$row_data{toggle} = $toggle;
- $row_data{server} = $serverhost[$k-1];
+ $row_data{server} = $serverhost[$k];
$row_data{isbn} = $oldbiblio->{isbn};
$row_data{title} =$oldbiblio->{title};
$row_data{author} = $oldbiblio->{author};
- $row_data{id} = $bid;
- $row_data{oldbiblionumber}=$oldbiblionumber;
+ $row_data{id} = $breedingid;
+ $row_data{oldbiblionumber}=$biblionumber;
push (@breeding_loop, \%row_data);
- }
+ }# upto 5 results
}#$numresults
- else {
- warn "no results for $serverhost[$k - 1]";
- }
- }
-
- }
-
+ }# if $k !=0
+ $numberpending=$nremaining-1;
$template->param(breeding_loop => \@breeding_loop, server=>$serverhost[$k],
numberpending => $numberpending,
);
- output_html_with_http_headers $input, $cookie, $template->output;
+ output_html_with_http_headers $input, $cookie, $template->output if $numberpending==0;
# print $template->output if $firstresult !=1;
-# $firstresult++;
+ $firstresult++;
+ MAYBE_AGAIN:
+ if (--$nremaining > 0) {
+ goto AGAIN;
+ }
} ## if op=search
More information about the Koha-cvs
mailing list