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;