Open-ILS/src/perlmods/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->import_authority_record($marc_xml, $source);
  36     $e->commit unless $U->event_code($rec);
  37     return $rec;
  38 }
  39
  40 __PACKAGE__->register_method(
  41     method => 'create_authority_record_from_bib_field',
  42     api_name => 'open-ils.cat.authority.record.create_from_bib',
  43     signature => {
  44         desc => q/Create an authority record entry from a field in a bibliographic record/,
  45         params => q/
  46             @param field A hash representing the field to control, consisting of: { tag: string, ind1: string, ind2: string, subfields: [ [code, value] ... ] }
  47             @param authtoken A valid authentication token
  48             @returns The new record object
  49  /}
  50 );
  51
  52 __PACKAGE__->register_method(
  53     method => 'create_authority_record_from_bib_field',
  54     api_name => 'open-ils.cat.authority.record.create_from_bib.readonly',
  55     signature => {
  56         desc => q/Creates MARCXML for an authority record entry from a field in a bibliographic record/,
  57         params => q/
  58             @param field A hash representing the field to control, consisting of: { tag: string, ind1: string, ind2: string, subfields: [ [code, value] ... ] }
  59             @returns The MARCXML for the authority record
  60  /}
  61 );
  62
  63 sub create_authority_record_from_bib_field {
  64     my($self, $conn, $field, $auth) = @_;
  65
  66     # Change the first character of the incoming bib field tag to a '1'
  67     # for use in our authority record; close enough for now?
  68     my $tag = $field->{'tag'};
  69     $tag =~ s/^./1/;
  70
  71     my $ind1 = $field->{ind1} || ' ';
  72     my $ind2 = $field->{ind2} || ' ';
  73
  74     my $control = qq{<datafield tag="$tag" ind1="$ind1" ind2="$ind2">};
  75     foreach my $sf (@{$field->{subfields}}) {
  76         my $code = $sf->[0];
  77         my $val = $U->entityize($sf->[1]);
  78         $control .= qq{<subfield code="$code">$val</subfield>};
  79     }
  80     $control .= '</datafield>';
  81
  82     # ARN, or "authority record number", needs to be unique across the database
  83     # Of course, we have no idea what's in the database, and if the
  84     # cat.maintain_control_numbers flag is set to "TRUE" then the 003 will
  85     # be reset to the record ID anyway. Just use time() for now and hope that
  86     # two attempts to create an authority record in the same second doesn't
  87     # happen too often.
  88     my $arn = 'AUTOGEN-' . time();
  89
  90     # Placeholder MARCXML;
  91     #   001/003 can be filled in via database triggers
  92     #   005 will be filled in automatically at creation time
  93     #   008 needs to be set by a cataloguer (could be some OU settings, I suppose)
  94     #   040 should come from OU settings / OU shortname
  95     #
  96     my $marc_xml = <<MARCXML;
  97 <record xmlns:marc="http://www.loc.gov/MARC21/slim" xmlns="http://www.loc.gov/MARC21/slim"><leader>     nz  a22     o  4500</leader>
  98 <controlfield tag="001">$arn</controlfield>
  99 <controlfield tag="003">CONS</controlfield>
 100 <controlfield tag="008">      ||||||||||||||||||||||||||||||||||</controlfield>
 101 <datafield tag="040" ind1=" " ind2=" "><subfield code="a">CONS</subfield><subfield code="c">CONS</subfield></datafield>
 102 $control
 103 </record>
 104 MARCXML
 105
 106     if ($self->api_name =~ m/readonly$/) {
 107         return $marc_xml;
 108     } else {
 109         my $e = new_editor(authtoken=>$auth, xact=>1);
 110         return $e->die_event unless $e->checkauth;
 111         return $e->die_event unless $e->allowed('CREATE_AUTHORITY_RECORD');
 112         my $rec = OpenILS::Application::Cat::AuthCommon->import_authority_record($e, $marc_xml);
 113         $e->commit unless $U->event_code($rec);
 114         return $rec;
 115     }
 116 }
 117
 118 __PACKAGE__->register_method(
 119         method  => 'overlay_authority_record',
 120         api_name        => 'open-ils.cat.authority.record.overlay',
 121 );
 122
 123 sub overlay_authority_record {
 124     my($self, $conn, $auth, $rec_id, $marc_xml, $source) = @_;
 125         my $e = new_editor(authtoken=>$auth, xact=>1);
 126         return $e->die_event unless $e->checkauth;
 127         return $e->die_event unless $e->allowed('UPDATE_AUTHORITY_RECORD');
 128     my $rec = OpenILS::Application::Cat::AuthCommon->overlay_authority_record($rec_id, $marc_xml, $source);
 129     $e->commit unless $U->event_code($rec);
 130     return $rec;
 131
 132 }
 133
 134 __PACKAGE__->register_method(
 135         method  => 'retrieve_authority_record',
 136         api_name        => 'open-ils.cat.authority.record.retrieve',
 137     signature => {
 138         desc => q/Retrieve an authority record entry/,
 139         params => [
 140             {desc => q/hash of options.  Options include "clear_marc" which clears
 141                 the MARC xml from the record before it is returned/}
 142         ]
 143     }
 144 );
 145 sub retrieve_authority_record {
 146     my($self, $conn, $auth, $rec_id, $options) = @_;
 147         my $e = new_editor(authtoken=>$auth);
 148         return $e->die_event unless $e->checkauth;
 149     my $rec = $e->retrieve_authority_record($rec_id) or return $e->event;
 150     $rec->clear_marc if $$options{clear_marc};
 151     return $rec;
 152 }
 153
 154 __PACKAGE__->register_method(
 155         method  => 'batch_retrieve_authority_record',
 156         api_name        => 'open-ils.cat.authority.record.batch.retrieve',
 157     stream => 1,
 158     signature => {
 159         desc => q/Retrieve a set of authority record entry objects/,
 160         params => [
 161             {desc => q/hash of options.  Options include "clear_marc" which clears
 162                 the MARC xml from the record before it is returned/}
 163         ]
 164     }
 165 );
 166 sub batch_retrieve_authority_record {
 167     my($self, $conn, $auth, $rec_id_list, $options) = @_;
 168         my $e = new_editor(authtoken=>$auth);
 169         return $e->die_event unless $e->checkauth;
 170     for my $rec_id (@$rec_id_list) {
 171         my $rec = $e->retrieve_authority_record($rec_id) or return $e->event;
 172         $rec->clear_marc if $$options{clear_marc};
 173         $conn->respond($rec);
 174     }
 175     return undef;
 176 }
 177
 178 __PACKAGE__->register_method(
 179     method    => 'count_linked_bibs',
 180     api_name  => 'open-ils.cat.authority.records.count_linked_bibs',
 181     signature => q/
 182         Counts the number of bib records linked to each authority record in the input list
 183         @param records Array of authority records to return counts
 184         @return A list of hashes containing the authority record ID ("id") and linked bib count ("bibs")
 185     /
 186 );
 187
 188 sub count_linked_bibs {
 189     my( $self, $conn, $records ) = @_;
 190
 191     my $editor = new_editor();
 192
 193     my $link_count;
 194     my @clean_records;
 195     for my $auth ( @$records ) {
 196         # Protection against SQL injection? Might be overkill.
 197         my $intauth = int($auth);
 198         if ($intauth) {
 199             push(@clean_records, $intauth);
 200         }
 201     }
 202     return $link_count if !@clean_records;
 203
 204     $link_count = $editor->json_query({
 205         "select" => {
 206             "abl" => [
 207                 {
 208                     "column" => "authority"
 209                 },
 210                 {
 211                     "alias" => "bibs",
 212                     "transform" => "count",
 213                     "column" => "bib",
 214                     "aggregate" => 1
 215                 }
 216             ]
 217         },
 218         "from" => "abl",
 219         "where" => { "authority" => \@clean_records }
 220     });
 221
 222     return $link_count;
 223 }
 224
 225 1;