Attachment #26171 for bug #6536

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




    my @encoding;
    my @serverhost;
    my @servername;
    my @sru;
    my @breeding_loop = ();
    my $numberpending;


    my @errconn;
    my $s = 0;
    my $query = '';
    my $squery= '';
    my $nterms;
    my $term;
    if ($pars->{isbn}) {
        $term=$pars->{isbn};
        $query .= " \@or \@attr 1=8 \"$term\" \@attr 1=7 \"$term\" ";
        $squery = "[isbn]=\"$term\" and ";
        $nterms++;
    }
    if ($pars->{title}) {
        $term=$pars->{title};
        utf8::decode($term);
        $query .= " \@attr 1=4 \"$term\" ";
        $squery .= "[title]=\"$term\" and ";
        $nterms++;
    }
    if ($pars->{author}) {
        $term=$pars->{author};
        utf8::decode($term);
        $query .= " \@attr 1=1003 \"$term\" ";
        $squery .= "[author]=\"$term\" and ";
        $nterms++;
    }
    if ($pars->{dewey}) {
        $term=$pars->{dewey};
        $query .= " \@attr 1=16 \"$term\" ";
        $squery .= "[dewey]=\"$term\" and ";
        $nterms++;
    }
    if ($pars->{subject}) {
        $term=$pars->{subject};
        utf8::decode($term);
        $query .= " \@attr 1=21 \"$term\" ";
        $squery .= "[subject]=\"$term\" and ";
        $nterms++;
    }
    if ($pars->{lccall}) {
        $term=$pars->{lccall};
        $query .= " \@attr 1=16 \@attr 2=3 \@attr 3=1 \@attr 4=1 \@attr 5=1 \@attr 6=1 \"$term\" ";
        $squery .= "[lccall]=\"$term\" and ";
        $nterms++;
    }
    if ($pars->{controlnumber}) {
        $term=$pars->{controlnumber};
        $query .= " \@attr 1=12 \"$term\" ";
        $squery .= "[controlnumber]=\"$term\" and ";
        $nterms++;
    }
    if ($pars->{stdid}) {
        $term=$pars->{stdid};
        $query .= " \@attr 1=1007 \"$term\" ";
        $squery .= "[stdid]=\"$term\" and ";
        $nterms++;
    }
    if ($pars->{srchany}) {
        $term=$pars->{srchany};
        $query .= " \@attr 1=1016 \"$term\" ";
        $squery .= "[any]=\"$term\" and ";
        $nterms++;
    }

    for my $i (1..$nterms-1) {
        $query = "\@and " . $query;
    }
    $squery=~s/\sand\s$//; #remove last AND in sru query

    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 ) {
            if($server->{host}=~/^sru=/) {
                $sru[$s]= {
                    srufields=>$server->{srufields},
                    syntax=>$server->{syntax},
                };
                change_sru_host($server);
            }
            my $option1      = new ZOOM::Options();
            $option1->option('async' => 1);
            $option1->option('elementSetName', 'F');
            $option1->option('databaseName', $server->{db}) if !$sru[$s];
            $option1->option('user',         $server->{userid}  ) if $server->{userid};
            $option1->option('password',     $server->{password}) if $server->{password};
            $option1->option('preferredRecordSyntax', $server->{syntax});
            $option1->option( 'timeout', $server->{timeout} ) if ($server->{timeout});
            pass_sru_options($server,$option1) if $sru[$s];
            $oConnection[$s] = create ZOOM::Connection($option1);
            #now connect
            if($sru[$s]) {
                $oConnection[$s]->connect( 'http://'.$server->{host});
            }
            else {
                $oConnection[$s]->connect( $server->{host}, $server->{port} );
            }
            $serverhost[$s] = $server->{host};
            $servername[$s] = $server->{name};
            $encoding[$s]   = ($server->{encoding}?$server->{encoding}:"iso-5426");

    my $firstresult = 1;

    for ( my $z = 0 ; $z < $s ; $z++ ) {
        if($sru[$z]) {
            $oResult[$z] = $oConnection[$z]->search(new ZOOM::Query::CQL(tran_query($squery, $sru[$z]->{srufields})));
        }
        else {
            $oResult[$z] = $oConnection[$z]->search_pqf($query);
        }
    }

  AGAIN:

    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;
        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) {
            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 $marcrecord;
                        $marcdata   = $rec->raw();

                        if($sru[$k]) { #SRU
                            $marcrecord= MARC::Record->new_from_xml($marcdata,'UTF-8',$sru[$k]->{syntax});
                        }
                        else { #z3950
                            ($marcrecord)= MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]);
                        }
                        SetUTF8Flag($marcrecord);

