1 package OpenILS::WWW::EGCatLoader;
6 use OpenSRF::Utils::Logger qw/$logger/;
7 use OpenILS::Utils::CStoreEditor qw/:funcs/;
8 use OpenILS::Utils::Fieldmapper;
9 use OpenILS::Utils::Normalize qw/search_normalize/;
10 use OpenILS::Application::AppUtils;
11 use OpenSRF::Utils::JSON;
12 use OpenSRF::Utils::Cache;
13 use OpenSRF::Utils::SettingsClient;
15 use Digest::MD5 qw/md5_hex/;
16 use Apache2::Const -compile => qw/OK/;
18 use List::Util qw/first/;
20 #$Data::Dumper::Indent = 0;
22 my $U = 'OpenILS::Application::AppUtils';
26 # Plain procedural functions start here.
28 sub _init_browse_cache {
29 if (not defined $browse_cache) {
30 my $conf = new OpenSRF::Utils::SettingsClient;
32 $browse_timeout = $conf->config_value(
33 "apps", "open-ils.search", "app_settings", "cache_timeout"
35 $browse_cache = new OpenSRF::Utils::Cache("global");
39 sub _get_authority_heading {
40 my ($field, $sf_lookup) = @_;
44 map { $_->[1] } grep { $sf_lookup->{$_->[0]} } $field->subfields
48 # Object methods start here.
51 # Returns cache key and a list of parameters for DB proc metabib.browse().
52 sub prepare_browse_parameters {
55 no warnings 'uninitialized';
57 # XXX TODO add config.global_flag rows for browse limit-limit ?
60 scalar($self->cgi->param('qtype')),
61 scalar($self->cgi->param('bterm')),
62 $self->ctx->{copy_location_group_org} ||
63 $self->ctx->{aou_tree}->()->id,
64 $self->ctx->{copy_location_group},
65 $self->ctx->{is_staff} ? 't' : 'f',
66 scalar($self->cgi->param('bpivot')),
68 $self->cgi->param('blimit') ||
69 $self->ctx->{opac_hits_per_page} || 10
74 "oils_browse_" . md5_hex(OpenSRF::Utils::JSON->perl2JSON(\@params)),
79 # Break out any Public General Notes (field 680) for display. These are
80 # sometimes (erroneously?) called "scope notes." I say erroneously,
81 # tentatively, because LoC doesn't seem to document a "scope notes"
82 # field for authority records, while it does so for classification
83 # records, which are something else. But I am not a librarian.
84 sub extract_public_general_notes {
85 my ($self, $record, $row) = @_;
87 # Make a list of strings, each string being a concatentation of any
88 # subfields 'i', '5', or 'a' from one field 680, in order of appearance.
93 map { $_->[1] } grep { $_->[0] =~ /[i5a]/ } $_->subfields
95 } $record->field('680')
99 sub find_authority_headings_and_notes {
100 my ($self, $row) = @_;
103 $self->ctx->{get_authority_fields}->($row->{control_set});
105 $row->{headings} = [];
109 $record = new_from_xml MARC::Record($row->{marc});
112 $logger->warn("Problem with MARC from authority record #" .
113 $row->{id} . ": $@");
114 return $row; # We're called in map(), so we must move on without
118 $self->extract_public_general_notes($record, $row);
120 # By applying grep in this way, we get acsaf objects that *have* and
121 # therefore *aren't* main entries, which is what we want.
122 foreach my $acsaf (grep { $_->main_entry } values(%$acsaf_table)) {
123 my @fields = $record->field($acsaf->tag);
124 my %sf_lookup = map { $_ => 1 } split("", $acsaf->display_sf_list);
127 foreach my $field (@fields) {
128 my $h = { heading => _get_authority_heading($field, \%sf_lookup) };
130 # XXX I was getting "target" from authority.authority_linking, but
131 # that makes no sense: that table can only tell you that one
132 # authority record as a whole points at another record. It does
133 # not record when a specific *field* in one authority record
134 # points to another record (not that it makes much sense for
135 # one authority record to have links to multiple others, but I can't
136 # say there definitely aren't cases for that).
138 if ($field->subfield('0') || "") =~ /(^|\))(\d+)$/;
143 push @{$row->{headings}}, {$acsaf->id => \@headings} if @headings;
149 sub map_authority_headings_to_results {
150 my ($self, $linked, $results, $auth_ids) = @_;
152 # Use the linked authority records' control sets to find and pick
153 # out non-main-entry headings. Build the headings and make a
154 # combined data structure for the template's use.
155 my %linked_headings_by_auth_id = map {
156 $_->{id} => $self->find_authority_headings_and_notes($_)
159 # Graft this authority heading data onto our main result set at the
160 # "authorities" column.
161 foreach my $row (@$results) {
162 $row->{authorities} = [
163 map { $linked_headings_by_auth_id{$_} } @{$row->{authorities}}
167 # Get linked-bib counts for each of those authorities, and put THAT
168 # information into place in the data structure.
169 my $counts = $self->editor->json_query({
172 {column => "id", transform => "count",
173 alias => "count", aggregate => 1},
182 $U->unique_unnested_numbers(map { $_->{target} } @$linked)
188 my %auth_counts = map { $_->{authority} => $_->{count} } @$counts;
190 # Soooo nesty! We look for places where we'll need a count of bibs
191 # linked to an authority record, and put it there for the template to find.
192 for my $row (@$results) {
193 for my $auth (@{$row->{authorities}}) {
194 if ($auth->{headings}) {
195 for my $outer_heading (@{$auth->{headings}}) {
196 for my $heading_blob (@{(values %$outer_heading)[0]}) {
197 if ($heading_blob->{target}) {
198 $heading_blob->{target_count} =
199 $auth_counts{$heading_blob->{target}};
208 # flesh_browse_results() attaches data from authority records. It
209 # changes $results and returns 1 for success, undef for failure (in which
210 # case $self->editor->event should always point to the reason for failure).
211 # $results must be an arrayref of result rows from the DB's metabib.browse()
212 sub flesh_browse_results {
213 my ($self, $results) = @_;
215 # Turn comma-seprated strings of numbers in "authorities" column
217 $_->{authorities} = [split /,/, $_->{authorities}] foreach @$results;
219 # Group them in one arrray, not worrying about dupes because we're about
220 # to use them in an IN () comparison in a SQL query.
221 my @auth_ids = map { @{$_->{authorities}} } @$results;
224 # Get all linked authority records themselves
225 my $linked = $self->editor->json_query({
227 are => [qw/id marc control_set/],
228 aalink => [{column => "target", transform => "array_agg",
235 fkey => "id", field => "source"
239 where => {"+are" => {id => \@auth_ids}}
242 $self->map_authority_headings_to_results($linked, $results, \@auth_ids);
248 sub load_browse_impl {
249 my ($self, @params) = @_;
251 my $results = $self->editor->json_query({
252 from => [ "metabib.browse", @params ]
255 if (not $results) { # DB error, not empty result set.
257 "error in browse (direct): " . $self->editor->event->{textcode}
259 $self->ctx->{browse_error} = 1;
262 } elsif (not $self->flesh_browse_results($results)) {
264 "error in browse (flesh): " . $self->editor->event->{textcode}
266 $self->ctx->{browse_error} = 1;
274 # Find paging information, put it into $self->ctx, and return "real"
275 # rows from $results, excluding those that contain only paging
277 sub infer_browse_paging {
278 my ($self, $results) = @_;
280 foreach (@$results) {
281 if ($_->{pivot_point}) {
282 if ($_->{row_number} < 0) { # sic
283 $self->ctx->{forward_pivot} = $_->{pivot_point};
285 $self->ctx->{back_pivot} = $_->{pivot_point};
290 return [ grep { not defined $_->{pivot_point} } @$results ];
293 sub leading_article_test {
294 my ($self, $qtype, $bterm) = @_;
296 my $flag_name = "opac.browse.warnable_regexp_per_class";
297 my $flag = $self->ctx->{get_cgf}->($flag_name);
299 return unless $flag->enabled eq 't';
303 eval { $map = OpenSRF::Utils::JSON->JSON2perl($flag->value); };
305 $logger->warn("cgf '$flag_name' enabled but value is invalid JSON? $@");
309 # Don't crash over any of the things that could go wrong in here:
311 if ($map->{$qtype}) {
312 if ($bterm =~ qr/$map->{$qtype}/i) {
313 $self->ctx->{browse_leading_article_warning} = 1;
314 ($self->ctx->{browse_leading_article_alternative} = $bterm) =~
320 $logger->warn("cgf '$flag_name' has valid JSON in value, but: $@");
327 _init_browse_cache();
329 # If there's a user logged in, flesh extended user info so we can get
330 # her opac.hits_per_page setting, if any.
331 if ($self->ctx->{user}) {
332 $self->prepare_extended_user_info('settings');
333 if (my $setting = first { $_->name eq 'opac.hits_per_page' }
334 @{$self->ctx->{user}->settings}) {
336 $self->ctx->{opac_hits_per_page} =
337 int(OpenSRF::Utils::JSON->JSON2perl($setting->value));
341 if ($self->cgi->param('qtype') and defined $self->cgi->param('bterm')) {
343 $self->leading_article_test(
344 $self->cgi->param('qtype'),
345 $self->cgi->param('bterm')
348 my ($cache_key, @params) = $self->prepare_browse_parameters;
350 my $results = $browse_cache->get_cache($cache_key);
352 $results = $self->load_browse_impl(@params);
354 $browse_cache->put_cache($cache_key, $results, $browse_timeout);
359 $self->ctx->{browse_results} = $self->infer_browse_paging($results);
362 # We don't need an else clause to send the user a 5XX error or
363 # anything. Errors will have been logged, and $ctx will be
364 # prepared so a template can show a nicer error to the user.
367 return Apache2::Const::OK;