3 INSERT INTO config.upgrade_log (version) VALUES ('0353'); -- miker
5 CREATE OR REPLACE FUNCTION maintain_control_numbers() RETURNS TRIGGER AS $func$
8 use MARC::File::XML (BinaryEncoding => 'UTF-8');
10 use Unicode::Normalize;
12 my $record = MARC::Record->new_from_xml($_TD->{new}{marc});
13 my $schema = $_TD->{table_schema};
14 my $rec_id = $_TD->{new}{id};
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') {
22 # Get the control number identifier from an OU setting based on $_TD->{new}{owner}
23 my $ou_cni = 'EVRGRN';
26 if ($schema eq 'serial') {
27 $owner = $_TD->{new}{owning_lib};
29 # are.owner and bre.owner can be null, so fall back to the consortial setting
30 $owner = $_TD->{new}{owner} || 1;
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"
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};
45 my ($create, $munge) = (0, 0);
46 my ($orig_001, $orig_003) = ('', '');
48 # Incoming MARC records may have multiple 001s or 003s, despite the spec
49 my @control_ids = $record->field('003');
50 my @scns = $record->field('035');
52 foreach my $id_field ('001', '003') {
54 my @controls = $record->field($id_field);
56 if ($id_field eq '001') {
57 $spec_value = $rec_id;
59 $spec_value = $ou_cni;
62 # Create the 001/003 if none exist
63 if (scalar(@controls) == 0) {
64 $record->insert_fields_ordered(MARC::Field->new($id_field, $spec_value));
66 } elsif (scalar(@controls) > 1) {
67 # Do we already have the right 001/003 value in the existing set?
68 unless (grep $_->data() eq $spec_value, @controls) {
72 # Delete the other fields, as with more than 1 001/003 we do not know which 003/001 to match
73 foreach my $control (@controls) {
74 unless ($control->data() eq $spec_value) {
75 $record->delete_field($control);
79 # Only one field; check to see if we need to munge it
80 unless (grep $_->data() eq $spec_value, @controls) {
86 # Now, if we need to munge the 001, we will first push the existing 001/003 into the 035
88 my $scn = "(" . $record->field('003')->data() . ")" . $record->field('001')->data();
90 # Do not create duplicate 035 fields
91 unless (grep $_->subfield('a') eq $scn, @scns) {
92 $record->insert_fields_ordered(MARC::Field->new('035', '', '', 'a' => $scn));
96 # Set the 001/003 and update the MARC
97 if ($create or $munge) {
98 $record->field('001')->data($rec_id);
99 $record->field('003')->data($ou_cni);
101 my $xml = $record->as_xml_record();
103 $xml =~ s/^<\?xml.+\?\s*>//go;
104 $xml =~ s/>\s+</></go;
105 $xml =~ s/\p{Cc}//go;
107 # Embed a version of OpenILS::Application::AppUtils->entityize()
108 # to avoid having to set PERL5LIB for PostgreSQL as well
110 # If we are going to convert non-ASCII characters to XML entities,
111 # we had better be dealing with a UTF8 string to begin with
112 $xml = decode_utf8($xml);
116 # Convert raw ampersands to entities
117 $xml =~ s/&(?!\S+;)/&/gso;
119 # Convert Unicode characters to entities
120 $xml =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
122 $xml =~ s/[\x00-\x1f]//go;
123 $_TD->{new}{marc} = $xml;
129 $func$ LANGUAGE PLPERLU;
131 CREATE OR REPLACE FUNCTION authority.generate_overlay_template ( TEXT, BIGINT ) RETURNS TEXT AS $func$
134 use MARC::File::XML (BinaryEncoding => 'UTF-8');
137 my $r = MARC::Record->new_from_xml( $xml );
139 return undef unless ($r);
141 my $id = shift() || $r->subfield( '901' => 'c' );
142 $id =~ s/^\s*(?:\([^)]+\))?\s*(.+)\s*?$/$1/;
143 return undef unless ($id); # We need an ID!
145 my $tmpl = MARC::Record->new();
148 for my $field ( $r->field( '1..' ) ) { # Get main entry fields from the authority record
150 my $tag = $field->tag;
151 my $i1 = $field->indicator(1);
152 my $i2 = $field->indicator(2);
153 my $sf = join '', map { $_->[0] } $field->subfields;
154 my @data = map { @$_ } $field->subfields;
158 # Map the authority field to bib fields it can control.
159 if ($tag >= 100 and $tag <= 111) { # names
160 @replace_them = map { $tag + $_ } (0, 300, 500, 600, 700);
161 } elsif ($tag eq '130') { # uniform title
162 @replace_them = qw/130 240 440 730 830/;
163 } elsif ($tag >= 150 and $tag <= 155) { # subjects
164 @replace_them = ($tag + 500);
165 } elsif ($tag >= 180 and $tag <= 185) { # floating subdivisions
166 @replace_them = qw/100 400 600 700 800 110 410 610 710 810 111 411 611 711 811 130 240 440 730 830 650 651 655/;
171 # Dummy up the bib-side data
172 $tmpl->append_fields(
174 MARC::Field->new( $_, $i1, $i2, @data )
178 # Construct some 'replace' rules
179 push @rule_fields, map { $_ . $sf . '[0~\)' .$id . '$]' } @replace_them;
182 # Insert the replace rules into the template
183 $tmpl->append_fields(
184 MARC::Field->new( '905' => ' ' => ' ' => 'r' => join(',', @rule_fields ) )
187 $xml = $tmpl->as_xml_record;
188 $xml =~ s/^<\?.+?\?>$//mo;
190 $xml =~ s/>\s+</></sgo;
194 $func$ LANGUAGE PLPERLU;
196 CREATE OR REPLACE FUNCTION vandelay.add_field ( target_xml TEXT, source_xml TEXT, field TEXT ) RETURNS TEXT AS $_$
199 use MARC::File::XML (BinaryEncoding => 'UTF-8');
202 my $target_xml = shift;
203 my $source_xml = shift;
204 my $field_spec = shift;
206 my $target_r = MARC::Record->new_from_xml( $target_xml );
207 my $source_r = MARC::Record->new_from_xml( $source_xml );
209 return $target_xml unless ($target_r && $source_r);
211 my @field_list = split(',', $field_spec);
214 for my $f (@field_list) {
215 $f =~ s/^\s*//; $f =~ s/\s*$//;
216 if ($f =~ /^(.{3})(\w*)(?:\[([^]]*)\])?$/) {
222 $match =~ s/^\s*//; $match =~ s/\s*$//;
223 $fields{$field} = { sf => [ split('', $sf) ] };
225 my ($msf,$mre) = split('~', $match);
226 if (length($msf) > 0 and length($mre) > 0) {
227 $msf =~ s/^\s*//; $msf =~ s/\s*$//;
228 $mre =~ s/^\s*//; $mre =~ s/\s*$//;
229 $fields{$field}{match} = { sf => $msf, re => qr/$mre/ };
235 for my $f ( keys %fields) {
236 if ( @{$fields{$f}{sf}} ) {
237 for my $from_field ($source_r->field( $f )) {
238 for my $to_field ($target_r->field( $f )) {
239 if (exists($fields{$f}{match})) {
240 next unless (grep { $_ =~ $fields{$f}{match}{re} } $to_field->subfield($fields{$f}{match}{sf}));
242 my @new_sf = map { ($_ => $from_field->subfield($_)) } @{$fields{$f}{sf}};
243 $to_field->add_subfields( @new_sf );
247 my @new_fields = map { $_->clone } $source_r->field( $f );
248 $target_r->insert_fields_ordered( @new_fields );
252 $target_xml = $target_r->as_xml_record;
253 $target_xml =~ s/^<\?.+?\?>$//mo;
254 $target_xml =~ s/\n//sgo;
255 $target_xml =~ s/>\s+</></sgo;
259 $_$ LANGUAGE PLPERLU;
261 CREATE OR REPLACE FUNCTION vandelay.strip_field ( xml TEXT, field TEXT ) RETURNS TEXT AS $_$
264 use MARC::File::XML (BinaryEncoding => 'UTF-8');
268 my $r = MARC::Record->new_from_xml( $xml );
270 return $xml unless ($r);
272 my $field_spec = shift;
273 my @field_list = split(',', $field_spec);
276 for my $f (@field_list) {
277 $f =~ s/^\s*//; $f =~ s/\s*$//;
278 if ($f =~ /^(.{3})(\w*)(?:\[([^]]*)\])?$/) {
284 $match =~ s/^\s*//; $match =~ s/\s*$//;
285 $fields{$field} = { sf => [ split('', $sf) ] };
287 my ($msf,$mre) = split('~', $match);
288 if (length($msf) > 0 and length($mre) > 0) {
289 $msf =~ s/^\s*//; $msf =~ s/\s*$//;
290 $mre =~ s/^\s*//; $mre =~ s/\s*$//;
291 $fields{$field}{match} = { sf => $msf, re => qr/$mre/ };
297 for my $f ( keys %fields) {
298 for my $to_field ($r->field( $f )) {
299 if (exists($fields{$f}{match})) {
300 next unless (grep { $_ =~ $fields{$f}{match}{re} } $to_field->subfield($fields{$f}{match}{sf}));
303 if ( @{$fields{$f}{sf}} ) {
304 $to_field->delete_subfield(code => $fields{$f}{sf});
306 $r->delete_field( $to_field );
311 $xml = $r->as_xml_record;
312 $xml =~ s/^<\?.+?\?>$//mo;
314 $xml =~ s/>\s+</></sgo;
318 $_$ LANGUAGE PLPERLU;