1 CREATE OR REPLACE FUNCTION migration_tools.marc_parses( TEXT ) RETURNS BOOLEAN AS $func$
4 use MARC::File::XML (BinaryEncoding => 'UTF-8');
7 MARC::Charset->assume_unicode(1);
12 my $r = MARC::Record->new_from_xml( $xml );
13 my $output_xml = $r->as_xml_record();
21 $func$ LANGUAGE PLPERLU;
22 COMMENT ON FUNCTION migration_tools.marc_parses(TEXT) IS 'Return boolean indicating if MARCXML string is parseable by MARC::File::XML';
24 CREATE OR REPLACE FUNCTION migration_tools.merge_marc_fields( TEXT, TEXT, TEXT[] ) RETURNS TEXT AS $func$
30 use MARC::File::XML (BinaryEncoding => 'UTF-8');
33 MARC::Charset->assume_unicode(1);
35 my $target_xml = shift;
36 my $source_xml = shift;
42 eval { $target = MARC::Record->new_from_xml( $target_xml ); };
46 eval { $source = MARC::Record->new_from_xml( $source_xml ); };
51 my $source_id = $source->subfield('901', 'c');
52 $source_id = $source->subfield('903', 'a') unless $source_id;
53 my $target_id = $target->subfield('901', 'c');
54 $target_id = $target->subfield('903', 'a') unless $target_id;
57 foreach my $tag (@$tags) {
58 my %existing_fields = map { $_->as_formatted() => 1 } $target->field($tag);
59 my @to_add = grep { not exists $existing_fields{$_->as_formatted()} } $source->field($tag);
60 $target->insert_fields_ordered(map { $_->clone() } @to_add);
62 elog(NOTICE, "Merged $tag tag(s) from $source_id to $target_id");
66 my $xml = $target->as_xml_record;
67 $xml =~ s/^<\?.+?\?>$//mo;
69 $xml =~ s/>\s+</></sgo;
73 $func$ LANGUAGE PLPERLU;
74 COMMENT ON FUNCTION migration_tools.merge_marc_fields( TEXT, TEXT, TEXT[] ) IS 'Given two MARCXML strings and an array of tags, returns MARCXML representing the merge of the specified fields from the second MARCXML record into the first.';
76 CREATE OR REPLACE FUNCTION migration_tools.make_stub_bib (text[], text[]) RETURNS TEXT AS $func$
82 use MARC::File::XML (BinaryEncoding => 'UTF-8');
86 my $in_values = shift;
88 # hack-and-slash parsing of array-passed-as-string;
89 # this can go away once everybody is running Postgres 9.1+
90 my $csv = Text::CSV->new({binary => 1});
93 my $status = $csv->parse($in_tags);
94 my $tags = [ $csv->fields() ];
97 $status = $csv->parse($in_values);
98 my $values = [ $csv->fields() ];
100 my $marc = MARC::Record->new();
102 $marc->leader('00000nam a22000007 4500');
103 $marc->append_fields(MARC::Field->new('008', '000000s 000 eng d'));
105 foreach my $i (0..$#$tags) {
107 if ($tags->[$i] =~ /^(\d{3})([0-9a-z])$/) {
110 $marc->append_fields(MARC::Field->new($tag, ' ', ' ', $sf => $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
111 } elsif ($tags->[$i] =~ /^(\d{3})$/) {
113 $marc->append_fields(MARC::Field->new($tag, $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
117 my $xml = $marc->as_xml_record;
118 $xml =~ s/^<\?.+?\?>$//mo;
120 $xml =~ s/>\s+</></sgo;
124 $func$ LANGUAGE PLPERLU;
125 COMMENT ON FUNCTION migration_tools.make_stub_bib (text[], text[]) IS $$Simple function to create a stub MARCXML bib from a set of columns.
126 The first argument is an array of tag/subfield specifiers, e.g., ARRAY['001', '245a', '500a'].
127 The second argument is an array of text containing the values to plug into each field.
128 If the value for a given field is NULL or the empty string, it is not inserted.
131 CREATE OR REPLACE FUNCTION migration_tools.make_stub_bib (text[], text[], text[], text[]) RETURNS TEXT AS $func$
137 use MARC::File::XML (BinaryEncoding => 'UTF-8');
143 my $in_values = shift;
145 # hack-and-slash parsing of array-passed-as-string;
146 # this can go away once everybody is running Postgres 9.1+
147 my $csv = Text::CSV->new({binary => 1});
150 my $status = $csv->parse($in_tags);
151 my $tags = [ $csv->fields() ];
154 $status = $csv->parse($in_ind1);
155 my $ind1s = [ $csv->fields() ];
158 $status = $csv->parse($in_ind2);
159 my $ind2s = [ $csv->fields() ];
160 $in_values =~ s/^{//;
161 $in_values =~ s/}$//;
162 $status = $csv->parse($in_values);
163 my $values = [ $csv->fields() ];
165 my $marc = MARC::Record->new();
167 $marc->leader('00000nam a22000007 4500');
168 $marc->append_fields(MARC::Field->new('008', '000000s 000 eng d'));
170 foreach my $i (0..$#$tags) {
172 if ($tags->[$i] =~ /^(\d{3})([0-9a-z])$/) {
175 $marc->append_fields(MARC::Field->new($tag, $ind1s->[$i], $ind2s->[$i], $sf => $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
176 } elsif ($tags->[$i] =~ /^(\d{3})$/) {
178 $marc->append_fields(MARC::Field->new($tag, $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
182 my $xml = $marc->as_xml_record;
183 $xml =~ s/^<\?.+?\?>$//mo;
185 $xml =~ s/>\s+</></sgo;
189 $func$ LANGUAGE PLPERLU;
190 COMMENT ON FUNCTION migration_tools.make_stub_bib (text[], text[], text[], text[]) IS $$Simple function to create a stub MARCXML bib from a set of columns.
191 The first argument is an array of tag/subfield specifiers, e.g., ARRAY['001', '245a', '500a'].
192 The second argument is an array of text containing the values to plug into indicator 1 for each field.
193 The third argument is an array of text containing the values to plug into indicator 2 for each field.
194 The fourth argument is an array of text containing the values to plug into each field.
195 If the value for a given field is NULL or the empty string, it is not inserted.
198 CREATE OR REPLACE FUNCTION migration_tools.set_indicator (TEXT, TEXT, INTEGER, CHAR(1)) RETURNS TEXT AS $func$
200 my ($marcxml, $tag, $pos, $value) = @_;
203 use MARC::File::XML (BinaryEncoding => 'UTF-8');
207 MARC::Charset->assume_unicode(1);
209 elog(ERROR, 'indicator position must be either 1 or 2') unless $pos =~ /^[12]$/;
210 elog(ERROR, 'MARC tag must be numeric') unless $tag =~ /^\d{3}$/;
211 elog(ERROR, 'MARC tag must not be control field') if $tag =~ /^00/;
212 elog(ERROR, 'Value must be exactly one character') unless $value =~ /^.$/;
216 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
218 foreach my $field ($marc->field($tag)) {
219 $field->update("ind$pos" => $value);
221 $xml = $marc->as_xml_record;
222 $xml =~ s/^<\?.+?\?>$//mo;
224 $xml =~ s/>\s+</></sgo;
228 $func$ LANGUAGE PLPERLU;
230 COMMENT ON FUNCTION migration_tools.set_indicator(TEXT, TEXT, INTEGER, CHAR(1)) IS $$Set indicator value of a specified MARC field.
231 The first argument is a MARCXML string.
232 The second argument is a MARC tag.
233 The third argument is the indicator position, either 1 or 2.
234 The fourth argument is the character to set the indicator value to.
235 All occurences of the specified field will be changed.
236 The function returns the revised MARCXML string.$$;
238 CREATE OR REPLACE FUNCTION migration_tools.get_marc_leader (TEXT) RETURNS TEXT AS $$
247 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
248 $field = $marc->leader();
251 $$ LANGUAGE PLPERLU STABLE;
253 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tag (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT AS $$
254 my ($marcxml, $tag, $subfield, $delimiter) = @_;
262 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
263 $field = $marc->field($tag);
265 return $field->as_string($subfield,$delimiter) if $field;
267 $$ LANGUAGE PLPERLU STABLE;
269 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tags (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT[] AS $$
270 my ($marcxml, $tag, $subfield, $delimiter) = @_;
278 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
279 @fields = $marc->field($tag);
282 foreach my $field (@fields) {
283 push @texts, $field->as_string($subfield,$delimiter);
286 $$ LANGUAGE PLPERLU STABLE;
288 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tags_filtered (TEXT, TEXT, TEXT, TEXT, TEXT) RETURNS TEXT[] AS $$
289 my ($marcxml, $tag, $subfield, $delimiter, $match) = @_;
297 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
298 @fields = $marc->field($tag);
301 foreach my $field (@fields) {
302 if ($field->as_string() =~ qr/$match/) {
303 push @texts, $field->as_string($subfield,$delimiter);
307 $$ LANGUAGE PLPERLU STABLE;
309 DROP FUNCTION IF EXISTS migration_tools.munge_sf9(INTEGER,TEXT,TEXT);
310 CREATE OR REPLACE FUNCTION migration_tools.merge_sf9(bib_id INTEGER,new_sf9 TEXT,force TEXT DEFAULT 'false')
317 SELECT marc FROM biblio.record_entry WHERE id = bib_id INTO marc_xml;
319 SELECT munge_sf9(marc_xml,new_sf9,force) INTO new_marc;
320 UPDATE biblio.record_entry SET marc = new_marc WHERE id = bib_id;
324 $BODY$ LANGUAGE plpgsql;
326 DROP FUNCTION IF EXISTS migration_tools.munge_sf9(TEXT,TEXT,TEXT);
327 CREATE OR REPLACE FUNCTION migration_tools.munge_sf9(marc_xml TEXT, new_9_to_set TEXT, force TEXT)
335 use MARC::File::XML (BinaryEncoding => 'utf8');
337 binmode(STDERR, ':bytes');
338 binmode(STDOUT, ':utf8');
339 binmode(STDERR, ':utf8');
341 my $marc_xml = shift;
342 my $new_9_to_set = shift;
345 $marc_xml =~ s/(<leader>.........)./${1}a/;
348 $marc_xml = MARC::Record->new_from_xml($marc_xml);
351 #elog("could not parse $bibid: $@\n");
352 import MARC::File::XML (BinaryEncoding => 'utf8');
356 my @uris = $marc_xml->field('856');
357 return $marc_xml->as_xml_record() unless @uris;
359 foreach my $field (@uris) {
360 my $ind1 = $field->indicator('1');
361 if (!defined $ind1) { next; }
362 if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'false') { next; }
363 if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'true') { $field->set_indicator(1,'4'); }
364 my $ind2 = $field->indicator('2');
365 if (!defined $ind2) { next; }
366 if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'false') { next; }
367 if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'true') { $field->set_indicator(2,'0'); }
368 $field->add_subfields( '9' => $new_9_to_set );
371 return $marc_xml->as_xml_record();
375 DROP FUNCTION IF EXISTS migration_tools.munge_sf9_qualifying_match(TEXT,TEXT,TEXT);
376 CREATE OR REPLACE FUNCTION migration_tools.munge_sf9_qualifying_match(marc_xml TEXT, qualifying_match TEXT, new_9_to_set TEXT, force TEXT)
384 use MARC::File::XML (BinaryEncoding => 'utf8');
386 binmode(STDERR, ':bytes');
387 binmode(STDOUT, ':utf8');
388 binmode(STDERR, ':utf8');
390 my $marc_xml = shift;
391 my $qualifying_match = shift;
392 my $new_9_to_set = shift;
395 $marc_xml =~ s/(<leader>.........)./${1}a/;
398 $marc_xml = MARC::Record->new_from_xml($marc_xml);
401 #elog("could not parse $bibid: $@\n");
402 import MARC::File::XML (BinaryEncoding => 'utf8');
406 my @uris = $marc_xml->field('856');
407 return $marc_xml->as_xml_record() unless @uris;
409 foreach my $field (@uris) {
410 if ($field->as_string() =~ qr/$qualifying_match/) {
411 my $ind1 = $field->indicator('1');
412 if (!defined $ind1) { next; }
413 if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'false') { next; }
414 if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'true') { $field->set_indicator(1,'4'); }
415 my $ind2 = $field->indicator('2');
416 if (!defined $ind2) { next; }
417 if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'false') { next; }
418 if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'true') { $field->set_indicator(2,'0'); }
419 $field->add_subfields( '9' => $new_9_to_set );
423 return $marc_xml->as_xml_record();
427 DROP FUNCTION IF EXISTS migration_tools.owner_change_sf9_substring_match(TEXT,TEXT,TEXT,TEXT);
428 CREATE OR REPLACE FUNCTION migration_tools.owner_change_sf9_substring_match (marc_xml TEXT, substring_old_value TEXT, new_value TEXT, fix_indicators TEXT)
436 use MARC::File::XML (BinaryEncoding => 'utf8');
438 binmode(STDERR, ':bytes');
439 binmode(STDOUT, ':utf8');
440 binmode(STDERR, ':utf8');
442 my $marc_xml = shift;
443 my $substring_old_value = shift;
444 my $new_value = shift;
445 my $fix_indicators = shift;
447 $marc_xml =~ s/(<leader>.........)./${1}a/;
450 $marc_xml = MARC::Record->new_from_xml($marc_xml);
453 #elog("could not parse $bibid: $@\n");
454 import MARC::File::XML (BinaryEncoding => 'utf8');
458 my @uris = $marc_xml->field('856');
459 return $marc_xml->as_xml_record() unless @uris;
461 foreach my $field (@uris) {
462 my $ind1 = $field->indicator('1');
464 if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
465 $field->set_indicator(1,'4');
468 my $ind2 = $field->indicator('2');
470 if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
471 $field->set_indicator(2,'0');
474 if ($field->as_string('9') =~ qr/$substring_old_value/) {
475 $field->delete_subfield('9');
476 $field->add_subfields( '9' => $new_value );
478 $marc_xml->delete_field($field); # -- we're going to dedup and add them back
481 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
482 $marc_xml->insert_fields_ordered( values( %hash ) );
484 return $marc_xml->as_xml_record();
488 DROP FUNCTION IF EXISTS migration_tools.owner_change_sf9_substring_match2(TEXT,TEXT,TEXT,TEXT,TEXT);
489 CREATE OR REPLACE FUNCTION migration_tools.owner_change_sf9_substring_match2 (marc_xml TEXT, qualifying_match TEXT, substring_old_value TEXT, new_value TEXT, fix_indicators TEXT)
497 use MARC::File::XML (BinaryEncoding => 'utf8');
499 binmode(STDERR, ':bytes');
500 binmode(STDOUT, ':utf8');
501 binmode(STDERR, ':utf8');
503 my $marc_xml = shift;
504 my $qualifying_match = shift;
505 my $substring_old_value = shift;
506 my $new_value = shift;
507 my $fix_indicators = shift;
509 $marc_xml =~ s/(<leader>.........)./${1}a/;
512 $marc_xml = MARC::Record->new_from_xml($marc_xml);
515 #elog("could not parse $bibid: $@\n");
516 import MARC::File::XML (BinaryEncoding => 'utf8');
520 my @unqualified_uris = $marc_xml->field('856');
522 foreach my $field (@unqualified_uris) {
523 if ($field->as_string() =~ qr/$qualifying_match/) {
527 return $marc_xml->as_xml_record() unless @uris;
529 foreach my $field (@uris) {
530 my $ind1 = $field->indicator('1');
532 if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
533 $field->set_indicator(1,'4');
536 my $ind2 = $field->indicator('2');
538 if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
539 $field->set_indicator(2,'0');
542 if ($field->as_string('9') =~ qr/$substring_old_value/) {
543 $field->delete_subfield('9');
544 $field->add_subfields( '9' => $new_value );
546 $marc_xml->delete_field($field); # -- we're going to dedup and add them back
549 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
550 $marc_xml->insert_fields_ordered( values( %hash ) );
552 return $marc_xml->as_xml_record();
557 DROP FUNCTION IF EXISTS migration_tools.strip_tag(TEXT,TEXT);
558 CREATE OR REPLACE FUNCTION migration_tools.strip_tag(marc TEXT, tag TEXT)
566 use MARC::File::XML (BinaryEncoding => 'utf8');
568 binmode(STDERR, ':bytes');
569 binmode(STDOUT, ':utf8');
570 binmode(STDERR, ':utf8');
572 my $marc_xml = shift;
575 $marc_xml =~ s/(<leader>.........)./${1}a/;
578 $marc_xml = MARC::Record->new_from_xml($marc_xml);
581 #elog("could not parse $bibid: $@\n");
582 import MARC::File::XML (BinaryEncoding => 'utf8');
586 my @fields = $marc_xml->field($tag);
587 return $marc_xml->as_xml_record() unless @fields;
589 $marc_xml->delete_fields(@fields);
591 return $marc_xml->as_xml_record();
595 -- removes tags from record based on tag, subfield and evidence
596 -- example: strip_tag(marc, '500', 'a', 'gift') will remove 500s with 'gift' as a part of the $a
597 DROP FUNCTION IF EXISTS migration_tools.strip_tag(TEXT,TEXT,TEXT,TEXT);
598 CREATE OR REPLACE FUNCTION migration_tools.strip_tag(marc TEXT, tag TEXT, subfield TEXT, evidence TEXT)
606 use MARC::File::XML (BinaryEncoding => 'utf8');
608 binmode(STDERR, ':bytes');
609 binmode(STDOUT, ':utf8');
610 binmode(STDERR, ':utf8');
612 my $marc_xml = shift;
614 my $subfield = shift;
615 my $evidence = shift;
617 $marc_xml =~ s/(<leader>.........)./${1}a/;
620 $marc_xml = MARC::Record->new_from_xml($marc_xml);
623 #elog("could not parse $bibid: $@\n");
624 import MARC::File::XML (BinaryEncoding => 'utf8');
628 my @fields = $marc_xml->field($tag);
629 return $marc_xml->as_xml_record() unless @fields;
631 my @fields_to_delete;
633 foreach my $f (@fields) {
634 my $sf = lc($f->as_string($subfield));
635 if ($sf =~ m/$evidence/) { push @fields_to_delete, $f; }
638 $marc_xml->delete_fields(@fields_to_delete);
640 return $marc_xml->as_xml_record();
644 -- consolidate marc tag
645 DROP FUNCTION IF EXISTS migration_tools.consolidate_tag(TEXT,TEXT);
646 CREATE OR REPLACE FUNCTION migration_tools.consolidate_tag(marc TEXT, tag TEXT)
654 use MARC::File::XML (BinaryEncoding => 'utf8');
656 binmode(STDERR, ':bytes');
657 binmode(STDOUT, ':utf8');
658 binmode(STDERR, ':utf8');
660 my $marc_xml = shift;
663 $marc_xml =~ s/(<leader>.........)./${1}a/;
666 $marc_xml = MARC::Record->new_from_xml($marc_xml);
669 #elog("could not parse $bibid: $@\n");
670 import MARC::File::XML (BinaryEncoding => 'utf8');
674 my @fields = $marc_xml->field($tag);
675 return $marc_xml->as_xml_record() unless @fields;
677 my @combined_subfield_refs = ();
678 my @combined_subfields = ();
679 foreach my $field (@fields) {
680 my @subfield_refs = $field->subfields();
681 push @combined_subfield_refs, @subfield_refs;
684 my @sorted_subfield_refs = reverse sort { $a->[0] <=> $b->[0] } @combined_subfield_refs;
686 while ( my $tuple = pop( @sorted_subfield_refs ) ) {
687 my ($code,$data) = @$tuple;
688 unshift( @combined_subfields, $code, $data );
691 $marc_xml->delete_fields(@fields);
693 my $new_field = new MARC::Field(
695 $fields[0]->indicator(1),
696 $fields[0]->indicator(2),
700 $marc_xml->insert_grouped_field( $new_field );
702 return $marc_xml->as_xml_record();
706 CREATE OR REPLACE FUNCTION migration_tools.set_leader (TEXT, INT, TEXT) RETURNS TEXT AS $$
707 my ($marcxml, $pos, $value) = @_;
714 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
715 my $leader = $marc->leader();
716 substr($leader, $pos, 1) = $value;
717 $marc->leader($leader);
718 $xml = $marc->as_xml_record;
719 $xml =~ s/^<\?.+?\?>$//mo;
721 $xml =~ s/>\s+</></sgo;
724 $$ LANGUAGE PLPERLU STABLE;
726 CREATE OR REPLACE FUNCTION migration_tools.set_008 (TEXT, INT, TEXT) RETURNS TEXT AS $$
727 my ($marcxml, $pos, $value) = @_;
734 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
735 my $f008 = $marc->field('008');
738 my $field = $f008->data();
739 substr($field, $pos, 1) = $value;
740 $f008->update($field);
741 $xml = $marc->as_xml_record;
742 $xml =~ s/^<\?.+?\?>$//mo;
744 $xml =~ s/>\s+</></sgo;
748 $$ LANGUAGE PLPERLU STABLE;
750 CREATE OR REPLACE FUNCTION migration_tools.insert_tags (TEXT, TEXT) RETURNS TEXT AS $$
752 my ($marcxml, $tags) = @_;
760 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
761 my $to_insert = MARC::Record->new_from_xml("<record>$tags</record>", 'UTF-8');
765 foreach my $field ( $marc->fields() ) {
766 push @incumbents, $field->as_formatted();
769 foreach $field ( $to_insert->fields() ) {
770 if (!grep {$_ eq $field->as_formatted()} @incumbents) {
771 $marc->insert_fields_ordered( ($field) );
775 $xml = $marc->as_xml_record;
776 $xml =~ s/^<\?.+?\?>$//mo;
778 $xml =~ s/>\s+</></sgo;
783 $$ LANGUAGE PLPERLU STABLE;