Open-ILS/src/sql/Pg/upgrade/0465.function.maintain_control_numbers.sql

   1 BEGIN;
   2
   3 INSERT INTO config.upgrade_log (version) VALUES ('0465'); -- dbs
   4
   5 CREATE OR REPLACE FUNCTION maintain_control_numbers() RETURNS TRIGGER AS $func$
   6 use strict;
   7 use MARC::Record;
   8 use MARC::File::XML (BinaryEncoding => 'UTF-8');
   9 use Encode;
  10 use Unicode::Normalize;
  11
  12 my $record = MARC::Record->new_from_xml($_TD->{new}{marc});
  13 my $schema = $_TD->{table_schema};
  14 my $rec_id = $_TD->{new}{id};
  15
  16 # Short-circuit if maintaining control numbers per MARC21 spec is not enabled
  17 my $enable = spi_exec_query("SELECT enabled FROM config.global_flag WHERE name = 'cat.maintain_control_numbers'");
  18 if (!($enable->{processed}) or $enable->{rows}[0]->{enabled} eq 'f') {
  19     return;
  20 }
  21
  22 # Get the control number identifier from an OU setting based on $_TD->{new}{owner}
  23 my $ou_cni = 'EVRGRN';
  24
  25 my $owner;
  26 if ($schema eq 'serial') {
  27     $owner = $_TD->{new}{owning_lib};
  28 } else {
  29     # are.owner and bre.owner can be null, so fall back to the consortial setting
  30     $owner = $_TD->{new}{owner} || 1;
  31 }
  32
  33 my $ous_rv = spi_exec_query("SELECT value FROM actor.org_unit_ancestor_setting('cat.marc_control_number_identifier', $owner)");
  34 if ($ous_rv->{processed}) {
  35     $ou_cni = $ous_rv->{rows}[0]->{value};
  36     $ou_cni =~ s/"//g; # Stupid VIM syntax highlighting"
  37 } else {
  38     # Fall back to the shortname of the OU if there was no OU setting
  39     $ous_rv = spi_exec_query("SELECT shortname FROM actor.org_unit WHERE id = $owner");
  40     if ($ous_rv->{processed}) {
  41         $ou_cni = $ous_rv->{rows}[0]->{shortname};
  42     }
  43 }
  44
  45 my ($create, $munge) = (0, 0);
  46
  47 my @scns = $record->field('035');
  48
  49 foreach my $id_field ('001', '003') {
  50     my $spec_value;
  51     my @controls = $record->field($id_field);
  52
  53     if ($id_field eq '001') {
  54         $spec_value = $rec_id;
  55     } else {
  56         $spec_value = $ou_cni;
  57     }
  58
  59     # Create the 001/003 if none exist
  60     if (scalar(@controls) == 1) {
  61         # Only one field; check to see if we need to munge it
  62         unless (grep $_->data() eq $spec_value, @controls) {
  63             $munge = 1;
  64         }
  65     } else {
  66         # Delete the other fields, as with more than 1 001/003 we do not know which 003/001 to match
  67         foreach my $control (@controls) {
  68             unless ($control->data() eq $spec_value) {
  69                 $record->delete_field($control);
  70             }
  71         }
  72         $record->insert_fields_ordered(MARC::Field->new($id_field, $spec_value));
  73         $create = 1;
  74     }
  75 }
  76
  77 # Now, if we need to munge the 001, we will first push the existing 001/003
  78 # into the 035; but if the record did not have one (and one only) 001 and 003
  79 # to begin with, skip this process
  80 if ($munge and not $create) {
  81     my $scn = "(" . $record->field('003')->data() . ")" . $record->field('001')->data();
  82
  83     # Do not create duplicate 035 fields
  84     unless (grep $_->subfield('a') eq $scn, @scns) {
  85         $record->insert_fields_ordered(MARC::Field->new('035', '', '', 'a' => $scn));
  86     }
  87 }
  88
  89 # Set the 001/003 and update the MARC
  90 if ($create or $munge) {
  91     $record->field('001')->data($rec_id);
  92     $record->field('003')->data($ou_cni);
  93
  94     my $xml = $record->as_xml_record();
  95     $xml =~ s/\n//sgo;
  96     $xml =~ s/^<\?xml.+\?\s*>//go;
  97     $xml =~ s/>\s+</></go;
  98     $xml =~ s/\p{Cc}//go;
  99
 100     # Embed a version of OpenILS::Application::AppUtils->entityize()
 101     # to avoid having to set PERL5LIB for PostgreSQL as well
 102
 103     # If we are going to convert non-ASCII characters to XML entities,
 104     # we had better be dealing with a UTF8 string to begin with
 105     $xml = decode_utf8($xml);
 106
 107     $xml = NFC($xml);
 108
 109     # Convert raw ampersands to entities
 110     $xml =~ s/&(?!\S+;)/&amp;/gso;
 111
 112     # Convert Unicode characters to entities
 113     $xml =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
 114
 115     $xml =~ s/[\x00-\x1f]//go;
 116     $_TD->{new}{marc} = $xml;
 117
 118     return "MODIFY";
 119 }
 120
 121 return;
 122 $func$ LANGUAGE PLPERLU;
 123
 124 COMMIT;