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