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

   1 package OpenILS::Application::Search::Browse;
   2 use base qw/OpenILS::Application/;
   3 use strict; use warnings;
   4
   5 # Most of this code is copied directly from ../../WWW/EGCatLoader/Browse.pm
   6 # and modified to be API-compatible.
   7
   8 use Digest::MD5 qw/md5_hex/;
   9 use Apache2::Const -compile => qw/OK/;
  10 use MARC::Record;
  11 use List::Util qw/first/;
  12
  13 use OpenSRF::Utils::Logger qw/$logger/;
  14 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  15 use OpenILS::Utils::Fieldmapper;
  16 use OpenILS::Utils::Normalize qw/search_normalize/;
  17 use OpenILS::Application::AppUtils;
  18 use OpenSRF::Utils::JSON;
  19 use OpenSRF::Utils::Cache;
  20 use OpenSRF::Utils::SettingsClient;
  21
  22 my $U = 'OpenILS::Application::AppUtils';
  23 my $browse_cache;
  24 my $browse_timeout;
  25
  26 sub initialize { return 1; }
  27
  28 sub child_init {
  29     if (not defined $browse_cache) {
  30         my $conf = new OpenSRF::Utils::SettingsClient;
  31
  32         $browse_timeout = $conf->config_value(
  33             "apps", "open-ils.search", "app_settings", "cache_timeout"
  34         ) || 300;
  35         $browse_cache = new OpenSRF::Utils::Cache("global");
  36     }
  37 }
  38
  39 __PACKAGE__->register_method(
  40     method      => "browse",
  41     api_name    => "open-ils.search.browse.staff",
  42     stream      => 1,
  43     signature   => {
  44         desc    => q/Bib + authority browse/,
  45         params  => [{
  46             params => {
  47                 name => 'Browse Parameters',
  48                 desc => q/Hash of arguments:
  49                     browse_class
  50                         -- title, author, subject, series
  51                     term
  52                         -- term to browse for
  53                     org_unit
  54                         -- context org unit ID
  55                     copy_location_group
  56                         -- copy location filter ID
  57                     limit
  58                         -- return this many results
  59                     pivot
  60                         -- browse entry ID
  61                 /
  62             }
  63         }]
  64     }
  65 );
  66
  67 __PACKAGE__->register_method(
  68     method      => "browse",
  69     api_name    => "open-ils.search.browse",
  70     stream      => 1,
  71     signature   => {
  72         desc    => q/See open-ils.search.browse.staff/
  73     }
  74 );
  75
  76 sub browse {
  77     my ($self, $client, $params) = @_;
  78
  79     $params->{staff} = 1 if $self->api_name =~ /staff/;
  80     my ($cache_key, @params) = prepare_browse_parameters($params);
  81
  82     my $results = $browse_cache->get_cache($cache_key);
  83
  84     if (!$results) {
  85         $results =
  86             new_editor()->json_query({from => ['metabib.browse', @params]});
  87         if ($results) {
  88             $browse_cache->put_cache($cache_key, $results, $browse_timeout);
  89         }
  90     }
  91
  92     my ($warning, $alternative) =
  93         leading_article_test($params->{browse_class}, $params->{term});
  94
  95     for my $result (@$results) {
  96         $result->{leading_article_warning} = $warning;
  97         $result->{leading_article_alternative} = $alternative;
  98         flesh_browse_results([$result]);
  99         $client->respond($result);
 100     }
 101
 102     return undef;
 103 }
 104
 105
 106 # Returns cache key and a list of parameters for DB proc metabib.browse().
 107 sub prepare_browse_parameters {
 108     my ($params) = @_;
 109
 110     no warnings 'uninitialized';
 111
 112     my @params = (
 113         $params->{browse_class},
 114         $params->{term},
 115         $params->{org_unit},
 116         $params->{copy_location_group},
 117         $params->{staff} ? 't' : 'f',
 118         $params->{pivot},
 119         $params->{limit} || 10
 120     );
 121
 122     return (
 123         "oils_browse_" . md5_hex(OpenSRF::Utils::JSON->perl2JSON(\@params)),
 124         @params
 125     );
 126 }
 127
 128 sub leading_article_test {
 129     my ($browse_class, $bterm) = @_;
 130
 131     my $flag_name = "opac.browse.warnable_regexp_per_class";
 132     my $flag = new_editor()->retrieve_config_global_flag($flag_name);
 133
 134     return unless $flag->enabled eq 't';
 135
 136     my $map;
 137     my $warning;
 138     my $alternative;
 139
 140     eval { $map = OpenSRF::Utils::JSON->JSON2perl($flag->value); };
 141     if ($@) {
 142         $logger->warn("cgf '$flag_name' enabled but value is invalid JSON? $@");
 143         return;
 144     }
 145
 146     # Don't crash over any of the things that could go wrong in here:
 147     eval {
 148         if ($map->{$browse_class}) {
 149             if ($bterm =~ qr/$map->{$browse_class}/i) {
 150                 $warning = 1;
 151                 ($alternative = $bterm) =~ s/$map->{$browse_class}//;
 152             }
 153         }
 154     };
 155
 156     if ($@) {
 157         $logger->warn("cgf '$flag_name' has valid JSON in value, but: $@");
 158     }
 159
 160     return ($warning, $alternative);
 161 }
 162
 163 # flesh_browse_results() attaches data from authority records. It
 164 # changes $results and returns 1 for success, undef for failure
 165 # $results must be an arrayref of result rows from the DB's metabib.browse()
 166 sub flesh_browse_results {
 167     my ($results) = @_;
 168
 169     for my $authority_field_name ( qw/authorities sees/ ) {
 170         for my $r (@$results) {
 171             # Turn comma-seprated strings of numbers in "authorities" and "sees"
 172             # columns into arrays.
 173             if ($r->{$authority_field_name}) {
 174                 $r->{$authority_field_name} = [split /,/, $r->{$authority_field_name}];
 175             } else {
 176                 $r->{$authority_field_name} = [];
 177             }
 178             $r->{"list_$authority_field_name"} = [ @{$r->{$authority_field_name} } ];
 179         }
 180
 181         # Group them in one arrray, not worrying about dupes because we're about
 182         # to use them in an IN () comparison in a SQL query.
 183         my @auth_ids = map { @{$_->{$authority_field_name}} } @$results;
 184
 185         if (@auth_ids) {
 186             # Get all linked authority records themselves
 187             my $linked = new_editor()->json_query({
 188                 select => {
 189                     are => [qw/id marc control_set/],
 190                     aalink => [{column => "target", transform => "array_agg",
 191                         aggregate => 1}]
 192                 },
 193                 from => {
 194                     are => {
 195                         aalink => {
 196                             type => "left",
 197                             fkey => "id", field => "source"
 198                         }
 199                     }
 200                 },
 201                 where => {"+are" => {id => \@auth_ids}}
 202             }) or return;
 203
 204             map_authority_headings_to_results(
 205                 $linked, $results, \@auth_ids, $authority_field_name);
 206         }
 207     }
 208
 209     return 1;
 210 }
 211
 212 sub map_authority_headings_to_results {
 213     my ($linked, $results, $auth_ids, $authority_field_name) = @_;
 214
 215     # Use the linked authority records' control sets to find and pick
 216     # out non-main-entry headings. Build the headings and make a
 217     # combined data structure for the template's use.
 218     my %linked_headings_by_auth_id = map {
 219         $_->{id} => find_authority_headings_and_notes($_)
 220     } @$linked;
 221
 222     # Avoid sending the full MARC blobs to the caller.
 223     delete $_->{marc} for @$linked;
 224
 225     # Graft this authority heading data onto our main result set at the
 226     # named column, either "authorities" or "sees".
 227     foreach my $row (@$results) {
 228         $row->{$authority_field_name} = [
 229             map { $linked_headings_by_auth_id{$_} } @{$row->{$authority_field_name}}
 230         ];
 231     }
 232
 233     # Get linked-bib counts for each of those authorities, and put THAT
 234     # information into place in the data structure.
 235     my $counts = new_editor()->json_query({
 236         select => {
 237             abl => [
 238                 {column => "id", transform => "count",
 239                     alias => "count", aggregate => 1},
 240                 "authority"
 241             ]
 242         },
 243         from => {abl => {}},
 244         where => {
 245             "+abl" => {
 246                 authority => [
 247                     @$auth_ids,
 248                     $U->unique_unnested_numbers(map { $_->{target} } @$linked)
 249                 ]
 250             }
 251         }
 252     }) or return;
 253
 254     my %auth_counts = map { $_->{authority} => $_->{count} } @$counts;
 255
 256     # Soooo nesty!  We look for places where we'll need a count of bibs
 257     # linked to an authority record, and put it there for the template to find.
 258     for my $row (@$results) {
 259         for my $auth (@{$row->{$authority_field_name}}) {
 260             if ($auth->{headings}) {
 261                 for my $outer_heading (@{$auth->{headings}}) {
 262                     for my $heading_blob (@{(values %$outer_heading)[0]}) {
 263                         if ($heading_blob->{target}) {
 264                             $heading_blob->{target_count} =
 265                                 $auth_counts{$heading_blob->{target}};
 266                         }
 267                     }
 268                 }
 269             }
 270         }
 271     }
 272 }
 273
 274
 275 # TOOD consider locale-aware caching
 276 sub get_acsaf {
 277     my $control_set = shift;
 278
 279     my $acs = new_editor()
 280         ->search_authority_control_set_authority_field(
 281             {control_set => $control_set}
 282         );
 283
 284     return {  map { $_->id => $_ } @$acs };
 285 }
 286
 287 sub find_authority_headings_and_notes {
 288     my ($row) = @_;
 289
 290     my $acsaf_table = get_acsaf($row->{control_set});
 291
 292     $row->{headings} = [];
 293
 294     my $record;
 295     eval {
 296         $record = new_from_xml MARC::Record($row->{marc});
 297     };
 298
 299     if ($@) {
 300         $logger->warn("Problem with MARC from authority record #" .
 301             $row->{id} . ": $@");
 302         return $row;    # We're called in map(), so we must move on without
 303                         # a fuss.
 304     }
 305
 306     extract_public_general_notes($record, $row);
 307
 308     # extract headings from the main authority record along with their
 309     # types
 310     my $parsed_headings = new_editor()->json_query({
 311         from => ['authority.extract_headings', $row->{marc}]
 312     });
 313     my %heading_type_map = ();
 314     if ($parsed_headings) {
 315         foreach my $h (@$parsed_headings) {
 316             $heading_type_map{$h->{normalized_heading}} =
 317                 $h->{purpose} eq 'variant' ? 'variant' :
 318                 $h->{purpose} eq 'related' ? $h->{related_type} :
 319                 '';
 320         }
 321     }
 322
 323     # By applying grep in this way, we get acsaf objects that *have* and
 324     # therefore *aren't* main entries, which is what we want.
 325     foreach my $acsaf (values(%$acsaf_table)) {
 326         my @fields = $record->field($acsaf->tag);
 327         my %sf_lookup = map { $_ => 1 } split("", $acsaf->display_sf_list);
 328         my @headings;
 329
 330         foreach my $field (@fields) {
 331             my $h = { main_entry => ( $acsaf->main_entry ? 0 : 1 ),
 332                       heading => get_authority_heading($field, \%sf_lookup, $acsaf->joiner) };
 333
 334             my $norm = search_normalize($h->{heading});
 335             if (exists $heading_type_map{$norm}) {
 336                 $h->{type} = $heading_type_map{$norm};
 337             }
 338             # XXX I was getting "target" from authority.authority_linking, but
 339             # that makes no sense: that table can only tell you that one
 340             # authority record as a whole points at another record.  It does
 341             # not record when a specific *field* in one authority record
 342             # points to another record (not that it makes much sense for
 343             # one authority record to have links to multiple others, but I can't
 344             # say there definitely aren't cases for that).
 345             $h->{target} = $2
 346                 if ($field->subfield('0') || "") =~ /(^|\))(\d+)$/;
 347
 348             # The target is the row id if this is a main entry...
 349             $h->{target} = $row->{id} if $h->{main_entry};
 350
 351             push @headings, $h;
 352         }
 353
 354         push @{$row->{headings}}, {$acsaf->id => \@headings} if @headings;
 355     }
 356
 357     return $row;
 358 }
 359
 360
 361 # Break out any Public General Notes (field 680) for display. These are
 362 # sometimes (erroneously?) called "scope notes." I say erroneously,
 363 # tentatively, because LoC doesn't seem to document a "scope notes"
 364 # field for authority records, while it does so for classification
 365 # records, which are something else. But I am not a librarian.
 366 sub extract_public_general_notes {
 367     my ($record, $row) = @_;
 368
 369     # Make a list of strings, each string being a concatentation of any
 370     # subfields 'i', '5', or 'a' from one field 680, in order of appearance.
 371     $row->{notes} = [
 372         map {
 373             join(
 374                 " ",
 375                 map { $_->[1] } grep { $_->[0] =~ /[i5a]/ } $_->subfields
 376             )
 377         } $record->field('680')
 378     ];
 379 }
 380
 381 sub get_authority_heading {
 382     my ($field, $sf_lookup, $joiner) = @_;
 383
 384     $joiner ||= ' ';
 385
 386     return join(
 387         $joiner,
 388         map { $_->[1] } grep { $sf_lookup->{$_->[0]} } $field->subfields
 389     );
 390 }
 391
 392 1;