cff8c6ffe3760bf99093394603f81728a3dd3fe8
[Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / Application / Search / Z3950.pm
1 package OpenILS::Application::Search::Z3950;
2 use strict; use warnings;
3 use base qw/OpenILS::Application/;
4
5 use OpenILS::Utils::ZClient;
6 use MARC::Record;
7 use MARC::File::XML (BinaryEncoding => 'UTF-8');
8 use MARC::Charset;
9 use Unicode::Normalize;
10 use XML::LibXML;
11
12 use OpenILS::Event;
13 use OpenSRF::EX qw(:try);
14 use OpenSRF::MultiSession;
15 use OpenILS::Utils::ModsParser;
16 use OpenSRF::Utils::SettingsClient;
17 use OpenSRF::Utils::JSON;
18 use OpenILS::Application::AppUtils;
19 use OpenSRF::Utils::Logger qw/$logger/;
20 use OpenILS::Utils::CStoreEditor q/:funcs/;
21 use OpenILS::Utils::Normalize qw/clean_marc/;                                  
22
23 MARC::Charset->assume_unicode(1);
24 MARC::Charset->ignore_errors(1);
25
26 my $output = "usmarc"; 
27 my $U = 'OpenILS::Application::AppUtils'; 
28
29 my $sclient;
30 my %services;
31 my $default_service;
32
33 __PACKAGE__->register_method(
34     method    => 'apply_credentials',
35     api_name  => 'open-ils.search.z3950.apply_credentials',
36     signature => {
37         desc   => "Apply credentials for a Z39.50 server",
38         params => [
39             {desc => 'Authtoken', type => 'string'},
40             {desc => 'Z39.50 Source (server) name', type => 'string'},
41             {desc => 'Context org unit', type => 'number'},
42             {desc => 'Username', type => 'string'},
43             {desc => 'Password', type => 'string'}
44         ],
45         return => {
46             desc => 'Event; SUCCESS on success, other event type on error'
47         }
48     }
49 );
50
51 sub apply_credentials {
52     my ($self, $client, $auth, $source, $ctx_ou, $username, $password) = @_;
53
54     my $e = new_editor(authtoken => $auth, xact => 1);
55
56     return $e->die_event unless 
57         $e->checkauth and 
58         $e->allowed('ADMIN_Z3950_SOURCE', $ctx_ou);
59
60     $e->json_query({from => [
61         'config.z3950_source_credentials_apply',
62         $source, $ctx_ou, $username, $password
63     ]}) or return $e->die_event;
64
65     $e->commit;
66
67     return OpenILS::Event->new('SUCCESS');
68 }
69  
70
71
72 __PACKAGE__->register_method(
73     method    => 'do_class_search',
74     api_name  => 'open-ils.search.z3950.search_class',
75     stream    => 1,
76     signature => q/
77         Performs a class based Z search.  The classes available
78         are defined by the 'attr' fields in the config for the
79         requested service.
80         @param auth The login session key
81         @param shash The search hash : { attr : value, attr2: value, ...}
82         @param service The service to connect to
83         @param username The username to use when connecting to the service
84         @param password The password to use when connecting to the service
85     /
86 );
87
88 __PACKAGE__->register_method(
89     method    => 'do_service_search',
90     api_name  => 'open-ils.search.z3950.search_service',
91     signature => q/
92         @param auth The login session key
93         @param query The Z3950 search string to use
94         @param service The service to connect to
95         @param username The username to use when connecting to the service
96         @param password The password to use when connecting to the service
97     /
98 );
99
100
101 __PACKAGE__->register_method(
102     method    => 'do_service_search',
103     api_name  => 'open-ils.search.z3950.search_raw',
104     signature => q/
105         @param auth The login session key
106         @param args An object of search params which must include:
107             host, port, db and query.  
108             optional fields include username and password
109     /
110 );
111
112
113 __PACKAGE__->register_method(
114     method    => "query_services",
115     api_name  => "open-ils.search.z3950.retrieve_services",
116     signature => q/
117         @param auth The login session key
118         Returns a list of service names that we have config
119         data for
120     /
121 );
122
123
124
125 # -------------------------------------------------------------------
126 # What services do we have config info for?
127 # -------------------------------------------------------------------
128 sub query_services {
129     my( $self, $client, $auth ) = @_;
130     my $e = new_editor(authtoken=>$auth);
131     return $e->event unless $e->checkauth;
132     return $e->event unless $e->allowed('REMOTE_Z3950_QUERY');
133
134     return fetch_service_defs($e);
135 }
136
137 # -------------------------------------------------------------------
138 # What services do we have config info for?
139 # -------------------------------------------------------------------
140 sub fetch_service_defs {
141
142     my $editor_with_authtoken = shift;
143
144     my $hash = $sclient->config_value('z3950', 'services');
145
146     # overlay config file values with in-db values
147     my $e = $editor_with_authtoken || new_editor();
148     if($e->can('search_config_z3950_source')) {
149
150         my $sources = $e->search_config_z3950_source(
151             [ { name => { '!=' => undef } },
152               { flesh => 1, flesh_fields => { czs => ['attrs'] } } ]
153         );
154
155         for my $s ( @$sources ) {
156             $$hash{ $s->name } = {
157                 name => $s->name,
158                 label => $s->label,
159                 host => $s->host,
160                 port => $s->port,
161                 db => $s->db,
162                 record_format => $s->record_format,
163                 transmission_format => $s->transmission_format,
164                 auth => $s->auth,
165                 use_perm => ($s->use_perm) ? 
166                     $e->retrieve_permission_perm_list($s->use_perm)->code : ''
167             };
168
169             for my $a ( @{ $s->attrs } ) {
170                 $$hash{ $a->source }{attrs}{ $a->name } = {
171                     name => $a->name,
172                     label => $a->label,
173                     code => $a->code,
174                     format => $a->format,
175                     source => $a->source,
176                     truncation => $a->truncation,
177                 };
178             }
179         }
180     }
181
182     # Define the set of native catalog services
183     # XXX There are i18n problems here, but let's get the staff client working first
184     # XXX Move into the DB?
185     $hash->{'native-evergreen-catalog'} = {
186         attrs => {
187             title => {code => 'title', label => 'Title'},
188             author => {code => 'author', label => 'Author'},
189             subject => {code => 'subject', label => 'Subject'},
190             keyword => {code => 'keyword', label => 'Keyword'},
191             tcn => {code => 'tcn', label => 'TCN'},
192             isbn => {code => 'isbn', label => 'ISBN'},
193             issn => {code => 'issn', label => 'ISSN'},
194             publisher => {code => 'publisher', label => 'Publisher'},
195             pubdate => {code => 'pubdate', label => 'Pub Date'},
196             item_type => {code => 'item_type', label => 'Item Type'},
197             upc => {code => 'upc', label => 'UPC'},
198         }
199     };
200
201     # then filter out any services which the requestor lacks the perm for
202     if ($editor_with_authtoken) {
203         foreach my $s (keys %{ $hash }) {
204             if ($$hash{$s}{use_perm}) {
205                 if ($U->check_perms(
206                     $e->requestor->id,
207                     $e->requestor->ws_ou,
208                     $$hash{$s}{use_perm}
209                 )) {
210                     delete $$hash{$s};
211                 }
212             };
213         }
214     }
215
216     %services = %$hash; # cache these internally so we can actually use the db-configured sources
217     return $hash;
218 }
219
220
221
222 # -------------------------------------------------------------------
223 # Load the pre-defined Z server configs
224 # -------------------------------------------------------------------
225 sub child_init {
226     $sclient = OpenSRF::Utils::SettingsClient->new();
227     $default_service = $sclient->config_value("z3950", "default" );
228 }
229
230
231 # -------------------------------------------------------------------
232 # High-level class based search. 
233 # -------------------------------------------------------------------
234 sub do_class_search {
235
236     fetch_service_defs() unless (scalar(keys(%services)));
237
238     my $self = shift;
239     my $conn = shift;
240     my $auth = shift;
241     my $args = shift;
242
243     if (!ref($$args{service})) {
244         $$args{service} = [$$args{service}];
245         $$args{username} = [$$args{username}];
246         $$args{password} = [$$args{password}];
247     }
248
249     $$args{async} = 1;
250
251     my @connections;
252     my @results;
253     my @services; 
254     for (my $i = 0; $i < @{$$args{service}}; $i++) {
255         my %tmp_args = %$args;
256         $tmp_args{service} = $$args{service}[$i];
257         $tmp_args{username} = $$args{username}[$i];
258         $tmp_args{password} = $$args{password}[$i];
259
260         $logger->debug("z3950: service: $tmp_args{service}, async: $tmp_args{async}");
261
262         if ($tmp_args{service} eq 'native-evergreen-catalog') { 
263             my $method = $self->method_lookup('open-ils.search.biblio.zstyle.staff'); 
264             $conn->respond( 
265                 $self->method_lookup('open-ils.search.biblio.zstyle.staff')->run($auth, \%tmp_args) 
266             ); 
267
268         } else { 
269
270             $tmp_args{query} = compile_query('and', $tmp_args{service}, $tmp_args{search}); 
271     
272             my $res = do_service_search( $self, $conn, $auth, \%tmp_args ); 
273     
274             if ($U->event_code($res)) { 
275                 $conn->respond($res) if $U->event_code($res); 
276
277             } else { 
278                 push @services, $tmp_args{service}; 
279                 push @results, $res->{result}; 
280                 push @connections, $res->{connection}; 
281
282                 $logger->debug("z3950: Result object: $results[$i], Connection object: $connections[$i]");
283             } 
284         }
285
286     }
287
288     $logger->debug("z3950: Connections created");
289
290     return undef unless (@connections);
291     my @records;
292
293     # local catalog search is not processed with other z39 results;
294     $$args{service} = [grep {$_ ne 'native-evergreen-catalog'} @{$$args{service}}];
295
296     @connections = grep {defined $_} @connections;
297     return undef unless @connections;
298
299     while ((my $index = OpenILS::Utils::ZClient::event( \@connections )) != 0) {
300         my $ev = $connections[$index - 1]->last_event();
301         $logger->debug("z3950: Received event $ev");
302         if ($ev == OpenILS::Utils::ZClient::EVENT_END()) {
303             my $munged = process_results( $results[$index - 1], $$args{limit}, $$args{offset}, $$args{service}[$index -1] );
304             $$munged{service} = $$args{service}[$index - 1];
305             $conn->respond($munged);
306         }
307     }
308
309     $logger->debug("z3950: Search Complete");
310     return undef;
311 }
312
313
314 # -------------------------------------------------------------------
315 # This handles the host settings, but expects a fully formed z query
316 # -------------------------------------------------------------------
317 sub do_service_search {
318
319     fetch_service_defs() unless (scalar(keys(%services)));
320
321     my $self = shift;
322     my $conn = shift;
323     my $auth = shift;
324     my $args = shift;
325     
326     my $info = $services{$$args{service}};
327
328     $$args{host} = $$info{host};
329     $$args{port} = $$info{port};
330     $$args{db} = $$info{db};
331     $logger->debug("z3950: do_search...");
332
333     return do_search( $self, $conn, $auth, $args );
334 }
335
336
337
338 # -------------------------------------------------------------------
339 # This is the low level search method.  All config and query
340 # data must be provided to this method
341 # -------------------------------------------------------------------
342 sub do_search {
343
344     fetch_service_defs() unless (scalar(keys(%services)));
345
346     my $self = shift;
347     my $conn = shift;
348     my $auth = shift;
349     my $args = shift;
350
351     my $host = $$args{host} or return undef;
352     my $port = $$args{port} or return undef;
353     my $db = $$args{db} or return undef;
354     my $query = $$args{query} or return undef;
355     my $async = $$args{async} || 0;
356
357     my $limit = $$args{limit} || 10;
358     my $offset = $$args{offset} || 0;
359
360     my $editor = new_editor(authtoken => $auth);
361     return $editor->event unless 
362         $editor->checkauth and
363         $editor->allowed('REMOTE_Z3950_QUERY', $editor->requestor->ws_ou);
364
365     my $creds = $editor->json_query({from => [
366         'config.z3950_source_credentials_lookup',
367         $$args{service}, $editor->requestor->ws_ou
368     ]})->[0] || {};
369
370     # use the caller-provided username/password if offered.
371     # otherwise, use the stored credentials.
372     my $username = $$args{username} || $creds->{username} || "";
373     my $password = $$args{password} || $creds->{password} || "";
374
375     my $tformat = $services{$args->{service}}->{transmission_format} || $output;
376
377     $logger->info("z3950: connecting to server $host:$port:$db as $username");
378
379     my $connection = OpenILS::Utils::ZClient->new(
380         $host, $port,
381         databaseName => $db, 
382         user => $username,
383         password => $password,
384         async => $async,
385         preferredRecordSyntax => $tformat, 
386     );
387
388     if( ! $connection ) {
389         $logger->error("z3950: Unable to connect to Z server: ".
390             "$host:$port:$db:$username:$password");
391         return OpenILS::Event->new('Z3950_LOGIN_FAILED') unless $connection;
392     }
393
394     my $start = time;
395     my $results;
396     my $err;
397
398     $logger->info("z3950: query => $query");
399
400     try {
401         $results = $connection->search_pqf( $query );
402     } catch Error with { $err = shift; };
403
404     return OpenILS::Event->new(
405         'Z3950_BAD_QUERY', payload => $query, debug => "$err") if $err;
406
407     return OpenILS::Event->new('Z3950_SEARCH_FAILED', 
408         debug => $connection->errcode." => ".$connection->errmsg." : query = $query") unless $results;
409
410     $logger->info("z3950: search [$query] took ".(time - $start)." seconds");
411
412     return {result => $results, connection => $connection} if ($async);
413
414     my $munged = process_results($results, $limit, $offset, $$args{service});
415     $munged->{query} = $query;
416
417     return $munged;
418 }
419
420
421 # -------------------------------------------------------------------
422 # Takes a result batch and returns the hitcount and a list of xml
423 # and mvr objects
424 # -------------------------------------------------------------------
425 sub process_results {
426
427     fetch_service_defs() unless (scalar(keys(%services)));
428
429     my $results = shift;
430     my $limit = shift || 10;
431     my $offset = shift || 0;
432     my $service = shift;
433
434     my $rformat = $services{$service}->{record_format};
435     my $tformat = $services{$service}->{transmission_format} || $output;
436
437     $results->option(elementSetName => $rformat);
438     $results->option(preferredRecordSyntax => $tformat);
439     $logger->info("z3950: using record format '$rformat' and transmission format '$tformat'");
440
441     my @records;
442     my $res = {};
443     my $count = $$res{count} = $results->size;
444
445     $logger->info("z3950: '$service' search returned $count hits");
446
447     my $tend = $limit + $offset;
448
449     my $end = ($tend <= $count) ? $tend : $count;
450
451     for($offset..$end - 1) {
452
453         my $err;
454         my $mods;
455         my $marc;
456         my $marcs;
457         my $marcxml;
458
459         $logger->info("z3950: fetching record $_");
460
461         try {
462
463             my $rec = $results->record($_);
464
465             if ($tformat eq 'usmarc') {
466                 my $raw = $rec->raw();
467                 if (length($raw) <= 99999) {
468                     $marc = MARC::Record->new_from_usmarc($raw);
469                 } else {
470                     $marcs = '';
471                     die "ISO2709 record is too large to process";
472                 }
473             } elsif ($tformat eq 'xml') {
474                 $marc = MARC::Record->new_from_xml($rec->raw());
475             } else {
476                 die "Unsupported record transmission format $tformat"
477             }
478
479             $marcs = $U->entityize($marc->as_xml_record);
480             $marcs = $U->strip_ctrl_chars($marcs);
481             my $doc = XML::LibXML->new->parse_string($marcs);
482             $marcxml = $U->entityize($doc->documentElement->toString);
483             $marcxml = $U->strip_ctrl_chars($marcxml);
484     
485             my $u = OpenILS::Utils::ModsParser->new();
486             $u->start_mods_batch( $marcxml );
487             $mods = $u->finish_mods_batch();
488     
489
490         } catch Error with { $err = shift; };
491
492         push @records, { 'mvr' => $mods, 'marcxml' => $marcxml } unless $err;
493         $logger->error("z3950: bad XML : $err") if $err;
494
495         if( $err ) {
496             warn "\n\n$marcs\n\n";
497         }
498     }
499     
500     $res->{records} = \@records;
501     return $res;
502 }
503
504
505
506 # -------------------------------------------------------------------
507 # Compiles the class based search query
508 # -------------------------------------------------------------------
509 sub compile_query {
510
511     fetch_service_defs() unless (scalar(keys(%services)));
512
513     my $separator = shift;
514     my $service = shift;
515     my $hash = shift;
516
517     my $count = scalar(keys %$hash);
518
519     my $str = "";
520     $str .= "\@$separator " for (1..$count-1);
521     
522     # -------------------------------------------------------------------
523     # "code" is the bib-1 "use attribute", "format" is the bib-1 
524     # "structure attribute"
525     # -------------------------------------------------------------------
526     for( keys %$hash ) {
527         next unless ( exists $services{$service}->{attrs}->{$_} );
528         $str .= '@attr 1=' . $services{$service}->{attrs}->{$_}->{code} . # add the use attribute
529             ' @attr 4=' . $services{$service}->{attrs}->{$_}->{format}; # add the structure attribute
530         if (exists $services{$service}->{attrs}->{$_}->{truncation}
531                 && $services{$service}->{attrs}->{$_}->{truncation} >= 0) {
532             $str .= ' @attr 5=' . $services{$service}->{attrs}->{$_}->{truncation};
533         }
534         $str .= " \"" . $$hash{$_} . "\" "; # add the search term
535     }
536     return $str;
537 }
538
539
540 __PACKAGE__->register_method(
541     method    => 'bucket_search_queue',
542     api_name  => 'open-ils.search.z3950.bucket_search_queue',
543     stream    => 1,
544     # disable opensrf chunking so the caller can receive timely responses
545     max_chunk_size => 0,
546     signature => {
547         desc => q/
548             Performs a Z39.50 search for every record in a bucket, using the
549             provided Z39.50 fields.  Add all search results to the specified
550             Vandelay queue.  If no source records or search results are found,
551             no queue is created.
552         /,
553         params => [
554             {desc => q/Authentication token/, type => 'string'},
555             {desc => q/Bucket ID/, type => 'number'},
556             {desc => q/Z39 Sources.  List of czs.name/, type => 'array'},
557             {desc => q/Z39 Index Maps.  List of czifm.id/, type => 'array'},
558             {   desc => q/Vandelay arguments
559                     queue_name -- required
560                     match_set
561                     ...
562                     /, 
563                 type => 'object'
564             }
565         ],
566         return => {
567             desc => q/Object containing status information about the on-going search
568             and queue operation. 
569             {
570                 bre_count    : $num, -- number of bibs to search against
571                 search_count : $num,
572                 search_complete  : $num,
573                 queue_count  : $num
574                 queue        : $queue_obj
575             }
576             This object will be streamed back with each milestone (search
577             result or complete).
578             Event object returned on failure
579             /
580         }
581     }
582 );
583
584 sub bucket_search_queue {
585     my $self = shift;
586     my $conn = shift;
587     my $auth = shift;
588     my $bucket_id = shift;
589     my $z_sources = shift;
590     my $z_indexes = shift;
591     my $vandelay = shift;
592
593     my $e = new_editor(authtoken => $auth);
594     return $e->event unless 
595         $e->checkauth and
596         $e->allowed('REMOTE_Z3950_QUERY') and
597         $e->allowed('CREATE_BIB_IMPORT_QUEUE');
598     
599     # find the source bib records
600
601     my $bre_ids = $e->json_query({
602         select => {cbrebi => ['target_biblio_record_entry']},
603         from => 'cbrebi',
604         where => {bucket => $bucket_id},
605         distinct => 1
606     });
607
608     # empty bucket
609     return {bre_count => 0} unless @$bre_ids;
610
611     $bre_ids = [ map {$_->{target_biblio_record_entry}} @$bre_ids ];
612
613     $z_indexes = $e->search_config_z3950_index_field_map({id => $z_indexes});
614
615     return OpenILS::Event->new('BAD_PARAMS', 
616         note => q/No z_indexes/) unless @$z_indexes;
617
618     # build the Z39 queries for the source bib records
619
620     my $z_searches = compile_bucket_zsearch(
621         $e, $bre_ids, $z_sources, $z_indexes);
622
623     return $e->event unless $z_searches;
624     return {bre_count => 0} unless @$z_searches;
625
626     my $queue = create_z39_bucket_queue($e, $bucket_id, $vandelay);
627     return $e->event unless $queue;
628
629     send_and_queue_bucket_searches($conn, $e, $queue, $z_searches);
630
631     return undef;
632 }
633
634  # create the queue for storing search results
635 sub create_z39_bucket_queue {
636     my ($e, $bucket_id, $vandelay) = @_;
637
638     my $existing = $e->search_vandelay_bib_queue({
639         name => $vandelay->{queue_name},
640         owner => $e->requestor->id
641     })->[0];
642
643     return $existing if $existing;
644
645     my $queue = Fieldmapper::vandelay::bib_queue->new;
646     $queue->match_bucket($bucket_id);
647     $queue->owner($e->requestor->id);
648     $queue->name($vandelay->{queue_name});
649     $queue->match_set($vandelay->{match_set});
650
651     $e->xact_begin;
652     unless ($e->create_vandelay_bib_queue($queue)) {
653         $e->rollback;
654         return undef;
655     }
656     $e->commit;
657
658     return $queue;
659 }
660
661 # sets the 901c value to the Z39 service and 
662 # adds the record to the growing vandelay queue
663 # returns the number of successfully queued records
664 sub stamp_and_queue_results {
665     my ($e, $queue, $service, $bre_id, $result) = @_;
666     my $qcount = 0;
667
668     for my $rec (@{$result->{records}}) {
669         # insert z39 service as the 901z
670         my $marc = MARC::Record->new_from_xml(
671             $rec->{marcxml}, 'UTF-8', 'USMARC');
672
673         $marc->insert_fields_ordered(
674             MARC::Field->new('901', '', '', z => $service));
675
676         # put the record into the queue
677         my $qrec = Fieldmapper::vandelay::queued_bib_record->new;
678         $qrec->marc(clean_marc($marc));
679         $qrec->queue($queue->id);
680
681         $e->xact_begin;
682         if ($e->create_vandelay_queued_bib_record($qrec)) {
683             $e->commit;
684             $qcount++;
685         } else {
686             my $evt = $e->die_event;
687             $logger->error("z39: unable to queue record: $evt");
688         }
689     }
690
691     return $qcount;
692 }
693
694 sub send_and_queue_bucket_searches {
695     my ($conn, $e, $queue, $z_searches) = @_;
696
697     my $max_parallel = $U->ou_ancestor_setting(
698         $e->requestor->ws_ou,
699         'cat.z3950.batch.max_parallel') || 5;
700
701     my $search_limit = $U->ou_ancestor_setting(
702         $e->requestor->ws_ou,
703         'cat.z3950.batch.max_results') || 5;
704
705     my $response = {
706         bre_count => 0,
707         search_count => 0,
708         search_complete => 0,
709         queue_count => 0
710     };
711
712     # searches are about to be in flight
713     # let the caller know we're still alive
714     $conn->respond($response);
715
716     my $handle_search_result = sub {
717         my ($self, $req) = @_;
718         my $bre_id = $req->{req}->{_bre_id};
719
720         my @p = $req->{req}->payload->params;
721         $logger->debug("z39: multi-search response for request [$bre_id]". 
722             OpenSRF::Utils::JSON->perl2JSON(\@p));
723
724         for my $resp (@{$req->{response}}) {
725             $response->{search_complete}++;
726             my $result = $resp->content or next;
727             my $service = $result->{service};
728             $response->{queue_count} += 
729                 stamp_and_queue_results($e, $queue, $service, $bre_id, $result);
730         }
731
732         $conn->respond($response);
733     };
734
735     my $multi_ses = OpenSRF::MultiSession->new(
736         app             => 'open-ils.search',
737         cap             => $max_parallel,
738         timeout         => 120,
739         success_handler => $handle_search_result
740     );
741
742     # note: mult-session blocks new requests when it hits max 
743     # parallel, so we need to cacluate summary values up front.
744     my %bre_uniq;
745     $bre_uniq{$_->{bre_id}} = 1 for @$z_searches;
746     $response->{bre_count} = scalar(keys %bre_uniq);
747     $response->{search_count} += scalar(@$z_searches);
748
749     # let the caller know searches are on their way out
750     $conn->respond($response);
751
752     for my $search (@$z_searches) {
753
754         my $bre_id = delete $search->{bre_id};
755         $search->{limit} = $search_limit;
756
757         # toss it onto the multi-pile
758         my $req = $multi_ses->request(
759             'open-ils.search.z3950.search_class', $e->authtoken, $search);
760
761         $req->{_bre_id} = $bre_id;
762     }
763
764     $multi_ses->session_wait(1);
765     $response->{queue} = $queue;
766     $conn->respond($response);
767 }
768
769
770 # creates a series of Z39.50 searchs based on the 
771 # in-bucket records and the selected sources and indexes
772 sub compile_bucket_zsearch {
773     my ($e, $bre_ids, $z_sources, $z_indexes) = @_;
774
775     # pre-load the metabib_field's we'll need for this batch
776
777     my %mb_fields;
778     my @mb_fields = grep { $_->metabib_field } @$z_indexes;
779     if (@mb_fields) {
780         @mb_fields = map { $_->metabib_field } @mb_fields;
781         my $field_objs = $e->search_config_metabib_field({id => \@mb_fields});
782         %mb_fields = map {$_->id => $_} @$field_objs;
783     }
784
785     # pre-load the z3950_attrs we'll need for this batch
786
787     my %z3950_attrs;
788     my @z3950_attrs = grep { $_->z3950_attr } @$z_indexes;
789     if (@z3950_attrs) {
790         @z3950_attrs = map { $_->z3950_attr } @z3950_attrs;
791         my $attr_objs = $e->search_config_z3950_attr({id => \@z3950_attrs});
792         %z3950_attrs = map {$_->id => $_} @$attr_objs;
793     }
794
795     # indexes with specific z3950_attr's take precedence
796     my @z_index_attrs = grep { $_->z3950_attr } @$z_indexes;
797     my @z_index_types = grep { !$_->z3950_attr } @$z_indexes;
798
799     # for each bib record, extract the indexed value for the selected indexes.  
800     my %z_searches;
801
802     for my $bre_id (@$bre_ids) {
803
804         $z_searches{$bre_id} = {};
805
806         for my $z_index (@z_index_attrs, @z_index_types) {
807
808             my $bre_val;
809             if ($z_index->record_attr) {
810
811                 my $attrs = $U->get_bre_attrs($bre_id, $e);
812                 $bre_val = $attrs->{$bre_id}{$z_index->record_attr}{code};
813
814             } else { # metabib_field
815                 my $fid = $z_index->metabib_field;
816
817                 # the value for each field will be in the 
818                 # index class-specific table
819                 my $entry_query = sprintf(
820                     'search_metabib_%s_field_entry', 
821                     $mb_fields{$fid}->field_class);
822
823                 my $entry = $e->$entry_query(
824                     {field => $fid, source => $bre_id})->[0];
825
826                 $bre_val = $entry->value if $entry;
827             }
828
829             # no value means no search
830             next unless $bre_val;
831
832             # determine which z3950 source to send this search field to 
833
834             my $z_source = [];
835             my $z_index_name;
836             if ($z_index->z3950_attr) {
837
838                 # a specific z3950_attr means this search index
839                 # only applies to the z_source linked to the attr
840
841                 $z_index_name = $z3950_attrs{$z_index->z3950_attr}->name;
842                 my $src = $z3950_attrs{$z_index->z3950_attr}->source;
843
844                 if (grep { $_ eq $src } @$z_sources) {
845                     $z_searches{$bre_id}{$src} ||= {
846                         service => [$src],
847                         search => {}
848                     };
849                     $z_searches{$bre_id}{$src}{search}{$z_index_name} = $bre_val;
850
851                 } else {
852                     $logger->warn("z39: z3950_attr '$z_index_name' for '$src'".
853                         " selected, but $src is not in the search list.  Skipping...");
854                 }
855
856             } else {
857
858                 # when a generic attr type is used, it applies to all 
859                 # z-sources, except those for which a more specific
860                 # z3950_attr has already been applied
861
862                 $z_index_name = $z_index->z3950_attr_type;
863
864                 my @excluded;
865                 for my $attr (values %z3950_attrs) {
866                     push(@excluded, $attr->source)
867                         if $attr->name eq $z_index_name;
868                 }
869
870                 for my $src (@$z_sources) {
871                     next if grep {$_ eq $src} @excluded;
872                     $z_searches{$bre_id}{$src} ||= {
873                         service => [$src],
874                         search => {}
875                     };
876                     $z_searches{$bre_id}{$src}{search}{$z_index_name} = $bre_val;
877                 }
878             }
879         }
880     }
881
882     # NOTE: ISBNs are sent through the translate_isbn1013 normalize
883     # before entring metabib.identifier_field_entry.  As such, there
884     # will always be at minimum 2 ISBNs per record w/ ISBN and the
885     # data will be pre-sanitized.  The first ISBN in the list is the
886     # ISBN from the record.  Use that for these searches.
887     for my $bre_id (keys %z_searches) {
888         for my $src (keys %{$z_searches{$bre_id}}) {
889             my $blob = $z_searches{$bre_id}{$src};
890
891             # Sanitized ISBNs are space-separated.
892             # kill everything past the first space
893             $blob->{search}{isbn} =~ s/\s.*//g if $blob->{search}{isbn};
894         }
895     }
896
897     # let's turn this into something slightly more digestable
898     my @searches;
899     for my $bre_id (keys %z_searches) {
900         for my $blobset (values %{$z_searches{$bre_id}}) {
901             $blobset = [$blobset] unless ref $blobset eq 'ARRAY';
902             for my $blob (@$blobset) {
903                 $blob->{bre_id} = $bre_id;
904                 push(@searches, $blob);
905             }
906         }
907     }
908
909     return \@searches;
910 }
911
912
913
914 1;
915 # vim:et:ts=4:sw=4: