X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=cataloguing%2Fz3950_search.pl;h=a44b5ea50c67e50c0108f7def69975042426bd3b;hb=a29a5df175f4112302de71456d4f21d0dd7f48cf;hp=a2837b7fb1db59059f3e6e91e7498ea001d1cbf7;hpb=f8e9fb6445dadbdef91e13a253c9c6bcb75e0eec;p=koha_fer diff --git a/cataloguing/z3950_search.pl b/cataloguing/z3950_search.pl index a2837b7fb1..a44b5ea50c 100755 --- a/cataloguing/z3950_search.pl +++ b/cataloguing/z3950_search.pl @@ -1,4 +1,5 @@ #!/usr/bin/perl + # This is a completely new Z3950 clients search using async ZOOM -TG 02/11/06 # Copyright 2000-2002 Katipo Communications # @@ -13,37 +14,43 @@ # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR # A PARTICULAR PURPOSE. See the GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use strict; +#use warnings; FIXME - Bug 2505 use CGI; use C4::Auth; use C4::Output; -use C4::Interface::CGI::Output; use C4::Biblio; use C4::Context; use C4::Breeding; use C4::Koha; +use C4::Charset; use ZOOM; -my $input = new CGI; -my $dbh = C4::Context->dbh; -my $error = $input->param('error'); -my $biblionumber=$input->param('biblionumber'); -$biblionumber=0 unless $biblionumber; -my $frameworkcode=$input->param('frameworkcode'); -my $title = $input->param('title'); -my $author = $input->param('author'); -my $isbn = $input->param('isbn'); -my $issn = $input->param('issn'); -my $random = $input->param('random'); -my $op=$input->param('op'); -my $noconnection; +my $input = new CGI; +my $dbh = C4::Context->dbh; +my $error = $input->param('error'); +my $biblionumber = $input->param('biblionumber') || 0; +my $frameworkcode = $input->param('frameworkcode'); +my $title = $input->param('title'); +my $author = $input->param('author'); +my $isbn = $input->param('isbn'); +my $issn = $input->param('issn'); +my $lccn = $input->param('lccn'); +my $lccall = $input->param('lccall'); +my $subject = $input->param('subject'); +my $dewey = $input->param('dewey'); +my $controlnumber = $input->param('controlnumber'); +my $stdid = $input->param('stdid'); +my $srchany = $input->param('srchany'); +my $random = $input->param('random') || rand(1000000000); # this var is not useful anymore just kept for rel2_2 compatibility +my $op = $input->param('op'); my $numberpending; -my $attr=''; +my $attr = ''; my $term; my $host; my $server; @@ -53,164 +60,241 @@ my $marcdata; my @encoding; my @results; my $count; -my $toggle; my $record; my $oldbiblio; -my $dbh = C4::Context->dbh; my $errmsg; -my @serverloop=(); +my @serverloop = (); my @serverhost; +my @servername; my @breeding_loop = (); -my $DEBUG = 1; # if set to 1, many debug message are send on syslog. +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 => "cataloguing/z3950_search.tmpl", + query => $input, + type => "intranet", + authnotrequired => 1, + flagsrequired => { catalogue => 1 }, + debug => 1, +}); -my ($template, $loggedinuser, $cookie)= get_template_and_user({ - template_name => "cataloguing/z3950_search.tmpl", - query => $input, - type => "intranet", - authnotrequired => 1, - flagsrequired => {catalogue => 1}, - debug => 1, - }); - -$template->param( - intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"), - intranetstylesheet => C4::Context->preference("intranetstylesheet"), - 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"); +$template->param( frameworkcode => $frameworkcode, ); + +if ( $op ne "do_search" ) { + my $sth = $dbh->prepare("SELECT id,host,name,checked FROM z3950servers ORDER BY rank, name"); $sth->execute(); - my $serverloop=$sth->fetchall_arrayref({}); - $template->param(isbn=>$isbn, issn=>$issn,title=>$title,author=>$author, - serverloop => $serverloop, - opsearch => "search", - biblionumber => $biblionumber, - ); + my $serverloop = $sth->fetchall_arrayref( {} ); + $template->param( + isbn => $isbn, + issn => $issn, + lccn => $lccn, + lccall => $lccall, + title => $title, + author => $author, + controlnumber=> $controlnumber, + stdid => $stdid, + srchany => $srchany, + serverloop => $serverloop, + opsearch => "search", + biblionumber => $biblionumber, + ); output_html_with_http_headers $input, $cookie, $template->output; -}else{ - my @id=$input->param('id'); +} +else { + my @id = $input->param('id'); + + if ( not defined @id ) { + # empty server list -> report and exit + $template->param( emptyserverlist => 1 ); + output_html_with_http_headers $input, $cookie, $template->output; + exit; + } + my @oConnection; my @oResult; - my $s=0; - + my @errconn; + my $s = 0; + my $query = ''; + my $nterms; if ($isbn || $issn) { - $attr='1=7'; -# warn "isbn : $isbn"; - $term=$isbn if ($isbn); - $term=$issn if ($issn); - } elsif ($title) { - $attr='1=4 '; + $term=$isbn if ($isbn); + $term=$issn if ($issn); + $query .= " \@or \@attr 1=8 \"$term\" \@attr 1=7 \"$term\" "; + $nterms++; + } + if ($title) { utf8::decode($title); - $title=~tr/àâäéèêëîïôöùû/aaaeeeeiioouu/; - $term=$title; - } elsif ($author) { - $attr='1=1003'; + $query .= " \@attr 1=4 \"$title\" "; + $nterms++; + } + if ($author) { utf8::decode($author); - $author=~tr/àâäéèêëîïôöùû/aaaeeeeiioouu/; - $term=$author; - } - - my $query="\@attr $attr \"$term\""; - warn "query ".$query if $DEBUG; - foreach my $servid (@id){ - my $sth=$dbh->prepare("select * from z3950servers where id=?"); + $query .= " \@attr 1=1003 \"$author\" "; + $nterms++; + } + if ($dewey) { + $query .= " \@attr 1=16 \"$dewey\" "; + $nterms++; + } + if ($subject) { + utf8::decode($subject); + $query .= " \@attr 1=21 \"$subject\" "; + $nterms++; + } + if ($lccn) { + $query .= " \@attr 1=9 $lccn "; + $nterms++; + } + if ($lccall) { + $query .= " \@attr 1=16 \@attr 2=3 \@attr 3=1 \@attr 4=1 \@attr 5=1 \@attr 6=1 \"$lccall\" "; + $nterms++; + } + if ($controlnumber) { + $query .= " \@attr 1=12 \"$controlnumber\" "; + $nterms++; + } + if ($stdid) { + $query .= " \@attr 1=1007 \"$stdid\" "; + $nterms++; + } + if ($srchany) { + $query .= " \@attr 1=1016 \"$srchany\" "; + $nterms++; + } +for my $i (1..$nterms-1) { + $query = "\@and " . $query; +} +warn "query ".$query if $DEBUG; + + foreach my $servid (@id) { + my $sth = $dbh->prepare("SELECT * FROM z3950servers WHERE id=? ORDER BY rank, name"); $sth->execute($servid); - while ($server=$sth->fetchrow_hashref) { - my $noconnection=0; - my $option1=new ZOOM::Options(); - $option1->option('async'=>1); + while ( $server = $sth->fetchrow_hashref ) { + warn "serverinfo ".join(':',%$server) if $DEBUG; + my $option1 = new ZOOM::Options(); + $option1->option('async' => 1); $option1->option('elementSetName', 'F'); - $option1->option('databaseName',$server->{db}) ; - $option1->option('user',$server->{userid}) if $server->{userid}; - $option1->option('password',$server->{password}) if $server->{password}; + $option1->option('databaseName', $server->{db}); + $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) || $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}; + $option1->option( 'timeout', $server->{timeout} ) if ($server->{timeout}); + $oConnection[$s] = create ZOOM::Connection($option1) + || $DEBUG + && warn( "" . $oConnection[$s]->errmsg() ); + warn( "server data", $server->{name}, $server->{port} ) if $DEBUG; + $oConnection[$s]->connect( $server->{host}, $server->{port} ) + || $DEBUG + && warn( "" . $oConnection[$s]->errmsg() ); + $serverhost[$s] = $server->{host}; + $servername[$s] = $server->{name}; + $encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); $s++; - }## while fetch - }# foreach - my $nremaining = $s; - my $firstresult=1; + } ## while fetch + } # foreach + my $nremaining = $s; + my $firstresult = 1; - for (my $z=0 ;$z<$s;$z++){ + 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); + $oResult[$z] = $oConnection[$z]->search_pqf($query) + || $DEBUG + && warn( "somthing went wrong: " . $oConnection[$s]->errmsg() ); + + # $oResult[$z] = $oConnection[$z]->search_pqf($query); } -AGAIN: + 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 $DEBUG; + while ( ( $k = ZOOM::event( \@oConnection ) ) != 0 ) { + $event = $oConnection[ $k - 1 ]->last_event(); + warn( "connection ", $k - 1, ": event $event (", + ZOOM::event_str($event), ")\n" ) + if $DEBUG; last if $event == ZOOM::Event::ZEND; } - if ($k != 0) { + if ( $k != 0 ) { $k--; warn $serverhost[$k] if $DEBUG; - my($error, $errmsg, $addinfo, $diagset) = $oConnection[$k]->error_x(); + my ( $error, $errmsg, $addinfo, $diagset ) = + $oConnection[$k]->error_x(); if ($error) { - warn "$k $serverhost[$k] error $query: $errmsg ($error) $addinfo\n" if $DEBUG; - - } else { - my $numresults=$oResult[$k]->size() ; - my $i; - my $result=''; - if ($numresults>0){ - for ($i=0; $i<(($numresults<20) ? ($numresults) : (20)) ; $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 - my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,""); - $oldbiblio->{isbn} =~ s/ |-|\.//g, - $oldbiblio->{issn} =~ s/ |-|\.//g, - my ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid)=ImportBreeding($marcdata,1,$serverhost[$k],$encoding[$k],$random); - my %row_data; - if ($i % 2) { - $toggle="#ffffcc"; - } else { - $toggle="white"; - } - $row_data{toggle} = $toggle; - $row_data{server} = $serverhost[$k]; - $row_data{isbn} = $oldbiblio->{isbn}; - $row_data{title} =$oldbiblio->{title}; - $row_data{author} = $oldbiblio->{author}; - $row_data{breedingid} = $breedingid; - $row_data{biblionumber}=$biblionumber; - push (@breeding_loop, \%row_data); - }# upto 5 results - }#$numresults + if ($error =~ m/^(10000|10007)$/ ) { + push(@errconn, {'server' => $serverhost[$k], 'error' => $error}); + } + $DEBUG and warn "$k $serverhost[$k] error $query: $errmsg ($error) $addinfo\n"; + } + else { + my $numresults = $oResult[$k]->size(); + my $i; + my $result = ''; + if ( $numresults > 0 ) { + for ($i = 0; $i < (($numresults < 20) ? $numresults : 20); $i++) { + my $rec = $oResult[$k]->record($i); + if ($rec) { + my $marcrecord; + $marcdata = $rec->raw(); + + my ($charset_result, $charset_errors); + ($marcrecord, $charset_result, $charset_errors) = + MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]); +####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 = TransformMarcToKoha( $dbh, $marcrecord, "" ); + $oldbiblio->{isbn} =~ s/ |-|\.//g if $oldbiblio->{isbn}; + # pad | and ( with spaces to allow line breaks in the HTML + $oldbiblio->{isbn} =~ s/\|/ \| /g if $oldbiblio->{isbn}; + $oldbiblio->{isbn} =~ s/\(/ \(/g if $oldbiblio->{isbn}; + + $oldbiblio->{issn} =~ s/ |-|\.//g if $oldbiblio->{issn}; + # pad | and ( with spaces to allow line breaks in the HTML + $oldbiblio->{issn} =~ s/\|/ \| /g if $oldbiblio->{issn}; + $oldbiblio->{issn} =~ s/\(/ \(/g if $oldbiblio->{issn}; + my ( + $notmarcrecord, $alreadyindb, $alreadyinfarm, + $imported, $breedingid + ) + = ImportBreeding( $marcdata, 2, $serverhost[$k], $encoding[$k], $random, 'z3950' ); + my %row_data; + $row_data{server} = $servername[$k]; + $row_data{isbn} = $oldbiblio->{isbn}; + $row_data{lccn} = $oldbiblio->{lccn}; + $row_data{title} = $oldbiblio->{title}; + $row_data{author} = $oldbiblio->{author}; + $row_data{date} = $oldbiblio->{copyrightdate}; + $row_data{edition} = $oldbiblio->{editionstatement}; + $row_data{breedingid} = $breedingid; + $row_data{biblionumber} = $biblionumber; + push( @breeding_loop, \%row_data ); + + } else { + push(@breeding_loop,{'server'=>$servername[$k],'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'biblionumber'=>-1}); + } # $rec + } + } #$numresults } - }# if $k !=0 - $numberpending=$nremaining-1; - $template->param(breeding_loop => \@breeding_loop, server=>$serverhost[$k], - numberpending => $numberpending, + } # if $k !=0 + $numberpending = $nremaining - 1; + $template->param( + breeding_loop => \@breeding_loop, + server => $servername[$k], + numberpending => $numberpending, + biblionumber => $biblionumber, + errconn => \@errconn ); - output_html_with_http_headers $input, $cookie, $template->output if $numberpending==0; + + output_html_with_http_headers $input, $cookie, $template->output if $numberpending == 0; -# print $template->output if $firstresult !=1; + # print $template->output if $firstresult !=1; $firstresult++; - MAYBE_AGAIN: - if (--$nremaining > 0) { - goto AGAIN; - } -} ## if op=search + MAYBE_AGAIN: + if ( --$nremaining > 0 ) { + goto AGAIN; + } +} ## if op=search