From: miker Date: Thu, 29 Jul 2010 00:55:52 +0000 (+0000) Subject: Patch from Jason Stephenson: X-Git-Url: https://old-git.evergreen-ils.org/?a=commitdiff_plain;h=5ff421fc5375296c7f4c245f24dd0c6638fbc655;p=evergreen%2Fmasslnc.git Patch from Jason Stephenson: The patch adds (BinaryEncoding => 'UTF-8') wherever MARC::File::XML is used in the database PgPerl functions where it is not already being done. This stops the functions like maintain_control_number() from trying to convert records from MARC8 to UTF-8 and blowing up, when the records are already UTF-8. git-svn-id: svn://svn.open-ils.org/ILS/trunk@17051 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- diff --git a/Open-ILS/src/sql/Pg/002.functions.config.sql b/Open-ILS/src/sql/Pg/002.functions.config.sql index 4d88756289..54e2cfb4e6 100644 --- a/Open-ILS/src/sql/Pg/002.functions.config.sql +++ b/Open-ILS/src/sql/Pg/002.functions.config.sql @@ -472,7 +472,7 @@ $func$ LANGUAGE PLPGSQL; CREATE OR REPLACE FUNCTION maintain_control_numbers() RETURNS TRIGGER AS $func$ use strict; use MARC::Record; -use MARC::File::XML; +use MARC::File::XML (BinaryEncoding => 'UTF-8'); use Encode; use Unicode::Normalize; diff --git a/Open-ILS/src/sql/Pg/002.schema.config.sql b/Open-ILS/src/sql/Pg/002.schema.config.sql index d0e0bd183f..1b033ab45f 100644 --- a/Open-ILS/src/sql/Pg/002.schema.config.sql +++ b/Open-ILS/src/sql/Pg/002.schema.config.sql @@ -68,7 +68,7 @@ CREATE TABLE config.upgrade_log ( install_date TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT NOW() ); -INSERT INTO config.upgrade_log (version) VALUES ('0352'); -- Scott McKellar +INSERT INTO config.upgrade_log (version) VALUES ('0353'); -- miker CREATE TABLE config.bib_source ( id SERIAL PRIMARY KEY, diff --git a/Open-ILS/src/sql/Pg/011.schema.authority.sql b/Open-ILS/src/sql/Pg/011.schema.authority.sql index ebbee0f582..0f777dc08d 100644 --- a/Open-ILS/src/sql/Pg/011.schema.authority.sql +++ b/Open-ILS/src/sql/Pg/011.schema.authority.sql @@ -123,7 +123,7 @@ CREATE OR REPLACE VIEW authority.tracing_links AS CREATE OR REPLACE FUNCTION authority.generate_overlay_template ( TEXT, BIGINT ) RETURNS TEXT AS $func$ use MARC::Record; - use MARC::File::XML; + use MARC::File::XML (BinaryEncoding => 'UTF-8'); my $xml = shift; my $r = MARC::Record->new_from_xml( $xml ); @@ -178,10 +178,8 @@ CREATE OR REPLACE FUNCTION authority.generate_overlay_template ( TEXT, BIGINT ) $xml = $tmpl->as_xml_record; $xml =~ s/^<\?.+?\?>$//mo; - - # Leave formatting intact for now - #$xml =~ s/\n//sgo; - #$xml =~ s/>\s+\s+ 'UTF-8'); use strict; my $target_xml = shift; @@ -371,7 +371,7 @@ $_$ LANGUAGE PLPERLU; CREATE OR REPLACE FUNCTION vandelay.strip_field ( xml TEXT, field TEXT ) RETURNS TEXT AS $_$ use MARC::Record; - use MARC::File::XML; + use MARC::File::XML (BinaryEncoding => 'UTF-8'); use strict; my $xml = shift; diff --git a/Open-ILS/src/sql/Pg/1.2.4-1.4-upgrade-db.sql b/Open-ILS/src/sql/Pg/1.2.4-1.4-upgrade-db.sql index 248d3256cd..869dce85e0 100644 --- a/Open-ILS/src/sql/Pg/1.2.4-1.4-upgrade-db.sql +++ b/Open-ILS/src/sql/Pg/1.2.4-1.4-upgrade-db.sql @@ -2043,7 +2043,7 @@ CREATE TABLE vandelay.import_bib_trash_fields ( CREATE OR REPLACE FUNCTION vandelay.strip_field ( xml TEXT, field TEXT ) RETURNS TEXT AS $_$ use MARC::Record; - use MARC::File::XML; + use MARC::File::XML (BinaryEncoding => 'UTF-8'); my $xml = shift; my $field_spec = shift; diff --git a/Open-ILS/src/sql/Pg/upgrade/0353.schema.plperl.binaryencoding.sql b/Open-ILS/src/sql/Pg/upgrade/0353.schema.plperl.binaryencoding.sql new file mode 100644 index 0000000000..aef7b5a5df --- /dev/null +++ b/Open-ILS/src/sql/Pg/upgrade/0353.schema.plperl.binaryencoding.sql @@ -0,0 +1,321 @@ +BEGIN; + +INSERT INTO config.upgrade_log (version) VALUES ('0353'); -- miker + +CREATE OR REPLACE FUNCTION maintain_control_numbers() RETURNS TRIGGER AS $func$ +use strict; +use MARC::Record; +use MARC::File::XML (BinaryEncoding => 'UTF-8'); +use Encode; +use Unicode::Normalize; + +my $record = MARC::Record->new_from_xml($_TD->{new}{marc}); +my $schema = $_TD->{table_schema}; +my $rec_id = $_TD->{new}{id}; + +# Short-circuit if maintaining control numbers per MARC21 spec is not enabled +my $enable = spi_exec_query("SELECT enabled FROM config.global_flag WHERE name = 'cat.maintain_control_numbers'"); +if (!($enable->{processed}) or $enable->{rows}[0]->{enabled} eq 'f') { + return; +} + +# Get the control number identifier from an OU setting based on $_TD->{new}{owner} +my $ou_cni = 'EVRGRN'; + +my $owner; +if ($schema eq 'serial') { + $owner = $_TD->{new}{owning_lib}; +} else { + # are.owner and bre.owner can be null, so fall back to the consortial setting + $owner = $_TD->{new}{owner} || 1; +} + +my $ous_rv = spi_exec_query("SELECT value FROM actor.org_unit_ancestor_setting('cat.marc_control_number_identifier', $owner)"); +if ($ous_rv->{processed}) { + $ou_cni = $ous_rv->{rows}[0]->{value}; + $ou_cni =~ s/"//g; # Stupid VIM syntax highlighting" +} else { + # Fall back to the shortname of the OU if there was no OU setting + $ous_rv = spi_exec_query("SELECT shortname FROM actor.org_unit WHERE id = $owner"); + if ($ous_rv->{processed}) { + $ou_cni = $ous_rv->{rows}[0]->{shortname}; + } +} + +my ($create, $munge) = (0, 0); +my ($orig_001, $orig_003) = ('', ''); + +# Incoming MARC records may have multiple 001s or 003s, despite the spec +my @control_ids = $record->field('003'); +my @scns = $record->field('035'); + +foreach my $id_field ('001', '003') { + my $spec_value; + my @controls = $record->field($id_field); + + if ($id_field eq '001') { + $spec_value = $rec_id; + } else { + $spec_value = $ou_cni; + } + + # Create the 001/003 if none exist + if (scalar(@controls) == 0) { + $record->insert_fields_ordered(MARC::Field->new($id_field, $spec_value)); + $create = 1; + } elsif (scalar(@controls) > 1) { + # Do we already have the right 001/003 value in the existing set? + unless (grep $_->data() eq $spec_value, @controls) { + $munge = 1; + } + + # Delete the other fields, as with more than 1 001/003 we do not know which 003/001 to match + foreach my $control (@controls) { + unless ($control->data() eq $spec_value) { + $record->delete_field($control); + } + } + } else { + # Only one field; check to see if we need to munge it + unless (grep $_->data() eq $spec_value, @controls) { + $munge = 1; + } + } +} + +# Now, if we need to munge the 001, we will first push the existing 001/003 into the 035 +if ($munge) { + my $scn = "(" . $record->field('003')->data() . ")" . $record->field('001')->data(); + + # Do not create duplicate 035 fields + unless (grep $_->subfield('a') eq $scn, @scns) { + $record->insert_fields_ordered(MARC::Field->new('035', '', '', 'a' => $scn)); + } +} + +# Set the 001/003 and update the MARC +if ($create or $munge) { + $record->field('001')->data($rec_id); + $record->field('003')->data($ou_cni); + + my $xml = $record->as_xml_record(); + $xml =~ s/\n//sgo; + $xml =~ s/^<\?xml.+\?\s*>//go; + $xml =~ s/>\s+entityize() + # to avoid having to set PERL5LIB for PostgreSQL as well + + # If we are going to convert non-ASCII characters to XML entities, + # we had better be dealing with a UTF8 string to begin with + $xml = decode_utf8($xml); + + $xml = NFC($xml); + + # Convert raw ampersands to entities + $xml =~ s/&(?!\S+;)/&/gso; + + # Convert Unicode characters to entities + $xml =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe; + + $xml =~ s/[\x00-\x1f]//go; + $_TD->{new}{marc} = $xml; + + return "MODIFY"; +} + +return; +$func$ LANGUAGE PLPERLU; + +CREATE OR REPLACE FUNCTION authority.generate_overlay_template ( TEXT, BIGINT ) RETURNS TEXT AS $func$ + + use MARC::Record; + use MARC::File::XML (BinaryEncoding => 'UTF-8'); + + my $xml = shift; + my $r = MARC::Record->new_from_xml( $xml ); + + return undef unless ($r); + + my $id = shift() || $r->subfield( '901' => 'c' ); + $id =~ s/^\s*(?:\([^)]+\))?\s*(.+)\s*?$/$1/; + return undef unless ($id); # We need an ID! + + my $tmpl = MARC::Record->new(); + + my @rule_fields; + for my $field ( $r->field( '1..' ) ) { # Get main entry fields from the authority record + + my $tag = $field->tag; + my $i1 = $field->indicator(1); + my $i2 = $field->indicator(2); + my $sf = join '', map { $_->[0] } $field->subfields; + my @data = map { @$_ } $field->subfields; + + my @replace_them; + + # Map the authority field to bib fields it can control. + if ($tag >= 100 and $tag <= 111) { # names + @replace_them = map { $tag + $_ } (0, 300, 500, 600, 700); + } elsif ($tag eq '130') { # uniform title + @replace_them = qw/130 240 440 730 830/; + } elsif ($tag >= 150 and $tag <= 155) { # subjects + @replace_them = ($tag + 500); + } elsif ($tag >= 180 and $tag <= 185) { # floating subdivisions + @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/; + } else { + next; + } + + # Dummy up the bib-side data + $tmpl->append_fields( + map { + MARC::Field->new( $_, $i1, $i2, @data ) + } @replace_them + ); + + # Construct some 'replace' rules + push @rule_fields, map { $_ . $sf . '[0~\)' .$id . '$]' } @replace_them; + } + + # Insert the replace rules into the template + $tmpl->append_fields( + MARC::Field->new( '905' => ' ' => ' ' => 'r' => join(',', @rule_fields ) ) + ); + + $xml = $tmpl->as_xml_record; + $xml =~ s/^<\?.+?\?>$//mo; + $xml =~ s/\n//sgo; + $xml =~ s/>\s+ 'UTF-8'); + use strict; + + my $target_xml = shift; + my $source_xml = shift; + my $field_spec = shift; + + my $target_r = MARC::Record->new_from_xml( $target_xml ); + my $source_r = MARC::Record->new_from_xml( $source_xml ); + + return $target_xml unless ($target_r && $source_r); + + my @field_list = split(',', $field_spec); + + my %fields; + for my $f (@field_list) { + $f =~ s/^\s*//; $f =~ s/\s*$//; + if ($f =~ /^(.{3})(\w*)(?:\[([^]]*)\])?$/) { + my $field = $1; + $field =~ s/\s+//; + my $sf = $2; + $sf =~ s/\s+//; + my $match = $3; + $match =~ s/^\s*//; $match =~ s/\s*$//; + $fields{$field} = { sf => [ split('', $sf) ] }; + if ($match) { + my ($msf,$mre) = split('~', $match); + if (length($msf) > 0 and length($mre) > 0) { + $msf =~ s/^\s*//; $msf =~ s/\s*$//; + $mre =~ s/^\s*//; $mre =~ s/\s*$//; + $fields{$field}{match} = { sf => $msf, re => qr/$mre/ }; + } + } + } + } + + for my $f ( keys %fields) { + if ( @{$fields{$f}{sf}} ) { + for my $from_field ($source_r->field( $f )) { + for my $to_field ($target_r->field( $f )) { + if (exists($fields{$f}{match})) { + next unless (grep { $_ =~ $fields{$f}{match}{re} } $to_field->subfield($fields{$f}{match}{sf})); + } + my @new_sf = map { ($_ => $from_field->subfield($_)) } @{$fields{$f}{sf}}; + $to_field->add_subfields( @new_sf ); + } + } + } else { + my @new_fields = map { $_->clone } $source_r->field( $f ); + $target_r->insert_fields_ordered( @new_fields ); + } + } + + $target_xml = $target_r->as_xml_record; + $target_xml =~ s/^<\?.+?\?>$//mo; + $target_xml =~ s/\n//sgo; + $target_xml =~ s/>\s+ 'UTF-8'); + use strict; + + my $xml = shift; + my $r = MARC::Record->new_from_xml( $xml ); + + return $xml unless ($r); + + my $field_spec = shift; + my @field_list = split(',', $field_spec); + + my %fields; + for my $f (@field_list) { + $f =~ s/^\s*//; $f =~ s/\s*$//; + if ($f =~ /^(.{3})(\w*)(?:\[([^]]*)\])?$/) { + my $field = $1; + $field =~ s/\s+//; + my $sf = $2; + $sf =~ s/\s+//; + my $match = $3; + $match =~ s/^\s*//; $match =~ s/\s*$//; + $fields{$field} = { sf => [ split('', $sf) ] }; + if ($match) { + my ($msf,$mre) = split('~', $match); + if (length($msf) > 0 and length($mre) > 0) { + $msf =~ s/^\s*//; $msf =~ s/\s*$//; + $mre =~ s/^\s*//; $mre =~ s/\s*$//; + $fields{$field}{match} = { sf => $msf, re => qr/$mre/ }; + } + } + } + } + + for my $f ( keys %fields) { + for my $to_field ($r->field( $f )) { + if (exists($fields{$f}{match})) { + next unless (grep { $_ =~ $fields{$f}{match}{re} } $to_field->subfield($fields{$f}{match}{sf})); + } + + if ( @{$fields{$f}{sf}} ) { + $to_field->delete_subfield(code => $fields{$f}{sf}); + } else { + $r->delete_field( $to_field ); + } + } + } + + $xml = $r->as_xml_record; + $xml =~ s/^<\?.+?\?>$//mo; + $xml =~ s/\n//sgo; + $xml =~ s/>\s+