Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Authority.pm

   1 package OpenILS::Application::Search::Authority;
   2 use base qw/OpenILS::Application/;
   3 use strict; use warnings;
   4
   5 use OpenILS::Utils::Fieldmapper;
   6 use OpenILS::Application::AppUtils;
   7 use MARC::Record;
   8 use MARC::File::XML (BinaryEncoding => 'UTF-8');
   9 use MARC::Charset;
  10 use XML::LibXML;
  11 use XML::LibXSLT;
  12 use OpenILS::Utils::CStoreEditor q/:funcs/;
  13 use OpenSRF::Utils::Logger qw/$logger/;
  14
  15 use OpenSRF::Utils::JSON;
  16
  17 use Time::HiRes qw(time);
  18 use OpenSRF::EX qw(:try);
  19 use Digest::MD5 qw(md5_hex);
  20
  21 my $cache;
  22
  23
  24 sub validate_authority {
  25     my $self = shift;
  26     my $client = shift;
  27
  28     my $session = OpenSRF::AppSession->create("open-ils.storage");
  29     return $session->request( 'open-ils.storage.authority.validate.tag' => @_ )->gather(1);
  30 }
  31 __PACKAGE__->register_method(
  32         method      => "validate_authority",
  33         api_name    => "open-ils.search.authority.validate.tag",
  34         argc        => 4,
  35         note        => "Validates authority data from existing controlled terms",
  36 );
  37
  38 sub validate_authority_return_records_by_id {
  39     my $self = shift;
  40     my $client = shift;
  41
  42     my $session = OpenSRF::AppSession->create("open-ils.storage");
  43     return $session->request( 'open-ils.storage.authority.validate.tag.id_list' => @_ )->gather(1);
  44 }
  45 __PACKAGE__->register_method(
  46         method      => "validate_authority_return_records_by_id",
  47         api_name    => "open-ils.search.authority.validate.tag.id_list",
  48         argc        => 4,
  49         note        => "Validates authority data from existing controlled terms",
  50 );
  51
  52 sub search_authority {
  53     my $self = shift;
  54     my $client = shift;
  55
  56     my $session = OpenSRF::AppSession->create("open-ils.storage");
  57     return $session->request( 'open-ils.storage.authority.search.marc.atomic' => @_ )->gather(1);
  58 }
  59 __PACKAGE__->register_method(
  60         method      => "search_authority",
  61         api_name    => "open-ils.search.authority.fts",
  62         argc        => 2,
  63         note        => "Searches authority data for existing controlled terms and crossrefs",
  64 );
  65
  66 sub search_authority_by_simple_normalize_heading {
  67     my $self = shift;
  68     my $client = shift;
  69     my $marcxml = shift;
  70     my $controlset = shift;
  71
  72     my $norm_heading_query = {
  73         from => [ 'authority.simple_normalize_heading' => $marcxml ]
  74     };
  75
  76     my $e = new_editor();
  77     my $norm_heading = $e->json_query($norm_heading_query)->[0]->{'authority.simple_normalize_heading'};
  78
  79     unless (defined($norm_heading) && $norm_heading != '') {
  80         return OpenILS::Event->new('BAD_PARAMS', note => 'Heading normalized to null or empty string');
  81     }
  82
  83     my $query = {
  84         select => { are => ['id'] },
  85         from   => 'are',
  86         where  => {
  87             deleted => 'f',
  88             simple_heading => {
  89                 'startwith' => $norm_heading
  90             },
  91             defined($controlset) ? ( control_set => $controlset ) : ()
  92         }
  93     };
  94
  95     $client->respond($_->{id}) for @{ $e->json_query( $query ) };
  96     $client->respond_complete;
  97 }
  98 __PACKAGE__->register_method(
  99         method      => "search_authority_by_simple_normalize_heading",
 100         api_name    => "open-ils.search.authority.simple_heading.from_xml",
 101         argc        => 1,
 102         stream      => 1,
 103         note        => "Searches authority data by main entry using marcxml, returning 'are' ids; params are marcxml and optional control-set-id",
 104 );
 105
 106 sub search_authority_batch_by_simple_normalize_heading {
 107     my $self = shift;
 108     my $client = shift;
 109     my $search_set = [@_];
 110
 111     my $m = $self->method_lookup('open-ils.search.authority.simple_heading.from_xml.atomic');
 112
 113     for my $s ( @$search_set ) {
 114         for my $k ( keys %$s ) {
 115             $client->respond( { $k => $m->run( $s->{$k}, $k ) } );
 116         }
 117     }
 118
 119     $client->respond_complete;
 120 }
 121 __PACKAGE__->register_method(
 122         method      => "search_authority_batch_by_simple_normalize_heading",
 123         api_name    => "open-ils.search.authority.simple_heading.from_xml.batch",
 124         argc        => 1,
 125         stream      => 1,
 126         note        => "Searches authority data by main entry using marcxml, in control-set batches, returning 'are' ids; params are hashes of { control-set-id => marcxml }",
 127 );
 128
 129
 130 sub crossref_authority {
 131     my $self = shift;
 132     my $client = shift;
 133     my $class = shift;
 134     my $term = shift;
 135     my $limit = shift || 10;
 136
 137     my $session = OpenSRF::AppSession->create("open-ils.storage");
 138
 139     # Avoid generating spurious errors for more granular indexes, like author|personal
 140     $class =~ s/^(.*?)\|.*?$/$1/;
 141
 142     $logger->info("authority xref search for $class=$term, limit=$limit");
 143     my $fr = $session->request(
 144         "open-ils.storage.authority.$class.see_from.controlled.atomic",$term, $limit)->gather(1);
 145     my $al = $session->request(
 146         "open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term, $limit)->gather(1);
 147
 148     my $data = _auth_flatten( $term, $fr, $al, 1 );
 149
 150     return $data;
 151 }
 152
 153 sub _auth_flatten {
 154     my $term = shift;
 155     my $fr = shift;
 156     my $al = shift;
 157     my $limit = shift;
 158
 159     my %hash = ();
 160     for my $x (@$fr) {
 161         my $string = $$x[0];
 162         for my $i (1..10) {
 163             last unless ($$x[$i]);
 164             if ($string =~ /\W$/o) {
 165                 $string .= ' '.$$x[$i];
 166             } else {
 167                 $string .= ' -- '.$$x[$i];
 168             }
 169         }
 170         next if (lc($string) eq lc($term));
 171         $hash{$string}++;
 172         $hash{$string}++ if (lc($$x[0]) eq lc($term));
 173     }
 174     my $from = [keys %hash]; #[ sort { $hash{$b} <=> $hash{$a} || $a cmp $b } keys %hash ];
 175
 176 #   $from = [ @$from[0..4] ] if $limit;
 177
 178     %hash = ();
 179     for my $x (@$al) {
 180         my $string = $$x[0];
 181         for my $i (1..10) {
 182             last unless ($$x[$i]);
 183             if ($string =~ /\W$/o) {
 184                 $string .= ' '.$$x[$i];
 185             } else {
 186                 $string .= ' -- '.$$x[$i];
 187             }
 188         }
 189         next if (lc($string) eq lc($term));
 190         $hash{$string}++;
 191         $hash{$string}++ if (lc($$x[0]) eq lc($term));
 192     }
 193     my $also = [keys %hash]; #[ sort { $hash{$b} <=> $hash{$a} || $a cmp $b } keys %hash ];
 194
 195 #   $also = [ @$also[0..4] ] if $limit;
 196
 197     #warn Dumper( { from => $from, also => $also } );
 198
 199     return { from => $from, also => $also };
 200 }
 201
 202 __PACKAGE__->register_method(
 203         method      => "crossref_authority",
 204         api_name    => "open-ils.search.authority.crossref",
 205         argc        => 2,
 206         note        => "Searches authority data for existing controlled terms and crossrefs",
 207 );
 208
 209 __PACKAGE__->register_method(
 210     #method     => "new_crossref_authority_batch",
 211     method      => "crossref_authority_batch2",
 212     api_name    => "open-ils.search.authority.crossref.batch",
 213     argc        => 1,
 214     note        => <<"    NOTE");
 215     Takes an array of class,term pair sub-arrays and performs an authority lookup for each
 216
 217     PARAMS( [ ["subject", "earth"], ["author","shakespeare"] ] );
 218
 219     Returns an object like so:
 220     {
 221         "classname" : {
 222             "term" : { "from" : [ ...], "also" : [...] }
 223             "term2" : { "from" : [ ...], "also" : [...] }
 224         }
 225     }
 226     NOTE
 227
 228 sub new_crossref_authority_batch {
 229     my( $self, $client, $reqs ) = @_;
 230
 231     my $response = {};
 232     my $lastr = [];
 233     my $session = OpenSRF::AppSession->create("open-ils.storage");
 234
 235     for my $req (@$reqs) {
 236
 237         my $class = $req->[0];
 238         my $term = $req->[1];
 239         next unless $class and $term;
 240         $logger->info("Sending authority request for $class : $term");
 241         my $fr = $session->request("open-ils.storage.authority.$class.see_from.controlled.atomic",$term, 10)->gather(1);
 242         my $al = $session->request("open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term, 10)->gather(1);
 243
 244         $response->{$class} = {} unless exists $response->{$class};
 245         $response->{$class}->{$term} = _auth_flatten( $term, $fr, $al, 1 );
 246
 247     }
 248
 249     #warn Dumper( $response );
 250     return $response;
 251 }
 252
 253 sub crossref_authority_batch {
 254     my( $self, $client, $reqs ) = @_;
 255
 256     my $response = {};
 257     my $lastr = [];
 258     my $session = OpenSRF::AppSession->create("open-ils.storage");
 259
 260     for my $req (@$reqs) {
 261
 262         my $class = $req->[0];
 263         my $term = $req->[1];
 264         next unless $class and $term;
 265         $logger->info("Sending authority request for $class : $term");
 266         my $freq = $session->request("open-ils.storage.authority.$class.see_from.controlled.atomic",$term, 10);
 267         my $areq = $session->request("open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term, 10);
 268
 269         if( $lastr->[0] ) { #process old data while waiting on new data
 270             my $cls = $lastr->[0];
 271             my $trm = $lastr->[1];
 272             my $fr  = $lastr->[2];
 273             my $al  = $lastr->[3];
 274             $response->{$cls} = {} unless exists $response->{$cls};
 275             $response->{$cls}->{$trm} = _auth_flatten( $trm, $fr, $al, 1 );
 276         }
 277
 278         $lastr->[0] = $class;
 279         $lastr->[1] = $term;
 280         $lastr->[2] = $freq->gather(1);
 281         $lastr->[3] = $areq->gather(1);
 282     }
 283
 284     if( $lastr->[0] ) { #process old data while waiting on new data
 285         my $cls = $lastr->[0];
 286         my $trm = $lastr->[1];
 287         my $fr  = $lastr->[2];
 288         my $al  = $lastr->[3];
 289         $response->{$cls} = {} unless exists $response->{$cls};
 290         $response->{$cls}->{$trm} = _auth_flatten( $trm, $fr, $al, 1);
 291     }
 292
 293     return $response;
 294 }
 295
 296
 297
 298
 299 sub crossref_authority_batch2 {
 300     my( $self, $client, $reqs ) = @_;
 301
 302     my $response = {};
 303     my $lastr = [];
 304     my $session = OpenSRF::AppSession->create("open-ils.storage");
 305
 306     $cache = OpenSRF::Utils::Cache->new('global') unless $cache;
 307
 308     for my $req (@$reqs) {
 309
 310         my $class = $req->[0];
 311         my $term = $req->[1];
 312         next unless $class and $term;
 313
 314         my $t = $term;
 315         $t =~ s/\s//og;
 316         my $cdata = $cache->get_cache("oils_authority_${class}_$t");
 317
 318         if( $cdata ) {
 319             $logger->debug("returning authority response from cache..");
 320             $response->{$class} = {} unless exists $response->{$class};
 321             $response->{$class}->{$term} = $cdata;
 322             next;
 323         }
 324
 325         $logger->debug("authority data not found in cache.. fetching from storage");
 326
 327         $logger->info("Sending authority request for $class : $term");
 328         my $freq = $session->request("open-ils.storage.authority.$class.see_from.controlled.atomic",$term, 10);
 329         my $areq = $session->request("open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term, 10);
 330         my $fr = $freq->gather(1);
 331         my $al = $areq->gather(1);
 332         $response->{$class} = {} unless exists $response->{$class};
 333         my $auth = _auth_flatten( $term, $fr, $al, 1 );
 334
 335         my $timeout = 7200; #two hours
 336         $timeout = 300 if @{$auth->{from}} or @{$auth->{also}}; # 5 minutes
 337         $response->{$class}->{$term} = $auth;
 338         $logger->debug("adding authority lookup to cache with timeout $timeout");
 339         $cache->put_cache("oils_authority_${class}_$t", $auth, $timeout);
 340     }
 341     return $response;
 342 }
 343
 344 __PACKAGE__->register_method(
 345     method        => "authority_main_entry",
 346     api_name      => "open-ils.search.authority.main_entry",
 347     stream => 1,
 348     signature     => {
 349         desc => q/
 350             Returns the main entry details for one or more authority
 351             records plus a few other details.
 352         /,
 353         params => [
 354             {desc => 'Authority IDs', type => 'number or array'}
 355         ],
 356         return => {
 357             desc => q/
 358                 Stream of authority metadata objects.
 359                 {   authority: are_object,
 360                     heading: heading_text,
 361                     thesaurus: short_code,
 362                     thesaurus_code: code,
 363                     control_set: control_set_object,
 364                     linked_bib_count: number
 365                 }
 366             /,
 367             type => 'object'
 368         }
 369     }
 370 );
 371
 372 sub authority_main_entry {
 373     my ($self, $client, $auth_ids) = @_;
 374
 375     $auth_ids = [$auth_ids] unless ref $auth_ids;
 376
 377     my $e = new_editor();
 378
 379     for my $auth_id (@$auth_ids) {
 380
 381         my $rec = $e->retrieve_authority_record_entry([
 382             $auth_id, {
 383                 flesh => 1,
 384                 flesh_fields => {are => [qw/control_set creator/]}
 385             }
 386         ]) or return $e->event;
 387
 388         my $response = {
 389             authority => $rec,
 390             control_set => $rec->control_set
 391         };
 392
 393         $response->{linked_bib_count} = $e->json_query({
 394             select => {abl => [
 395                 {column => 'bib', transform => 'count', aggregate => 1}
 396             ]},
 397             from => 'abl',
 398             where => {authority => $auth_id}
 399         })->[0]->{bib};
 400
 401         # Extract the heading and thesaurus.
 402         # In theory this data has already been extracted in the DB, but
 403         # using authority.simple_heading results in data that varies
 404         # quite a bit from the previous authority manage interface.  I
 405         # took the MARC parsing approach because it matches the logic
 406         # (and results) of the previous UI.
 407
 408         my $marc = MARC::Record->new_from_xml($rec->marc);
 409         my $heading_field = $marc->field('1..');
 410         $response->{heading} = $heading_field->as_string if $heading_field;
 411
 412         my $field_008 = $marc->field('008');
 413         if ($field_008) {
 414
 415             my $extract_thesaurus_query = {
 416                 from => [ 'authority.extract_thesaurus' => $rec->marc ]
 417             };
 418             my $thes = $e->json_query($extract_thesaurus_query)->[0]->{'authority.extract_thesaurus'};
 419
 420             if (defined $thes) {
 421                 $response->{thesaurus_code} = $thes;
 422                 my $thesaurus = $e->search_authority_thesaurus(
 423                     {code => $thes})->[0];
 424
 425                 $response->{thesaurus} = $thesaurus->short_code if $thesaurus;
 426             }
 427         }
 428
 429         $rec->clear_marc;
 430         $client->respond($response);
 431     }
 432
 433     return undef;
 434 }
 435
 436
 437
 438 1;