|
Lines 19-37
Link Here
|
| 19 |
# with Koha; if not, write to the Free Software Foundation, Inc., |
19 |
# with Koha; if not, write to the Free Software Foundation, Inc., |
| 20 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
20 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
| 21 |
|
21 |
|
| 22 |
use warnings; |
|
|
| 23 |
use strict; |
22 |
use strict; |
|
|
23 |
use warnings; |
| 24 |
use CGI; |
24 |
use CGI; |
| 25 |
|
25 |
|
| 26 |
use C4::Auth; |
26 |
use C4::Auth; |
| 27 |
use C4::Output; |
27 |
use C4::Output; |
| 28 |
use C4::Biblio; |
28 |
#use C4::Biblio; |
| 29 |
use C4::Context; |
29 |
use C4::Context; |
| 30 |
use C4::Breeding; |
30 |
use C4::Breeding; |
| 31 |
use C4::Koha; |
31 |
use C4::Koha; |
| 32 |
use C4::Charset; |
32 |
#use C4::Charset; |
| 33 |
use C4::Bookseller qw/ GetBookSellerFromId /; |
33 |
use C4::Bookseller qw/ GetBookSellerFromId /; |
| 34 |
use ZOOM; |
34 |
#use ZOOM; |
| 35 |
|
35 |
|
| 36 |
my $input = new CGI; |
36 |
my $input = new CGI; |
| 37 |
my ( $template, $loggedinuser, $cookie ) = get_template_and_user( |
37 |
my ( $template, $loggedinuser, $cookie ) = get_template_and_user( |
|
Lines 47-56
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
Link Here
|
| 47 |
|
47 |
|
| 48 |
|
48 |
|
| 49 |
my $dbh = C4::Context->dbh; |
49 |
my $dbh = C4::Context->dbh; |
| 50 |
my $error = $input->param('error'); |
50 |
my $biblionumber = $input->param('biblionumber') || 0; |
| 51 |
my $biblionumber = $input->param('biblionumber'); |
51 |
my $frameworkcode = $input->param('frameworkcode') || ''; |
| 52 |
$biblionumber = 0 unless $biblionumber; |
|
|
| 53 |
my $frameworkcode = $input->param('frameworkcode'); |
| 54 |
my $title = $input->param('title'); |
52 |
my $title = $input->param('title'); |
| 55 |
my $author = $input->param('author'); |
53 |
my $author = $input->param('author'); |
| 56 |
my $isbn = $input->param('isbn'); |
54 |
my $isbn = $input->param('isbn'); |
|
Lines 60-93
my $lccall = $input->param('lccall');
Link Here
|
| 60 |
my $subject= $input->param('subject'); |
58 |
my $subject= $input->param('subject'); |
| 61 |
my $dewey = $input->param('dewey'); |
59 |
my $dewey = $input->param('dewey'); |
| 62 |
my $controlnumber = $input->param('controlnumber'); |
60 |
my $controlnumber = $input->param('controlnumber'); |
| 63 |
my $op = $input->param('op'); |
61 |
my $op = $input->param('op')||''; |
| 64 |
my $booksellerid = $input->param('booksellerid'); |
62 |
my $booksellerid = $input->param('booksellerid'); |
| 65 |
my $basketno = $input->param('basketno'); |
63 |
my $basketno = $input->param('basketno'); |
| 66 |
my $noconnection; |
|
|
| 67 |
my $attr = ''; |
| 68 |
my $term; |
| 69 |
my $host; |
| 70 |
my $server; |
| 71 |
my $database; |
| 72 |
my $port; |
| 73 |
my $marcdata; |
| 74 |
my @encoding; |
| 75 |
my @results; |
| 76 |
my $count; |
| 77 |
my $toggle; |
| 78 |
my $record; |
| 79 |
my $oldbiblio; |
| 80 |
my $errmsg; |
| 81 |
my @serverhost; |
| 82 |
my @servername; |
| 83 |
my @breeding_loop = (); |
| 84 |
my $random = $input->param('random'); |
| 85 |
unless ($random) |
| 86 |
{ # this var is not useful anymore just kept to keep rel2_2 compatibility |
| 87 |
$random = rand(1000000000); |
| 88 |
} |
| 89 |
|
| 90 |
my $DEBUG = $ENV{DEBUG} || 0; # if set to 1, many debug message are send on syslog. |
| 91 |
|
64 |
|
| 92 |
# get framework list |
65 |
# get framework list |
| 93 |
my $frameworks = getframeworks; |
66 |
my $frameworks = getframeworks; |
|
Lines 130-324
if ( $op ne "do_search" ) {
Link Here
|
| 130 |
biblionumber => $biblionumber, |
103 |
biblionumber => $biblionumber, |
| 131 |
); |
104 |
); |
| 132 |
output_html_with_http_headers $input, $cookie, $template->output; |
105 |
output_html_with_http_headers $input, $cookie, $template->output; |
| 133 |
exit; |
|
|
| 134 |
} |
106 |
} |
| 135 |
|
107 |
else { |
| 136 |
my @id = $input->param('id'); |
108 |
my @id = $input->param('id'); |
| 137 |
|
109 |
if (@id==0) { |
| 138 |
if ( not @id ) { |
|
|
| 139 |
# empty server list -> report and exit |
110 |
# empty server list -> report and exit |
| 140 |
$template->param( emptyserverlist => 1 ); |
111 |
$template->param( emptyserverlist => 1 ); |
| 141 |
output_html_with_http_headers $input, $cookie, $template->output; |
112 |
output_html_with_http_headers $input, $cookie, $template->output; |
| 142 |
exit; |
113 |
exit; |
| 143 |
} |
114 |
} |
| 144 |
|
115 |
my $pars= { |
| 145 |
my @oConnection; |
116 |
random => $input->param('random') || rand(1000000000), |
| 146 |
my @oResult; |
117 |
biblionumber => $biblionumber, |
| 147 |
my @errconn; |
118 |
id => \@id, |
| 148 |
my $s = 0; |
119 |
isbn => $isbn, |
| 149 |
my $query; |
120 |
title => $title, |
| 150 |
my $nterms; |
121 |
author => $author, |
| 151 |
if ($isbn || $issn) { |
122 |
dewey => $dewey, |
| 152 |
$term=$isbn if ($isbn); |
123 |
subject => $subject, |
| 153 |
$term=$issn if ($issn); |
124 |
lccall => $lccall, |
| 154 |
$query .= " \@or \@attr 1=8 \"$term\" \@attr 1=7 \"$term\" "; |
125 |
controlnumber => $controlnumber, |
| 155 |
$nterms++; |
126 |
stdid => 0, |
| 156 |
} |
127 |
srchany => 0, |
| 157 |
if ($title) { |
128 |
}; |
| 158 |
utf8::decode($title); |
129 |
Z3950Search($pars, $template); |
| 159 |
$query .= " \@attr 1=4 \"$title\" "; |
130 |
output_html_with_http_headers $input, $cookie, $template->output; |
| 160 |
$nterms++; |
|
|
| 161 |
} |
| 162 |
if ($author) { |
| 163 |
utf8::decode($author); |
| 164 |
$query .= " \@attr 1=1003 \"$author\" "; |
| 165 |
$nterms++; |
| 166 |
} |
| 167 |
if ($dewey) { |
| 168 |
$query .= " \@attr 1=16 \"$dewey\" "; |
| 169 |
$nterms++; |
| 170 |
} |
| 171 |
if ($subject) { |
| 172 |
utf8::decode($subject); |
| 173 |
$query .= " \@attr 1=21 \"$subject\" "; |
| 174 |
$nterms++; |
| 175 |
} |
| 176 |
if ($lccn) { |
| 177 |
$query .= " \@attr 1=9 $lccn "; |
| 178 |
$nterms++; |
| 179 |
} |
| 180 |
if ($lccall) { |
| 181 |
$query .= " \@attr 1=16 \@attr 2=3 \@attr 3=1 \@attr 4=1 \@attr 5=1 \@attr 6=1 \"$lccall\" "; |
| 182 |
$nterms++; |
| 183 |
} |
| 184 |
if ($controlnumber) { |
| 185 |
$query .= " \@attr 1=12 \"$controlnumber\" "; |
| 186 |
$nterms++; |
| 187 |
} |
| 188 |
for my $i (1..$nterms-1) { |
| 189 |
$query = "\@and " . $query; |
| 190 |
} |
131 |
} |
| 191 |
warn "query ".$query if $DEBUG; |
|
|
| 192 |
|
| 193 |
foreach my $servid (@id) { |
| 194 |
my $sth = $dbh->prepare("select * from z3950servers where id=?"); |
| 195 |
$sth->execute($servid); |
| 196 |
while ( $server = $sth->fetchrow_hashref ) { |
| 197 |
warn "serverinfo ".join(':',%$server) if $DEBUG; |
| 198 |
my $option1 = new ZOOM::Options(); |
| 199 |
$option1->option( 'async' => 1 ); |
| 200 |
$option1->option( 'elementSetName', 'F' ); |
| 201 |
$option1->option( 'databaseName', $server->{db} ); |
| 202 |
$option1->option( 'user', $server->{userid} ) if $server->{userid}; |
| 203 |
$option1->option( 'password', $server->{password} ) |
| 204 |
if $server->{password}; |
| 205 |
$option1->option( 'preferredRecordSyntax', $server->{syntax} ); |
| 206 |
$oConnection[$s] = create ZOOM::Connection($option1) |
| 207 |
|| $DEBUG |
| 208 |
&& warn( "" . $oConnection[$s]->errmsg() ); |
| 209 |
warn( "server data", $server->{name}, $server->{port} ) if $DEBUG; |
| 210 |
$oConnection[$s]->connect( $server->{host}, $server->{port} ) |
| 211 |
|| $DEBUG |
| 212 |
&& warn( "" . $oConnection[$s]->errmsg() ); |
| 213 |
$serverhost[$s] = $server->{host}; |
| 214 |
$servername[$s] = $server->{name}; |
| 215 |
$encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); |
| 216 |
$s++; |
| 217 |
} ## while fetch |
| 218 |
} # foreach |
| 219 |
my $nremaining = $s; |
| 220 |
my $firstresult = 1; |
| 221 |
|
| 222 |
for ( my $z = 0 ; $z < $s ; $z++ ) { |
| 223 |
warn "doing the search" if $DEBUG; |
| 224 |
$oResult[$z] = $oConnection[$z]->search_pqf($query) |
| 225 |
|| $DEBUG |
| 226 |
&& warn( "somthing went wrong: " . $oConnection[$s]->errmsg() ); |
| 227 |
|
| 228 |
# $oResult[$z] = $oConnection[$z]->search_pqf($query); |
| 229 |
} |
| 230 |
|
| 231 |
warn "# nremaining = $nremaining\n" if $DEBUG; |
| 232 |
|
| 233 |
while ( $nremaining-- ) { |
| 234 |
|
| 235 |
my $k; |
| 236 |
my $event; |
| 237 |
while ( ( $k = ZOOM::event( \@oConnection ) ) != 0 ) { |
| 238 |
$event = $oConnection[ $k - 1 ]->last_event(); |
| 239 |
warn( "connection ", $k - 1, ": event $event (", |
| 240 |
ZOOM::event_str($event), ")\n" ) |
| 241 |
if $DEBUG; |
| 242 |
last if $event == ZOOM::Event::ZEND; |
| 243 |
} |
| 244 |
|
| 245 |
if ( $k != 0 ) { |
| 246 |
$k--; |
| 247 |
warn "event from $k server = ",$serverhost[$k] if $DEBUG; |
| 248 |
my ( $error, $errmsg, $addinfo, $diagset ) = |
| 249 |
$oConnection[$k]->error_x(); |
| 250 |
if ($error) { |
| 251 |
if ($error =~ m/^(10000|10007)$/ ) { |
| 252 |
push(@errconn, {'server' => $serverhost[$k]}); |
| 253 |
} |
| 254 |
$DEBUG and warn "$k $serverhost[$k] error $query: $errmsg ($error) $addinfo\n"; |
| 255 |
} |
| 256 |
else { |
| 257 |
my $numresults = $oResult[$k]->size(); |
| 258 |
warn "numresults = $numresults" if $DEBUG; |
| 259 |
my $i; |
| 260 |
my $result = ''; |
| 261 |
if ( $numresults > 0 ) { |
| 262 |
for ( |
| 263 |
$i = 0 ; |
| 264 |
$i < ( ( $numresults < 20 ) ? ($numresults) : (20) ) ; |
| 265 |
$i++ |
| 266 |
) |
| 267 |
{ |
| 268 |
my $rec = $oResult[$k]->record($i); |
| 269 |
if ($rec) { |
| 270 |
my $marcrecord; |
| 271 |
$marcdata = $rec->raw(); |
| 272 |
|
| 273 |
my ($charset_result, $charset_errors); |
| 274 |
($marcrecord, $charset_result, $charset_errors) = |
| 275 |
MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]); |
| 276 |
SetUTF8Flag($marcrecord); |
| 277 |
####WARNING records coming from Z3950 clients are in various character sets MARC8,UTF8,UNIMARC etc |
| 278 |
## In HEAD i change everything to UTF-8 |
| 279 |
# In rel2_2 i am not sure what encoding is so no character conversion is done here |
| 280 |
##Add necessary encoding changes to here -TG |
| 281 |
my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, "" ); |
| 282 |
$oldbiblio->{isbn} =~ s/ |-|\.//g if $oldbiblio->{isbn}; |
| 283 |
# pad | and ( with spaces to allow line breaks in the HTML |
| 284 |
$oldbiblio->{isbn} =~ s/\|/ \| /g if $oldbiblio->{isbn}; |
| 285 |
$oldbiblio->{isbn} =~ s/\(/ \(/g if $oldbiblio->{isbn}; |
| 286 |
|
| 287 |
$oldbiblio->{issn} =~ s/ |-|\.//g if $oldbiblio->{issn}; |
| 288 |
# pad | and ( with spaces to allow line breaks in the HTML |
| 289 |
$oldbiblio->{issn} =~ s/\|/ \| /g if $oldbiblio->{issn}; |
| 290 |
$oldbiblio->{issn} =~ s/\(/ \(/g if $oldbiblio->{issn}; |
| 291 |
my ( |
| 292 |
$notmarcrecord, $alreadyindb, $alreadyinfarm, |
| 293 |
$imported, $breedingid |
| 294 |
) |
| 295 |
= ImportBreeding( $marcdata, 2, $serverhost[$k], $encoding[$k], $random, 'z3950' ); |
| 296 |
my %row_data; |
| 297 |
$row_data{server} = $servername[$k]; |
| 298 |
$row_data{isbn} = $oldbiblio->{isbn}; |
| 299 |
$row_data{lccn} = $oldbiblio->{lccn}; |
| 300 |
$row_data{title} = $oldbiblio->{title}; |
| 301 |
$row_data{author} = $oldbiblio->{author}; |
| 302 |
$row_data{breedingid} = $breedingid; |
| 303 |
$row_data{biblionumber} = $biblionumber; |
| 304 |
push( @breeding_loop, \%row_data ); |
| 305 |
|
| 306 |
} else { |
| 307 |
push(@breeding_loop,{'server'=>$servername[$k],'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'biblionumber'=>-1}); |
| 308 |
} # $rec |
| 309 |
} # upto 5 results |
| 310 |
} #$numresults |
| 311 |
} |
| 312 |
} # if $k !=0 |
| 313 |
# print $template->output if $firstresult !=1; |
| 314 |
$firstresult++; |
| 315 |
|
| 316 |
} # while nremaining |
| 317 |
|
| 318 |
$template->param( |
| 319 |
breeding_loop => \@breeding_loop, |
| 320 |
#server => $servername[$k], |
| 321 |
numberpending => $nremaining > 0 ? $nremaining : 0, |
| 322 |
errconn => \@errconn |
| 323 |
); |
| 324 |
output_html_with_http_headers $input, $cookie, $template->output; |