3 INSERT INTO config.upgrade_log (version) VALUES ('0528'); -- dbs
5 CREATE OR REPLACE FUNCTION maintain_control_numbers() RETURNS TRIGGER AS $func$
8 use MARC::File::XML (BinaryEncoding => 'UTF-8');
11 use Unicode::Normalize;
13 MARC::Charset->assume_unicode(1);
15 my $record = MARC::Record->new_from_xml($_TD->{new}{marc});
16 my $schema = $_TD->{table_schema};
17 my $rec_id = $_TD->{new}{id};
19 # Short-circuit if maintaining control numbers per MARC21 spec is not enabled
20 my $enable = spi_exec_query("SELECT enabled FROM config.global_flag WHERE name = 'cat.maintain_control_numbers'");
21 if (!($enable->{processed}) or $enable->{rows}[0]->{enabled} eq 'f') {
25 # Get the control number identifier from an OU setting based on $_TD->{new}{owner}
26 my $ou_cni = 'EVRGRN';
29 if ($schema eq 'serial') {
30 $owner = $_TD->{new}{owning_lib};
32 # are.owner and bre.owner can be null, so fall back to the consortial setting
33 $owner = $_TD->{new}{owner} || 1;
36 my $ous_rv = spi_exec_query("SELECT value FROM actor.org_unit_ancestor_setting('cat.marc_control_number_identifier', $owner)");
37 if ($ous_rv->{processed}) {
38 $ou_cni = $ous_rv->{rows}[0]->{value};
39 $ou_cni =~ s/"//g; # Stupid VIM syntax highlighting"
41 # Fall back to the shortname of the OU if there was no OU setting
42 $ous_rv = spi_exec_query("SELECT shortname FROM actor.org_unit WHERE id = $owner");
43 if ($ous_rv->{processed}) {
44 $ou_cni = $ous_rv->{rows}[0]->{shortname};
48 my ($create, $munge) = (0, 0);
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) == 1) {
64 # Only one field; check to see if we need to munge it
65 unless (grep $_->data() eq $spec_value, @controls) {
69 # Delete the other fields, as with more than 1 001/003 we do not know which 003/001 to match
70 foreach my $control (@controls) {
71 unless ($control->data() eq $spec_value) {
72 $record->delete_field($control);
75 $record->insert_fields_ordered(MARC::Field->new($id_field, $spec_value));
80 # Now, if we need to munge the 001, we will first push the existing 001/003
81 # into the 035; but if the record did not have one (and one only) 001 and 003
82 # to begin with, skip this process
83 if ($munge and not $create) {
84 my $scn = "(" . $record->field('003')->data() . ")" . $record->field('001')->data();
86 # Do not create duplicate 035 fields
87 unless (grep $_->subfield('a') eq $scn, @scns) {
88 $record->insert_fields_ordered(MARC::Field->new('035', '', '', 'a' => $scn));
92 # Set the 001/003 and update the MARC
93 if ($create or $munge) {
94 $record->field('001')->data($rec_id);
95 $record->field('003')->data($ou_cni);
97 my $xml = $record->as_xml_record();
99 $xml =~ s/^<\?xml.+\?\s*>//go;
100 $xml =~ s/>\s+</></go;
101 $xml =~ s/\p{Cc}//go;
103 # Embed a version of OpenILS::Application::AppUtils->entityize()
104 # to avoid having to set PERL5LIB for PostgreSQL as well
106 # If we are going to convert non-ASCII characters to XML entities,
107 # we had better be dealing with a UTF8 string to begin with
108 $xml = decode_utf8($xml);
112 # Convert raw ampersands to entities
113 $xml =~ s/&(?!\S+;)/&/gso;
115 # Convert Unicode characters to entities
116 $xml =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
118 $xml =~ s/[\x00-\x1f]//go;
119 $_TD->{new}{marc} = $xml;
125 $func$ LANGUAGE PLPERLU;
127 CREATE OR REPLACE FUNCTION authority.generate_overlay_template ( TEXT, BIGINT ) RETURNS TEXT AS $func$
130 use MARC::File::XML (BinaryEncoding => 'UTF-8');
133 MARC::Charset->assume_unicode(1);
136 my $r = MARC::Record->new_from_xml( $xml );
138 return undef unless ($r);
140 my $id = shift() || $r->subfield( '901' => 'c' );
141 $id =~ s/^\s*(?:\([^)]+\))?\s*(.+)\s*?$/$1/;
142 return undef unless ($id); # We need an ID!
144 my $tmpl = MARC::Record->new();
145 $tmpl->encoding( 'UTF-8' );
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, force_add INT ) RETURNS TEXT AS $_$
199 use MARC::File::XML (BinaryEncoding => 'UTF-8');
203 MARC::Charset->assume_unicode(1);
205 my $target_xml = shift;
206 my $source_xml = shift;
207 my $field_spec = shift;
208 my $force_add = shift || 0;
210 my $target_r = MARC::Record->new_from_xml( $target_xml );
211 my $source_r = MARC::Record->new_from_xml( $source_xml );
213 return $target_xml unless ($target_r && $source_r);
215 my @field_list = split(',', $field_spec);
218 for my $f (@field_list) {
219 $f =~ s/^\s*//; $f =~ s/\s*$//;
220 if ($f =~ /^(.{3})(\w*)(?:\[([^]]*)\])?$/) {
226 $match =~ s/^\s*//; $match =~ s/\s*$//;
227 $fields{$field} = { sf => [ split('', $sf) ] };
229 my ($msf,$mre) = split('~', $match);
230 if (length($msf) > 0 and length($mre) > 0) {
231 $msf =~ s/^\s*//; $msf =~ s/\s*$//;
232 $mre =~ s/^\s*//; $mre =~ s/\s*$//;
233 $fields{$field}{match} = { sf => $msf, re => qr/$mre/ };
239 for my $f ( keys %fields) {
240 if ( @{$fields{$f}{sf}} ) {
241 for my $from_field ($source_r->field( $f )) {
242 my @tos = $target_r->field( $f );
244 next if (exists($fields{$f}{match}) and !$force_add);
245 my @new_fields = map { $_->clone } $source_r->field( $f );
246 $target_r->insert_fields_ordered( @new_fields );
248 for my $to_field (@tos) {
249 if (exists($fields{$f}{match})) {
250 next unless (grep { $_ =~ $fields{$f}{match}{re} } $to_field->subfield($fields{$f}{match}{sf}));
252 my @new_sf = map { ($_ => $from_field->subfield($_)) } @{$fields{$f}{sf}};
253 $to_field->add_subfields( @new_sf );
258 my @new_fields = map { $_->clone } $source_r->field( $f );
259 $target_r->insert_fields_ordered( @new_fields );
263 $target_xml = $target_r->as_xml_record;
264 $target_xml =~ s/^<\?.+?\?>$//mo;
265 $target_xml =~ s/\n//sgo;
266 $target_xml =~ s/>\s+</></sgo;
270 $_$ LANGUAGE PLPERLU;
272 CREATE OR REPLACE FUNCTION authority.normalize_heading( TEXT ) RETURNS TEXT AS $func$
278 use MARC::File::XML (BinaryEncoding => 'UTF8');
280 use UUID::Tiny ':std';
282 MARC::Charset->assume_unicode(1);
284 my $xml = shift() or return undef;
288 # Prevent errors in XML parsing from blowing out ungracefully
290 $r = MARC::Record->new_from_xml( $xml );
293 return 'BAD_MARCXML_' . create_uuid_as_string(UUID_MD5, $xml);
297 return 'BAD_MARCXML_' . create_uuid_as_string(UUID_MD5, $xml);
300 # From http://www.loc.gov/standards/sourcelist/subject.html
301 my $thes_code_map = {
307 n => 'notapplicable',
313 # Default to "No attempt to code" if the leader is horribly broken
314 my $fixed_field = $r->field('008');
317 $thes_char = substr($fixed_field->data(), 11, 1) || '|';
320 my $thes_code = 'UNDEFINED';
322 if ($thes_char eq 'z') {
323 # Grab the 040 $f per http://www.loc.gov/marc/authority/ad040.html
324 $thes_code = $r->subfield('040', 'f') || 'UNDEFINED';
325 } elsif ($thes_code_map->{$thes_char}) {
326 $thes_code = $thes_code_map->{$thes_char};
330 my $head = $r->field('1..');
332 # Concatenate all of these subfields together, prefixed by their code
333 # to prevent collisions along the lines of "Fiction, North Carolina"
334 foreach my $sf ($head->subfields()) {
335 $auth_txt .= '‡' . $sf->[0] . ' ' . $sf->[1];
340 my $stmt = spi_prepare('SELECT public.naco_normalize($1) AS norm_text', 'TEXT');
341 my $result = spi_exec_prepared($stmt, $auth_txt);
342 my $norm_txt = $result->{rows}[0]->{norm_text};
345 return $head->tag() . "_" . $thes_code . " " . $norm_txt;
348 return 'NOHEADING_' . $thes_code . ' ' . create_uuid_as_string(UUID_MD5, $xml);
349 $func$ LANGUAGE 'plperlu' IMMUTABLE;
351 CREATE OR REPLACE FUNCTION vandelay.strip_field ( xml TEXT, field TEXT ) RETURNS TEXT AS $_$
354 use MARC::File::XML (BinaryEncoding => 'UTF-8');
358 MARC::Charset->assume_unicode(1);
361 my $r = MARC::Record->new_from_xml( $xml );
363 return $xml unless ($r);
365 my $field_spec = shift;
366 my @field_list = split(',', $field_spec);
369 for my $f (@field_list) {
370 $f =~ s/^\s*//; $f =~ s/\s*$//;
371 if ($f =~ /^(.{3})(\w*)(?:\[([^]]*)\])?$/) {
377 $match =~ s/^\s*//; $match =~ s/\s*$//;
378 $fields{$field} = { sf => [ split('', $sf) ] };
380 my ($msf,$mre) = split('~', $match);
381 if (length($msf) > 0 and length($mre) > 0) {
382 $msf =~ s/^\s*//; $msf =~ s/\s*$//;
383 $mre =~ s/^\s*//; $mre =~ s/\s*$//;
384 $fields{$field}{match} = { sf => $msf, re => qr/$mre/ };
390 for my $f ( keys %fields) {
391 for my $to_field ($r->field( $f )) {
392 if (exists($fields{$f}{match})) {
393 next unless (grep { $_ =~ $fields{$f}{match}{re} } $to_field->subfield($fields{$f}{match}{sf}));
396 if ( @{$fields{$f}{sf}} ) {
397 $to_field->delete_subfield(code => $fields{$f}{sf});
399 $r->delete_field( $to_field );
404 $xml = $r->as_xml_record;
405 $xml =~ s/^<\?.+?\?>$//mo;
407 $xml =~ s/>\s+</></sgo;
411 $_$ LANGUAGE PLPERLU;
413 CREATE OR REPLACE FUNCTION biblio.flatten_marc ( TEXT ) RETURNS SETOF metabib.full_rec AS $func$
416 use MARC::File::XML (BinaryEncoding => 'UTF-8');
419 MARC::Charset->assume_unicode(1);
422 my $r = MARC::Record->new_from_xml( $xml );
424 return_next( { tag => 'LDR', value => $r->leader } );
426 for my $f ( $r->fields ) {
427 if ($f->is_control_field) {
428 return_next({ tag => $f->tag, value => $f->data });
430 for my $s ($f->subfields) {
433 ind1 => $f->indicator(1),
434 ind2 => $f->indicator(2),
439 if ( $f->tag eq '245' and $s->[0] eq 'a' ) {
440 my $trim = $f->indicator(2) || 0;
443 ind1 => $f->indicator(1),
444 ind2 => $f->indicator(2),
446 value => substr( $s->[1], $trim )
455 $func$ LANGUAGE PLPERLU;
457 CREATE OR REPLACE FUNCTION authority.flatten_marc ( TEXT ) RETURNS SETOF authority.full_rec AS $func$
460 use MARC::File::XML (BinaryEncoding => 'UTF-8');
463 MARC::Charset->assume_unicode(1);
466 my $r = MARC::Record->new_from_xml( $xml );
468 return_next( { tag => 'LDR', value => $r->leader } );
470 for my $f ( $r->fields ) {
471 if ($f->is_control_field) {
472 return_next({ tag => $f->tag, value => $f->data });
474 for my $s ($f->subfields) {
477 ind1 => $f->indicator(1),
478 ind2 => $f->indicator(2),
489 $func$ LANGUAGE PLPERLU;