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