## 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

                        # 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};

                        #call to ImportBreeding replaced by next two calls for optimization
                        my $batch_id = GetZ3950BatchId($servername[$k]);
                        my $breedingid = AddBiblioToBatch($batch_id, 0, $marcrecord, 'UTF-8', $pars->{random});

                        my %row_data;
                        $row_data{server}       = $servername[$k];
                        $row_data{isbn}         = $oldbiblio->{isbn};

        server        => $servername[$k],
        numberpending => $numberpending,
        biblionumber  => $pars->{biblionumber},
        errconn       => \@errconn,
    );

    return if $numberpending==0;

    }
}

sub change_sru_host { #merge port and database into hostname
  my $server= shift;
  if($server->{port} ne '80') {
    if($server->{host}=~/^([^\/]+)\/(.*)$/ ) {
      $server->{host}= $1.':'.$server->{port}.'/'.$2;
    }
    else {
      $server->{host}.= ':'.$server->{port};
    }
  }
  #prevent double slash between host and db when concatenating
  $server->{host}=~ s/\/$//g;
  $server->{db}=~ s/^\///g;
  $server->{host}.= '/'.$server->{db};
}

sub pass_sru_options {
  my ($server, $option1)=@_;
  my @parts= split /,/,$server->{host};
  foreach(my $i=0; $i<@parts; $i++) {
    if($i==@parts-1) {
      $server->{host}=$parts[$i];
    }
    else {
      if($parts[$i]=~/^([^=]+)=(.*)/) {
        $option1->option( $1 => $2);
      }
    }
  }
}

