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