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