1 package OpenILS::Application::Cat::Authority;
2 use strict; use warnings;
4 use MARC::File::XML (BinaryEncoding => 'utf8', RecordFormat => 'USMARC');
5 use base qw/OpenILS::Application/;
6 use OpenILS::Utils::CStoreEditor q/:funcs/;
7 use OpenILS::Application::Cat::AuthCommon;
8 use OpenSRF::Utils::Logger qw($logger);
9 use OpenILS::Application::AppUtils;
10 use OpenILS::Utils::Fieldmapper;
11 use OpenILS::Const qw/:const/;
13 my $U = 'OpenILS::Application::AppUtils';
14 my $MARC_NAMESPACE = 'http://www.loc.gov/MARC21/slim';
17 # generate a MARC XML document from a MARC XML string
20 my $marc_doc = XML::LibXML->new->parse_string($xml);
21 $marc_doc->documentElement->setNamespace($MARC_NAMESPACE, 'marc', 1);
22 $marc_doc->documentElement->setNamespace($MARC_NAMESPACE);
27 __PACKAGE__->register_method(
28 method => 'import_authority_record',
29 api_name => 'open-ils.cat.authority.record.import',
32 sub import_authority_record {
33 my($self, $conn, $auth, $marc_xml, $source) = @_;
34 my $e = new_editor(authtoken=>$auth, xact=>1);
35 return $e->die_event unless $e->checkauth;
36 return $e->die_event unless $e->allowed('CREATE_AUTHORITY_RECORD');
37 my $rec = OpenILS::Application::Cat::AuthCommon->
38 import_authority_record($e, $marc_xml, $source);
39 $e->commit unless $U->event_code($rec);
43 __PACKAGE__->register_method(
44 method => 'create_authority_record_from_bib_field',
45 api_name => 'open-ils.cat.authority.record.create_from_bib',
47 desc => q/Create an authority record entry from a field in a bibliographic record/,
49 @param field A hash representing the field to control, consisting of: { tag: string, ind1: string, ind2: string, subfields: [ [code, value] ... ] }
50 @param identifier A MARC control number identifier
51 @param authtoken A valid authentication token
52 @returns The new record object
56 __PACKAGE__->register_method(
57 method => 'create_authority_record_from_bib_field',
58 api_name => 'open-ils.cat.authority.record.create_from_bib.readonly',
60 desc => q/Creates MARCXML for an authority record entry from a field in a bibliographic record/,
62 @param field A hash representing the field to control, consisting of: { tag: string, ind1: string, ind2: string, subfields: [ [code, value] ... ] }
63 @param identifier A MARC control number identifier
64 @returns The MARCXML for the authority record
68 sub create_authority_record_from_bib_field {
69 my($self, $conn, $field, $cni, $auth) = @_;
71 # Control number identifier should have been passed in
76 # Change the first character of the incoming bib field tag to a '1'
77 # for use in our authority record; close enough for now?
78 my $tag = $field->{'tag'};
81 my $ind1 = $field->{ind1} || ' ';
82 my $ind2 = $field->{ind2} || ' ';
84 my $control = qq{<datafield tag="$tag" ind1="$ind1" ind2="$ind2">};
85 foreach my $sf (@{$field->{subfields}}) {
87 my $val = $U->entityize($sf->[1]);
88 $control .= qq{<subfield code="$code">$val</subfield>};
90 $control .= '</datafield>';
92 # ARN, or "authority record number", used to need to be unique across the database.
93 # Of course, we have no idea what's in the database, and if the
94 # cat.maintain_control_numbers flag is set to "TRUE" then the 001 will
95 # be reset to the record ID anyway.
96 my $arn = 'AUTOGEN-' . time();
98 # Placeholder MARCXML;
99 # 001/003 can be be properly filled in via database triggers
100 # 005 will be filled in automatically at creation time
101 # 008 needs to be set by a cataloguer (could be some OU settings, I suppose)
102 # 040 should come from OU settings / OU shortname
104 my $marc_xml = <<MARCXML;
105 <record xmlns:marc="http://www.loc.gov/MARC21/slim" xmlns="http://www.loc.gov/MARC21/slim"><leader> nz a22 o 4500</leader>
106 <controlfield tag="001">$arn</controlfield>
107 <controlfield tag="008"> ||||||||||||||||||||||||||||||||||</controlfield>
108 <datafield tag="040" ind1=" " ind2=" "><subfield code="a">$cni</subfield><subfield code="c">$cni</subfield></datafield>
113 if ($self->api_name =~ m/readonly$/) {
116 my $e = new_editor(authtoken=>$auth, xact=>1);
117 return $e->die_event unless $e->checkauth;
118 return $e->die_event unless $e->allowed('CREATE_AUTHORITY_RECORD');
119 my $rec = OpenILS::Application::Cat::AuthCommon->import_authority_record($e, $marc_xml);
120 $e->commit unless $U->event_code($rec);
125 __PACKAGE__->register_method(
126 method => 'overlay_authority_record',
127 api_name => 'open-ils.cat.authority.record.overlay',
130 sub overlay_authority_record {
131 my($self, $conn, $auth, $rec_id, $marc_xml, $source) = @_;
132 my $e = new_editor(authtoken=>$auth, xact=>1);
133 return $e->die_event unless $e->checkauth;
134 return $e->die_event unless $e->allowed('UPDATE_AUTHORITY_RECORD');
135 my $rec = OpenILS::Application::Cat::AuthCommon->
136 overlay_authority_record($e, $rec_id, $marc_xml, $source);
137 $e->commit unless $U->event_code($rec);
141 __PACKAGE__->register_method(
142 method => 'retrieve_authority_record',
143 api_name => 'open-ils.cat.authority.record.retrieve',
145 desc => q/Retrieve an authority record entry/,
147 {desc => q/hash of options. Options include "clear_marc" which clears
148 the MARC xml from the record before it is returned/}
152 sub retrieve_authority_record {
153 my($self, $conn, $auth, $rec_id, $options) = @_;
154 my $e = new_editor(authtoken=>$auth);
155 return $e->die_event unless $e->checkauth;
156 my $rec = $e->retrieve_authority_record_entry($rec_id) or return $e->event;
157 $rec->clear_marc if $$options{clear_marc};
161 __PACKAGE__->register_method(
162 method => 'batch_retrieve_authority_record',
163 api_name => 'open-ils.cat.authority.record.batch.retrieve',
166 desc => q/Retrieve a set of authority record entry objects/,
168 {desc => q/hash of options. Options include "clear_marc" which clears
169 the MARC xml from the record before it is returned/}
173 sub batch_retrieve_authority_record {
174 my($self, $conn, $auth, $rec_id_list, $options) = @_;
175 my $e = new_editor(authtoken=>$auth);
176 return $e->die_event unless $e->checkauth;
177 for my $rec_id (@$rec_id_list) {
178 my $rec = $e->retrieve_authority_record_entry($rec_id) or return $e->event;
179 $rec->clear_marc if $$options{clear_marc};
180 $conn->respond($rec);
185 __PACKAGE__->register_method(
186 method => 'count_linked_bibs',
187 api_name => 'open-ils.cat.authority.records.count_linked_bibs',
189 Counts the number of bib records linked to each authority record in the input list
190 @param records Array of authority records to return counts
191 @return A list of hashes containing the authority record ID ("id") and linked bib count ("bibs")
195 sub count_linked_bibs {
196 my( $self, $conn, $records ) = @_;
198 my $editor = new_editor();
202 for my $auth ( @$records ) {
203 # Protection against SQL injection? Might be overkill.
204 my $intauth = int($auth);
206 push(@clean_records, $intauth);
209 return $link_count if !@clean_records;
211 $link_count = $editor->json_query({
215 "column" => "authority"
219 "transform" => "count",
226 "where" => { "authority" => \@clean_records }
232 __PACKAGE__->register_method(
233 "method" => "retrieve_acs",
234 "api_name" => "open-ils.cat.authority.control_set.retrieve",
239 "desc" => q/Retrieve authority.control_set objects with fleshed
240 thesauri and authority fields/,
242 {"name" => "limit", "desc" => "limit (optional; default 15)", "type" => "number"},
243 {"name" => "offset", "desc" => "offset doptional; default 0)", "type" => "number"},
244 {"name" => "focus", "desc" => "optionally make sure the acs object with ID matching this value comes at the top of the result set (only works with offset 0)", "type" => "number"}
249 # XXX I don't think this really needs to be protected by perms, or does it?
254 my ($limit, $offset, $focus) = map int, @_;
262 {"class" => "acs", "field" => "name"}
265 # Here is the magic that let's us say that a given acsaf
266 # will be our first result.
267 unshift @$order_by, {
268 "class" => "acs", "field" => "id",
269 "transform" => "numeric_eq", "params" => [$focus],
270 "direction" => "desc"
273 my $sets = $e->search_authority_control_set([
274 {"id" => {"!=" => undef}}, {
276 "flesh_fields" => {"acs" => [qw/thesauri authority_fields/]},
277 "order_by" => $order_by,
281 ]) or return $e->die_event;
285 $client->respond($_) foreach @$sets;
289 __PACKAGE__->register_method(
290 "method" => "retrieve_acsaf",
291 "api_name" => "open-ils.cat.authority.control_set_authority_field.retrieve",
296 "desc" => q/Retrieve authority.control_set_authority_field objects with
297 fleshed bib_fields and axes/,
299 {"name" => "limit", "desc" => "limit (optional; default 15)", "type" => "number"},
300 {"name" => "offset", "desc" => "offset (optional; default 0)", "type" => "number"},
301 {"name" => "control_set", "desc" => "optionally constrain by value of acsaf.control_set field", "type" => "number"},
302 {"name" => "focus", "desc" => "optionally make sure the acsaf object with ID matching this value comes at the top of the result set (only works with offset 0)"}
311 my ($limit, $offset, $control_set, $focus) = map int, @_;
315 $control_set ||= undef;
320 "control_set" => ($control_set ? $control_set : {"!=" => undef})
323 {"class" => "acsaf", "field" => "main_entry", "direction" => "desc"},
324 {"class" => "acsaf", "field" => "id"}
327 unshift @$order_by, {
328 "class" => "acsaf", "field" => "id",
329 "transform" => "numeric_eq", "params" => [$focus],
330 "direction" => "desc"
333 my $fields = $e->search_authority_control_set_authority_field([
337 "acsaf" => ["bib_fields", "axis_maps"],
340 "order_by" => $order_by,
344 ]) or return $e->die_event;
348 $client->respond($_) foreach @$fields;
352 __PACKAGE__->register_method(
353 method => "bib_field_overlay_authority_field",
354 api_name => "open-ils.cat.authority.bib_field.overlay_authority",
359 desc => q/Given a bib field hash and an authority field hash,
360 merge the authority data for controlled fields into the
363 {name => 'Bib Field',
364 desc => '{tag:., ind1:., ind2:.,subfields:[[code, value],...]}'},
365 {name => 'Authority Field',
366 desc => '{tag:., ind1:., ind2:.,subfields:[[code, value],...]}'},
367 {name => 'Control Set ID',
368 desc => q/Optional control set limiter. If no control set
369 is provided, the first matching authority field
370 definition will be used./}
372 return => q/The modified bib field/
376 # Returns the first found field.
377 sub get_auth_field_by_tag {
378 my ($atag, $cset_id) = @_;
380 my $e = new_editor();
382 my $where = {tag => $atag};
384 $where->{control_set} = $cset_id if $cset_id;
386 return $e->search_authority_control_set_authority_field($where)->[0];
389 sub bib_field_overlay_authority_field {
390 my ($self, $client, $bib_field, $auth_field, $cset_id) = @_;
392 return $bib_field unless $bib_field && $auth_field;
394 my $btag = $bib_field->{'tag'};
395 my $atag = $auth_field->{'tag'};
397 # Find the controlled subfields. Here we assume the authority
398 # field provided should be used as the source of which subfields
399 # are controlled. If passed a set of bib and auth data that are
400 # not consistent with the control set, it may produce unexpected
403 my $acsaf = get_auth_field_by_tag($atag, $cset_id);
406 $sf_list = $acsaf->sf_list;
411 (my $alt_atag = $atag) =~ s/^./1/;
412 $acsaf = get_auth_field_by_tag($alt_atag, $cset_id) if $alt_atag ne $atag;
414 $sf_list = $acsaf->sf_list if $acsaf;
420 # Add the controlled authority subfields
421 for my $sf (@{$auth_field->{subfields}}) {
422 my $c = $sf->[0]; # subfield code
423 my $v = $sf->[1]; # subfield value
428 } elsif (index($sf_list, $c) > -1) {
429 push(@$subfields, [$c, $v]);
433 # Add the uncontrolled bib subfields
434 for my $sf (@{$bib_field->{subfields}}) {
435 my $c = $sf->[0]; # subfield code
436 my $v = $sf->[1]; # subfield value
438 # Discard the bib '0' since the link is no longer valid,
439 # given we're replacing the contents of the field.
440 if (index($sf_list, $c) < 0 && $c ne '0') {
441 push(@$subfields, [$c, $v]);
445 # The data on this authority field may link to yet
446 # another authority record. Track that in our bib field
447 # as the last subfield;
448 push(@$subfields, ['0', $auth_sf_zero]) if $auth_sf_zero;
450 my $new_bib_field = {
451 tag => $bib_field->{tag},
452 ind1 => $auth_field->{'ind1'},
453 ind2 => $auth_field->{'ind2'},
454 subfields => $subfields
457 $new_bib_field->{ind1} = $auth_field->{'ind2'}
458 if $atag eq '130' && $btag eq '130';
460 return $new_bib_field;
463 __PACKAGE__->register_method(
464 method => "validate_bib_fields",
465 api_name => "open-ils.cat.authority.validate.bib_field",
468 desc => q/Returns a stream of bib field objects with a 'valid'
469 attribute added, set to 1 or 0, indicating whether the field
470 has a matching authority entry. If no control set ID is provided
471 all configured control sets will be tested. Testing will stop
472 with the first positive validation./,
474 {type => 'object', name => 'Bib Fields',
476 List of objects like this
481 subfields: [[code, value], ...]
485 srfsh# request open-ils.cat open-ils.cat.authority.validate.bib_field
486 [{"tag":"600","ind1":"", "ind2":"", "subfields":[["a","shakespeare william"], ...]}]
489 {type => 'number', name => 'Optional Control Set ID'},
494 # for stub records sent to
495 # open-ils.cat.authority.simple_heading
496 my $auth_leader = '00000czm a2200205Ka 4500';
498 sub validate_bib_fields {
499 my ($self, $client, $bib_fields, $control_set) = @_;
501 $bib_fields = [$bib_fields] unless ref $bib_fields eq 'ARRAY';
503 my $e = new_editor();
505 for my $bib_field (@$bib_fields) {
507 $bib_field->{valid} = 0;
509 my $where = {'+acsbf' => {tag => $bib_field->{tag}}};
510 $where->{'+acsaf'} = {control_set => $control_set} if $control_set;
512 my $auth_field_list = $e->json_query({
514 acsbf => ['authority_field'],
515 acsaf => ['id', 'tag', 'sf_list', 'control_set']
517 from => {acsbf => {acsaf => {}}},
520 {class => 'acsaf', field => 'main_entry', direction => 'desc'},
521 {class => 'acsaf', field => 'tag'}
526 for my $auth_field (@$auth_field_list) {
528 my $sf_list = $auth_field->{sf_list};
530 # Some auth fields have the same sf_list values. Track the
531 # ones we've already tested.
532 next if grep {$_ eq $sf_list} @seen_subfields;
534 push(@seen_subfields, $sf_list);
537 for my $subfield (@{$bib_field->{subfields}}) {
538 my $code = $subfield->[0];
539 my $value = $subfield->[1];
541 next unless defined $value && $value ne '';
543 # is this a controlled subfield?
544 next unless index($sf_list, $code) > -1;
546 push(@sf_values, $code, $value);
549 next unless @sf_values;
551 my $record = MARC::Record->new;
552 $record->leader($auth_leader);
554 my $field = MARC::Field->new($auth_field->{tag},
555 $bib_field->{ind1}, $bib_field->{ind2}, @sf_values);
557 $record->append_fields($field);
559 my $match = $U->simplereq(
561 'open-ils.search.authority.simple_heading.from_xml',
562 $record->as_xml_record, $control_set);
565 $bib_field->{valid} = 1;
566 $bib_field->{authority_record} = $match;
567 $bib_field->{authority_field} = $auth_field->{id};
568 $bib_field->{control_set} = $auth_field->{control_set};
573 # Present our findings.
574 $client->respond($bib_field);
581 __PACKAGE__->register_method(
582 method => "bib_field_authority_linking_browse",
583 api_name => "open-ils.cat.authority.bib_field.linking_browse",
586 desc => q/Returns a stream of authority record blobs including
587 information on its main heading and its see froms and see
588 alsos, based on an axis-based browse search. This was
589 initially created to move some MARC editor authority linking
590 logic to the server. The browse axis is derived from the
591 bib field data provided.
595 {type => 'object', name => 'MARC Field hash {tag:.,ind1:.,ind2:,subfields:[[code,value],.]}'},
596 {type => 'number', name => 'Page size / limit'},
597 {type => 'number', name => 'Page offset'},
598 {type => 'string', name => 'Optional thesauri, comma separated'}
603 sub get_heading_string {
607 for my $subfield ($field->subfields) {
608 $heading .= ' --' if index('xyz', $subfield->[0]) > -1;
609 $heading .= ' ' if $heading;
610 $heading .= $subfield->[1];
616 # Turns a MARC::Field into a hash and adds the field's heading string.
620 heading => get_heading_string($field),
622 ind1 => $field->indicator(1),
623 ind2 => $field->indicator(2),
624 subfields => [$field->subfields]
628 sub bib_field_authority_linking_browse {
629 my ($self, $client, $bib_field, $limit, $offset, $thesauri) = @_;
634 my $e = new_editor();
636 return [] unless $bib_field;
638 my $term = join(' ', map {$_->[1]} @{$bib_field->{subfields}});
640 return [] unless $term;
642 my $axis = $e->json_query({
643 select => {abaafm => ['axis']},
644 from => {acsbf => {acsaf => {join => 'abaafm'}}},
645 where => {'+acsbf' => {tag => $bib_field->{tag}}},
647 {class => 'acsaf', field => 'main_entry', direction => 'desc'},
648 {class => 'acsaf', field => 'tag'},
650 # This lets us favor the 'subject' axis to the 'topic' axis.
651 # Topic is a subset of subject. It's not clear if a field
652 # can link only to the 'topic' axes. In stock EG, the one
653 # 'topic' field also links to 'subject'.
654 {class => 'abaafm', field => 'axis'}
658 return [] unless $axis && ($axis = $axis->{axis});
660 # See https://bugs.launchpad.net/evergreen/+bug/1403098
661 my $are_ids = $U->simplereq(
663 'open-ils.supercat.authority.browse_center.by_axis.refs',
664 $axis, $term, $offset, $limit, $thesauri);
666 for my $are_id (@$are_ids) {
668 my $are = $e->retrieve_authority_record_entry($are_id);
669 my $rec = MARC::Record->new_from_xml($are->marc, 'UTF-8');
671 my $main_field = $rec->field('1..');
672 my $auth_org_field = $rec->field('003');
673 my $auth_org = $auth_org_field ? $auth_org_field->data : undef;
676 authority_id => $are_id,
677 main_heading => hashify_field($main_field),
678 auth_org => $auth_org,
683 for my $also_field ($rec->field('5..')) {
684 push(@{$resp->{see_alsos}}, hashify_field($also_field));
687 for my $from_field ($rec->field('4..')) {
688 push(@{$resp->{see_froms}}, hashify_field($from_field));
691 $client->respond($resp);