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.create_staff_user(
243 first_name TEXT DEFAULT '',
244 last_name TEXT DEFAULT ''
245 ) RETURNS VOID AS $func$
247 RAISE NOTICE '%', org ;
248 INSERT INTO actor.usr (usrname, passwd, ident_type, first_given_name, family_name, home_ou, profile)
249 SELECT username, password, 1, first_name, last_name, aou.id, pgt.id
250 FROM actor.org_unit aou, permission.grp_tree pgt
251 WHERE aou.shortname = org
252 AND pgt.name = perm_group;
257 CREATE OR REPLACE FUNCTION migration_tools.get_marc_leader (TEXT) RETURNS TEXT AS $$
266 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
267 $field = $marc->leader();
270 $$ LANGUAGE PLPERLU STABLE;
272 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tag (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT AS $$
273 my ($marcxml, $tag, $subfield, $delimiter) = @_;
281 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
282 $field = $marc->field($tag);
284 return $field->as_string($subfield,$delimiter) if $field;
286 $$ LANGUAGE PLPERLU STABLE;
288 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tags (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT[] AS $$
289 my ($marcxml, $tag, $subfield, $delimiter) = @_;
297 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
298 @fields = $marc->field($tag);
301 foreach my $field (@fields) {
302 push @texts, $field->as_string($subfield,$delimiter);
305 $$ LANGUAGE PLPERLU STABLE;
307 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tags_filtered (TEXT, TEXT, TEXT, TEXT, TEXT) RETURNS TEXT[] AS $$
308 my ($marcxml, $tag, $subfield, $delimiter, $match) = @_;
316 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
317 @fields = $marc->field($tag);
320 foreach my $field (@fields) {
321 if ($field->as_string() =~ qr/$match/) {
322 push @texts, $field->as_string($subfield,$delimiter);
326 $$ LANGUAGE PLPERLU STABLE;
328 DROP FUNCTION IF EXISTS migration_tools.munge_sf9(INTEGER,TEXT,TEXT);
329 CREATE OR REPLACE FUNCTION migration_tools.merge_sf9(bib_id INTEGER,new_sf9 TEXT,force TEXT DEFAULT 'false')
336 SELECT marc FROM biblio.record_entry WHERE id = bib_id INTO marc_xml;
338 SELECT munge_sf9(marc_xml,new_sf9,force) INTO new_marc;
339 UPDATE biblio.record_entry SET marc = new_marc WHERE id = bib_id;
343 $BODY$ LANGUAGE plpgsql;
345 DROP FUNCTION IF EXISTS migration_tools.munge_sf9(TEXT,TEXT,TEXT);
346 CREATE OR REPLACE FUNCTION migration_tools.munge_sf9(marc_xml TEXT, new_9_to_set TEXT, force TEXT)
354 use MARC::File::XML (BinaryEncoding => 'utf8');
356 binmode(STDERR, ':bytes');
357 binmode(STDOUT, ':utf8');
358 binmode(STDERR, ':utf8');
360 my $marc_xml = shift;
361 my $new_9_to_set = shift;
364 $marc_xml =~ s/(<leader>.........)./${1}a/;
367 $marc_xml = MARC::Record->new_from_xml($marc_xml);
370 #elog("could not parse $bibid: $@\n");
371 import MARC::File::XML (BinaryEncoding => 'utf8');
375 my @uris = $marc_xml->field('856');
376 return $marc_xml->as_xml_record() unless @uris;
378 foreach my $field (@uris) {
379 my $ind1 = $field->indicator('1');
380 if (!defined $ind1) { next; }
381 if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'false') { next; }
382 if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'true') { $field->set_indicator(1,'4'); }
383 my $ind2 = $field->indicator('2');
384 if (!defined $ind2) { next; }
385 if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'false') { next; }
386 if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'true') { $field->set_indicator(2,'0'); }
387 $field->add_subfields( '9' => $new_9_to_set );
390 return $marc_xml->as_xml_record();
394 DROP FUNCTION IF EXISTS migration_tools.munge_sf9_qualifying_match(TEXT,TEXT,TEXT);
395 CREATE OR REPLACE FUNCTION migration_tools.munge_sf9_qualifying_match(marc_xml TEXT, qualifying_match TEXT, new_9_to_set TEXT, force TEXT)
403 use MARC::File::XML (BinaryEncoding => 'utf8');
405 binmode(STDERR, ':bytes');
406 binmode(STDOUT, ':utf8');
407 binmode(STDERR, ':utf8');
409 my $marc_xml = shift;
410 my $qualifying_match = shift;
411 my $new_9_to_set = shift;
414 $marc_xml =~ s/(<leader>.........)./${1}a/;
417 $marc_xml = MARC::Record->new_from_xml($marc_xml);
420 #elog("could not parse $bibid: $@\n");
421 import MARC::File::XML (BinaryEncoding => 'utf8');
425 my @uris = $marc_xml->field('856');
426 return $marc_xml->as_xml_record() unless @uris;
428 foreach my $field (@uris) {
429 if ($field->as_string() =~ qr/$qualifying_match/) {
430 my $ind1 = $field->indicator('1');
431 if (!defined $ind1) { next; }
432 if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'false') { next; }
433 if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'true') { $field->set_indicator(1,'4'); }
434 my $ind2 = $field->indicator('2');
435 if (!defined $ind2) { next; }
436 if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'false') { next; }
437 if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'true') { $field->set_indicator(2,'0'); }
438 $field->add_subfields( '9' => $new_9_to_set );
442 return $marc_xml->as_xml_record();
446 DROP FUNCTION IF EXISTS migration_tools.owner_change_sf9_substring_match(TEXT,TEXT,TEXT,TEXT);
447 CREATE OR REPLACE FUNCTION migration_tools.owner_change_sf9_substring_match (marc_xml TEXT, substring_old_value TEXT, new_value TEXT, fix_indicators TEXT)
455 use MARC::File::XML (BinaryEncoding => 'utf8');
457 binmode(STDERR, ':bytes');
458 binmode(STDOUT, ':utf8');
459 binmode(STDERR, ':utf8');
461 my $marc_xml = shift;
462 my $substring_old_value = shift;
463 my $new_value = shift;
464 my $fix_indicators = shift;
466 $marc_xml =~ s/(<leader>.........)./${1}a/;
469 $marc_xml = MARC::Record->new_from_xml($marc_xml);
472 #elog("could not parse $bibid: $@\n");
473 import MARC::File::XML (BinaryEncoding => 'utf8');
477 my @uris = $marc_xml->field('856');
478 return $marc_xml->as_xml_record() unless @uris;
480 foreach my $field (@uris) {
481 my $ind1 = $field->indicator('1');
483 if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
484 $field->set_indicator(1,'4');
487 my $ind2 = $field->indicator('2');
489 if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
490 $field->set_indicator(2,'0');
493 if ($field->as_string('9') =~ qr/$substring_old_value/) {
494 $field->delete_subfield('9');
495 $field->add_subfields( '9' => $new_value );
497 $marc_xml->delete_field($field); # -- we're going to dedup and add them back
500 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
501 $marc_xml->insert_fields_ordered( values( %hash ) );
503 return $marc_xml->as_xml_record();
507 DROP FUNCTION IF EXISTS migration_tools.owner_change_sf9_substring_match2(TEXT,TEXT,TEXT,TEXT,TEXT);
508 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)
516 use MARC::File::XML (BinaryEncoding => 'utf8');
518 binmode(STDERR, ':bytes');
519 binmode(STDOUT, ':utf8');
520 binmode(STDERR, ':utf8');
522 my $marc_xml = shift;
523 my $qualifying_match = shift;
524 my $substring_old_value = shift;
525 my $new_value = shift;
526 my $fix_indicators = shift;
528 $marc_xml =~ s/(<leader>.........)./${1}a/;
531 $marc_xml = MARC::Record->new_from_xml($marc_xml);
534 #elog("could not parse $bibid: $@\n");
535 import MARC::File::XML (BinaryEncoding => 'utf8');
539 my @unqualified_uris = $marc_xml->field('856');
541 foreach my $field (@unqualified_uris) {
542 if ($field->as_string() =~ qr/$qualifying_match/) {
546 return $marc_xml->as_xml_record() unless @uris;
548 foreach my $field (@uris) {
549 my $ind1 = $field->indicator('1');
551 if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
552 $field->set_indicator(1,'4');
555 my $ind2 = $field->indicator('2');
557 if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
558 $field->set_indicator(2,'0');
561 if ($field->as_string('9') =~ qr/$substring_old_value/) {
562 $field->delete_subfield('9');
563 $field->add_subfields( '9' => $new_value );
565 $marc_xml->delete_field($field); # -- we're going to dedup and add them back
568 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
569 $marc_xml->insert_fields_ordered( values( %hash ) );
571 return $marc_xml->as_xml_record();
576 DROP FUNCTION IF EXISTS migration_tools.strip_tag(TEXT,TEXT);
577 CREATE OR REPLACE FUNCTION migration_tools.strip_tag(marc TEXT, tag TEXT)
585 use MARC::File::XML (BinaryEncoding => 'utf8');
587 binmode(STDERR, ':bytes');
588 binmode(STDOUT, ':utf8');
589 binmode(STDERR, ':utf8');
591 my $marc_xml = shift;
594 $marc_xml =~ s/(<leader>.........)./${1}a/;
597 $marc_xml = MARC::Record->new_from_xml($marc_xml);
600 #elog("could not parse $bibid: $@\n");
601 import MARC::File::XML (BinaryEncoding => 'utf8');
605 my @fields = $marc_xml->field($tag);
606 return $marc_xml->as_xml_record() unless @fields;
608 $marc_xml->delete_fields(@fields);
610 return $marc_xml->as_xml_record();
614 -- removes tags from record based on tag, subfield and evidence
615 -- example: strip_tag(marc, '500', 'a', 'gift') will remove 500s with 'gift' as a part of the $a
616 DROP FUNCTION IF EXISTS migration_tools.strip_tag(TEXT,TEXT,TEXT,TEXT);
617 CREATE OR REPLACE FUNCTION migration_tools.strip_tag(marc TEXT, tag TEXT, subfield TEXT, evidence TEXT)
625 use MARC::File::XML (BinaryEncoding => 'utf8');
627 binmode(STDERR, ':bytes');
628 binmode(STDOUT, ':utf8');
629 binmode(STDERR, ':utf8');
631 my $marc_xml = shift;
633 my $subfield = shift;
634 my $evidence = shift;
636 $marc_xml =~ s/(<leader>.........)./${1}a/;
639 $marc_xml = MARC::Record->new_from_xml($marc_xml);
642 #elog("could not parse $bibid: $@\n");
643 import MARC::File::XML (BinaryEncoding => 'utf8');
647 my @fields = $marc_xml->field($tag);
648 return $marc_xml->as_xml_record() unless @fields;
650 my @fields_to_delete;
652 foreach my $f (@fields) {
653 my $sf = lc($f->as_string($subfield));
654 if ($sf =~ m/$evidence/) { push @fields_to_delete, $f; }
657 $marc_xml->delete_fields(@fields_to_delete);
659 return $marc_xml->as_xml_record();
663 -- consolidate marc tag
664 DROP FUNCTION IF EXISTS migration_tools.consolidate_tag(TEXT,TEXT);
665 CREATE OR REPLACE FUNCTION migration_tools.consolidate_tag(marc TEXT, tag TEXT)
673 use MARC::File::XML (BinaryEncoding => 'utf8');
675 binmode(STDERR, ':bytes');
676 binmode(STDOUT, ':utf8');
677 binmode(STDERR, ':utf8');
679 my $marc_xml = shift;
682 $marc_xml =~ s/(<leader>.........)./${1}a/;
685 $marc_xml = MARC::Record->new_from_xml($marc_xml);
688 #elog("could not parse $bibid: $@\n");
689 import MARC::File::XML (BinaryEncoding => 'utf8');
693 my @fields = $marc_xml->field($tag);
694 return $marc_xml->as_xml_record() unless @fields;
696 my @combined_subfield_refs = ();
697 my @combined_subfields = ();
698 foreach my $field (@fields) {
699 my @subfield_refs = $field->subfields();
700 push @combined_subfield_refs, @subfield_refs;
703 my @sorted_subfield_refs = reverse sort { $a->[0] <=> $b->[0] } @combined_subfield_refs;
705 while ( my $tuple = pop( @sorted_subfield_refs ) ) {
706 my ($code,$data) = @$tuple;
707 unshift( @combined_subfields, $code, $data );
710 $marc_xml->delete_fields(@fields);
712 my $new_field = new MARC::Field(
714 $fields[0]->indicator(1),
715 $fields[0]->indicator(2),
719 $marc_xml->insert_grouped_field( $new_field );
721 return $marc_xml->as_xml_record();