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: