Open-ILS/src/sql/Pg/002.functions.config.sql

   1 /*
   2  * Copyright (C) 2004-2008  Georgia Public Library Service
   3  * Copyright (C) 2008-2014  Equinox Software, Inc.
   4  * Mike Rylander <miker@esilibrary.com>
   5  *
   6  * This program is free software; you can redistribute it and/or
   7  * modify it under the terms of the GNU General Public License
   8  * as published by the Free Software Foundation; either version 2
   9  * of the License, or (at your option) any later version.
  10  *
  11  * This program is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  * GNU General Public License for more details.
  15  *
  16  */
  17
  18
  19 BEGIN;
  20
  21 CREATE OR REPLACE FUNCTION evergreen.xml_famous5_to_text( TEXT ) RETURNS TEXT AS $f$
  22  SELECT REPLACE(
  23             REPLACE(
  24                 REPLACE(
  25                     REPLACE(
  26                         REPLACE( $1, '&lt;', '<'),
  27                         '&gt;',
  28                         '>'
  29                     ),
  30                     '&apos;',
  31                     $$'$$
  32                 ), -- ' ... vim
  33                 '&quot;',
  34                 '"'
  35             ),
  36             '&amp;',
  37             '&'
  38         );
  39 $f$ LANGUAGE SQL IMMUTABLE;
  40
  41 CREATE OR REPLACE FUNCTION evergreen.oils_xpath ( TEXT, TEXT, TEXT[] ) RETURNS TEXT[] AS $f$
  42     SELECT  ARRAY_AGG(
  43                 CASE WHEN strpos(x,'<') = 1 THEN -- It's an element node
  44                     x
  45                 ELSE -- it's text-ish
  46                     evergreen.xml_famous5_to_text(x)
  47                 END
  48             )
  49       FROM  UNNEST(XPATH( $1, $2::XML, $3 )::TEXT[]) x;
  50 $f$ LANGUAGE SQL IMMUTABLE;
  51
  52 -- Trust me, it's just simpler to duplicate these...
  53 CREATE OR REPLACE FUNCTION evergreen.oils_xpath ( TEXT, TEXT ) RETURNS TEXT[] AS $f$
  54     SELECT  ARRAY_AGG(
  55                 CASE WHEN strpos(x,'<') = 1 THEN -- It's an element node
  56                     x
  57                 ELSE -- it's text-ish
  58                     evergreen.xml_famous5_to_text(x)
  59                 END
  60             )
  61       FROM  UNNEST(XPATH( $1, $2::XML)::TEXT[]) x;
  62 $f$ LANGUAGE SQL IMMUTABLE;
  63
  64 CREATE OR REPLACE FUNCTION evergreen.oils_xslt_process(TEXT, TEXT) RETURNS TEXT AS $func$
  65   use strict;
  66
  67   use XML::LibXSLT;
  68   use XML::LibXML;
  69
  70   my $doc = shift;
  71   my $xslt = shift;
  72
  73   # The following approach uses the older XML::LibXML 1.69 / XML::LibXSLT 1.68
  74   # methods of parsing XML documents and stylesheets, in the hopes of broader
  75   # compatibility with distributions
  76   my $parser = $_SHARED{'_xslt_process'}{parsers}{xml} || XML::LibXML->new();
  77
  78   # Cache the XML parser, if we do not already have one
  79   $_SHARED{'_xslt_process'}{parsers}{xml} = $parser
  80     unless ($_SHARED{'_xslt_process'}{parsers}{xml});
  81
  82   my $xslt_parser = $_SHARED{'_xslt_process'}{parsers}{xslt} || XML::LibXSLT->new();
  83
  84   # Cache the XSLT processor, if we do not already have one
  85   $_SHARED{'_xslt_process'}{parsers}{xslt} = $xslt_parser
  86     unless ($_SHARED{'_xslt_process'}{parsers}{xslt});
  87
  88   my $stylesheet = $_SHARED{'_xslt_process'}{stylesheets}{$xslt} ||
  89     $xslt_parser->parse_stylesheet( $parser->parse_string($xslt) );
  90
  91   $_SHARED{'_xslt_process'}{stylesheets}{$xslt} = $stylesheet
  92     unless ($_SHARED{'_xslt_process'}{stylesheets}{$xslt});
  93
  94   return $stylesheet->output_as_chars(
  95     $stylesheet->transform(
  96       $parser->parse_string($doc)
  97     )
  98   );
  99
 100 $func$ LANGUAGE 'plperlu' STRICT IMMUTABLE;
 101
 102 CREATE OR REPLACE FUNCTION oils_xpath_string ( TEXT, TEXT, TEXT, ANYARRAY ) RETURNS TEXT AS $func$
 103     SELECT  ARRAY_TO_STRING(
 104                 oils_xpath(
 105                     $1 ||
 106                         CASE WHEN $1 ~ $re$/[^/[]*@[^]]+$$re$ OR $1 ~ $re$text\(\)$$re$ THEN '' ELSE '//text()' END,
 107                     $2,
 108                     $4
 109                 ),
 110                 $3
 111             );
 112 $func$ LANGUAGE SQL IMMUTABLE;
 113
 114 CREATE OR REPLACE FUNCTION oils_xpath_string ( TEXT, TEXT, TEXT ) RETURNS TEXT AS $func$
 115     SELECT oils_xpath_string( $1, $2, $3, '{}'::TEXT[] );
 116 $func$ LANGUAGE SQL IMMUTABLE;
 117
 118 CREATE OR REPLACE FUNCTION oils_xpath_string ( TEXT, TEXT, ANYARRAY ) RETURNS TEXT AS $func$
 119     SELECT oils_xpath_string( $1, $2, '', $3 );
 120 $func$ LANGUAGE SQL IMMUTABLE;
 121
 122 CREATE OR REPLACE FUNCTION oils_xpath_string ( TEXT, TEXT ) RETURNS TEXT AS $func$
 123     SELECT oils_xpath_string( $1, $2, '{}'::TEXT[] );
 124 $func$ LANGUAGE SQL IMMUTABLE;
 125
 126
 127 CREATE OR REPLACE FUNCTION oils_xpath_table ( key TEXT, document_field TEXT, relation_name TEXT, xpaths TEXT, criteria TEXT ) RETURNS SETOF RECORD AS $func$
 128 DECLARE
 129     xpath_list  TEXT[];
 130     select_list TEXT[];
 131     where_list  TEXT[];
 132     q           TEXT;
 133     out_record  RECORD;
 134     empty_test  RECORD;
 135 BEGIN
 136     xpath_list := STRING_TO_ARRAY( xpaths, '|' );
 137
 138     select_list := ARRAY_APPEND( select_list, key || '::INT AS key' );
 139
 140     FOR i IN 1 .. ARRAY_UPPER(xpath_list,1) LOOP
 141         IF xpath_list[i] = 'null()' THEN
 142             select_list := ARRAY_APPEND( select_list, 'NULL::TEXT AS c_' || i );
 143         ELSE
 144             select_list := ARRAY_APPEND(
 145                 select_list,
 146                 $sel$
 147                 unnest(
 148                     COALESCE(
 149                         NULLIF(
 150                             oils_xpath(
 151                                 $sel$ ||
 152                                     quote_literal(
 153                                         CASE
 154                                             WHEN xpath_list[i] ~ $re$/[^/[]*@[^/]+$$re$ OR xpath_list[i] ~ $re$text\(\)$$re$ THEN xpath_list[i]
 155                                             ELSE xpath_list[i] || '//text()'
 156                                         END
 157                                     ) ||
 158                                 $sel$,
 159                                 $sel$ || document_field || $sel$
 160                             ),
 161                            '{}'::TEXT[]
 162                         ),
 163                         '{NULL}'::TEXT[]
 164                     )
 165                 ) AS c_$sel$ || i
 166             );
 167             where_list := ARRAY_APPEND(
 168                 where_list,
 169                 'c_' || i || ' IS NOT NULL'
 170             );
 171         END IF;
 172     END LOOP;
 173
 174     q := $q$
 175 SELECT * FROM (
 176     SELECT $q$ || ARRAY_TO_STRING( select_list, ', ' ) || $q$ FROM $q$ || relation_name || $q$ WHERE ($q$ || criteria || $q$)
 177 )x WHERE $q$ || ARRAY_TO_STRING( where_list, ' OR ' );
 178     -- RAISE NOTICE 'query: %', q;
 179
 180     FOR out_record IN EXECUTE q LOOP
 181         RETURN NEXT out_record;
 182     END LOOP;
 183
 184     RETURN;
 185 END;
 186 $func$ LANGUAGE PLPGSQL IMMUTABLE;
 187
 188 CREATE OR REPLACE FUNCTION oils_xpath_tag_to_table(marc text, tag text, xpaths text[]) RETURNS SETOF record AS $function$
 189
 190 -- This function currently populates columns with the FIRST matching value
 191 -- of each XPATH.  It would be reasonable to add a 'return_arrays' option
 192 -- where each column is an array of all matching values for each path, but
 193 -- that remains as a TODO
 194
 195 DECLARE
 196     field RECORD;
 197     output RECORD;
 198     select_list TEXT[];
 199     from_list TEXT[];
 200     q TEXT;
 201 BEGIN
 202     -- setup query select
 203     FOR i IN 1 .. ARRAY_UPPER(xpaths,1) LOOP
 204         IF xpaths[i] = 'null()' THEN
 205             select_list := ARRAY_APPEND(select_list, 'NULL::TEXT AS c_' || i );
 206         ELSE
 207             select_list := ARRAY_APPEND(select_list, '(oils_xpath(' ||
 208                 quote_literal(
 209                     CASE
 210                         WHEN xpaths[i] ~ $re$/[^/[]*@[^/]+$$re$ -- attribute
 211                             OR xpaths[i] ~ $re$text\(\)$$re$
 212                         THEN xpaths[i]
 213                         ELSE xpaths[i] || '//text()'
 214                     END
 215                 ) || ', field_marc))[1] AS cl_' || i);
 216                 -- hardcoded to first value for each path
 217         END IF;
 218     END LOOP;
 219
 220     -- run query over tag set
 221     q := 'SELECT ' || ARRAY_TO_STRING(select_list, ',')
 222         || ' FROM UNNEST(oils_xpath(' || quote_literal('//*[@tag="' || tag
 223         || '"]') || ', ' || quote_literal(marc) || ')) AS field_marc;';
 224     --RAISE NOTICE '%', q;
 225
 226     RETURN QUERY EXECUTE q;
 227 END;
 228
 229 $function$ LANGUAGE PLPGSQL;
 230
 231 CREATE OR REPLACE FUNCTION extract_marc_field ( TEXT, BIGINT, TEXT, TEXT ) RETURNS TEXT AS $$
 232 DECLARE
 233     query TEXT;
 234     output TEXT;
 235 BEGIN
 236     query := $q$
 237         SELECT  regexp_replace(
 238                     oils_xpath_string(
 239                         $q$ || quote_literal($3) || $q$,
 240                         marc,
 241                         ' '
 242                     ),
 243                     $q$ || quote_literal($4) || $q$,
 244                     '',
 245                     'g')
 246           FROM  $q$ || $1 || $q$
 247           WHERE id = $q$ || $2;
 248
 249     EXECUTE query INTO output;
 250
 251     -- RAISE NOTICE 'query: %, output; %', query, output;
 252
 253     RETURN output;
 254 END;
 255 $$ LANGUAGE PLPGSQL IMMUTABLE;
 256
 257 CREATE OR REPLACE FUNCTION extract_marc_field_set
 258         (TEXT, BIGINT, TEXT, TEXT) RETURNS SETOF TEXT AS $$
 259 DECLARE
 260     query TEXT;
 261     output TEXT;
 262 BEGIN
 263     FOR output IN
 264         SELECT x.t FROM (
 265             SELECT id,t
 266                 FROM  oils_xpath_table(
 267                     'id', 'marc', $1, $3, 'id = ' || $2)
 268                 AS t(id int, t text))x
 269         LOOP
 270         IF $4 IS NOT NULL THEN
 271             SELECT INTO output (SELECT regexp_replace(output, $4, '', 'g'));
 272         END IF;
 273         RETURN NEXT output;
 274     END LOOP;
 275     RETURN;
 276 END;
 277 $$ LANGUAGE PLPGSQL IMMUTABLE;
 278
 279
 280 CREATE OR REPLACE FUNCTION extract_marc_field ( TEXT, BIGINT, TEXT ) RETURNS TEXT AS $$
 281     SELECT extract_marc_field($1,$2,$3,'');
 282 $$ LANGUAGE SQL IMMUTABLE;
 283
 284
 285
 286 CREATE OR REPLACE FUNCTION oils_i18n_xlate ( keytable TEXT, keyclass TEXT, keycol TEXT, identcol TEXT, keyvalue TEXT, raw_locale TEXT ) RETURNS TEXT AS $func$
 287 DECLARE
 288     locale      TEXT := REGEXP_REPLACE( REGEXP_REPLACE( raw_locale, E'[;, ].+$', '' ), E'_', '-', 'g' );
 289     language    TEXT := REGEXP_REPLACE( locale, E'-.+$', '' );
 290     result      config.i18n_core%ROWTYPE;
 291     fallback    TEXT;
 292     keyfield    TEXT := keyclass || '.' || keycol;
 293 BEGIN
 294
 295     -- Try the full locale
 296     SELECT  * INTO result
 297       FROM  config.i18n_core
 298       WHERE fq_field = keyfield
 299             AND identity_value = keyvalue
 300             AND translation = locale;
 301
 302     -- Try just the language
 303     IF NOT FOUND THEN
 304         SELECT  * INTO result
 305           FROM  config.i18n_core
 306           WHERE fq_field = keyfield
 307                 AND identity_value = keyvalue
 308                 AND translation = language;
 309     END IF;
 310
 311     -- Fall back to the string we passed in in the first place
 312     IF NOT FOUND THEN
 313         EXECUTE
 314             'SELECT ' ||
 315                 keycol ||
 316             ' FROM ' || keytable ||
 317             ' WHERE ' || identcol || ' = ' || quote_literal(keyvalue)
 318                 INTO fallback;
 319         RETURN fallback;
 320     END IF;
 321
 322     RETURN result.string;
 323 END;
 324 $func$ LANGUAGE PLPGSQL STABLE;
 325
 326 -- Functions for marking translatable strings in SQL statements
 327 -- Parameters are: primary key, string, class hint, property
 328 CREATE OR REPLACE FUNCTION oils_i18n_gettext( INT, TEXT, TEXT, TEXT ) RETURNS TEXT AS $$
 329     SELECT $2;
 330 $$ LANGUAGE SQL;
 331
 332 CREATE OR REPLACE FUNCTION oils_i18n_gettext( TEXT, TEXT, TEXT, TEXT ) RETURNS TEXT AS $$
 333     SELECT $2;
 334 $$ LANGUAGE SQL;
 335
 336 CREATE OR REPLACE FUNCTION is_json( TEXT ) RETURNS BOOL AS $f$
 337     use JSON::XS;
 338     my $json = shift();
 339     eval { JSON::XS->new->allow_nonref->decode( $json ) };
 340     return $@ ? 0 : 1;
 341 $f$ LANGUAGE PLPERLU;
 342
 343 -- turn a JSON scalar into an SQL TEXT value
 344 CREATE OR REPLACE FUNCTION oils_json_to_text( TEXT ) RETURNS TEXT AS $f$
 345     use JSON::XS;
 346     my $json = shift();
 347     my $txt;
 348     eval { $txt = JSON::XS->new->allow_nonref->decode( $json ) };
 349     return undef if ($@);
 350     return $txt
 351 $f$ LANGUAGE PLPERLU;
 352
 353 CREATE OR REPLACE FUNCTION evergreen.maintain_901 () RETURNS TRIGGER AS $func$
 354 use strict;
 355 use MARC::Record;
 356 use MARC::File::XML (BinaryEncoding => 'UTF-8');
 357 use MARC::Charset;
 358 use Encode;
 359 use Unicode::Normalize;
 360
 361 MARC::Charset->assume_unicode(1);
 362
 363 my $schema = $_TD->{table_schema};
 364 my $marc = MARC::Record->new_from_xml($_TD->{new}{marc});
 365
 366 my @old901s = $marc->field('901');
 367 $marc->delete_fields(@old901s);
 368
 369 if ($schema eq 'biblio') {
 370     my $tcn_value = $_TD->{new}{tcn_value};
 371
 372     # Set TCN value to record ID?
 373     my $id_as_tcn = spi_exec_query("
 374         SELECT enabled
 375         FROM config.global_flag
 376         WHERE name = 'cat.bib.use_id_for_tcn'
 377     ");
 378     if (($id_as_tcn->{processed}) && $id_as_tcn->{rows}[0]->{enabled} eq 't') {
 379         $tcn_value = $_TD->{new}{id};
 380         $_TD->{new}{tcn_value} = $tcn_value;
 381     }
 382
 383     my $new_901 = MARC::Field->new("901", " ", " ",
 384         "a" => $tcn_value,
 385         "b" => $_TD->{new}{tcn_source},
 386         "c" => $_TD->{new}{id},
 387         "t" => $schema
 388     );
 389
 390     if ($_TD->{new}{owner}) {
 391         $new_901->add_subfields("o" => $_TD->{new}{owner});
 392     }
 393
 394     if ($_TD->{new}{share_depth}) {
 395         $new_901->add_subfields("d" => $_TD->{new}{share_depth});
 396     }
 397
 398     if ($_TD->{new}{source}) {
 399         my $plan = spi_prepare('
 400             SELECT source
 401             FROM config.bib_source
 402             WHERE id = $1
 403         ', 'INTEGER');
 404         my $source_name =
 405             spi_exec_prepared($plan, {limit => 1}, $_TD->{new}{source})->{rows}[0]{source};
 406         spi_freeplan($plan);
 407         $new_901->add_subfields("s" => $source_name) if $source_name;
 408     }
 409
 410     $marc->append_fields($new_901);
 411 } elsif ($schema eq 'authority') {
 412     my $new_901 = MARC::Field->new("901", " ", " ",
 413         "c" => $_TD->{new}{id},
 414         "t" => $schema,
 415     );
 416     $marc->append_fields($new_901);
 417 } elsif ($schema eq 'serial') {
 418     my $new_901 = MARC::Field->new("901", " ", " ",
 419         "c" => $_TD->{new}{id},
 420         "t" => $schema,
 421         "o" => $_TD->{new}{owning_lib},
 422     );
 423
 424     if ($_TD->{new}{record}) {
 425         $new_901->add_subfields("r" => $_TD->{new}{record});
 426     }
 427
 428     $marc->append_fields($new_901);
 429 } else {
 430     my $new_901 = MARC::Field->new("901", " ", " ",
 431         "c" => $_TD->{new}{id},
 432         "t" => $schema,
 433     );
 434     $marc->append_fields($new_901);
 435 }
 436
 437 my $xml = $marc->as_xml_record();
 438 $xml =~ s/\n//sgo;
 439 $xml =~ s/^<\?xml.+\?\s*>//go;
 440 $xml =~ s/>\s+</></go;
 441 $xml =~ s/\p{Cc}//go;
 442
 443 # Embed a version of OpenILS::Application::AppUtils->entityize()
 444 # to avoid having to set PERL5LIB for PostgreSQL as well
 445
 446 $xml = NFC($xml);
 447
 448 # Convert raw ampersands to entities
 449 $xml =~ s/&(?!\S+;)/&amp;/gso;
 450
 451 # Convert Unicode characters to entities
 452 $xml =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
 453
 454 $xml =~ s/[\x00-\x1f]//go;
 455 $_TD->{new}{marc} = $xml;
 456
 457 return "MODIFY";
 458 $func$ LANGUAGE PLPERLU;
 459
 460 CREATE OR REPLACE FUNCTION evergreen.force_unicode_normal_form(string TEXT, form TEXT) RETURNS TEXT AS $func$
 461 use Unicode::Normalize 'normalize';
 462 return normalize($_[1],$_[0]); # reverse the params
 463 $func$ LANGUAGE PLPERLU;
 464
 465 CREATE OR REPLACE FUNCTION evergreen.maintain_control_numbers() RETURNS TRIGGER AS $func$
 466 use strict;
 467 use MARC::Record;
 468 use MARC::File::XML (BinaryEncoding => 'UTF-8');
 469 use MARC::Charset;
 470 use Encode;
 471 use Unicode::Normalize;
 472
 473 MARC::Charset->assume_unicode(1);
 474
 475 my $record = MARC::Record->new_from_xml($_TD->{new}{marc});
 476 my $schema = $_TD->{table_schema};
 477 my $rec_id = $_TD->{new}{id};
 478
 479 # Short-circuit if maintaining control numbers per MARC21 spec is not enabled
 480 my $enable = spi_exec_query("SELECT enabled FROM config.global_flag WHERE name = 'cat.maintain_control_numbers'");
 481 if (!($enable->{processed}) or $enable->{rows}[0]->{enabled} eq 'f') {
 482     return;
 483 }
 484
 485 # Get the control number identifier from an OU setting based on $_TD->{new}{owner}
 486 my $ou_cni = 'EVRGRN';
 487
 488 my $owner;
 489 if ($schema eq 'serial') {
 490     $owner = $_TD->{new}{owning_lib};
 491 } else {
 492     # are.owner and bre.owner can be null, so fall back to the consortial setting
 493     $owner = $_TD->{new}{owner} || 1;
 494 }
 495
 496 my $ous_rv = spi_exec_query("SELECT value FROM actor.org_unit_ancestor_setting('cat.marc_control_number_identifier', $owner)");
 497 if ($ous_rv->{processed}) {
 498     $ou_cni = $ous_rv->{rows}[0]->{value};
 499     $ou_cni =~ s/"//g; # Stupid VIM syntax highlighting"
 500 } else {
 501     # Fall back to the shortname of the OU if there was no OU setting
 502     $ous_rv = spi_exec_query("SELECT shortname FROM actor.org_unit WHERE id = $owner");
 503     if ($ous_rv->{processed}) {
 504         $ou_cni = $ous_rv->{rows}[0]->{shortname};
 505     }
 506 }
 507
 508 my ($create, $munge) = (0, 0);
 509
 510 my @scns = $record->field('035');
 511
 512 foreach my $id_field ('001', '003') {
 513     my $spec_value;
 514     my @controls = $record->field($id_field);
 515
 516     if ($id_field eq '001') {
 517         $spec_value = $rec_id;
 518     } else {
 519         $spec_value = $ou_cni;
 520     }
 521
 522     # Create the 001/003 if none exist
 523     if (scalar(@controls) == 1) {
 524         # Only one field; check to see if we need to munge it
 525         unless (grep $_->data() eq $spec_value, @controls) {
 526             $munge = 1;
 527         }
 528     } else {
 529         # Delete the other fields, as with more than 1 001/003 we do not know which 003/001 to match
 530         foreach my $control (@controls) {
 531             $record->delete_field($control);
 532         }
 533         $record->insert_fields_ordered(MARC::Field->new($id_field, $spec_value));
 534         $create = 1;
 535     }
 536 }
 537
 538 my $cn = $record->field('001')->data();
 539 # Special handling of OCLC numbers, often found in records that lack 003
 540 if ($cn =~ /^o(c[nm]|n)\d/) {
 541     $cn =~ s/^o(c[nm]|n)0*(\d+)/$2/;
 542     $record->field('003')->data('OCoLC');
 543     $create = 0;
 544 }
 545
 546 # Now, if we need to munge the 001, we will first push the existing 001/003
 547 # into the 035; but if the record did not have one (and one only) 001 and 003
 548 # to begin with, skip this process
 549 if ($munge and not $create) {
 550
 551     my $scn = "(" . $record->field('003')->data() . ")" . $cn;
 552
 553     # Do not create duplicate 035 fields
 554     unless (grep $_->subfield('a') eq $scn, @scns) {
 555         $record->insert_fields_ordered(MARC::Field->new('035', '', '', 'a' => $scn));
 556     }
 557 }
 558
 559 # Set the 001/003 and update the MARC
 560 if ($create or $munge) {
 561     $record->field('001')->data($rec_id);
 562     $record->field('003')->data($ou_cni);
 563
 564     my $xml = $record->as_xml_record();
 565     $xml =~ s/\n//sgo;
 566     $xml =~ s/^<\?xml.+\?\s*>//go;
 567     $xml =~ s/>\s+</></go;
 568     $xml =~ s/\p{Cc}//go;
 569
 570     # Embed a version of OpenILS::Application::AppUtils->entityize()
 571     # to avoid having to set PERL5LIB for PostgreSQL as well
 572
 573     $xml = NFC($xml);
 574
 575     # Convert raw ampersands to entities
 576     $xml =~ s/&(?!\S+;)/&amp;/gso;
 577
 578     # Convert Unicode characters to entities
 579     $xml =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
 580
 581     $xml =~ s/[\x00-\x1f]//go;
 582     $_TD->{new}{marc} = $xml;
 583
 584     return "MODIFY";
 585 }
 586
 587 return;
 588 $func$ LANGUAGE PLPERLU;
 589
 590 CREATE OR REPLACE FUNCTION oils_text_as_bytea (TEXT) RETURNS BYTEA AS $_$
 591     SELECT CAST(REGEXP_REPLACE(UPPER($1), $$\\$$, $$\\\\$$, 'g') AS BYTEA);
 592 $_$ LANGUAGE SQL IMMUTABLE;
 593
 594 CREATE OR REPLACE FUNCTION evergreen.lpad_number_substrings( TEXT, TEXT, INT ) RETURNS TEXT AS $$
 595     my $string = shift;            # Source string
 596     my $pad = shift;               # string to fill. Typically '0'. This should be a single character.
 597     my $len = shift;               # length of resultant padded field
 598
 599     $string =~ s/([0-9]+)/$pad x ($len - length($1)) . $1/eg;
 600
 601     return $string;
 602 $$ LANGUAGE PLPERLU;
 603
 604 CREATE OR REPLACE FUNCTION public.naco_normalize( TEXT, TEXT ) RETURNS TEXT AS $func$
 605
 606     use strict;
 607     use Unicode::Normalize;
 608     use Encode;
 609
 610     my $str = shift;
 611     my $sf = shift;
 612
 613     # Apply NACO normalization to input string; based on
 614     # https://www.loc.gov/aba/pcc/naco/documents/SCA_PccNormalization_Final_revised.pdf
 615     #
 616     # Note that unlike a strict reading of the NACO normalization rules,
 617     # output is returned as lowercase instead of uppercase for compatibility
 618     # with previous versions of the Evergreen naco_normalize routine.
 619
 620     # Convert to upper-case first; even though final output will be lowercase, doing this will
 621     # ensure that the German eszett (ß) and certain ligatures (ﬀ, ﬁ, ﬄ, etc.) will be handled correctly.
 622     # If there are any bugs in Perl's implementation of upcasing, they will be passed through here.
 623     $str = uc $str;
 624
 625     # remove non-filing strings
 626     $str =~ s/\x{0098}.*?\x{009C}//g;
 627
 628     $str = NFKD($str);
 629
 630     # additional substitutions - 3.6.
 631     $str =~ s/\x{00C6}/AE/g;
 632     $str =~ s/\x{00DE}/TH/g;
 633     $str =~ s/\x{0152}/OE/g;
 634     $str =~ tr/\x{0110}\x{00D0}\x{00D8}\x{0141}\x{2113}\x{02BB}\x{02BC}]['/DDOLl/d;
 635
 636     # transformations based on Unicode category codes
 637     $str =~ s/[\p{Cc}\p{Cf}\p{Co}\p{Cs}\p{Lm}\p{Mc}\p{Me}\p{Mn}]//g;
 638
 639         if ($sf && $sf =~ /^a/o) {
 640                 my $commapos = index($str, ',');
 641                 if ($commapos > -1) {
 642                         if ($commapos != length($str) - 1) {
 643                 $str =~ s/,/\x07/; # preserve first comma
 644                         }
 645                 }
 646         }
 647
 648     # since we've stripped out the control characters, we can now
 649     # use a few as placeholders temporarily
 650     $str =~ tr/+&@\x{266D}\x{266F}#/\x01\x02\x03\x04\x05\x06/;
 651     $str =~ s/[\p{Pc}\p{Pd}\p{Pe}\p{Pf}\p{Pi}\p{Po}\p{Ps}\p{Sk}\p{Sm}\p{So}\p{Zl}\p{Zp}\p{Zs}]/ /g;
 652     $str =~ tr/\x01\x02\x03\x04\x05\x06\x07/+&@\x{266D}\x{266F}#,/;
 653
 654     # decimal digits
 655     $str =~ tr/\x{0660}-\x{0669}\x{06F0}-\x{06F9}\x{07C0}-\x{07C9}\x{0966}-\x{096F}\x{09E6}-\x{09EF}\x{0A66}-\x{0A6F}\x{0AE6}-\x{0AEF}\x{0B66}-\x{0B6F}\x{0BE6}-\x{0BEF}\x{0C66}-\x{0C6F}\x{0CE6}-\x{0CEF}\x{0D66}-\x{0D6F}\x{0E50}-\x{0E59}\x{0ED0}-\x{0ED9}\x{0F20}-\x{0F29}\x{1040}-\x{1049}\x{1090}-\x{1099}\x{17E0}-\x{17E9}\x{1810}-\x{1819}\x{1946}-\x{194F}\x{19D0}-\x{19D9}\x{1A80}-\x{1A89}\x{1A90}-\x{1A99}\x{1B50}-\x{1B59}\x{1BB0}-\x{1BB9}\x{1C40}-\x{1C49}\x{1C50}-\x{1C59}\x{A620}-\x{A629}\x{A8D0}-\x{A8D9}\x{A900}-\x{A909}\x{A9D0}-\x{A9D9}\x{AA50}-\x{AA59}\x{ABF0}-\x{ABF9}\x{FF10}-\x{FF19}/0-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-9/;
 656
 657     # intentionally skipping step 8 of the NACO algorithm; if the string
 658     # gets normalized away, that's fine.
 659
 660     # leading and trailing spaces
 661     $str =~ s/\s+/ /g;
 662     $str =~ s/^\s+//;
 663     $str =~ s/\s+$//g;
 664
 665     return lc $str;
 666 $func$ LANGUAGE 'plperlu' STRICT IMMUTABLE;
 667
 668 -- Currently, the only difference from naco_normalize is that search_normalize
 669 -- turns apostrophes into spaces, while naco_normalize collapses them.
 670 CREATE OR REPLACE FUNCTION public.search_normalize( TEXT, TEXT ) RETURNS TEXT AS $func$
 671
 672     use strict;
 673     use Unicode::Normalize;
 674     use Encode;
 675
 676     my $str = shift;
 677     my $sf = shift;
 678
 679     # Apply NACO normalization to input string; based on
 680     # https://www.loc.gov/aba/pcc/naco/documents/SCA_PccNormalization_Final_revised.pdf
 681     #
 682     # Note that unlike a strict reading of the NACO normalization rules,
 683     # output is returned as lowercase instead of uppercase for compatibility
 684     # with previous versions of the Evergreen naco_normalize routine.
 685
 686     # Convert to upper-case first; even though final output will be lowercase, doing this will
 687     # ensure that the German eszett (ß) and certain ligatures (ﬀ, ﬁ, ﬄ, etc.) will be handled correctly.
 688     # If there are any bugs in Perl's implementation of upcasing, they will be passed through here.
 689     $str = uc $str;
 690
 691     # remove non-filing strings
 692     $str =~ s/\x{0098}.*?\x{009C}//g;
 693
 694     $str = NFKD($str);
 695
 696     # additional substitutions - 3.6.
 697     $str =~ s/\x{00C6}/AE/g;
 698     $str =~ s/\x{00DE}/TH/g;
 699     $str =~ s/\x{0152}/OE/g;
 700     $str =~ tr/\x{0110}\x{00D0}\x{00D8}\x{0141}\x{2113}\x{02BB}\x{02BC}][/DDOLl/d;
 701
 702     # transformations based on Unicode category codes
 703     $str =~ s/[\p{Cc}\p{Cf}\p{Co}\p{Cs}\p{Lm}\p{Mc}\p{Me}\p{Mn}]//g;
 704
 705         if ($sf && $sf =~ /^a/o) {
 706                 my $commapos = index($str, ',');
 707                 if ($commapos > -1) {
 708                         if ($commapos != length($str) - 1) {
 709                 $str =~ s/,/\x07/; # preserve first comma
 710                         }
 711                 }
 712         }
 713
 714     # since we've stripped out the control characters, we can now
 715     # use a few as placeholders temporarily
 716     $str =~ tr/+&@\x{266D}\x{266F}#/\x01\x02\x03\x04\x05\x06/;
 717     $str =~ s/[\p{Pc}\p{Pd}\p{Pe}\p{Pf}\p{Pi}\p{Po}\p{Ps}\p{Sk}\p{Sm}\p{So}\p{Zl}\p{Zp}\p{Zs}]/ /g;
 718     $str =~ tr/\x01\x02\x03\x04\x05\x06\x07/+&@\x{266D}\x{266F}#,/;
 719
 720     # decimal digits
 721     $str =~ tr/\x{0660}-\x{0669}\x{06F0}-\x{06F9}\x{07C0}-\x{07C9}\x{0966}-\x{096F}\x{09E6}-\x{09EF}\x{0A66}-\x{0A6F}\x{0AE6}-\x{0AEF}\x{0B66}-\x{0B6F}\x{0BE6}-\x{0BEF}\x{0C66}-\x{0C6F}\x{0CE6}-\x{0CEF}\x{0D66}-\x{0D6F}\x{0E50}-\x{0E59}\x{0ED0}-\x{0ED9}\x{0F20}-\x{0F29}\x{1040}-\x{1049}\x{1090}-\x{1099}\x{17E0}-\x{17E9}\x{1810}-\x{1819}\x{1946}-\x{194F}\x{19D0}-\x{19D9}\x{1A80}-\x{1A89}\x{1A90}-\x{1A99}\x{1B50}-\x{1B59}\x{1BB0}-\x{1BB9}\x{1C40}-\x{1C49}\x{1C50}-\x{1C59}\x{A620}-\x{A629}\x{A8D0}-\x{A8D9}\x{A900}-\x{A909}\x{A9D0}-\x{A9D9}\x{AA50}-\x{AA59}\x{ABF0}-\x{ABF9}\x{FF10}-\x{FF19}/0-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-9/;
 722
 723     # intentionally skipping step 8 of the NACO algorithm; if the string
 724     # gets normalized away, that's fine.
 725
 726     # leading and trailing spaces
 727     $str =~ s/\s+/ /g;
 728     $str =~ s/^\s+//;
 729     $str =~ s/\s+$//g;
 730
 731     return lc $str;
 732 $func$ LANGUAGE 'plperlu' STRICT IMMUTABLE;
 733
 734 CREATE OR REPLACE FUNCTION public.naco_normalize_keep_comma( TEXT ) RETURNS TEXT AS $func$
 735         SELECT public.naco_normalize($1,'a');
 736 $func$ LANGUAGE SQL STRICT IMMUTABLE;
 737
 738 CREATE OR REPLACE FUNCTION public.naco_normalize( TEXT ) RETURNS TEXT AS $func$
 739         SELECT public.naco_normalize($1,'');
 740 $func$ LANGUAGE 'sql' STRICT IMMUTABLE;
 741
 742 CREATE OR REPLACE FUNCTION public.search_normalize_keep_comma( TEXT ) RETURNS TEXT AS $func$
 743         SELECT public.search_normalize($1,'a');
 744 $func$ LANGUAGE SQL STRICT IMMUTABLE;
 745
 746 CREATE OR REPLACE FUNCTION public.search_normalize( TEXT ) RETURNS TEXT AS $func$
 747         SELECT public.search_normalize($1,'');
 748 $func$ LANGUAGE 'sql' STRICT IMMUTABLE;
 749
 750
 751 COMMIT;
 752