sub tran_query { #translate to specific sru fields per server
  my ($q, $srufields)= @_;
  #srufields is in format title=field,isbn=field,...
  #if a field doesn't exist, try anywhere or remove [field]=
  my @parts= split(',', $srufields);
  my %trans= map { if(/=/){($`,$')}else{()} } @parts;

  my $any= $trans{any}?$trans{any}.'=':'';
  foreach my $key (keys %trans) {
    my $f=$trans{$key};
    if($f) {$q=~s/\[$key\]/$f/g; } else {$q=~s/\[$key\]=/$any/g; }
  }
  $q=~s/\[\w+\]=/$any/g; # remove remaining fields (not found in field list)
  return $q;
}

1;
__END__

- 

Return to bug 6536

Lines 234-239 sub Z3950Search { Link Here

(-)a/C4/Breeding.pm (-33 / +95 lines)
234	my @encoding;	234	my @encoding;
235	my @serverhost;	235	my @serverhost;
236	my @servername;	236	my @servername;
		237	my @sru;
237	my @breeding_loop = ();	238	my @breeding_loop = ();
238	my $numberpending;	239	my $numberpending;
239		240
Lines 244-323 sub Z3950Search { Link Here
244	my @errconn;	245	my @errconn;
245	my $s = 0;	246	my $s = 0;
246	my $query = '';	247	my $query = '';
		248	my $squery= '';
247	my $nterms;	249	my $nterms;
248	my $term;	250	my $term;
249	if ($pars->{isbn}) {	251	if ($pars->{isbn}) {
250	$term=$pars->{isbn};	252	$term=$pars->{isbn};
251	$query .= " \@or \@attr 1=8 \"$term\" \@attr 1=7 \"$term\" ";	253	$query .= " \@or \@attr 1=8 \"$term\" \@attr 1=7 \"$term\" ";
		254	$squery = "[isbn]=\"$term\" and ";
252	$nterms++;	255	$nterms++;
253	}	256	}
254	if ($pars->{title}) {	257	if ($pars->{title}) {
255	$term=$pars->{title};	258	$term=$pars->{title};
256	utf8::decode($term);	259	utf8::decode($term);
257	$query .= " \@attr 1=4 \"$term\" ";	260	$query .= " \@attr 1=4 \"$term\" ";
		261	$squery .= "[title]=\"$term\" and ";
258	$nterms++;	262	$nterms++;
259	}	263	}
260	if ($pars->{author}) {	264	if ($pars->{author}) {
261	$term=$pars->{author};	265	$term=$pars->{author};
262	utf8::decode($term);	266	utf8::decode($term);
263	$query .= " \@attr 1=1003 \"$term\" ";	267	$query .= " \@attr 1=1003 \"$term\" ";
		268	$squery .= "[author]=\"$term\" and ";
264	$nterms++;	269	$nterms++;
265	}	270	}
266	if ($pars->{dewey}) {	271	if ($pars->{dewey}) {
267	$term=$pars->{dewey};	272	$term=$pars->{dewey};
268	$query .= " \@attr 1=16 \"$term\" ";	273	$query .= " \@attr 1=16 \"$term\" ";
		274	$squery .= "[dewey]=\"$term\" and ";
269	$nterms++;	275	$nterms++;
270	}	276	}
271	if ($pars->{subject}) {	277	if ($pars->{subject}) {
272	$term=$pars->{subject};	278	$term=$pars->{subject};
273	utf8::decode($term);	279	utf8::decode($term);
274	$query .= " \@attr 1=21 \"$term\" ";	280	$query .= " \@attr 1=21 \"$term\" ";
		281	$squery .= "[subject]=\"$term\" and ";
275	$nterms++;	282	$nterms++;
276	}	283	}
277	if ($pars->{lccall}) {	284	if ($pars->{lccall}) {
278	$term=$pars->{lccall};	285	$term=$pars->{lccall};
279	$query .= " \@attr 1=16 \@attr 2=3 \@attr 3=1 \@attr 4=1 \@attr 5=1 \@attr 6=1 \"$term\" ";	286	$query .= " \@attr 1=16 \@attr 2=3 \@attr 3=1 \@attr 4=1 \@attr 5=1 \@attr 6=1 \"$term\" ";
		287	$squery .= "[lccall]=\"$term\" and ";
280	$nterms++;	288	$nterms++;
281	}	289	}
282	if ($pars->{controlnumber}) {	290	if ($pars->{controlnumber}) {
283	$term=$pars->{controlnumber};	291	$term=$pars->{controlnumber};
284	$query .= " \@attr 1=12 \"$term\" ";	292	$query .= " \@attr 1=12 \"$term\" ";
		293	$squery .= "[controlnumber]=\"$term\" and ";
285	$nterms++;	294	$nterms++;
286	}	295	}
287	if ($pars->{stdid}) {	296	if ($pars->{stdid}) {
288	$term=$pars->{stdid};	297	$term=$pars->{stdid};
289	$query .= " \@attr 1=1007 \"$term\" ";	298	$query .= " \@attr 1=1007 \"$term\" ";
		299	$squery .= "[stdid]=\"$term\" and ";
290	$nterms++;	300	$nterms++;
291	}	301	}
292	if ($pars->{srchany}) {	302	if ($pars->{srchany}) {
293	$term=$pars->{srchany};	303	$term=$pars->{srchany};
294	$query .= " \@attr 1=1016 \"$term\" ";	304	$query .= " \@attr 1=1016 \"$term\" ";
		305	$squery .= "[any]=\"$term\" and ";
295	$nterms++;	306	$nterms++;
296	}	307	}
297		308
298	for my $i (1..$nterms-1) {	309	for my $i (1..$nterms-1) {
299	$query = "\@and " . $query;	310	$query = "\@and " . $query;
300	}	311	}
		312	$squery=~s/\sand\s$//; #remove last AND in sru query
301		313
302	foreach my $servid (@id) {	314	foreach my $servid (@id) {
303	my $sth = $dbh->prepare("SELECT * FROM z3950servers WHERE id=? ORDER BY rank, name");	315	my $sth = $dbh->prepare("SELECT * FROM z3950servers WHERE id=? ORDER BY rank, name");
304	$sth->execute($servid);	316	$sth->execute($servid);
305	while ( $server = $sth->fetchrow_hashref ) {	317	while ( $server = $sth->fetchrow_hashref ) {
		318	if($server->{host}=~/^sru=/) {
		319	$sru[$s]= {
		320	srufields=>$server->{srufields},
		321	syntax=>$server->{syntax},
		322	};
		323	change_sru_host($server);
		324	}
306	my $option1 = new ZOOM::Options();	325	my $option1 = new ZOOM::Options();
307	$option1->option('async' => 1);	326	$option1->option('async' => 1);
308	$option1->option('elementSetName', 'F');	327	$option1->option('elementSetName', 'F');
309	$option1->option('databaseName', $server->{db});	328	$option1->option('databaseName', $server->{db}) if !$sru[$s];
310	$option1->option('user', $server->{userid} ) if $server->{userid};	329	$option1->option('user', $server->{userid} ) if $server->{userid};
311	$option1->option('password', $server->{password}) if $server->{password};	330	$option1->option('password', $server->{password}) if $server->{password};
312	$option1->option('preferredRecordSyntax', $server->{syntax});	331	$option1->option('preferredRecordSyntax', $server->{syntax});
313	$option1->option( 'timeout', $server->{timeout} ) if ($server->{timeout});	332	$option1->option( 'timeout', $server->{timeout} ) if ($server->{timeout});
314	$oConnection[$s] = create ZOOM::Connection($option1)	333	pass_sru_options($server,$option1) if $sru[$s];
315	\|\| $DEBUG	334	$oConnection[$s] = create ZOOM::Connection($option1);
316	&& warn( "" . $oConnection[$s]->errmsg() );	335	#now connect
317	warn( "server data", $server->{name}, $server->{port} ) if $DEBUG;	336	if($sru[$s]) {
318	$oConnection[$s]->connect( $server->{host}, $server->{port} )	337	$oConnection[$s]->connect( 'http://'.$server->{host});
319	\|\| $DEBUG	338	}
320	&& warn( "" . $oConnection[$s]->errmsg() );	339	else {
		340	$oConnection[$s]->connect( $server->{host}, $server->{port} );
		341	}
321	$serverhost[$s] = $server->{host};	342	$serverhost[$s] = $server->{host};
322	$servername[$s] = $server->{name};	343	$servername[$s] = $server->{name};
323	$encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426");	344	$encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426");
Lines 328-338 sub Z3950Search { Link Here
328	my $firstresult = 1;	349	my $firstresult = 1;
329		350
330	for ( my $z = 0 ; $z < $s ; $z++ ) {	351	for ( my $z = 0 ; $z < $s ; $z++ ) {
331	warn "doing the search" if $DEBUG;	352	if($sru[$z]) {
332	$oResult[$z] = $oConnection[$z]->search_pqf($query)	353	$oResult[$z] = $oConnection[$z]->search(new ZOOM::Query::CQL(tran_query($squery, $sru[$z]->{srufields})));
333	\|\| $DEBUG	354	}
334	&& warn( "somthing went wrong: " . $oConnection[$s]->errmsg() );	355	else {
335		356	$oResult[$z] = $oConnection[$z]->search_pqf($query);
		357	}
336	}	358	}
337		359
338	AGAIN:	360	AGAIN:
Lines 340-361 sub Z3950Search { Link Here
340	my $event;	362	my $event;
341	while ( ( $k = ZOOM::event( \@oConnection ) ) != 0 ) {	363	while ( ( $k = ZOOM::event( \@oConnection ) ) != 0 ) {
342	$event = $oConnection[ $k - 1 ]->last_event();	364	$event = $oConnection[ $k - 1 ]->last_event();
343	warn( "connection ", $k - 1, ": event $event (",
344	ZOOM::event_str($event), ")\n" )
345	if $DEBUG;
346	last if $event == ZOOM::Event::ZEND;	365	last if $event == ZOOM::Event::ZEND;
347	}	366	}
348		367
349	if ( $k != 0 ) {	368	if ( $k != 0 ) {
350	$k--;	369	$k--;
351	warn $serverhost[$k] if $DEBUG;
352	my ( $error, $errmsg, $addinfo, $diagset ) =	370	my ( $error, $errmsg, $addinfo, $diagset ) =
353	$oConnection[$k]->error_x();	371	$oConnection[$k]->error_x();
354	if ($error) {	372	if ($error) {
355	if ($error =~ m/^(10000\|10007)$/ ) {	373	if ($error =~ m/^(10000\|10007)$/ ) {
356	push(@errconn, {'server' => $serverhost[$k], 'error' => $error});	374	push(@errconn, {'server' => $serverhost[$k], 'error' => $error});
357	}	375	}
358	$DEBUG and warn "$k $serverhost[$k] error $query: $errmsg ($error) $addinfo\n";
359	}	376	}
360	else {	377	else {
361	my $numresults = $oResult[$k]->size();	378	my $numresults = $oResult[$k]->size();
Lines 368-381 sub Z3950Search { Link Here
368	my $marcrecord;	385	my $marcrecord;
369	$marcdata = $rec->raw();	386	$marcdata = $rec->raw();
370		387
371	my ($charset_result, $charset_errors);	388	if($sru[$k]) { #SRU
372	($marcrecord, $charset_result, $charset_errors) =	389	$marcrecord= MARC::Record->new_from_xml($marcdata,'UTF-8',$sru[$k]->{syntax});
373	MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]);	390	}
		391	else { #z3950
		392	($marcrecord)= MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]);
		393	}
374	SetUTF8Flag($marcrecord);	394	SetUTF8Flag($marcrecord);
375	####WARNING records coming from Z3950 clients are in various character sets MARC8,UTF8,UNIMARC etc	395
376	## In HEAD i change everything to UTF-8
377	# In rel2_2 i am not sure what encoding is so no character conversion is done here
378	##Add necessary encoding changes to here -TG
379	my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, "" );	396	my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, "" );
380	$oldbiblio->{isbn} =~ s/ \|-\|\.//g if $oldbiblio->{isbn};	397	$oldbiblio->{isbn} =~ s/ \|-\|\.//g if $oldbiblio->{isbn};
381	# pad \| and ( with spaces to allow line breaks in the HTML	398	# pad \| and ( with spaces to allow line breaks in the HTML
Lines 386-396 sub Z3950Search { Link Here
386	# pad \| and ( with spaces to allow line breaks in the HTML	403	# pad \| and ( with spaces to allow line breaks in the HTML
387	$oldbiblio->{issn} =~ s/\\|/ \\| /g if $oldbiblio->{issn};	404	$oldbiblio->{issn} =~ s/\\|/ \\| /g if $oldbiblio->{issn};
388	$oldbiblio->{issn} =~ s/\(/ \(/g if $oldbiblio->{issn};	405	$oldbiblio->{issn} =~ s/\(/ \(/g if $oldbiblio->{issn};
389	my (	406
390	$notmarcrecord, $alreadyindb, $alreadyinfarm,	407	#call to ImportBreeding replaced by next two calls for optimization
391	$imported, $breedingid	408	my $batch_id = GetZ3950BatchId($servername[$k]);
392	)	409	my $breedingid = AddBiblioToBatch($batch_id, 0, $marcrecord, 'UTF-8', $pars->{random});
393	= ImportBreeding( $marcdata, 2, $serverhost[$k], $encoding[$k], $pars->{random}, 'z3950' );	410
394	my %row_data;	411	my %row_data;
395	$row_data{server} = $servername[$k];	412	$row_data{server} = $servername[$k];
396	$row_data{isbn} = $oldbiblio->{isbn};	413	$row_data{isbn} = $oldbiblio->{isbn};
Lines 416-422 sub Z3950Search { Link Here
416	server => $servername[$k],	433	server => $servername[$k],
417	numberpending => $numberpending,	434	numberpending => $numberpending,
418	biblionumber => $pars->{biblionumber},	435	biblionumber => $pars->{biblionumber},
419	errconn => \@errconn	436	errconn => \@errconn,
420	);	437	);
421		438
422	return if $numberpending==0;	439	return if $numberpending==0;
Lines 429-434 sub Z3950Search { Link Here
429	}	446	}
430	}	447	}
431		448
		449	sub change_sru_host { #merge port and database into hostname
		450	my $server= shift;
		451	if($server->{port} ne '80') {
		452	if($server->{host}=~/^([^\/]+)\/(.*)$/ ) {
		453	$server->{host}= $1.':'.$server->{port}.'/'.$2;
		454	}
		455	else {
		456	$server->{host}.= ':'.$server->{port};
		457	}
		458	}
		459	#prevent double slash between host and db when concatenating
		460	$server->{host}=~ s/\/$//g;
		461	$server->{db}=~ s/^\///g;
		462	$server->{host}.= '/'.$server->{db};
		463	}
		464
		465	sub pass_sru_options {
		466	my ($server, $option1)=@_;
		467	my @parts= split /,/,$server->{host};
		468	foreach(my $i=0; $i<@parts; $i++) {
		469	if($i==@parts-1) {
		470	$server->{host}=$parts[$i];
		471	}
		472	else {
		473	if($parts[$i]=~/^([^=]+)=(.*)/) {
		474	$option1->option( $1 => $2);
		475	}
		476	}
		477	}
		478	}
		479
		480	sub tran_query { #translate to specific sru fields per server
		481	my ($q, $srufields)= @_;
		482	#srufields is in format title=field,isbn=field,...
		483	#if a field doesn't exist, try anywhere or remove [field]=
		484	my @parts= split(',', $srufields);
		485	my %trans= map { if(/=/){($`,$')}else{()} } @parts;
		486
		487	my $any= $trans{any}?$trans{any}.'=':'';
		488	foreach my $key (keys %trans) {
		489	my $f=$trans{$key};
		490	if($f) {$q=~s/\[$key\]/$f/g; } else {$q=~s/\[$key\]=/$any/g; }
		491	}
		492	$q=~s/\[\w+\]=/$any/g; # remove remaining fields (not found in field list)
		493	return $q;
		494	}
		495
432	1;	496	1;
433	__END__	497	__END__
434
435	-