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 = $U->ou_ancestor_setting(
 690         $e->requestor->ws_ou,
 691         'cat.z3950.batch.max_parallel') || 5;
 692
 693     my $search_limit = $U->ou_ancestor_setting(
 694         $e->requestor->ws_ou,
 695         'cat.z3950.batch.max_results') || 5;
 696
 697     my $response = {
 698         bre_count => 0,
 699         search_count => 0,
 700         search_complete => 0,
 701         queue_count => 0
 702     };
 703
 704     # searches are about to be in flight
 705     # let the caller know we're still alive
 706     $conn->respond($response);
 707
 708     my $handle_search_result = sub {
 709         my ($self, $req) = @_;
 710         my $bre_id = $req->{req}->{_bre_id};
 711
 712         my @p = $req->{req}->payload->params;
 713         $logger->debug("z39: multi-search response for request [$bre_id]".
 714             OpenSRF::Utils::JSON->perl2JSON(\@p));
 715
 716         for my $resp (@{$req->{response}}) {
 717             $response->{search_complete}++;
 718             my $result = $resp->content or next;
 719             my $service = $result->{service};
 720             $response->{queue_count} +=
 721                 stamp_and_queue_results($e, $queue, $service, $bre_id, $result);
 722         }
 723
 724         $conn->respond($response);
 725     };
 726
 727     my $multi_ses = OpenSRF::MultiSession->new(
 728         app             => 'open-ils.search',
 729         cap             => $max_parallel,
 730         timeout         => 120,
 731         success_handler => $handle_search_result
 732     );
 733
 734     # note: mult-session blocks new requests when it hits max
 735     # parallel, so we need to cacluate summary values up front.
 736     my %bre_uniq;
 737     $bre_uniq{$_->{bre_id}} = 1 for @$z_searches;
 738     $response->{bre_count} = scalar(keys %bre_uniq);
 739     $response->{search_count} += scalar(@$z_searches);
 740
 741     # let the caller know searches are on their way out
 742     $conn->respond($response);
 743
 744     for my $search (@$z_searches) {
 745
 746         my $bre_id = delete $search->{bre_id};
 747         $search->{limit} = $search_limit;
 748
 749         # toss it onto the multi-pile
 750         my $req = $multi_ses->request(
 751             'open-ils.search.z3950.search_class', $e->authtoken, $search);
 752
 753         $req->{_bre_id} = $bre_id;
 754     }
 755
 756     $multi_ses->session_wait(1);
 757     $response->{queue} = $queue;
 758     $conn->respond($response);
 759 }
 760
 761
 762 # creates a series of Z39.50 searchs based on the
 763 # in-bucket records and the selected sources and indexes
 764 sub compile_bucket_zsearch {
 765     my ($e, $bre_ids, $z_sources, $z_indexes) = @_;
 766
 767     # pre-load the metabib_field's we'll need for this batch
 768
 769     my %mb_fields;
 770     my @mb_fields = grep { $_->metabib_field } @$z_indexes;
 771     if (@mb_fields) {
 772         @mb_fields = map { $_->metabib_field } @mb_fields;
 773         my $field_objs = $e->search_config_metabib_field({id => \@mb_fields});
 774         %mb_fields = map {$_->id => $_} @$field_objs;
 775     }
 776
 777     # pre-load the z3950_attrs we'll need for this batch
 778
 779     my %z3950_attrs;
 780     my @z3950_attrs = grep { $_->z3950_attr } @$z_indexes;
 781     if (@z3950_attrs) {
 782         @z3950_attrs = map { $_->z3950_attr } @z3950_attrs;
 783         my $attr_objs = $e->search_config_z3950_attr({id => \@z3950_attrs});
 784         %z3950_attrs = map {$_->id => $_} @$attr_objs;
 785     }
 786
 787     # indexes with specific z3950_attr's take precedence
 788     my @z_index_attrs = grep { $_->z3950_attr } @$z_indexes;
 789     my @z_index_types = grep { !$_->z3950_attr } @$z_indexes;
 790
 791     # for each bib record, extract the indexed value for the selected indexes.
 792     my %z_searches;
 793
 794     for my $bre_id (@$bre_ids) {
 795
 796         $z_searches{$bre_id} = {};
 797
 798         for my $z_index (@z_index_attrs, @z_index_types) {
 799
 800             my $bre_val;
 801             if ($z_index->record_attr) {
 802
 803                 my $attrs = $U->get_bre_attrs($bre_id, $e);
 804                 $bre_val = $attrs->{$bre_id}{$z_index->record_attr}{code};
 805
 806             } else { # metabib_field
 807                 my $fid = $z_index->metabib_field;
 808
 809                 # the value for each field will be in the
 810                 # index class-specific table
 811                 my $entry_query = sprintf(
 812                     'search_metabib_%s_field_entry',
 813                     $mb_fields{$fid}->field_class);
 814
 815                 my $entry = $e->$entry_query(
 816                     {field => $fid, source => $bre_id})->[0];
 817
 818                 $bre_val = $entry->value if $entry;
 819             }
 820
 821             # no value means no search
 822             next unless $bre_val;
 823
 824             # determine which z3950 source to send this search field to
 825
 826             my $z_source = [];
 827             my $z_index_name;
 828             if ($z_index->z3950_attr) {
 829
 830                 # a specific z3950_attr means this search index
 831                 # only applies to the z_source linked to the attr
 832
 833                 $z_index_name = $z3950_attrs{$z_index->z3950_attr}->name;
 834                 my $src = $z3950_attrs{$z_index->z3950_attr}->source;
 835
 836                 if (grep { $_ eq $src } @$z_sources) {
 837                     $z_searches{$bre_id}{$src} ||= {
 838                         service => [$src],
 839                         search => {}
 840                     };
 841                     $z_searches{$bre_id}{$src}{search}{$z_index_name} = $bre_val;
 842
 843                 } else {
 844                     $logger->warn("z39: z3950_attr '$z_index_name' for '$src'".
 845                         " selected, but $src is not in the search list.  Skipping...");
 846                 }
 847
 848             } else {
 849
 850                 # when a generic attr type is used, it applies to all
 851                 # z-sources, except those for which a more specific
 852                 # z3950_attr has already been applied
 853
 854                 $z_index_name = $z_index->z3950_attr_type;
 855
 856                 my @excluded;
 857                 for my $attr (values %z3950_attrs) {
 858                     push(@excluded, $attr->source)
 859                         if $attr->name eq $z_index_name;
 860                 }
 861
 862                 for my $src (@$z_sources) {
 863                     next if grep {$_ eq $src} @excluded;
 864                     $z_searches{$bre_id}{$src} ||= {
 865                         service => [$src],
 866                         search => {}
 867                     };
 868                     $z_searches{$bre_id}{$src}{search}{$z_index_name} = $bre_val;
 869                 }
 870             }
 871         }
 872     }
 873
 874     # NOTE: ISBNs are sent through the translate_isbn1013 normalize
 875     # before entring metabib.identifier_field_entry.  As such, there
 876     # will always be at minimum 2 ISBNs per record w/ ISBN and the
 877     # data will be pre-sanitized.  The first ISBN in the list is the
 878     # ISBN from the record.  Use that for these searches.
 879     for my $bre_id (keys %z_searches) {
 880         for my $src (keys %{$z_searches{$bre_id}}) {
 881             my $blob = $z_searches{$bre_id}{$src};
 882
 883             # Sanitized ISBNs are space-separated.
 884             # kill everything past the first space
 885             $blob->{search}{isbn} =~ s/\s.*//g if $blob->{search}{isbn};
 886         }
 887     }
 888
 889     # let's turn this into something slightly more digestable
 890     my @searches;
 891     for my $bre_id (keys %z_searches) {
 892         for my $blobset (values %{$z_searches{$bre_id}}) {
 893             $blobset = [$blobset] unless ref $blobset eq 'ARRAY';
 894             for my $blob (@$blobset) {
 895                 $blob->{bre_id} = $bre_id;
 896                 push(@searches, $blob);
 897             }
 898         }
 899     }
 900
 901     return \@searches;
 902 }
 903
 904
 905
 906 1;
 907 # vim:et:ts=4:sw=4: