Z39 Batch ML

Signed-off-by: Bill Erickson <berick@esilibrary.com>

diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Z3950.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Z3950.pm
index 48baa89..a217f7b 100644 (file)
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Z3950.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Z3950.pm
@@ -566,7 +566,7 @@ sub bucket_search_queue {
         $e, $bre_ids, $z_sources, $z_indexes);
 
     return $e->event unless $z_searches;
-    return {bre_count => 0} unless keys %$z_searches;
+    return {bre_count => 0} unless @$z_searches;
 
     my $queue = create_z39_bucket_queue($e, $bucket_id, $vandelay);
     return $e->event unless $queue;
@@ -612,7 +612,7 @@ sub send_and_queue_bucket_searches {
     my $search_limit = 5; # TODO org setting
 
     my $response = {
-        bre_count => scalar(keys %$z_searches),
+        bre_count => 0,
         search_count => 0,
         search_complete => 0,
         queue_count => 0
@@ -623,13 +623,13 @@ sub send_and_queue_bucket_searches {
 
     my $handle_search_result = sub {
         my ($self, $req) = @_;
+        my $bre_id = $req->{req}->{_bre_id};
 
         # there will be one response per z-source
         for my $resp (@{$req->{response}}) {
             $response->{search_complete}++;
 
-            $logger->info("z3950 got bucket response for request " .
-                OpenSRF::Utils::JSON->perl2JSON($req->{params}));
+            $logger->info("z3950 got bucket response for $bre_id");
 
             my $result = $resp->content or next;
             my $service = $result->{service};
@@ -637,7 +637,7 @@ sub send_and_queue_bucket_searches {
             for my $rec (@{$result->{records}}) {
                 # TODO stamp zsource 901z; add to queue
                 $response->{queue_count}++;
-                $logger->info("z39: got result $rec");
+                $logger->info("z39: got result for $bre_id : $rec");
             }
         }
 
@@ -651,54 +651,20 @@ sub send_and_queue_bucket_searches {
         success_handler => $handle_search_result
     );
 
-    # compile and send the z3950-compatible search blobs
-    my @searches;
-    for my $bre_id (keys %$z_searches) {
-
-        # one search blob per distinct set of Z sources for this record
-        my @rec_searches;
-
-        for my $z_index (keys %{$z_searches->{$bre_id}}) {
-            my $search = $z_searches->{$bre_id}{$z_index};
-
-            $logger->info("z39 search piece [$bre_id]: " . $search->{z_index_name});
-
-            my ($blob) = grep { 
-                # array compare, weee
-                @{$_->{service}} ~~ @{$search->{z_source}} 
-            } @rec_searches;
-
-            if ($blob) {
-
-                $blob->{search}{$search->{z_index_name}} = 
-                    $search->{bib_value};
-
-            } else {
-
-                $blob = {
-                    service => $search->{z_source},
-                    search => {
-                        $search->{z_index_name} => $search->{bib_value}
-                    },
-                    limit => $search_limit,
-                    offset => 0
-                };
-                push(@rec_searches, $blob);
-            }
-        }
-
-        push(@searches, $_) for @rec_searches;
-    }
-
+    # note: mult-session blocks new requests when it hits max 
+    # parallel, so we need to cacluate summary values up front.
+    my %bre_uniq;
+    $bre_uniq{$_->{bre_id}} = 1 for @$z_searches;
+    $response->{bre_count} = scalar(keys %bre_uniq);
+    $response->{search_count} += scalar(@$z_searches);
 
+    # let the caller know searches are on their way out
+    $conn->respond($response);
 
-    # multi-session blocks new requests once it reaches max parallel,
-    # so we need to calculate the number of searches up front 
-    # for accurate reporting
-    $response->{search_count} += scalar(@{$_->{service}}) for @searches;
-    $conn->respond($response); # searches in flight
+    for my $search (@$z_searches) {
 
-    for my $search (@searches) {
+        my $bre_id = delete $search->{bre_id};
+        $search->{limit} = $search_limit;
 
         $logger->info("z39 firing bucket search " .
             OpenSRF::Utils::JSON->perl2JSON($search));
@@ -706,6 +672,8 @@ sub send_and_queue_bucket_searches {
         # toss it onto the multi-pile
         my $req = $multi_ses->request(
             'open-ils.search.z3950.search_class', $e->authtoken, $search);
+
+        $req->{_bre_id} = $bre_id;
     }
 
     $multi_ses->session_wait(1);
@@ -740,8 +708,8 @@ sub compile_bucket_zsearch {
     }
 
     # indexes with specific z3950_attr's take precedence
-    my @z_index_attrs = grep { {defined $_->z3950_attr} } @$z_indexes;
-    my @z_index_types = grep { {not defined $_->z3950_attr} } @$z_indexes;
+    my @z_index_attrs = grep { $_->z3950_attr } @$z_indexes;
+    my @z_index_types = grep { !$_->z3950_attr } @$z_indexes;
 
     # for each bib record, extract the indexed value for the selected indexes.  
     my %z_searches;
@@ -789,7 +757,12 @@ sub compile_bucket_zsearch {
                 my $src = $z3950_attrs{$z_index->z3950_attr}->source;
 
                 if (grep { $_ eq $src } @$z_sources) {
-                    push(@$z_source, $src);
+                    $z_searches{$bre_id}{$src} ||= {
+                        service => [$src],
+                        search => {}
+                    };
+                    $z_searches{$bre_id}{$src}{search}{$z_index_name} = $bre_val;
+
                 } else {
                     $logger->warn("z39: z3950_attr '$z_index_name' for '$src'".
                         " selected, but $src is not in the search list.  Skipping...");
@@ -810,22 +783,27 @@ sub compile_bucket_zsearch {
                 }
 
                 for my $src (@$z_sources) {
-                    push(@$z_source, $src) unless 
-                        grep {$_ eq $src} @excluded;
+                    next if grep {$_ eq $src} @excluded;
+                    $z_searches{$bre_id}{$src} ||= {
+                        service => [$src],
+                        search => {}
+                    };
+                    $z_searches{$bre_id}{$src}{search}{$z_index_name} = $bre_val;
                 }
             }
+        }
+    }
 
-            if (@$z_source) {
-                $z_searches{$bre_id}{$z_index->id} = {
-                    z_source     => $z_source,
-                    z_index_name => $z_index_name, 
-                    bib_value    => $bre_val
-                };
-            }
+    # let's turn this into something slightly more digestable
+    my @searches;
+    for my $bre_id (keys %z_searches) {
+        for my $blob (values %{$z_searches{$bre_id}}) {
+            $blob->{bre_id} = $bre_id;
+            push(@searches, $blob);
         }
     }
 
-    return \%z_searches;
+    return \@searches;
 }