c830844577f893543374645fa2c7994eb44507b7
[working/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                 $marc = MARC::Record->new_from_usmarc($rec->raw());
466             } elsif ($tformat eq 'xml') {
467                 $marc = MARC::Record->new_from_xml($rec->raw());
468             } else {
469                 die "Unsupported record transmission format $tformat"
470             }
471
472             $marcs = $U->entityize($marc->as_xml_record);
473             $marcs = $U->strip_ctrl_chars($marcs);
474             my $doc = XML::LibXML->new->parse_string($marcs);
475             $marcxml = $U->entityize($doc->documentElement->toString);
476             $marcxml = $U->strip_ctrl_chars($marcxml);
477     
478             my $u = OpenILS::Utils::ModsParser->new();
479             $u->start_mods_batch( $marcxml );
480             $mods = $u->finish_mods_batch();
481     
482
483         } catch Error with { $err = shift; };
484
485         push @records, { 'mvr' => $mods, 'marcxml' => $marcxml } unless $err;
486         $logger->error("z3950: bad XML : $err") if $err;
487
488         if( $err ) {
489             warn "\n\n$marcs\n\n";
490         }
491     }
492     
493     $res->{records} = \@records;
494     return $res;
495 }
496
497
498
499 # -------------------------------------------------------------------
500 # Compiles the class based search query
501 # -------------------------------------------------------------------
502 sub compile_query {
503
504     fetch_service_defs() unless (scalar(keys(%services)));
505
506     my $separator = shift;
507     my $service = shift;
508     my $hash = shift;
509
510     my $count = scalar(keys %$hash);
511
512     my $str = "";
513     $str .= "\@$separator " for (1..$count-1);
514     
515     # -------------------------------------------------------------------
516     # "code" is the bib-1 "use attribute", "format" is the bib-1 
517     # "structure attribute"
518     # -------------------------------------------------------------------
519     for( keys %$hash ) {
520         next unless ( exists $services{$service}->{attrs}->{$_} );
521         $str .= '@attr 1=' . $services{$service}->{attrs}->{$_}->{code} . # add the use attribute
522             ' @attr 4=' . $services{$service}->{attrs}->{$_}->{format}; # add the structure attribute
523         if (exists $services{$service}->{attrs}->{$_}->{truncation}
524                 && $services{$service}->{attrs}->{$_}->{truncation} >= 0) {
525             $str .= ' @attr 5=' . $services{$service}->{attrs}->{$_}->{truncation};
526         }
527         $str .= " \"" . $$hash{$_} . "\" "; # add the search term
528     }
529     return $str;
530 }
531
532
533 __PACKAGE__->register_method(
534     method    => 'bucket_search_queue',
535     api_name  => 'open-ils.search.z3950.bucket_search_queue',
536     stream    => 1,
537     # disable opensrf chunking so the caller can receive timely responses
538     max_chunk_size => 0,
539     signature => {
540         desc => q/
541             Performs a Z39.50 search for every record in a bucket, using the
542             provided Z39.50 fields.  Add all search results to the specified
543             Vandelay queue.  If no source records or search results are found,
544             no queue is created.
545         /,
546         params => [
547             {desc => q/Authentication token/, type => 'string'},
548             {desc => q/Bucket ID/, type => 'number'},
549             {desc => q/Z39 Sources.  List of czs.name/, type => 'array'},
550             {desc => q/Z39 Index Maps.  List of czifm.id/, type => 'array'},
551             {   desc => q/Vandelay arguments
552                     queue_name -- required
553                     match_set
554                     ...
555                     /, 
556                 type => 'object'
557             }
558         ],
559         return => {
560             desc => q/Object containing status information about the on-going search
561             and queue operation. 
562             {
563                 bre_count    : $num, -- number of bibs to search against
564                 search_count : $num,
565                 search_complete  : $num,
566                 queue_count  : $num
567                 queue        : $queue_obj
568             }
569             This object will be streamed back with each milestone (search
570             result or complete).
571             Event object returned on failure
572             /
573         }
574     }
575 );
576
577 sub bucket_search_queue {
578     my $self = shift;
579     my $conn = shift;
580     my $auth = shift;
581     my $bucket_id = shift;
582     my $z_sources = shift;
583     my $z_indexes = shift;
584     my $vandelay = shift;
585
586     my $e = new_editor(authtoken => $auth);
587     return $e->event unless 
588         $e->checkauth and
589         $e->allowed('REMOTE_Z3950_QUERY') and
590         $e->allowed('CREATE_BIB_IMPORT_QUEUE');
591     
592     # find the source bib records
593
594     my $bre_ids = $e->json_query({
595         select => {cbrebi => ['target_biblio_record_entry']},
596         from => 'cbrebi',
597         where => {bucket => $bucket_id},
598         distinct => 1
599     });
600
601     # empty bucket
602     return {bre_count => 0} unless @$bre_ids;
603
604     $bre_ids = [ map {$_->{target_biblio_record_entry}} @$bre_ids ];
605
606     $z_indexes = $e->search_config_z3950_index_field_map({id => $z_indexes});
607
608     return OpenILS::Event->new('BAD_PARAMS', 
609         note => q/No z_indexes/) unless @$z_indexes;
610
611     # build the Z39 queries for the source bib records
612
613     my $z_searches = compile_bucket_zsearch(
614         $e, $bre_ids, $z_sources, $z_indexes);
615
616     return $e->event unless $z_searches;
617     return {bre_count => 0} unless @$z_searches;
618
619     my $queue = create_z39_bucket_queue($e, $bucket_id, $vandelay);
620     return $e->event unless $queue;
621
622     send_and_queue_bucket_searches($conn, $e, $queue, $z_searches);
623
624     return undef;
625 }
626
627  # create the queue for storing search results
628 sub create_z39_bucket_queue {
629     my ($e, $bucket_id, $vandelay) = @_;
630
631     my $existing = $e->search_vandelay_bib_queue({
632         name => $vandelay->{queue_name},
633         owner => $e->requestor->id
634     })->[0];
635
636     return $existing if $existing;
637
638     my $queue = Fieldmapper::vandelay::bib_queue->new;
639     $queue->match_bucket($bucket_id);
640     $queue->owner($e->requestor->id);
641     $queue->name($vandelay->{queue_name});
642     $queue->match_set($vandelay->{match_set});
643
644     $e->xact_begin;
645     unless ($e->create_vandelay_bib_queue($queue)) {
646         $e->rollback;
647         return undef;
648     }
649     $e->commit;
650
651     return $queue;
652 }
653
654 # sets the 901c value to the Z39 service and 
655 # adds the record to the growing vandelay queue
656 # returns the number of successfully queued records
657 sub stamp_and_queue_results {
658     my ($e, $queue, $service, $bre_id, $result) = @_;
659     my $qcount = 0;
660
661     for my $rec (@{$result->{records}}) {
662         # insert z39 service as the 901z
663         my $marc = MARC::Record->new_from_xml(
664             $rec->{marcxml}, 'UTF-8', 'USMARC');
665
666         $marc->insert_fields_ordered(
667             MARC::Field->new('901', '', '', z => $service));
668
669         # put the record into the queue
670         my $qrec = Fieldmapper::vandelay::queued_bib_record->new;
671         $qrec->marc(clean_marc($marc));
672         $qrec->queue($queue->id);
673
674         $e->xact_begin;
675         if ($e->create_vandelay_queued_bib_record($qrec)) {
676             $e->commit;
677             $qcount++;
678         } else {
679             my $evt = $e->die_event;
680             $logger->error("z39: unable to queue record: $evt");
681         }
682     }
683
684     return $qcount;
685 }
686
687 sub send_and_queue_bucket_searches {
688     my ($conn, $e, $queue, $z_searches) = @_;
689
690     my $max_parallel = $U->ou_ancestor_setting(
691         $e->requestor->ws_ou,
692         'cat.z3950.batch.max_parallel') || 5;
693
694     my $search_limit = $U->ou_ancestor_setting(
695         $e->requestor->ws_ou,
696         'cat.z3950.batch.max_results') || 5;
697
698     my $response = {
699         bre_count => 0,
700         search_count => 0,
701         search_complete => 0,
702         queue_count => 0
703     };
704
705     # searches are about to be in flight
706     # let the caller know we're still alive
707     $conn->respond($response);
708
709     my $handle_search_result = sub {
710         my ($self, $req) = @_;
711         my $bre_id = $req->{req}->{_bre_id};
712
713         my @p = $req->{req}->payload->params;
714         $logger->debug("z39: multi-search response for request [$bre_id]". 
715             OpenSRF::Utils::JSON->perl2JSON(\@p));
716
717         for my $resp (@{$req->{response}}) {
718             $response->{search_complete}++;
719             my $result = $resp->content or next;
720             my $service = $result->{service};
721             $response->{queue_count} += 
722                 stamp_and_queue_results($e, $queue, $service, $bre_id, $result);
723         }
724
725         $conn->respond($response);
726     };
727
728     my $multi_ses = OpenSRF::MultiSession->new(
729         app             => 'open-ils.search',
730         cap             => $max_parallel,
731         timeout         => 120,
732         success_handler => $handle_search_result
733     );
734
735     # note: mult-session blocks new requests when it hits max 
736     # parallel, so we need to cacluate summary values up front.
737     my %bre_uniq;
738     $bre_uniq{$_->{bre_id}} = 1 for @$z_searches;
739     $response->{bre_count} = scalar(keys %bre_uniq);
740     $response->{search_count} += scalar(@$z_searches);
741
742     # let the caller know searches are on their way out
743     $conn->respond($response);
744
745     for my $search (@$z_searches) {
746
747         my $bre_id = delete $search->{bre_id};
748         $search->{limit} = $search_limit;
749
750         # toss it onto the multi-pile
751         my $req = $multi_ses->request(
752             'open-ils.search.z3950.search_class', $e->authtoken, $search);
753
754         $req->{_bre_id} = $bre_id;
755     }
756
757     $multi_ses->session_wait(1);
758     $response->{queue} = $queue;
759     $conn->respond($response);
760 }
761
762
763 # creates a series of Z39.50 searchs based on the 
764 # in-bucket records and the selected sources and indexes
765 sub compile_bucket_zsearch {
766     my ($e, $bre_ids, $z_sources, $z_indexes) = @_;
767
768     # pre-load the metabib_field's we'll need for this batch
769
770     my %mb_fields;
771     my @mb_fields = grep { $_->metabib_field } @$z_indexes;
772     if (@mb_fields) {
773         @mb_fields = map { $_->metabib_field } @mb_fields;
774         my $field_objs = $e->search_config_metabib_field({id => \@mb_fields});
775         %mb_fields = map {$_->id => $_} @$field_objs;
776     }
777
778     # pre-load the z3950_attrs we'll need for this batch
779
780     my %z3950_attrs;
781     my @z3950_attrs = grep { $_->z3950_attr } @$z_indexes;
782     if (@z3950_attrs) {
783         @z3950_attrs = map { $_->z3950_attr } @z3950_attrs;
784         my $attr_objs = $e->search_config_z3950_attr({id => \@z3950_attrs});
785         %z3950_attrs = map {$_->id => $_} @$attr_objs;
786     }
787
788     # indexes with specific z3950_attr's take precedence
789     my @z_index_attrs = grep { $_->z3950_attr } @$z_indexes;
790     my @z_index_types = grep { !$_->z3950_attr } @$z_indexes;
791
792     # for each bib record, extract the indexed value for the selected indexes.  
793     my %z_searches;
794
795     for my $bre_id (@$bre_ids) {
796
797         $z_searches{$bre_id} = {};
798
799         for my $z_index (@z_index_attrs, @z_index_types) {
800
801             my $bre_val;
802             if ($z_index->record_attr) {
803
804                 my $attrs = $U->get_bre_attrs($bre_id, $e);
805                 $bre_val = $attrs->{$bre_id}{$z_index->record_attr}{code};
806
807             } else { # metabib_field
808                 my $fid = $z_index->metabib_field;
809
810                 # the value for each field will be in the 
811                 # index class-specific table
812                 my $entry_query = sprintf(
813                     'search_metabib_%s_field_entry', 
814                     $mb_fields{$fid}->field_class);
815
816                 my $entry = $e->$entry_query(
817                     {field => $fid, source => $bre_id})->[0];
818
819                 $bre_val = $entry->value if $entry;
820             }
821
822             # no value means no search
823             next unless $bre_val;
824
825             # determine which z3950 source to send this search field to 
826
827             my $z_source = [];
828             my $z_index_name;
829             if ($z_index->z3950_attr) {
830
831                 # a specific z3950_attr means this search index
832                 # only applies to the z_source linked to the attr
833
834                 $z_index_name = $z3950_attrs{$z_index->z3950_attr}->name;
835                 my $src = $z3950_attrs{$z_index->z3950_attr}->source;
836
837                 if (grep { $_ eq $src } @$z_sources) {
838                     $z_searches{$bre_id}{$src} ||= {
839                         service => [$src],
840                         search => {}
841                     };
842                     $z_searches{$bre_id}{$src}{search}{$z_index_name} = $bre_val;
843
844                 } else {
845                     $logger->warn("z39: z3950_attr '$z_index_name' for '$src'".
846                         " selected, but $src is not in the search list.  Skipping...");
847                 }
848
849             } else {
850
851                 # when a generic attr type is used, it applies to all 
852                 # z-sources, except those for which a more specific
853                 # z3950_attr has already been applied
854
855                 $z_index_name = $z_index->z3950_attr_type;
856
857                 my @excluded;
858                 for my $attr (values %z3950_attrs) {
859                     push(@excluded, $attr->source)
860                         if $attr->name eq $z_index_name;
861                 }
862
863                 for my $src (@$z_sources) {
864                     next if grep {$_ eq $src} @excluded;
865                     $z_searches{$bre_id}{$src} ||= {
866                         service => [$src],
867                         search => {}
868                     };
869                     $z_searches{$bre_id}{$src}{search}{$z_index_name} = $bre_val;
870                 }
871             }
872         }
873     }
874
875     # NOTE: ISBNs are sent through the translate_isbn1013 normalize
876     # before entring metabib.identifier_field_entry.  As such, there
877     # will always be at minimum 2 ISBNs per record w/ ISBN and the
878     # data will be pre-sanitized.  The first ISBN in the list is the
879     # ISBN from the record.  Use that for these searches.
880     for my $bre_id (keys %z_searches) {
881         for my $src (keys %{$z_searches{$bre_id}}) {
882             my $blob = $z_searches{$bre_id}{$src};
883
884             # Sanitized ISBNs are space-separated.
885             # kill everything past the first space
886             $blob->{search}{isbn} =~ s/\s.*//g if $blob->{search}{isbn};
887         }
888     }
889
890     # let's turn this into something slightly more digestable
891     my @searches;
892     for my $bre_id (keys %z_searches) {
893         for my $blobset (values %{$z_searches{$bre_id}}) {
894             $blobset = [$blobset] unless ref $blobset eq 'ARRAY';
895             for my $blob (@$blobset) {
896                 $blob->{bre_id} = $bre_id;
897                 push(@searches, $blob);
898             }
899         }
900     }
901
902     return \@searches;
903 }
904
905
906
907 1;
908 # vim:et:ts=4:sw=4: