2 * Copyright (C) 2004-2008 Georgia Public Library Service
3 * Copyright (C) 2008-2014 Equinox Software, Inc.
4 * Mike Rylander <miker@esilibrary.com>
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.
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.
21 CREATE OR REPLACE FUNCTION evergreen.xml_famous5_to_text( TEXT ) RETURNS TEXT AS $f$
26 REPLACE( $1, '<', '<'),
39 $f$ LANGUAGE SQL IMMUTABLE;
41 CREATE OR REPLACE FUNCTION evergreen.oils_xpath ( TEXT, TEXT, TEXT[] ) RETURNS TEXT[] AS $f$
43 CASE WHEN strpos(x,'<') = 1 THEN -- It's an element node
46 evergreen.xml_famous5_to_text(x)
49 FROM UNNEST(XPATH( $1, $2::XML, $3 )::TEXT[]) x;
50 $f$ LANGUAGE SQL IMMUTABLE;
52 -- Trust me, it's just simpler to duplicate these...
53 CREATE OR REPLACE FUNCTION evergreen.oils_xpath ( TEXT, TEXT ) RETURNS TEXT[] AS $f$
55 CASE WHEN strpos(x,'<') = 1 THEN -- It's an element node
58 evergreen.xml_famous5_to_text(x)
61 FROM UNNEST(XPATH( $1, $2::XML)::TEXT[]) x;
62 $f$ LANGUAGE SQL IMMUTABLE;
64 CREATE OR REPLACE FUNCTION evergreen.oils_xslt_process(TEXT, TEXT) RETURNS TEXT AS $func$
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();
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});
82 my $xslt_parser = $_SHARED{'_xslt_process'}{parsers}{xslt} || XML::LibXSLT->new();
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});
88 my $stylesheet = $_SHARED{'_xslt_process'}{stylesheets}{$xslt} ||
89 $xslt_parser->parse_stylesheet( $parser->parse_string($xslt) );
91 $_SHARED{'_xslt_process'}{stylesheets}{$xslt} = $stylesheet
92 unless ($_SHARED{'_xslt_process'}{stylesheets}{$xslt});
94 return $stylesheet->output_string(
95 $stylesheet->transform(
96 $parser->parse_string($doc)
100 $func$ LANGUAGE 'plperlu' STRICT IMMUTABLE;
102 CREATE OR REPLACE FUNCTION oils_xpath_string ( TEXT, TEXT, TEXT, ANYARRAY ) RETURNS TEXT AS $func$
103 SELECT ARRAY_TO_STRING(
106 CASE WHEN $1 ~ $re$/[^/[]*@[^]]+$$re$ OR $1 ~ $re$text\(\)$$re$ THEN '' ELSE '//text()' END,
112 $func$ LANGUAGE SQL IMMUTABLE;
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;
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;
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;
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$
136 xpath_list := STRING_TO_ARRAY( xpaths, '|' );
138 select_list := ARRAY_APPEND( select_list, key || '::INT AS key' );
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 );
144 select_list := ARRAY_APPEND(
154 WHEN xpath_list[i] ~ $re$/[^/[]*@[^/]+$$re$ OR xpath_list[i] ~ $re$text\(\)$$re$ THEN xpath_list[i]
155 ELSE xpath_list[i] || '//text()'
159 $sel$ || document_field || $sel$
167 where_list := ARRAY_APPEND(
169 'c_' || i || ' IS NOT NULL'
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;
180 FOR out_record IN EXECUTE q LOOP
181 RETURN NEXT out_record;
186 $func$ LANGUAGE PLPGSQL IMMUTABLE;
188 CREATE OR REPLACE FUNCTION oils_xpath_tag_to_table(marc text, tag text, xpaths text[]) RETURNS SETOF record AS $function$
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
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 );
207 select_list := ARRAY_APPEND(select_list, '(oils_xpath(' ||
210 WHEN xpaths[i] ~ $re$/[^/[]*@[^/]+$$re$ -- attribute
211 OR xpaths[i] ~ $re$text\(\)$$re$
213 ELSE xpaths[i] || '//text()'
215 ) || ', field_marc))[1] AS cl_' || i);
216 -- hardcoded to first value for each path
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;
226 RETURN QUERY EXECUTE q;
229 $function$ LANGUAGE PLPGSQL;
231 CREATE OR REPLACE FUNCTION extract_marc_field ( TEXT, BIGINT, TEXT, TEXT ) RETURNS TEXT AS $$
237 SELECT regexp_replace(
239 $q$ || quote_literal($3) || $q$,
243 $q$ || quote_literal($4) || $q$,
246 FROM $q$ || $1 || $q$
247 WHERE id = $q$ || $2;
249 EXECUTE query INTO output;
251 -- RAISE NOTICE 'query: %, output; %', query, output;
255 $$ LANGUAGE PLPGSQL IMMUTABLE;
257 CREATE OR REPLACE FUNCTION extract_marc_field_set
258 (TEXT, BIGINT, TEXT, TEXT) RETURNS SETOF TEXT AS $$
266 FROM oils_xpath_table(
267 'id', 'marc', $1, $3, 'id = ' || $2)
268 AS t(id int, t text))x
270 IF $4 IS NOT NULL THEN
271 SELECT INTO output (SELECT regexp_replace(output, $4, '', 'g'));
277 $$ LANGUAGE PLPGSQL IMMUTABLE;
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;
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$
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;
292 keyfield TEXT := keyclass || '.' || keycol;
295 -- Try the full locale
297 FROM config.i18n_core
298 WHERE fq_field = keyfield
299 AND identity_value = keyvalue
300 AND translation = locale;
302 -- Try just the language
305 FROM config.i18n_core
306 WHERE fq_field = keyfield
307 AND identity_value = keyvalue
308 AND translation = language;
311 -- Fall back to the string we passed in in the first place
316 ' FROM ' || keytable ||
317 ' WHERE ' || identcol || ' = ' || quote_literal(keyvalue)
322 RETURN result.string;
324 $func$ LANGUAGE PLPGSQL STABLE;
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 $$
332 CREATE OR REPLACE FUNCTION oils_i18n_gettext( TEXT, TEXT, TEXT, TEXT ) RETURNS TEXT AS $$
336 CREATE OR REPLACE FUNCTION is_json( TEXT ) RETURNS BOOL AS $f$
339 eval { JSON::XS->new->allow_nonref->decode( $json ) };
341 $f$ LANGUAGE PLPERLU;
343 -- turn a JSON scalar into an SQL TEXT value
344 CREATE OR REPLACE FUNCTION oils_json_to_text( TEXT ) RETURNS TEXT AS $f$
348 eval { $txt = JSON::XS->new->allow_nonref->decode( $json ) };
349 return undef if ($@);
351 $f$ LANGUAGE PLPERLU;
353 CREATE OR REPLACE FUNCTION evergreen.maintain_901 () RETURNS TRIGGER AS $func$
356 use MARC::File::XML (BinaryEncoding => 'UTF-8');
359 use Unicode::Normalize;
361 MARC::Charset->assume_unicode(1);
363 my $schema = $_TD->{table_schema};
364 my $marc = MARC::Record->new_from_xml($_TD->{new}{marc});
366 my @old901s = $marc->field('901');
367 $marc->delete_fields(@old901s);
369 if ($schema eq 'biblio') {
370 my $tcn_value = $_TD->{new}{tcn_value};
372 # Set TCN value to record ID?
373 my $id_as_tcn = spi_exec_query("
375 FROM config.global_flag
376 WHERE name = 'cat.bib.use_id_for_tcn'
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;
383 my $new_901 = MARC::Field->new("901", " ", " ",
385 "b" => $_TD->{new}{tcn_source},
386 "c" => $_TD->{new}{id},
390 if ($_TD->{new}{owner}) {
391 $new_901->add_subfields("o" => $_TD->{new}{owner});
394 if ($_TD->{new}{share_depth}) {
395 $new_901->add_subfields("d" => $_TD->{new}{share_depth});
398 $marc->append_fields($new_901);
399 } elsif ($schema eq 'authority') {
400 my $new_901 = MARC::Field->new("901", " ", " ",
401 "c" => $_TD->{new}{id},
404 $marc->append_fields($new_901);
405 } elsif ($schema eq 'serial') {
406 my $new_901 = MARC::Field->new("901", " ", " ",
407 "c" => $_TD->{new}{id},
409 "o" => $_TD->{new}{owning_lib},
412 if ($_TD->{new}{record}) {
413 $new_901->add_subfields("r" => $_TD->{new}{record});
416 $marc->append_fields($new_901);
418 my $new_901 = MARC::Field->new("901", " ", " ",
419 "c" => $_TD->{new}{id},
422 $marc->append_fields($new_901);
425 my $xml = $marc->as_xml_record();
427 $xml =~ s/^<\?xml.+\?\s*>//go;
428 $xml =~ s/>\s+</></go;
429 $xml =~ s/\p{Cc}//go;
431 # Embed a version of OpenILS::Application::AppUtils->entityize()
432 # to avoid having to set PERL5LIB for PostgreSQL as well
436 # Convert raw ampersands to entities
437 $xml =~ s/&(?!\S+;)/&/gso;
439 # Convert Unicode characters to entities
440 $xml =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
442 $xml =~ s/[\x00-\x1f]//go;
443 $_TD->{new}{marc} = $xml;
446 $func$ LANGUAGE PLPERLU;
448 CREATE OR REPLACE FUNCTION evergreen.force_unicode_normal_form(string TEXT, form TEXT) RETURNS TEXT AS $func$
449 use Unicode::Normalize 'normalize';
450 return normalize($_[1],$_[0]); # reverse the params
451 $func$ LANGUAGE PLPERLU;
453 CREATE OR REPLACE FUNCTION maintain_control_numbers() RETURNS TRIGGER AS $func$
456 use MARC::File::XML (BinaryEncoding => 'UTF-8');
459 use Unicode::Normalize;
461 MARC::Charset->assume_unicode(1);
463 my $record = MARC::Record->new_from_xml($_TD->{new}{marc});
464 my $schema = $_TD->{table_schema};
465 my $rec_id = $_TD->{new}{id};
467 # Short-circuit if maintaining control numbers per MARC21 spec is not enabled
468 my $enable = spi_exec_query("SELECT enabled FROM config.global_flag WHERE name = 'cat.maintain_control_numbers'");
469 if (!($enable->{processed}) or $enable->{rows}[0]->{enabled} eq 'f') {
473 # Get the control number identifier from an OU setting based on $_TD->{new}{owner}
474 my $ou_cni = 'EVRGRN';
477 if ($schema eq 'serial') {
478 $owner = $_TD->{new}{owning_lib};
480 # are.owner and bre.owner can be null, so fall back to the consortial setting
481 $owner = $_TD->{new}{owner} || 1;
484 my $ous_rv = spi_exec_query("SELECT value FROM actor.org_unit_ancestor_setting('cat.marc_control_number_identifier', $owner)");
485 if ($ous_rv->{processed}) {
486 $ou_cni = $ous_rv->{rows}[0]->{value};
487 $ou_cni =~ s/"//g; # Stupid VIM syntax highlighting"
489 # Fall back to the shortname of the OU if there was no OU setting
490 $ous_rv = spi_exec_query("SELECT shortname FROM actor.org_unit WHERE id = $owner");
491 if ($ous_rv->{processed}) {
492 $ou_cni = $ous_rv->{rows}[0]->{shortname};
496 my ($create, $munge) = (0, 0);
498 my @scns = $record->field('035');
500 foreach my $id_field ('001', '003') {
502 my @controls = $record->field($id_field);
504 if ($id_field eq '001') {
505 $spec_value = $rec_id;
507 $spec_value = $ou_cni;
510 # Create the 001/003 if none exist
511 if (scalar(@controls) == 1) {
512 # Only one field; check to see if we need to munge it
513 unless (grep $_->data() eq $spec_value, @controls) {
517 # Delete the other fields, as with more than 1 001/003 we do not know which 003/001 to match
518 foreach my $control (@controls) {
519 $record->delete_field($control);
521 $record->insert_fields_ordered(MARC::Field->new($id_field, $spec_value));
526 my $cn = $record->field('001')->data();
527 # Special handling of OCLC numbers, often found in records that lack 003
528 if ($cn =~ /^o(c[nm]|n)\d/) {
529 $cn =~ s/^o(c[nm]|n)0*(\d+)/$2/;
530 $record->field('003')->data('OCoLC');
534 # Now, if we need to munge the 001, we will first push the existing 001/003
535 # into the 035; but if the record did not have one (and one only) 001 and 003
536 # to begin with, skip this process
537 if ($munge and not $create) {
539 my $scn = "(" . $record->field('003')->data() . ")" . $cn;
541 # Do not create duplicate 035 fields
542 unless (grep $_->subfield('a') eq $scn, @scns) {
543 $record->insert_fields_ordered(MARC::Field->new('035', '', '', 'a' => $scn));
547 # Set the 001/003 and update the MARC
548 if ($create or $munge) {
549 $record->field('001')->data($rec_id);
550 $record->field('003')->data($ou_cni);
552 my $xml = $record->as_xml_record();
554 $xml =~ s/^<\?xml.+\?\s*>//go;
555 $xml =~ s/>\s+</></go;
556 $xml =~ s/\p{Cc}//go;
558 # Embed a version of OpenILS::Application::AppUtils->entityize()
559 # to avoid having to set PERL5LIB for PostgreSQL as well
563 # Convert raw ampersands to entities
564 $xml =~ s/&(?!\S+;)/&/gso;
566 # Convert Unicode characters to entities
567 $xml =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
569 $xml =~ s/[\x00-\x1f]//go;
570 $_TD->{new}{marc} = $xml;
576 $func$ LANGUAGE PLPERLU;
578 CREATE OR REPLACE FUNCTION oils_text_as_bytea (TEXT) RETURNS BYTEA AS $_$
579 SELECT CAST(REGEXP_REPLACE(UPPER($1), $$\\$$, $$\\\\$$, 'g') AS BYTEA);
580 $_$ LANGUAGE SQL IMMUTABLE;
582 CREATE OR REPLACE FUNCTION evergreen.lpad_number_substrings( TEXT, TEXT, INT ) RETURNS TEXT AS $$
583 my $string = shift; # Source string
584 my $pad = shift; # string to fill. Typically '0'. This should be a single character.
585 my $len = shift; # length of resultant padded field
588 while ($string =~ /(^|\D)(\d{1,$find})($|\D)/) {
590 $padded = $pad x ($len - length($padded)) . $padded;
591 $string = $` . $1 . $padded . $3 . $';
597 CREATE OR REPLACE FUNCTION public.naco_normalize( TEXT, TEXT ) RETURNS TEXT AS $func$
600 use Unicode::Normalize;
606 # Apply NACO normalization to input string; based on
607 # http://www.loc.gov/catdir/pcc/naco/SCA_PccNormalization_Final_revised.pdf
609 # Note that unlike a strict reading of the NACO normalization rules,
610 # output is returned as lowercase instead of uppercase for compatibility
611 # with previous versions of the Evergreen naco_normalize routine.
613 # Convert to upper-case first; even though final output will be lowercase, doing this will
614 # ensure that the German eszett (ß) and certain ligatures (ff, fi, ffl, etc.) will be handled correctly.
615 # If there are any bugs in Perl's implementation of upcasing, they will be passed through here.
618 # remove non-filing strings
619 $str =~ s/\x{0098}.*?\x{009C}//g;
623 # additional substitutions - 3.6.
624 $str =~ s/\x{00C6}/AE/g;
625 $str =~ s/\x{00DE}/TH/g;
626 $str =~ s/\x{0152}/OE/g;
627 $str =~ tr/\x{0110}\x{00D0}\x{00D8}\x{0141}\x{2113}\x{02BB}\x{02BC}]['/DDOLl/d;
629 # transformations based on Unicode category codes
630 $str =~ s/[\p{Cc}\p{Cf}\p{Co}\p{Cs}\p{Lm}\p{Mc}\p{Me}\p{Mn}]//g;
632 if ($sf && $sf =~ /^a/o) {
633 my $commapos = index($str, ',');
634 if ($commapos > -1) {
635 if ($commapos != length($str) - 1) {
636 $str =~ s/,/\x07/; # preserve first comma
641 # since we've stripped out the control characters, we can now
642 # use a few as placeholders temporarily
643 $str =~ tr/+&@\x{266D}\x{266F}#/\x01\x02\x03\x04\x05\x06/;
644 $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;
645 $str =~ tr/\x01\x02\x03\x04\x05\x06\x07/+&@\x{266D}\x{266F}#,/;
648 $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/;
650 # intentionally skipping step 8 of the NACO algorithm; if the string
651 # gets normalized away, that's fine.
653 # leading and trailing spaces
659 $func$ LANGUAGE 'plperlu' STRICT IMMUTABLE;
661 -- Currently, the only difference from naco_normalize is that search_normalize
662 -- turns apostrophes into spaces, while naco_normalize collapses them.
663 CREATE OR REPLACE FUNCTION public.search_normalize( TEXT, TEXT ) RETURNS TEXT AS $func$
666 use Unicode::Normalize;
672 # Apply NACO normalization to input string; based on
673 # http://www.loc.gov/catdir/pcc/naco/SCA_PccNormalization_Final_revised.pdf
675 # Note that unlike a strict reading of the NACO normalization rules,
676 # output is returned as lowercase instead of uppercase for compatibility
677 # with previous versions of the Evergreen naco_normalize routine.
679 # Convert to upper-case first; even though final output will be lowercase, doing this will
680 # ensure that the German eszett (ß) and certain ligatures (ff, fi, ffl, etc.) will be handled correctly.
681 # If there are any bugs in Perl's implementation of upcasing, they will be passed through here.
684 # remove non-filing strings
685 $str =~ s/\x{0098}.*?\x{009C}//g;
689 # additional substitutions - 3.6.
690 $str =~ s/\x{00C6}/AE/g;
691 $str =~ s/\x{00DE}/TH/g;
692 $str =~ s/\x{0152}/OE/g;
693 $str =~ tr/\x{0110}\x{00D0}\x{00D8}\x{0141}\x{2113}\x{02BB}\x{02BC}][/DDOLl/d;
695 # transformations based on Unicode category codes
696 $str =~ s/[\p{Cc}\p{Cf}\p{Co}\p{Cs}\p{Lm}\p{Mc}\p{Me}\p{Mn}]//g;
698 if ($sf && $sf =~ /^a/o) {
699 my $commapos = index($str, ',');
700 if ($commapos > -1) {
701 if ($commapos != length($str) - 1) {
702 $str =~ s/,/\x07/; # preserve first comma
707 # since we've stripped out the control characters, we can now
708 # use a few as placeholders temporarily
709 $str =~ tr/+&@\x{266D}\x{266F}#/\x01\x02\x03\x04\x05\x06/;
710 $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;
711 $str =~ tr/\x01\x02\x03\x04\x05\x06\x07/+&@\x{266D}\x{266F}#,/;
714 $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/;
716 # intentionally skipping step 8 of the NACO algorithm; if the string
717 # gets normalized away, that's fine.
719 # leading and trailing spaces
725 $func$ LANGUAGE 'plperlu' STRICT IMMUTABLE;
727 CREATE OR REPLACE FUNCTION public.naco_normalize_keep_comma( TEXT ) RETURNS TEXT AS $func$
728 SELECT public.naco_normalize($1,'a');
729 $func$ LANGUAGE SQL STRICT IMMUTABLE;
731 CREATE OR REPLACE FUNCTION public.naco_normalize( TEXT ) RETURNS TEXT AS $func$
732 SELECT public.naco_normalize($1,'');
733 $func$ LANGUAGE 'sql' STRICT IMMUTABLE;
735 CREATE OR REPLACE FUNCTION public.search_normalize_keep_comma( TEXT ) RETURNS TEXT AS $func$
736 SELECT public.search_normalize($1,'a');
737 $func$ LANGUAGE SQL STRICT IMMUTABLE;
739 CREATE OR REPLACE FUNCTION public.search_normalize( TEXT ) RETURNS TEXT AS $func$
740 SELECT public.search_normalize($1,'');
741 $func$ LANGUAGE 'sql' STRICT IMMUTABLE;