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