Attachment 26171 Details for Bug 6536 – [TESTPATCH 3.8] 6536 3 sru

[patch] [TESTPATCH 3.8] 6536 3 sru

6536-3-sru.patch (text/plain), 10.12 KB, created by Marcel de Rooy on 2014-03-12 12:40:28 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Marcel de Rooy

Created: 2014-03-12 12:40:28 UTC

Size: 10.12 KB

patch

obsolete

>From fb12497c6ee7ed0de83d321dfc11be32cc276953 Mon Sep 17 00:00:00 2001
>From: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
>Date: Thu, 25 Oct 2012 09:11:56 +0200
>Subject: [PATCH] 6536 3 sru
>Content-Type: text/plain; charset=utf-8
>
>---
> C4/Breeding.pm |  127 ++++++++++++++++++++++++++++++++++++++++++--------------
> 1 files changed, 95 insertions(+), 32 deletions(-)
>
>diff --git a/C4/Breeding.pm b/C4/Breeding.pm
>index 85e8bbd..b49c65f 100644
>--- a/C4/Breeding.pm
>+++ b/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__
>-
>-- 
>1.7.7.6

Actions: View | Diff | Splinter Review

Attachments on bug 6536: 4540 | 4541 | 4959 | 6901 | 6919 | 6920 | 6924 | 13462 | 26169 | 26170 | 26171 | 26172 | 29754 | 29755 | 29756 | 29779 | 29780 | 29788 | 29790 | 29791 | 29812 | 29813 | 29814 | 29815 | 29816 | 29817 | 29818 | 29819 | 30189 | 30190 | 30191 | 30192 | 30193 | 30194 | 30900 | 30901 | 30902 | 30903 | 30904 | 30905 | 30906 | 30907 | 30929 | 30930 | 30931 | 30932 | 30933 | 30934 | 30935 | 30936 | 31046 | 31048 | 31137 | 31193 | 31194 | 31195 | 31227 | 31247 | 31248 | 37264