Bug Fixing:
[koha.git] / cataloguing / z3950_search.pl
1 #!/usr/bin/perl
2 # This is a completely new Z3950 clients search using async ZOOM -TG 02/11/06
3 # Copyright 2000-2002 Katipo Communications
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA  02111-1307 USA
19
20 use strict;
21 use CGI;
22
23 use C4::Auth;
24 use C4::Output;
25 use C4::Biblio;
26 use C4::Context;
27 use C4::Breeding;
28 use C4::Koha;
29 use ZOOM;
30
31 my $input = new CGI;
32 my $dbh = C4::Context->dbh;
33 my $error = $input->param('error');
34 my $biblionumber=$input->param('biblionumber');
35 $biblionumber=0 unless $biblionumber;
36 my $frameworkcode=$input->param('frameworkcode');
37 my $title = $input->param('title');
38 my $author = $input->param('author');
39 my $isbn = $input->param('isbn');
40 my $issn = $input->param('issn');
41 my $random = $input->param('random');
42 my $op=$input->param('op');
43 my $noconnection;
44 my $numberpending;
45 my $attr='';
46 my $term;
47 my $host;
48 my $server;
49 my $database;
50 my $port;
51 my $marcdata;
52 my @encoding;
53 my @results;
54 my $count;
55 my $toggle;
56 my $record;
57 my $oldbiblio;
58 my $dbh = C4::Context->dbh;
59 my $errmsg;
60 my @serverloop=();
61 my @serverhost;
62 my @breeding_loop = ();
63
64 my $DEBUG = 1; # if set to 1, many debug message are send on syslog.
65
66 unless ($random) { # this var is not useful anymore just kept to keep rel2_2 compatibility
67     $random =rand(1000000000);
68 }
69
70 my ($template, $loggedinuser, $cookie)= get_template_and_user({
71                 template_name => "cataloguing/z3950_search.tmpl",
72                 query => $input,
73                 type => "intranet",
74                 authnotrequired => 1,
75                 flagsrequired => {catalogue => 1},
76                 debug => 1,
77                 });
78
79 $template->param(
80         intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
81         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
82         IntranetNav => C4::Context->preference("IntranetNav"),
83         frameworkcode => $frameworkcode,
84         );
85
86 if ($op ne "do_search"){
87     my $sth=$dbh->prepare("select id,host,checked from z3950servers  order by host");
88     $sth->execute();
89     my $serverloop=$sth->fetchall_arrayref({});
90     $template->param(isbn=>$isbn, issn=>$issn,title=>$title,author=>$author,
91                         serverloop => $serverloop,
92                         opsearch => "search",
93                         biblionumber => $biblionumber,
94                         );
95     output_html_with_http_headers $input, $cookie, $template->output;
96 }else{
97     my @id=$input->param('id');
98     my @oConnection;
99     my @oResult;
100     my $s=0;
101                             
102     if ($isbn || $issn) {
103             $attr='1=7';
104             $term=$isbn if ($isbn);
105             $term=$issn if ($issn);
106         } elsif ($title) {
107             $attr='1=4 ';
108             utf8::decode($title);
109             $term=$title;
110         } elsif ($author) {
111             $attr='1=1003';
112             utf8::decode($author);
113             $term=$author;
114         }
115
116     my $query="\@attr $attr \"$term\""; 
117     warn "query ".$query if $DEBUG;
118     foreach my $servid (@id){
119         my $sth=$dbh->prepare("select * from z3950servers where id=?");
120         $sth->execute($servid);
121         while ($server=$sth->fetchrow_hashref) {
122             my $noconnection=0;                                                 
123             my $option1=new ZOOM::Options();
124             $option1->option('async'=>1);
125             $option1->option('elementSetName', 'F');
126             $option1->option('databaseName',$server->{db})  ;
127             $option1->option('user',$server->{userid}) if $server->{userid};
128             $option1->option('password',$server->{password})  if $server->{password};
129             $option1->option('preferredRecordSyntax', $server->{syntax});
130             $oConnection[$s]=create ZOOM::Connection($option1) || $DEBUG && warn ("something went wrong: ".$oConnection[$s]->errmsg());
131             warn ("server data",$server->{name}, $server->{port}) if $DEBUG;
132             $oConnection[$s]->connect($server->{host}, $server->{port}) || $DEBUG && warn ("something went wrong: ".$oConnection[$s]->errmsg());
133             $serverhost[$s]=$server->{host};
134             $encoding[$s]=$server->{syntax};
135             $s++;
136         }## while fetch
137     }# foreach
138     my $nremaining = $s;
139     my $firstresult=1;
140
141     for (my $z=0 ;$z<$s;$z++){
142         warn "doing the search" if $DEBUG;
143         $oResult[$z] = $oConnection[$z]->search_pqf($query) || $DEBUG && warn ("somthing went wrong: " . $oConnection[$s]->errmsg());
144 #$oResult[$z] = $oConnection[$z]->search_pqf($query);
145     }
146
147 AGAIN:
148     my $k;
149     my $event;
150     while (($k = ZOOM::event(\@oConnection)) != 0) {
151         $event = $oConnection[$k-1]->last_event();
152         warn ("connection ", $k-1, ": event $event (", ZOOM::event_str($event), ")\n") if $DEBUG;
153         last if $event == ZOOM::Event::ZEND;
154     }
155
156     if ($k != 0) {
157         $k--;
158         warn $serverhost[$k] if $DEBUG;
159         my($error, $errmsg, $addinfo, $diagset) = $oConnection[$k]->error_x();
160         if ($error) {
161             warn "$k $serverhost[$k] error $query: $errmsg ($error) $addinfo\n" if $DEBUG;
162             
163         } else {
164         my $numresults=$oResult[$k]->size() ;
165         my $i;
166         my $result='';
167         if ($numresults>0){
168             for ($i=0; $i<(($numresults<20) ? ($numresults) : (20)) ; $i++) {
169                 my $rec=$oResult[$k]->record($i);
170                 my $marcrecord;
171                 $marcdata = $rec->raw();
172                 $marcrecord= FixEncoding($marcdata);
173                 warn "MARC : ".$marcrecord->as_formatted;
174 ####WARNING records coming from Z3950 clients are in various character sets MARC8,UTF8,UNIMARC etc
175 ## In HEAD i change everything to UTF-8
176 # In rel2_2 i am not sure what encoding is so no character conversion is done here
177 ##Add necessary encoding changes to here -TG
178                 my $oldbiblio = TransformMarcToKoha($dbh,$marcrecord,"");
179                 $oldbiblio->{isbn} =~ s/ |-|\.//g,
180                 $oldbiblio->{issn} =~ s/ |-|\.//g,
181                 my ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid)=ImportBreeding($marcdata,1,$serverhost[$k],$encoding[$k],$random);
182                 my %row_data;
183                 if ($i % 2) {
184                     $toggle="#ffffcc";
185                 } else {
186                     $toggle="white";
187                 }
188                 $row_data{toggle} = $toggle;
189                 $row_data{server} = $serverhost[$k];
190                 $row_data{isbn} = $oldbiblio->{isbn};
191                 $row_data{title} =$oldbiblio->{title};
192                 $row_data{author} = $oldbiblio->{author};
193                 $row_data{breedingid} = $breedingid;
194                 $row_data{biblionumber}=$biblionumber;
195                 push (@breeding_loop, \%row_data);
196             }# upto 5 results
197         }#$numresults
198         }
199     }# if $k !=0
200     $numberpending=$nremaining-1;
201     $template->param(breeding_loop => \@breeding_loop, server=>$serverhost[$k],
202                 numberpending => $numberpending,
203     );
204     output_html_with_http_headers $input, $cookie, $template->output if $numberpending==0;
205
206 #       print  $template->output  if $firstresult !=1;
207     $firstresult++;
208
209     MAYBE_AGAIN:
210         if (--$nremaining > 0) {
211             goto AGAIN;
212         }
213 } ## if op=search