2 * Copyright (C) 2004-2008 Georgia Public Library Service
3 * Copyright (C) 2007-2008 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.
18 CREATE OR REPLACE FUNCTION public.non_filing_normalize ( TEXT, "char" ) RETURNS TEXT AS $$
30 WHEN $2::INT NOT BETWEEN 48 AND 57 THEN 1
31 ELSE $2::TEXT::INT + 1
34 $$ LANGUAGE SQL STRICT IMMUTABLE;
36 CREATE OR REPLACE FUNCTION public.naco_normalize( TEXT, TEXT ) RETURNS TEXT AS $func$
39 use Unicode::Normalize;
44 # Apply NACO normalization to input string; based on
45 # http://www.loc.gov/catdir/pcc/naco/SCA_PccNormalization_Final_revised.pdf
47 # Note that unlike a strict reading of the NACO normalization rules,
48 # output is returned as lowercase instead of uppercase for compatibility
49 # with previous versions of the Evergreen naco_normalize routine.
51 # Convert to upper-case first; even though final output will be lowercase, doing this will
52 # ensure that the German eszett (ß) and certain ligatures (ff, fi, ffl, etc.) will be handled correctly.
53 # If there are any bugs in Perl's implementation of upcasing, they will be passed through here.
56 # remove non-filing strings
57 $str =~ s/\x{0098}.*?\x{009C}//g;
61 # additional substitutions - 3.6.
62 $str =~ s/\x{00C6}/AE/g;
63 $str =~ s/\x{00DE}/TH/g;
64 $str =~ s/\x{0152}/OE/g;
65 $str =~ tr/\x{0110}\x{00D0}\x{00D8}\x{0141}\x{2113}\x{02BB}\x{02BC}]['/DDOLl/d;
67 # transformations based on Unicode category codes
68 $str =~ s/[\p{Cc}\p{Cf}\p{Co}\p{Cs}\p{Lm}\p{Mc}\p{Me}\p{Mn}]//g;
70 if ($sf && $sf =~ /^a/o) {
71 my $commapos = index($str, ',');
73 if ($commapos != length($str) - 1) {
74 $str =~ s/,/\x07/; # preserve first comma
79 # since we've stripped out the control characters, we can now
80 # use a few as placeholders temporarily
81 $str =~ tr/+&@\x{266D}\x{266F}#/\x01\x02\x03\x04\x05\x06/;
82 $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;
83 $str =~ tr/\x01\x02\x03\x04\x05\x06\x07/+&@\x{266D}\x{266F}#,/;
86 $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/;
88 # intentionally skipping step 8 of the NACO algorithm; if the string
89 # gets normalized away, that's fine.
91 # leading and trailing spaces
97 $func$ LANGUAGE 'plperlu' STRICT IMMUTABLE;
99 CREATE OR REPLACE FUNCTION public.naco_normalize( TEXT ) RETURNS TEXT AS $func$
100 SELECT public.naco_normalize($1,'');
101 $func$ LANGUAGE 'sql' STRICT IMMUTABLE;
103 CREATE OR REPLACE FUNCTION public.first_word ( TEXT ) RETURNS TEXT AS $$
104 SELECT COALESCE(SUBSTRING( $1 FROM $_$^\S+$_$), '');
105 $$ LANGUAGE SQL STRICT IMMUTABLE;
107 CREATE OR REPLACE FUNCTION public.naco_normalize_keep_comma( TEXT ) RETURNS TEXT AS $func$
108 SELECT public.naco_normalize($1,'a');
109 $func$ LANGUAGE SQL STRICT IMMUTABLE;
111 CREATE OR REPLACE FUNCTION public.normalize_space( TEXT ) RETURNS TEXT AS $$
112 SELECT regexp_replace(regexp_replace(regexp_replace($1, E'\\n', ' ', 'g'), E'(?:^\\s+)|(\\s+$)', '', 'g'), E'\\s+', ' ', 'g');
113 $$ LANGUAGE SQL STRICT IMMUTABLE;
115 CREATE OR REPLACE FUNCTION public.remove_commas( TEXT ) RETURNS TEXT AS $$
116 SELECT regexp_replace($1, ',', '', 'g');
117 $$ LANGUAGE SQL STRICT IMMUTABLE;
119 CREATE OR REPLACE FUNCTION public.remove_paren_substring( TEXT ) RETURNS TEXT AS $func$
120 SELECT regexp_replace($1, $$\([^)]+\)$$, '', 'g');
121 $func$ LANGUAGE SQL STRICT IMMUTABLE;
123 CREATE OR REPLACE FUNCTION public.remove_whitespace( TEXT ) RETURNS TEXT AS $$
124 SELECT regexp_replace(normalize_space($1), E'\\s+', '', 'g');
125 $$ LANGUAGE SQL STRICT IMMUTABLE;
127 CREATE OR REPLACE FUNCTION public.lowercase( TEXT ) RETURNS TEXT AS $$
129 $$ LANGUAGE PLPERLU STRICT IMMUTABLE;
131 CREATE OR REPLACE FUNCTION public.uppercase( TEXT ) RETURNS TEXT AS $$
133 $$ LANGUAGE PLPERLU STRICT IMMUTABLE;
135 CREATE OR REPLACE FUNCTION public.remove_diacritics( TEXT ) RETURNS TEXT AS $$
136 use Unicode::Normalize;
142 $$ LANGUAGE PLPERLU STRICT IMMUTABLE;
144 CREATE OR REPLACE FUNCTION public.entityize( TEXT ) RETURNS TEXT AS $$
145 use Unicode::Normalize;
148 $x =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
151 $$ LANGUAGE PLPERLU STRICT IMMUTABLE;
153 CREATE OR REPLACE FUNCTION public.call_number_dewey( TEXT ) RETURNS TEXT AS $$
156 $txt =~ s/[\[\]\{\}\(\)`'"#<>\*\?\-\+\$\\]+//og;
158 if ($txt =~ /(\d{3}(?:\.\d+)?)/o) {
161 return (split /\s+/, $txt)[0];
163 $$ LANGUAGE 'plperlu' STRICT IMMUTABLE;
165 CREATE OR REPLACE FUNCTION public.call_number_dewey( TEXT, INT ) RETURNS TEXT AS $$
166 SELECT SUBSTRING(call_number_dewey($1) FROM 1 FOR $2);
167 $$ LANGUAGE SQL STRICT IMMUTABLE;
169 CREATE OR REPLACE FUNCTION tableoid2name ( oid ) RETURNS TEXT AS $$
173 $$ language 'plpgsql';
175 CREATE OR REPLACE FUNCTION actor.org_unit_descendants( INT, INT ) RETURNS SETOF actor.org_unit AS $$
176 WITH RECURSIVE descendant_depth AS (
180 FROM actor.org_unit ou
181 JOIN actor.org_unit_type out ON (out.id = ou.ou_type)
182 JOIN anscestor_depth ad ON (ad.id = ou.id)
188 FROM actor.org_unit ou
189 JOIN actor.org_unit_type out ON (out.id = ou.ou_type)
190 JOIN descendant_depth ot ON (ot.id = ou.parent_ou)
191 ), anscestor_depth AS (
195 FROM actor.org_unit ou
196 JOIN actor.org_unit_type out ON (out.id = ou.ou_type)
202 FROM actor.org_unit ou
203 JOIN actor.org_unit_type out ON (out.id = ou.ou_type)
204 JOIN anscestor_depth ot ON (ot.parent_ou = ou.id)
205 ) SELECT ou.* FROM actor.org_unit ou JOIN descendant_depth USING (id);
208 CREATE OR REPLACE FUNCTION actor.org_unit_descendants( INT ) RETURNS SETOF actor.org_unit AS $$
209 WITH RECURSIVE descendant_depth AS (
213 FROM actor.org_unit ou
214 JOIN actor.org_unit_type out ON (out.id = ou.ou_type)
220 FROM actor.org_unit ou
221 JOIN actor.org_unit_type out ON (out.id = ou.ou_type)
222 JOIN descendant_depth ot ON (ot.id = ou.parent_ou)
223 ) SELECT ou.* FROM actor.org_unit ou JOIN descendant_depth USING (id);
226 CREATE OR REPLACE FUNCTION actor.org_unit_ancestors( INT ) RETURNS SETOF actor.org_unit AS $$
227 WITH RECURSIVE anscestor_depth AS (
230 FROM actor.org_unit ou
235 FROM actor.org_unit ou
236 JOIN anscestor_depth ot ON (ot.parent_ou = ou.id)
237 ) SELECT ou.* FROM actor.org_unit ou JOIN anscestor_depth USING (id);
240 CREATE OR REPLACE FUNCTION actor.org_unit_ancestor_at_depth ( INT,INT ) RETURNS actor.org_unit AS $$
242 FROM actor.org_unit a
243 WHERE id = ( SELECT FIRST(x.id)
244 FROM actor.org_unit_ancestors($1) x
245 JOIN actor.org_unit_type y
246 ON x.ou_type = y.id AND y.depth = $2);
247 $$ LANGUAGE SQL STABLE;
249 CREATE OR REPLACE FUNCTION actor.org_unit_full_path ( INT ) RETURNS SETOF actor.org_unit AS $$
251 FROM actor.org_unit_ancestors($1)
254 FROM actor.org_unit_descendants($1);
255 $$ LANGUAGE SQL STABLE;
257 CREATE OR REPLACE FUNCTION actor.org_unit_full_path ( INT, INT ) RETURNS SETOF actor.org_unit AS $$
258 SELECT * FROM actor.org_unit_full_path((actor.org_unit_ancestor_at_depth($1, $2)).id)
259 $$ LANGUAGE SQL STABLE;
261 CREATE OR REPLACE FUNCTION actor.org_unit_combined_ancestors ( INT, INT ) RETURNS SETOF actor.org_unit AS $$
263 FROM actor.org_unit_ancestors($1)
266 FROM actor.org_unit_ancestors($2);
267 $$ LANGUAGE SQL STABLE;
269 CREATE OR REPLACE FUNCTION actor.org_unit_common_ancestors ( INT, INT ) RETURNS SETOF actor.org_unit AS $$
271 FROM actor.org_unit_ancestors($1)
274 FROM actor.org_unit_ancestors($2);
275 $$ LANGUAGE SQL STABLE;
277 CREATE OR REPLACE FUNCTION actor.org_unit_proximity ( INT, INT ) RETURNS INT AS $$
278 SELECT COUNT(id)::INT FROM (
279 SELECT id FROM actor.org_unit_combined_ancestors($1, $2)
281 SELECT id FROM actor.org_unit_common_ancestors($1, $2)
283 $$ LANGUAGE SQL STABLE;
285 CREATE OR REPLACE FUNCTION actor.org_unit_ancestor_setting( setting_name TEXT, org_id INT ) RETURNS SETOF actor.org_unit_setting AS $$
292 SELECT INTO setting * FROM actor.org_unit_setting WHERE org_unit = cur_org AND name = setting_name;
296 SELECT INTO cur_org parent_ou FROM actor.org_unit WHERE id = cur_org;
297 EXIT WHEN cur_org IS NULL;
301 $$ LANGUAGE plpgsql STABLE;
303 COMMENT ON FUNCTION actor.org_unit_ancestor_setting( TEXT, INT) IS $$
305 * Search "up" the org_unit tree until we find the first occurrence of an
306 * org_unit_setting with the given name.
310 -- Intended to be used in a unique index on authority.record_entry like so:
311 -- CREATE UNIQUE INDEX unique_by_heading_and_thesaurus
312 -- ON authority.record_entry (authority.normalize_heading(marc))
313 -- WHERE deleted IS FALSE or deleted = FALSE;
314 CREATE OR REPLACE FUNCTION authority.normalize_heading( TEXT ) RETURNS TEXT AS $func$
320 use MARC::File::XML (BinaryEncoding => 'UTF8');
321 use UUID::Tiny ':std';
323 my $xml = shift() or return undef;
327 # Prevent errors in XML parsing from blowing out ungracefully
329 $r = MARC::Record->new_from_xml( $xml );
332 return 'BAD_MARCXML_' . create_uuid_as_string(UUID_MD5, $xml);
336 return 'BAD_MARCXML_' . create_uuid_as_string(UUID_MD5, $xml);
339 # From http://www.loc.gov/standards/sourcelist/subject.html
340 my $thes_code_map = {
346 n => 'notapplicable',
352 # Default to "No attempt to code" if the leader is horribly broken
353 my $fixed_field = $r->field('008');
356 $thes_char = substr($fixed_field->data(), 11, 1) || '|';
359 my $thes_code = 'UNDEFINED';
361 if ($thes_char eq 'z') {
362 # Grab the 040 $f per http://www.loc.gov/marc/authority/ad040.html
363 $thes_code = $r->subfield('040', 'f') || 'UNDEFINED';
364 } elsif ($thes_code_map->{$thes_char}) {
365 $thes_code = $thes_code_map->{$thes_char};
369 my $head = $r->field('1..');
371 # Concatenate all of these subfields together, prefixed by their code
372 # to prevent collisions along the lines of "Fiction, North Carolina"
373 foreach my $sf ($head->subfields()) {
374 $auth_txt .= '‡' . $sf->[0] . ' ' . $sf->[1];
379 my $stmt = spi_prepare('SELECT public.naco_normalize($1) AS norm_text', 'TEXT');
380 my $result = spi_exec_prepared($stmt, $auth_txt);
381 my $norm_txt = $result->{rows}[0]->{norm_text};
384 return $head->tag() . "_" . $thes_code . " " . $norm_txt;
387 return 'NOHEADING_' . $thes_code . ' ' . create_uuid_as_string(UUID_MD5, $xml);
388 $func$ LANGUAGE 'plperlu' IMMUTABLE;
390 COMMENT ON FUNCTION authority.normalize_heading( TEXT ) IS $$
392 * Extract the authority heading, thesaurus, and NACO-normalized values
393 * from an authority record. The primary purpose is to build a unique
394 * index to defend against duplicated authority records from the same