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

   1 package OpenILS::Application::Cat::Authority;
   2 use strict; use warnings;
   3 use base qw/OpenILS::Application/;
   4 use OpenILS::Utils::CStoreEditor q/:funcs/;
   5 use OpenILS::Application::Cat::AuthCommon;
   6 use OpenSRF::Utils::Logger qw($logger);
   7 use OpenILS::Application::AppUtils;
   8 use OpenILS::Utils::Fieldmapper;
   9 use OpenILS::Const qw/:const/;
  10 use OpenILS::Event;
  11 my $U = 'OpenILS::Application::AppUtils';
  12 my $MARC_NAMESPACE = 'http://www.loc.gov/MARC21/slim';
  13
  14
  15 # generate a MARC XML document from a MARC XML string
  16 sub marc_xml_to_doc {
  17     my $xml = shift;
  18     my $marc_doc = XML::LibXML->new->parse_string($xml);
  19     $marc_doc->documentElement->setNamespace($MARC_NAMESPACE, 'marc', 1);
  20     $marc_doc->documentElement->setNamespace($MARC_NAMESPACE);
  21     return $marc_doc;
  22 }
  23
  24
  25 __PACKAGE__->register_method(
  26     method  => 'import_authority_record',
  27     api_name    => 'open-ils.cat.authority.record.import',
  28 );
  29
  30 sub import_authority_record {
  31     my($self, $conn, $auth, $marc_xml, $source) = @_;
  32     my $e = new_editor(authtoken=>$auth, xact=>1);
  33     return $e->die_event unless $e->checkauth;
  34     return $e->die_event unless $e->allowed('CREATE_AUTHORITY_RECORD');
  35     my $rec = OpenILS::Application::Cat::AuthCommon->
  36         import_authority_record($e, $marc_xml, $source);
  37     $e->commit unless $U->event_code($rec);
  38     return $rec;
  39 }
  40
  41 __PACKAGE__->register_method(
  42     method => 'create_authority_record_from_bib_field',
  43     api_name => 'open-ils.cat.authority.record.create_from_bib',
  44     signature => {
  45         desc => q/Create an authority record entry from a field in a bibliographic record/,
  46         params => q/
  47             @param field A hash representing the field to control, consisting of: { tag: string, ind1: string, ind2: string, subfields: [ [code, value] ... ] }
  48             @param identifier A MARC control number identifier
  49             @param authtoken A valid authentication token
  50             @returns The new record object
  51  /}
  52 );
  53
  54 __PACKAGE__->register_method(
  55     method => 'create_authority_record_from_bib_field',
  56     api_name => 'open-ils.cat.authority.record.create_from_bib.readonly',
  57     signature => {
  58         desc => q/Creates MARCXML for an authority record entry from a field in a bibliographic record/,
  59         params => q/
  60             @param field A hash representing the field to control, consisting of: { tag: string, ind1: string, ind2: string, subfields: [ [code, value] ... ] }
  61             @param identifier A MARC control number identifier
  62             @returns The MARCXML for the authority record
  63  /}
  64 );
  65
  66 sub create_authority_record_from_bib_field {
  67     my($self, $conn, $field, $cni, $auth) = @_;
  68
  69     # Control number identifier should have been passed in
  70     if (!$cni) {
  71         $cni = 'UNSET';
  72     }
  73
  74     # Change the first character of the incoming bib field tag to a '1'
  75     # for use in our authority record; close enough for now?
  76     my $tag = $field->{'tag'};
  77     $tag =~ s/^./1/;
  78
  79     my $ind1 = $field->{ind1} || ' ';
  80     my $ind2 = $field->{ind2} || ' ';
  81
  82     my $control = qq{<datafield tag="$tag" ind1="$ind1" ind2="$ind2">};
  83     foreach my $sf (@{$field->{subfields}}) {
  84         my $code = $sf->[0];
  85         my $val = $U->entityize($sf->[1]);
  86         $control .= qq{<subfield code="$code">$val</subfield>};
  87     }
  88     $control .= '</datafield>';
  89
  90     # ARN, or "authority record number", used to need to be unique across the database.
  91     # Of course, we have no idea what's in the database, and if the
  92     # cat.maintain_control_numbers flag is set to "TRUE" then the 001 will
  93     # be reset to the record ID anyway.
  94     my $arn = 'AUTOGEN-' . time();
  95
  96     # Placeholder MARCXML;
  97     #   001/003 can be be properly filled in via database triggers
  98     #   005 will be filled in automatically at creation time
  99     #   008 needs to be set by a cataloguer (could be some OU settings, I suppose)
 100     #   040 should come from OU settings / OU shortname
 101     #
 102     my $marc_xml = <<MARCXML;
 103 <record xmlns:marc="http://www.loc.gov/MARC21/slim" xmlns="http://www.loc.gov/MARC21/slim"><leader>     nz  a22     o  4500</leader>
 104 <controlfield tag="001">$arn</controlfield>
 105 <controlfield tag="008">      ||||||||||||||||||||||||||||||||||</controlfield>
 106 <datafield tag="040" ind1=" " ind2=" "><subfield code="a">$cni</subfield><subfield code="c">$cni</subfield></datafield>
 107 $control
 108 </record>
 109 MARCXML
 110
 111     if ($self->api_name =~ m/readonly$/) {
 112         return $marc_xml;
 113     } else {
 114         my $e = new_editor(authtoken=>$auth, xact=>1);
 115         return $e->die_event unless $e->checkauth;
 116         return $e->die_event unless $e->allowed('CREATE_AUTHORITY_RECORD');
 117         my $rec = OpenILS::Application::Cat::AuthCommon->import_authority_record($e, $marc_xml);
 118         $e->commit unless $U->event_code($rec);
 119         return $rec;
 120     }
 121 }
 122
 123 __PACKAGE__->register_method(
 124     method  => 'overlay_authority_record',
 125     api_name    => 'open-ils.cat.authority.record.overlay',
 126 );
 127
 128 sub overlay_authority_record {
 129     my($self, $conn, $auth, $rec_id, $marc_xml, $source) = @_;
 130     my $e = new_editor(authtoken=>$auth, xact=>1);
 131     return $e->die_event unless $e->checkauth;
 132     return $e->die_event unless $e->allowed('UPDATE_AUTHORITY_RECORD');
 133     my $rec = OpenILS::Application::Cat::AuthCommon->
 134         overlay_authority_record($e, $rec_id, $marc_xml, $source);
 135     $e->commit unless $U->event_code($rec);
 136     return $rec;
 137 }
 138
 139 __PACKAGE__->register_method(
 140     method  => 'retrieve_authority_record',
 141     api_name    => 'open-ils.cat.authority.record.retrieve',
 142     signature => {
 143         desc => q/Retrieve an authority record entry/,
 144         params => [
 145             {desc => q/hash of options.  Options include "clear_marc" which clears
 146                 the MARC xml from the record before it is returned/}
 147         ]
 148     }
 149 );
 150 sub retrieve_authority_record {
 151     my($self, $conn, $auth, $rec_id, $options) = @_;
 152     my $e = new_editor(authtoken=>$auth);
 153     return $e->die_event unless $e->checkauth;
 154     my $rec = $e->retrieve_authority_record_entry($rec_id) or return $e->event;
 155     $rec->clear_marc if $$options{clear_marc};
 156     return $rec;
 157 }
 158
 159 __PACKAGE__->register_method(
 160     method  => 'batch_retrieve_authority_record',
 161     api_name    => 'open-ils.cat.authority.record.batch.retrieve',
 162     stream => 1,
 163     signature => {
 164         desc => q/Retrieve a set of authority record entry objects/,
 165         params => [
 166             {desc => q/hash of options.  Options include "clear_marc" which clears
 167                 the MARC xml from the record before it is returned/}
 168         ]
 169     }
 170 );
 171 sub batch_retrieve_authority_record {
 172     my($self, $conn, $auth, $rec_id_list, $options) = @_;
 173     my $e = new_editor(authtoken=>$auth);
 174     return $e->die_event unless $e->checkauth;
 175     for my $rec_id (@$rec_id_list) {
 176         my $rec = $e->retrieve_authority_record_entry($rec_id) or return $e->event;
 177         $rec->clear_marc if $$options{clear_marc};
 178         $conn->respond($rec);
 179     }
 180     return undef;
 181 }
 182
 183 __PACKAGE__->register_method(
 184     method    => 'count_linked_bibs',
 185     api_name  => 'open-ils.cat.authority.records.count_linked_bibs',
 186     signature => q/
 187         Counts the number of bib records linked to each authority record in the input list
 188         @param records Array of authority records to return counts
 189         @return A list of hashes containing the authority record ID ("id") and linked bib count ("bibs")
 190     /
 191 );
 192
 193 sub count_linked_bibs {
 194     my( $self, $conn, $records ) = @_;
 195
 196     my $editor = new_editor();
 197
 198     my $link_count = [];
 199     my @clean_records;
 200     for my $auth ( @$records ) {
 201         # Protection against SQL injection? Might be overkill.
 202         my $intauth = int($auth);
 203         if ($intauth) {
 204             push(@clean_records, $intauth);
 205         }
 206     }
 207     return $link_count if !@clean_records;
 208
 209     $link_count = $editor->json_query({
 210         "select" => {
 211             "abl" => [
 212                 {
 213                     "column" => "authority"
 214                 },
 215                 {
 216                     "alias" => "bibs",
 217                     "transform" => "count",
 218                     "column" => "bib",
 219                     "aggregate" => 1
 220                 }
 221             ]
 222         },
 223         "from" => "abl",
 224         "where" => { "authority" => \@clean_records }
 225     });
 226
 227     return $link_count;
 228 }
 229
 230 __PACKAGE__->register_method(
 231     "method" => "retrieve_acs",
 232     "api_name" => "open-ils.cat.authority.control_set.retrieve",
 233     "api_level" => 1,
 234     "stream" => 1,
 235     "argc" => 2,
 236     "signature" => {
 237         "desc" => q/Retrieve authority.control_set objects with fleshed
 238         thesauri and authority fields/,
 239         "params" => [
 240             {"name" => "limit",  "desc" => "limit (optional; default 15)", "type" => "number"},
 241             {"name" => "offset",  "desc" => "offset doptional; default 0)", "type" => "number"},
 242             {"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"}
 243         ]
 244     }
 245 );
 246
 247 # XXX I don't think this really needs to be protected by perms, or does it?
 248 sub retrieve_acs {
 249     my $self = shift;
 250     my $client = shift;
 251
 252     my ($limit, $offset, $focus) = map int, @_;
 253
 254     $limit ||= 15;
 255     $offset ||= 0;
 256     $focus ||= undef;
 257
 258     my $e = new_editor;
 259     my $order_by = [
 260         {"class" => "acs", "field" => "name"}
 261     ];
 262
 263     # Here is the magic that let's us say that a given acsaf
 264     # will be our first result.
 265     unshift @$order_by, {
 266         "class" => "acs", "field" => "id",
 267         "transform" => "numeric_eq", "params" => [$focus],
 268         "direction" => "desc"
 269     } if $focus;
 270
 271     my $sets = $e->search_authority_control_set([
 272         {"id" => {"!=" => undef}}, {
 273             "flesh" => 1,
 274             "flesh_fields" => {"acs" => [qw/thesauri authority_fields/]},
 275             "order_by" => $order_by,
 276             "limit" => $limit,
 277             "offset" => $offset
 278         }
 279     ]) or return $e->die_event;
 280
 281     $e->disconnect;
 282
 283     $client->respond($_) foreach @$sets;
 284     return undef;
 285 }
 286
 287 __PACKAGE__->register_method(
 288     "method" => "retrieve_acsaf",
 289     "api_name" => "open-ils.cat.authority.control_set_authority_field.retrieve",
 290     "api_level" => 1,
 291     "stream" => 1,
 292     "argc" => 2,
 293     "signature" => {
 294         "desc" => q/Retrieve authority.control_set_authority_field objects with
 295         fleshed bib_fields and axes/,
 296         "params" => [
 297             {"name" => "limit",  "desc" => "limit (optional; default 15)", "type" => "number"},
 298             {"name" => "offset",  "desc" => "offset (optional; default 0)", "type" => "number"},
 299             {"name" => "control_set",  "desc" => "optionally constrain by value of acsaf.control_set field", "type" => "number"},
 300             {"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)"}
 301         ]
 302     }
 303 );
 304
 305 sub retrieve_acsaf {
 306     my $self = shift;
 307     my $client = shift;
 308
 309     my ($limit, $offset, $control_set, $focus) = map int, @_;
 310
 311     $limit ||= 15;
 312     $offset ||= 0;
 313     $control_set ||= undef;
 314     $focus ||= undef;
 315
 316     my $e = new_editor;
 317     my $where = {
 318         "control_set" => ($control_set ? $control_set : {"!=" => undef})
 319     };
 320     my $order_by = [
 321         {"class" => "acsaf", "field" => "main_entry", "direction" => "desc"},
 322         {"class" => "acsaf", "field" => "id"}
 323     ];
 324
 325     unshift @$order_by, {
 326         "class" => "acsaf", "field" => "id",
 327         "transform" => "numeric_eq", "params" => [$focus],
 328         "direction" => "desc"
 329     } if $focus;
 330
 331     my $fields = $e->search_authority_control_set_authority_field([
 332         $where, {
 333             "flesh" => 2,
 334             "flesh_fields" => {
 335                 "acsaf" => ["bib_fields", "axis_maps"],
 336                 "abaafm" => ["axis"]
 337             },
 338             "order_by" => $order_by,
 339             "limit" => $limit,
 340             "offset" => $offset
 341         }
 342     ]) or return $e->die_event;
 343
 344     $e->disconnect;
 345
 346     $client->respond($_) foreach @$fields;
 347     return undef;
 348 }
 349
 350 1;