@@ -, +, @@ --- C4/Breeding.pm | 127 ++++++++++++++++++++++++++++++++++++++++++-------------- 1 files changed, 95 insertions(+), 32 deletions(-) --- a/C4/Breeding.pm +++ a/C4/Breeding.pm @@ -234,6 +234,7 @@ sub Z3950Search { my @encoding; my @serverhost; my @servername; + my @sru; my @breeding_loop = (); my $numberpending; @@ -244,80 +245,100 @@ sub Z3950Search { 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}); + $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}); - $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() ); + 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"); @@ -328,11 +349,12 @@ sub Z3950Search { 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() ); - + 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: @@ -340,22 +362,17 @@ sub Z3950Search { 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(); @@ -368,14 +385,14 @@ sub Z3950Search { my $marcrecord; $marcdata = $rec->raw(); - my ($charset_result, $charset_errors); - ($marcrecord, $charset_result, $charset_errors) = - MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]); + 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); -####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 @@ -386,11 +403,11 @@ sub Z3950Search { # 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], $pars->{random}, 'z3950' ); + + #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}; @@ -416,7 +433,7 @@ sub Z3950Search { server => $servername[$k], numberpending => $numberpending, biblionumber => $pars->{biblionumber}, - errconn => \@errconn + errconn => \@errconn, ); return if $numberpending==0; @@ -429,6 +446,52 @@ sub Z3950Search { } } +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__ - --