1 DROP FUNCTION IF EXISTS migration_tools.strip_subfield(TEXT,CHAR(3),CHAR(1));
2 CREATE OR REPLACE FUNCTION migration_tools.strip_subfield(marc TEXT, tag CHAR(3), subfield CHAR(1))
10 use MARC::File::XML (BinaryEncoding => 'utf8');
12 binmode(STDERR, ':bytes');
13 binmode(STDOUT, ':utf8');
14 binmode(STDERR, ':utf8');
19 $marc_xml =~ s/(<leader>.........)./${1}a/;
22 $marc_xml = MARC::Record->new_from_xml($marc_xml);
25 #elog("could not parse: $@\n");
26 import MARC::File::XML (BinaryEncoding => 'utf8');
30 my @fields = $marc_xml->field($tag);
31 return $marc_xml->as_xml_record() unless @fields;
33 $marc_xml->delete_fields(@fields);
35 foreach my $f (@fields) {
36 $f->delete_subfield(code => '0');
38 $marc_xml->insert_fields_ordered(@fields);
40 return $marc_xml->as_xml_record();
45 CREATE OR REPLACE FUNCTION migration_tools.set_leader (TEXT, INT, TEXT) RETURNS TEXT AS $$
46 my ($marcxml, $pos, $value) = @_;
53 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
54 my $leader = $marc->leader();
55 substr($leader, $pos, 1) = $value;
56 $marc->leader($leader);
57 $xml = $marc->as_xml_record;
58 $xml =~ s/^<\?.+?\?>$//mo;
60 $xml =~ s/>\s+</></sgo;
63 $$ LANGUAGE PLPERLU STABLE;
65 CREATE OR REPLACE FUNCTION migration_tools.set_008 (TEXT, INT, TEXT) RETURNS TEXT AS $$
66 my ($marcxml, $pos, $value) = @_;
73 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
74 my $f008 = $marc->field('008');
77 my $field = $f008->data();
78 substr($field, $pos, 1) = $value;
79 $f008->update($field);
80 $xml = $marc->as_xml_record;
81 $xml =~ s/^<\?.+?\?>$//mo;
83 $xml =~ s/>\s+</></sgo;
87 $$ LANGUAGE PLPERLU STABLE;
89 CREATE OR REPLACE FUNCTION migration_tools.insert_tags (TEXT, TEXT) RETURNS TEXT AS $$
91 my ($marcxml, $tags) = @_;
99 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
100 my $to_insert = MARC::Record->new_from_xml("<record>$tags</record>", 'UTF-8');
104 foreach my $field ( $marc->fields() ) {
105 push @incumbents, $field->as_formatted();
108 foreach $field ( $to_insert->fields() ) {
109 if (!grep {$_ eq $field->as_formatted()} @incumbents) {
110 $marc->insert_fields_ordered( ($field) );
114 $xml = $marc->as_xml_record;
115 $xml =~ s/^<\?.+?\?>$//mo;
117 $xml =~ s/>\s+</></sgo;
122 $$ LANGUAGE PLPERLU STABLE;
124 CREATE OR REPLACE FUNCTION migration_tools.marc_parses( TEXT ) RETURNS BOOLEAN AS $func$
127 use MARC::File::XML (BinaryEncoding => 'UTF-8');
130 MARC::Charset->assume_unicode(1);
135 my $r = MARC::Record->new_from_xml( $xml );
136 my $output_xml = $r->as_xml_record();
144 $func$ LANGUAGE PLPERLU;
145 COMMENT ON FUNCTION migration_tools.marc_parses(TEXT) IS 'Return boolean indicating if MARCXML string is parseable by MARC::File::XML';
147 CREATE OR REPLACE FUNCTION migration_tools.merge_marc_fields( TEXT, TEXT, TEXT[] ) RETURNS TEXT AS $func$
153 use MARC::File::XML (BinaryEncoding => 'UTF-8');
156 MARC::Charset->assume_unicode(1);
158 my $target_xml = shift;
159 my $source_xml = shift;
165 eval { $target = MARC::Record->new_from_xml( $target_xml ); };
169 eval { $source = MARC::Record->new_from_xml( $source_xml ); };
174 my $source_id = $source->subfield('901', 'c');
175 $source_id = $source->subfield('903', 'a') unless $source_id;
176 my $target_id = $target->subfield('901', 'c');
177 $target_id = $target->subfield('903', 'a') unless $target_id;
180 foreach my $tag (@$tags) {
181 my %existing_fields = map { $_->as_formatted() => 1 } $target->field($tag);
182 my @to_add = grep { not exists $existing_fields{$_->as_formatted()} } $source->field($tag);
183 $target->insert_fields_ordered(map { $_->clone() } @to_add);
185 elog(NOTICE, "Merged $tag tag(s) from $source_id to $target_id");
189 my $xml = $target->as_xml_record;
190 $xml =~ s/^<\?.+?\?>$//mo;
192 $xml =~ s/>\s+</></sgo;
196 $func$ LANGUAGE PLPERLU;
197 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.';
199 CREATE OR REPLACE FUNCTION migration_tools.make_stub_bib (text[], text[]) RETURNS TEXT AS $func$
205 use MARC::File::XML (BinaryEncoding => 'UTF-8');
209 my $in_values = shift;
211 # hack-and-slash parsing of array-passed-as-string;
212 # this can go away once everybody is running Postgres 9.1+
213 my $csv = Text::CSV->new({binary => 1});
216 my $status = $csv->parse($in_tags);
217 my $tags = [ $csv->fields() ];
218 $in_values =~ s/^{//;
219 $in_values =~ s/}$//;
220 $status = $csv->parse($in_values);
221 my $values = [ $csv->fields() ];
223 my $marc = MARC::Record->new();
225 $marc->leader('00000nam a22000007 4500');
226 $marc->append_fields(MARC::Field->new('008', '000000s 000 eng d'));
228 foreach my $i (0..$#$tags) {
230 if ($tags->[$i] =~ /^(\d{3})([0-9a-z])$/) {
233 $marc->append_fields(MARC::Field->new($tag, ' ', ' ', $sf => $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
234 } elsif ($tags->[$i] =~ /^(\d{3})$/) {
236 $marc->append_fields(MARC::Field->new($tag, $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
240 my $xml = $marc->as_xml_record;
241 $xml =~ s/^<\?.+?\?>$//mo;
243 $xml =~ s/>\s+</></sgo;
247 $func$ LANGUAGE PLPERLU;
248 COMMENT ON FUNCTION migration_tools.make_stub_bib (text[], text[]) IS $$Simple function to create a stub MARCXML bib from a set of columns.
249 The first argument is an array of tag/subfield specifiers, e.g., ARRAY['001', '245a', '500a'].
250 The second argument is an array of text containing the values to plug into each field.
251 If the value for a given field is NULL or the empty string, it is not inserted.
254 CREATE OR REPLACE FUNCTION migration_tools.make_stub_bib (text[], text[], text[], text[]) RETURNS TEXT AS $func$
260 use MARC::File::XML (BinaryEncoding => 'UTF-8');
266 my $in_values = shift;
268 # hack-and-slash parsing of array-passed-as-string;
269 # this can go away once everybody is running Postgres 9.1+
270 my $csv = Text::CSV->new({binary => 1});
273 my $status = $csv->parse($in_tags);
274 my $tags = [ $csv->fields() ];
277 $status = $csv->parse($in_ind1);
278 my $ind1s = [ $csv->fields() ];
281 $status = $csv->parse($in_ind2);
282 my $ind2s = [ $csv->fields() ];
283 $in_values =~ s/^{//;
284 $in_values =~ s/}$//;
285 $status = $csv->parse($in_values);
286 my $values = [ $csv->fields() ];
288 my $marc = MARC::Record->new();
290 $marc->leader('00000nam a22000007 4500');
291 $marc->append_fields(MARC::Field->new('008', '000000s 000 eng d'));
293 foreach my $i (0..$#$tags) {
295 if ($tags->[$i] =~ /^(\d{3})([0-9a-z])$/) {
298 $marc->append_fields(MARC::Field->new($tag, $ind1s->[$i], $ind2s->[$i], $sf => $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
299 } elsif ($tags->[$i] =~ /^(\d{3})$/) {
301 $marc->append_fields(MARC::Field->new($tag, $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
305 my $xml = $marc->as_xml_record;
306 $xml =~ s/^<\?.+?\?>$//mo;
308 $xml =~ s/>\s+</></sgo;
312 $func$ LANGUAGE PLPERLU;
313 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.
314 The first argument is an array of tag/subfield specifiers, e.g., ARRAY['001', '245a', '500a'].
315 The second argument is an array of text containing the values to plug into indicator 1 for each field.
316 The third argument is an array of text containing the values to plug into indicator 2 for each field.
317 The fourth argument is an array of text containing the values to plug into each field.
318 If the value for a given field is NULL or the empty string, it is not inserted.
321 CREATE OR REPLACE FUNCTION migration_tools.set_indicator (TEXT, TEXT, INTEGER, CHAR(1)) RETURNS TEXT AS $func$
323 my ($marcxml, $tag, $pos, $value) = @_;
326 use MARC::File::XML (BinaryEncoding => 'UTF-8');
330 MARC::Charset->assume_unicode(1);
332 elog(ERROR, 'indicator position must be either 1 or 2') unless $pos =~ /^[12]$/;
333 elog(ERROR, 'MARC tag must be numeric') unless $tag =~ /^\d{3}$/;
334 elog(ERROR, 'MARC tag must not be control field') if $tag =~ /^00/;
335 elog(ERROR, 'Value must be exactly one character') unless $value =~ /^.$/;
339 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
341 foreach my $field ($marc->field($tag)) {
342 $field->update("ind$pos" => $value);
344 $xml = $marc->as_xml_record;
345 $xml =~ s/^<\?.+?\?>$//mo;
347 $xml =~ s/>\s+</></sgo;
351 $func$ LANGUAGE PLPERLU;
353 COMMENT ON FUNCTION migration_tools.set_indicator(TEXT, TEXT, INTEGER, CHAR(1)) IS $$Set indicator value of a specified MARC field.
354 The first argument is a MARCXML string.
355 The second argument is a MARC tag.
356 The third argument is the indicator position, either 1 or 2.
357 The fourth argument is the character to set the indicator value to.
358 All occurences of the specified field will be changed.
359 The function returns the revised MARCXML string.$$;
361 CREATE OR REPLACE FUNCTION migration_tools.get_marc_leader (TEXT) RETURNS TEXT AS $$
370 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
371 $field = $marc->leader();
374 $$ LANGUAGE PLPERLU STABLE;
376 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tag (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT AS $$
377 my ($marcxml, $tag, $subfield, $delimiter) = @_;
385 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
386 $field = $marc->field($tag);
388 return $field->as_string($subfield,$delimiter) if $field;
390 $$ LANGUAGE PLPERLU STABLE;
392 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tags (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT[] AS $$
393 my ($marcxml, $tag, $subfield, $delimiter) = @_;
401 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
402 @fields = $marc->field($tag);
405 foreach my $field (@fields) {
406 push @texts, $field->as_string($subfield,$delimiter);
409 $$ LANGUAGE PLPERLU STABLE;
411 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tags_filtered (TEXT, TEXT, TEXT, TEXT, TEXT) RETURNS TEXT[] AS $$
412 my ($marcxml, $tag, $subfield, $delimiter, $match) = @_;
420 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
421 @fields = $marc->field($tag);
424 foreach my $field (@fields) {
425 if ($field->as_string() =~ qr/$match/) {
426 push @texts, $field->as_string($subfield,$delimiter);
430 $$ LANGUAGE PLPERLU STABLE;
432 DROP FUNCTION IF EXISTS migration_tools.munge_sf9(BIGINT,TEXT,TEXT);
433 CREATE OR REPLACE FUNCTION migration_tools.merge_sf9(bib_id BIGINT,new_sf9 TEXT,force TEXT DEFAULT 'false')
440 SELECT marc FROM biblio.record_entry WHERE id = bib_id INTO marc_xml;
442 SELECT munge_sf9(marc_xml,new_sf9,force) INTO new_marc;
443 UPDATE biblio.record_entry SET marc = new_marc WHERE id = bib_id;
447 $BODY$ LANGUAGE plpgsql;
449 DROP FUNCTION IF EXISTS migration_tools.munge_sf9(TEXT,TEXT,TEXT);
450 CREATE OR REPLACE FUNCTION migration_tools.munge_sf9(marc_xml TEXT, new_9_to_set TEXT, force TEXT)
458 use MARC::File::XML (BinaryEncoding => 'utf8');
460 binmode(STDERR, ':bytes');
461 binmode(STDOUT, ':utf8');
462 binmode(STDERR, ':utf8');
464 my $marc_xml = shift;
465 my $new_9_to_set = shift;
468 $marc_xml =~ s/(<leader>.........)./${1}a/;
471 $marc_xml = MARC::Record->new_from_xml($marc_xml);
474 #elog("could not parse $bibid: $@\n");
475 import MARC::File::XML (BinaryEncoding => 'utf8');
479 my @uris = $marc_xml->field('856');
480 return $marc_xml->as_xml_record() unless @uris;
482 foreach my $field (@uris) {
483 my $ind1 = $field->indicator('1');
484 if (!defined $ind1) { next; }
485 if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'false') { next; }
486 if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'true') { $field->set_indicator(1,'4'); }
487 my $ind2 = $field->indicator('2');
488 if (!defined $ind2) { next; }
489 if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'false') { next; }
490 if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'true') { $field->set_indicator(2,'0'); }
491 $field->add_subfields( '9' => $new_9_to_set );
494 return $marc_xml->as_xml_record();
498 DROP FUNCTION IF EXISTS migration_tools.munge_sf9_qualifying_match(TEXT,TEXT,TEXT);
499 CREATE OR REPLACE FUNCTION migration_tools.munge_sf9_qualifying_match(marc_xml TEXT, qualifying_match TEXT, new_9_to_set TEXT, force TEXT)
507 use MARC::File::XML (BinaryEncoding => 'utf8');
509 binmode(STDERR, ':bytes');
510 binmode(STDOUT, ':utf8');
511 binmode(STDERR, ':utf8');
513 my $marc_xml = shift;
514 my $qualifying_match = shift;
515 my $new_9_to_set = shift;
518 $marc_xml =~ s/(<leader>.........)./${1}a/;
521 $marc_xml = MARC::Record->new_from_xml($marc_xml);
524 #elog("could not parse $bibid: $@\n");
525 import MARC::File::XML (BinaryEncoding => 'utf8');
529 my @uris = $marc_xml->field('856');
530 return $marc_xml->as_xml_record() unless @uris;
532 foreach my $field (@uris) {
533 if ($field->as_string() =~ qr/$qualifying_match/) {
534 my $ind1 = $field->indicator('1');
535 if (!defined $ind1) { next; }
536 if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'false') { next; }
537 if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'true') { $field->set_indicator(1,'4'); }
538 my $ind2 = $field->indicator('2');
539 if (!defined $ind2) { next; }
540 if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'false') { next; }
541 if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'true') { $field->set_indicator(2,'0'); }
542 $field->add_subfields( '9' => $new_9_to_set );
546 return $marc_xml->as_xml_record();
550 DROP FUNCTION IF EXISTS migration_tools.owner_change_sf9_substring_match(TEXT,TEXT,TEXT,TEXT);
551 CREATE OR REPLACE FUNCTION migration_tools.owner_change_sf9_substring_match (marc_xml TEXT, substring_old_value TEXT, new_value TEXT, fix_indicators TEXT)
559 use MARC::File::XML (BinaryEncoding => 'utf8');
561 binmode(STDERR, ':bytes');
562 binmode(STDOUT, ':utf8');
563 binmode(STDERR, ':utf8');
565 my $marc_xml = shift;
566 my $substring_old_value = shift;
567 my $new_value = shift;
568 my $fix_indicators = shift;
570 $marc_xml =~ s/(<leader>.........)./${1}a/;
573 $marc_xml = MARC::Record->new_from_xml($marc_xml);
576 #elog("could not parse $bibid: $@\n");
577 import MARC::File::XML (BinaryEncoding => 'utf8');
581 my @uris = $marc_xml->field('856');
582 return $marc_xml->as_xml_record() unless @uris;
584 foreach my $field (@uris) {
585 my $ind1 = $field->indicator('1');
587 if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
588 $field->set_indicator(1,'4');
591 my $ind2 = $field->indicator('2');
593 if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
594 $field->set_indicator(2,'0');
597 if ($field->as_string('9') =~ qr/$substring_old_value/) {
598 $field->delete_subfield('9');
599 $field->add_subfields( '9' => $new_value );
601 $marc_xml->delete_field($field); # -- we're going to dedup and add them back
604 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
605 $marc_xml->insert_fields_ordered( values( %hash ) );
607 return $marc_xml->as_xml_record();
611 DROP FUNCTION IF EXISTS migration_tools.owner_change_sf9_substring_match2(TEXT,TEXT,TEXT,TEXT,TEXT);
612 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)
620 use MARC::File::XML (BinaryEncoding => 'utf8');
622 binmode(STDERR, ':bytes');
623 binmode(STDOUT, ':utf8');
624 binmode(STDERR, ':utf8');
626 my $marc_xml = shift;
627 my $qualifying_match = shift;
628 my $substring_old_value = shift;
629 my $new_value = shift;
630 my $fix_indicators = shift;
632 $marc_xml =~ s/(<leader>.........)./${1}a/;
635 $marc_xml = MARC::Record->new_from_xml($marc_xml);
638 #elog("could not parse $bibid: $@\n");
639 import MARC::File::XML (BinaryEncoding => 'utf8');
643 my @unqualified_uris = $marc_xml->field('856');
645 foreach my $field (@unqualified_uris) {
646 if ($field->as_string() =~ qr/$qualifying_match/) {
650 return $marc_xml->as_xml_record() unless @uris;
652 foreach my $field (@uris) {
653 my $ind1 = $field->indicator('1');
655 if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
656 $field->set_indicator(1,'4');
659 my $ind2 = $field->indicator('2');
661 if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
662 $field->set_indicator(2,'0');
665 if ($field->as_string('9') =~ qr/$substring_old_value/) {
666 $field->delete_subfield('9');
667 $field->add_subfields( '9' => $new_value );
669 $marc_xml->delete_field($field); # -- we're going to dedup and add them back
672 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
673 $marc_xml->insert_fields_ordered( values( %hash ) );
675 return $marc_xml->as_xml_record();
680 DROP FUNCTION IF EXISTS migration_tools.strip_tag(TEXT,TEXT);
681 CREATE OR REPLACE FUNCTION migration_tools.strip_tag(marc TEXT, tag TEXT)
689 use MARC::File::XML (BinaryEncoding => 'utf8');
691 binmode(STDERR, ':bytes');
692 binmode(STDOUT, ':utf8');
693 binmode(STDERR, ':utf8');
695 my $marc_xml = shift;
698 $marc_xml =~ s/(<leader>.........)./${1}a/;
701 $marc_xml = MARC::Record->new_from_xml($marc_xml);
704 #elog("could not parse $bibid: $@\n");
705 import MARC::File::XML (BinaryEncoding => 'utf8');
709 my @fields = $marc_xml->field($tag);
710 return $marc_xml->as_xml_record() unless @fields;
712 $marc_xml->delete_fields(@fields);
714 return $marc_xml->as_xml_record();
718 -- removes tags from record based on tag, subfield and evidence
719 -- example: strip_tag(marc, '500', 'a', 'gift') will remove 500s with 'gift' as a part of the $a
720 DROP FUNCTION IF EXISTS migration_tools.strip_tag(TEXT,TEXT,TEXT,TEXT);
721 CREATE OR REPLACE FUNCTION migration_tools.strip_tag(marc TEXT, tag TEXT, subfield TEXT, evidence TEXT)
729 use MARC::File::XML (BinaryEncoding => 'utf8');
731 binmode(STDERR, ':bytes');
732 binmode(STDOUT, ':utf8');
733 binmode(STDERR, ':utf8');
735 my $marc_xml = shift;
737 my $subfield = shift;
738 my $evidence = shift;
740 $marc_xml =~ s/(<leader>.........)./${1}a/;
743 $marc_xml = MARC::Record->new_from_xml($marc_xml);
746 #elog("could not parse $bibid: $@\n");
747 import MARC::File::XML (BinaryEncoding => 'utf8');
751 my @fields = $marc_xml->field($tag);
752 return $marc_xml->as_xml_record() unless @fields;
754 my @fields_to_delete;
756 foreach my $f (@fields) {
757 my $sf = lc($f->as_string($subfield));
758 if ($sf =~ m/$evidence/) { push @fields_to_delete, $f; }
761 $marc_xml->delete_fields(@fields_to_delete);
763 return $marc_xml->as_xml_record();
767 -- consolidate marc tag
768 DROP FUNCTION IF EXISTS migration_tools.consolidate_tag(TEXT,TEXT);
769 CREATE OR REPLACE FUNCTION migration_tools.consolidate_tag(marc TEXT, tag TEXT)
777 use MARC::File::XML (BinaryEncoding => 'utf8');
779 binmode(STDERR, ':bytes');
780 binmode(STDOUT, ':utf8');
781 binmode(STDERR, ':utf8');
783 my $marc_xml = shift;
786 $marc_xml =~ s/(<leader>.........)./${1}a/;
789 $marc_xml = MARC::Record->new_from_xml($marc_xml);
792 #elog("could not parse $bibid: $@\n");
793 import MARC::File::XML (BinaryEncoding => 'utf8');
797 my @fields = $marc_xml->field($tag);
798 return $marc_xml->as_xml_record() unless @fields;
800 my @combined_subfield_refs = ();
801 my @combined_subfields = ();
802 foreach my $field (@fields) {
803 my @subfield_refs = $field->subfields();
804 push @combined_subfield_refs, @subfield_refs;
807 my @sorted_subfield_refs = reverse sort { $a->[0] <=> $b->[0] } @combined_subfield_refs;
809 while ( my $tuple = pop( @sorted_subfield_refs ) ) {
810 my ($code,$data) = @$tuple;
811 unshift( @combined_subfields, $code, $data );
814 $marc_xml->delete_fields(@fields);
816 my $new_field = new MARC::Field(
818 $fields[0]->indicator(1),
819 $fields[0]->indicator(2),
823 $marc_xml->insert_grouped_field( $new_field );
825 return $marc_xml->as_xml_record();
829 CREATE OR REPLACE FUNCTION migration_tools.set_leader (TEXT, INT, TEXT) RETURNS TEXT AS $$
830 my ($marcxml, $pos, $value) = @_;
837 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
838 my $leader = $marc->leader();
839 substr($leader, $pos, 1) = $value;
840 $marc->leader($leader);
841 $xml = $marc->as_xml_record;
842 $xml =~ s/^<\?.+?\?>$//mo;
844 $xml =~ s/>\s+</></sgo;
847 $$ LANGUAGE PLPERLU STABLE;
849 CREATE OR REPLACE FUNCTION migration_tools.set_008 (TEXT, INT, TEXT) RETURNS TEXT AS $$
850 my ($marcxml, $pos, $value) = @_;
857 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
858 my $f008 = $marc->field('008');
861 my $field = $f008->data();
862 substr($field, $pos, 1) = $value;
863 $f008->update($field);
864 $xml = $marc->as_xml_record;
865 $xml =~ s/^<\?.+?\?>$//mo;
867 $xml =~ s/>\s+</></sgo;
871 $$ LANGUAGE PLPERLU STABLE;
873 CREATE OR REPLACE FUNCTION migration_tools.insert_tags (TEXT, TEXT) RETURNS TEXT AS $$
875 my ($marcxml, $tags) = @_;
883 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
884 my $to_insert = MARC::Record->new_from_xml("<record>$tags</record>", 'UTF-8');
888 foreach my $field ( $marc->fields() ) {
889 push @incumbents, $field->as_formatted();
892 foreach $field ( $to_insert->fields() ) {
893 if (!grep {$_ eq $field->as_formatted()} @incumbents) {
894 $marc->insert_fields_ordered( ($field) );
898 $xml = $marc->as_xml_record;
899 $xml =~ s/^<\?.+?\?>$//mo;
901 $xml =~ s/>\s+</></sgo;
906 $$ LANGUAGE PLPERLU STABLE;