Avoid data loss by setting MARC::Charset->assume_unicode(1)
[working/Evergreen.git] / Open-ILS / src / sql / Pg / upgrade / 0528.schema.functions_assume_unicode.sql
1 BEGIN;
2
3 INSERT INTO config.upgrade_log (version) VALUES ('0528'); -- 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 MARC::Charset;
10 use Encode;
11 use Unicode::Normalize;
12
13 MARC::Charset->assume_unicode(1);
14
15 my $record = MARC::Record->new_from_xml($_TD->{new}{marc});
16 my $schema = $_TD->{table_schema};
17 my $rec_id = $_TD->{new}{id};
18
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') {
22     return;
23 }
24
25 # Get the control number identifier from an OU setting based on $_TD->{new}{owner}
26 my $ou_cni = 'EVRGRN';
27
28 my $owner;
29 if ($schema eq 'serial') {
30     $owner = $_TD->{new}{owning_lib};
31 } else {
32     # are.owner and bre.owner can be null, so fall back to the consortial setting
33     $owner = $_TD->{new}{owner} || 1;
34 }
35
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"
40 } else {
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};
45     }
46 }
47
48 my ($create, $munge) = (0, 0);
49
50 my @scns = $record->field('035');
51
52 foreach my $id_field ('001', '003') {
53     my $spec_value;
54     my @controls = $record->field($id_field);
55
56     if ($id_field eq '001') {
57         $spec_value = $rec_id;
58     } else {
59         $spec_value = $ou_cni;
60     }
61
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) {
66             $munge = 1;
67         }
68     } else {
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);
73             }
74         }
75         $record->insert_fields_ordered(MARC::Field->new($id_field, $spec_value));
76         $create = 1;
77     }
78 }
79
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();
85
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));
89     }
90 }
91
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);
96
97     my $xml = $record->as_xml_record();
98     $xml =~ s/\n//sgo;
99     $xml =~ s/^<\?xml.+\?\s*>//go;
100     $xml =~ s/>\s+</></go;
101     $xml =~ s/\p{Cc}//go;
102
103     # Embed a version of OpenILS::Application::AppUtils->entityize()
104     # to avoid having to set PERL5LIB for PostgreSQL as well
105
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);
109
110     $xml = NFC($xml);
111
112     # Convert raw ampersands to entities
113     $xml =~ s/&(?!\S+;)/&amp;/gso;
114
115     # Convert Unicode characters to entities
116     $xml =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
117
118     $xml =~ s/[\x00-\x1f]//go;
119     $_TD->{new}{marc} = $xml;
120
121     return "MODIFY";
122 }
123
124 return;
125 $func$ LANGUAGE PLPERLU;
126
127 CREATE OR REPLACE FUNCTION authority.generate_overlay_template ( TEXT, BIGINT ) RETURNS TEXT AS $func$
128
129     use MARC::Record;
130     use MARC::File::XML (BinaryEncoding => 'UTF-8');
131     use MARC::Charset;
132
133     MARC::Charset->assume_unicode(1);
134
135     my $xml = shift;
136     my $r = MARC::Record->new_from_xml( $xml );
137
138     return undef unless ($r);
139
140     my $id = shift() || $r->subfield( '901' => 'c' );
141     $id =~ s/^\s*(?:\([^)]+\))?\s*(.+)\s*?$/$1/;
142     return undef unless ($id); # We need an ID!
143
144     my $tmpl = MARC::Record->new();
145     $tmpl->encoding( 'UTF-8' );
146
147     my @rule_fields;
148     for my $field ( $r->field( '1..' ) ) { # Get main entry fields from the authority record
149
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;
155
156         my @replace_them;
157
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/;
167         } else {
168             next;
169         }
170
171         # Dummy up the bib-side data
172         $tmpl->append_fields(
173             map {
174                 MARC::Field->new( $_, $i1, $i2, @data )
175             } @replace_them
176         );
177
178         # Construct some 'replace' rules
179         push @rule_fields, map { $_ . $sf . '[0~\)' .$id . '$]' } @replace_them;
180     }
181
182     # Insert the replace rules into the template
183     $tmpl->append_fields(
184         MARC::Field->new( '905' => ' ' => ' ' => 'r' => join(',', @rule_fields ) )
185     );
186
187     $xml = $tmpl->as_xml_record;
188     $xml =~ s/^<\?.+?\?>$//mo;
189     $xml =~ s/\n//sgo;
190     $xml =~ s/>\s+</></sgo;
191
192     return $xml;
193
194 $func$ LANGUAGE PLPERLU;
195
196 CREATE OR REPLACE FUNCTION vandelay.add_field ( target_xml TEXT, source_xml TEXT, field TEXT, force_add INT ) RETURNS TEXT AS $_$
197
198     use MARC::Record;
199     use MARC::File::XML (BinaryEncoding => 'UTF-8');
200     use MARC::Charset;
201     use strict;
202
203     MARC::Charset->assume_unicode(1);
204
205     my $target_xml = shift;
206     my $source_xml = shift;
207     my $field_spec = shift;
208     my $force_add = shift || 0;
209
210     my $target_r = MARC::Record->new_from_xml( $target_xml );
211     my $source_r = MARC::Record->new_from_xml( $source_xml );
212
213     return $target_xml unless ($target_r && $source_r);
214
215     my @field_list = split(',', $field_spec);
216
217     my %fields;
218     for my $f (@field_list) {
219         $f =~ s/^\s*//; $f =~ s/\s*$//;
220         if ($f =~ /^(.{3})(\w*)(?:\[([^]]*)\])?$/) {
221             my $field = $1;
222             $field =~ s/\s+//;
223             my $sf = $2;
224             $sf =~ s/\s+//;
225             my $match = $3;
226             $match =~ s/^\s*//; $match =~ s/\s*$//;
227             $fields{$field} = { sf => [ split('', $sf) ] };
228             if ($match) {
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/ };
234                 }
235             }
236         }
237     }
238
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 );
243                 if (!@tos) {
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 );
247                 } else {
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}));
251                         }
252                         my @new_sf = map { ($_ => $from_field->subfield($_)) } @{$fields{$f}{sf}};
253                         $to_field->add_subfields( @new_sf );
254                     }
255                 }
256             }
257         } else {
258             my @new_fields = map { $_->clone } $source_r->field( $f );
259             $target_r->insert_fields_ordered( @new_fields );
260         }
261     }
262
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;
267
268     return $target_xml;
269
270 $_$ LANGUAGE PLPERLU;
271
272 CREATE OR REPLACE FUNCTION authority.normalize_heading( TEXT ) RETURNS TEXT AS $func$
273     use strict;
274     use warnings;
275
276     use utf8;
277     use MARC::Record;
278     use MARC::File::XML (BinaryEncoding => 'UTF8');
279     use MARC::Charset;
280     use UUID::Tiny ':std';
281
282     MARC::Charset->assume_unicode(1);
283
284     my $xml = shift() or return undef;
285
286     my $r;
287
288     # Prevent errors in XML parsing from blowing out ungracefully
289     eval {
290         $r = MARC::Record->new_from_xml( $xml );
291         1;
292     } or do {
293        return 'BAD_MARCXML_' . create_uuid_as_string(UUID_MD5, $xml);
294     };
295
296     if (!$r) {
297        return 'BAD_MARCXML_' . create_uuid_as_string(UUID_MD5, $xml);
298     }
299
300     # From http://www.loc.gov/standards/sourcelist/subject.html
301     my $thes_code_map = {
302         a => 'lcsh',
303         b => 'lcshac',
304         c => 'mesh',
305         d => 'nal',
306         k => 'cash',
307         n => 'notapplicable',
308         r => 'aat',
309         s => 'sears',
310         v => 'rvm',
311     };
312
313     # Default to "No attempt to code" if the leader is horribly broken
314     my $fixed_field = $r->field('008');
315     my $thes_char = '|';
316     if ($fixed_field) { 
317         $thes_char = substr($fixed_field->data(), 11, 1) || '|';
318     }
319
320     my $thes_code = 'UNDEFINED';
321
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};
327     }
328
329     my $auth_txt = '';
330     my $head = $r->field('1..');
331     if ($head) {
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];
336         }
337     }
338     
339     if ($auth_txt) {
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};
343         spi_freeplan($stmt);
344         undef($stmt);
345         return $head->tag() . "_" . $thes_code . " " . $norm_txt;
346     }
347
348     return 'NOHEADING_' . $thes_code . ' ' . create_uuid_as_string(UUID_MD5, $xml);
349 $func$ LANGUAGE 'plperlu' IMMUTABLE;
350
351 CREATE OR REPLACE FUNCTION vandelay.strip_field ( xml TEXT, field TEXT ) RETURNS TEXT AS $_$
352
353     use MARC::Record;
354     use MARC::File::XML (BinaryEncoding => 'UTF-8');
355     use MARC::Charset;
356     use strict;
357
358     MARC::Charset->assume_unicode(1);
359
360     my $xml = shift;
361     my $r = MARC::Record->new_from_xml( $xml );
362
363     return $xml unless ($r);
364
365     my $field_spec = shift;
366     my @field_list = split(',', $field_spec);
367
368     my %fields;
369     for my $f (@field_list) {
370         $f =~ s/^\s*//; $f =~ s/\s*$//;
371         if ($f =~ /^(.{3})(\w*)(?:\[([^]]*)\])?$/) {
372             my $field = $1;
373             $field =~ s/\s+//;
374             my $sf = $2;
375             $sf =~ s/\s+//;
376             my $match = $3;
377             $match =~ s/^\s*//; $match =~ s/\s*$//;
378             $fields{$field} = { sf => [ split('', $sf) ] };
379             if ($match) {
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/ };
385                 }
386             }
387         }
388     }
389
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}));
394             }
395
396             if ( @{$fields{$f}{sf}} ) {
397                 $to_field->delete_subfield(code => $fields{$f}{sf});
398             } else {
399                 $r->delete_field( $to_field );
400             }
401         }
402     }
403
404     $xml = $r->as_xml_record;
405     $xml =~ s/^<\?.+?\?>$//mo;
406     $xml =~ s/\n//sgo;
407     $xml =~ s/>\s+</></sgo;
408
409     return $xml;
410
411 $_$ LANGUAGE PLPERLU;
412
413 CREATE OR REPLACE FUNCTION biblio.flatten_marc ( TEXT ) RETURNS SETOF metabib.full_rec AS $func$
414
415 use MARC::Record;
416 use MARC::File::XML (BinaryEncoding => 'UTF-8');
417 use MARC::Charset;
418
419 MARC::Charset->assume_unicode(1);
420
421 my $xml = shift;
422 my $r = MARC::Record->new_from_xml( $xml );
423
424 return_next( { tag => 'LDR', value => $r->leader } );
425
426 for my $f ( $r->fields ) {
427         if ($f->is_control_field) {
428                 return_next({ tag => $f->tag, value => $f->data });
429         } else {
430                 for my $s ($f->subfields) {
431                         return_next({
432                                 tag      => $f->tag,
433                                 ind1     => $f->indicator(1),
434                                 ind2     => $f->indicator(2),
435                                 subfield => $s->[0],
436                                 value    => $s->[1]
437                         });
438
439                         if ( $f->tag eq '245' and $s->[0] eq 'a' ) {
440                                 my $trim = $f->indicator(2) || 0;
441                                 return_next({
442                                         tag      => 'tnf',
443                                         ind1     => $f->indicator(1),
444                                         ind2     => $f->indicator(2),
445                                         subfield => 'a',
446                                         value    => substr( $s->[1], $trim )
447                                 });
448                         }
449                 }
450         }
451 }
452
453 return undef;
454
455 $func$ LANGUAGE PLPERLU;
456
457 CREATE OR REPLACE FUNCTION authority.flatten_marc ( TEXT ) RETURNS SETOF authority.full_rec AS $func$
458
459 use MARC::Record;
460 use MARC::File::XML (BinaryEncoding => 'UTF-8');
461 use MARC::Charset;
462
463 MARC::Charset->assume_unicode(1);
464
465 my $xml = shift;
466 my $r = MARC::Record->new_from_xml( $xml );
467
468 return_next( { tag => 'LDR', value => $r->leader } );
469
470 for my $f ( $r->fields ) {
471     if ($f->is_control_field) {
472         return_next({ tag => $f->tag, value => $f->data });
473     } else {
474         for my $s ($f->subfields) {
475             return_next({
476                 tag      => $f->tag,
477                 ind1     => $f->indicator(1),
478                 ind2     => $f->indicator(2),
479                 subfield => $s->[0],
480                 value    => $s->[1]
481             });
482
483         }
484     }
485 }
486
487 return undef;
488
489 $func$ LANGUAGE PLPERLU;
490
491 COMMIT;