sql/base/marc.sql

   1 CREATE OR REPLACE FUNCTION migration_tools.marc_parses( TEXT ) RETURNS BOOLEAN AS $func$
   2
   3 use MARC::Record;
   4 use MARC::File::XML (BinaryEncoding => 'UTF-8');
   5 use MARC::Charset;
   6
   7 MARC::Charset->assume_unicode(1);
   8
   9 my $xml = shift;
  10
  11 eval {
  12     my $r = MARC::Record->new_from_xml( $xml );
  13     my $output_xml = $r->as_xml_record();
  14 };
  15 if ($@) {
  16     return 0;
  17 } else {
  18     return 1;
  19 }
  20
  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';
  23
  24 CREATE OR REPLACE FUNCTION migration_tools.merge_marc_fields( TEXT, TEXT, TEXT[] ) RETURNS TEXT AS $func$
  25
  26 use strict;
  27 use warnings;
  28
  29 use MARC::Record;
  30 use MARC::File::XML (BinaryEncoding => 'UTF-8');
  31 use MARC::Charset;
  32
  33 MARC::Charset->assume_unicode(1);
  34
  35 my $target_xml = shift;
  36 my $source_xml = shift;
  37 my $tags = shift;
  38
  39 my $target;
  40 my $source;
  41
  42 eval { $target = MARC::Record->new_from_xml( $target_xml ); };
  43 if ($@) {
  44     return;
  45 }
  46 eval { $source = MARC::Record->new_from_xml( $source_xml ); };
  47 if ($@) {
  48     return;
  49 }
  50
  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;
  55
  56 my %existing_fields;
  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);
  61     if (@to_add) {
  62         elog(NOTICE, "Merged $tag tag(s) from $source_id to $target_id");
  63     }
  64 }
  65
  66 my $xml = $target->as_xml_record;
  67 $xml =~ s/^<\?.+?\?>$//mo;
  68 $xml =~ s/\n//sgo;
  69 $xml =~ s/>\s+</></sgo;
  70
  71 return $xml;
  72
  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.';
  75
  76 CREATE OR REPLACE FUNCTION migration_tools.make_stub_bib (text[], text[]) RETURNS TEXT AS $func$
  77
  78 use strict;
  79 use warnings;
  80
  81 use MARC::Record;
  82 use MARC::File::XML (BinaryEncoding => 'UTF-8');
  83 use Text::CSV;
  84
  85 my $in_tags = shift;
  86 my $in_values = shift;
  87
  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});
  91 $in_tags =~ s/^{//;
  92 $in_tags =~ s/}$//;
  93 my $status = $csv->parse($in_tags);
  94 my $tags = [ $csv->fields() ];
  95 $in_values =~ s/^{//;
  96 $in_values =~ s/}$//;
  97 $status = $csv->parse($in_values);
  98 my $values = [ $csv->fields() ];
  99
 100 my $marc = MARC::Record->new();
 101
 102 $marc->leader('00000nam a22000007  4500');
 103 $marc->append_fields(MARC::Field->new('008', '000000s                       000   eng d'));
 104
 105 foreach my $i (0..$#$tags) {
 106     my ($tag, $sf);
 107     if ($tags->[$i] =~ /^(\d{3})([0-9a-z])$/) {
 108         $tag = $1;
 109         $sf = $2;
 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})$/) {
 112         $tag = $1;
 113         $marc->append_fields(MARC::Field->new($tag, $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
 114     }
 115 }
 116
 117 my $xml = $marc->as_xml_record;
 118 $xml =~ s/^<\?.+?\?>$//mo;
 119 $xml =~ s/\n//sgo;
 120 $xml =~ s/>\s+</></sgo;
 121
 122 return $xml;
 123
 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.
 129 $$;
 130
 131 CREATE OR REPLACE FUNCTION migration_tools.make_stub_bib (text[], text[], text[], text[]) RETURNS TEXT AS $func$
 132
 133 use strict;
 134 use warnings;
 135
 136 use MARC::Record;
 137 use MARC::File::XML (BinaryEncoding => 'UTF-8');
 138 use Text::CSV;
 139
 140 my $in_tags = shift;
 141 my $in_ind1 = shift;
 142 my $in_ind2 = shift;
 143 my $in_values = shift;
 144
 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});
 148 $in_tags =~ s/^{//;
 149 $in_tags =~ s/}$//;
 150 my $status = $csv->parse($in_tags);
 151 my $tags = [ $csv->fields() ];
 152 $in_ind1 =~ s/^{//;
 153 $in_ind1 =~ s/}$//;
 154 $status = $csv->parse($in_ind1);
 155 my $ind1s = [ $csv->fields() ];
 156 $in_ind2 =~ s/^{//;
 157 $in_ind2 =~ s/}$//;
 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() ];
 164
 165 my $marc = MARC::Record->new();
 166
 167 $marc->leader('00000nam a22000007  4500');
 168 $marc->append_fields(MARC::Field->new('008', '000000s                       000   eng d'));
 169
 170 foreach my $i (0..$#$tags) {
 171     my ($tag, $sf);
 172     if ($tags->[$i] =~ /^(\d{3})([0-9a-z])$/) {
 173         $tag = $1;
 174         $sf = $2;
 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})$/) {
 177         $tag = $1;
 178         $marc->append_fields(MARC::Field->new($tag, $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
 179     }
 180 }
 181
 182 my $xml = $marc->as_xml_record;
 183 $xml =~ s/^<\?.+?\?>$//mo;
 184 $xml =~ s/\n//sgo;
 185 $xml =~ s/>\s+</></sgo;
 186
 187 return $xml;
 188
 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.
 196 $$;
 197
 198 CREATE OR REPLACE FUNCTION migration_tools.set_indicator (TEXT, TEXT, INTEGER, CHAR(1)) RETURNS TEXT AS $func$
 199
 200 my ($marcxml, $tag, $pos, $value) = @_;
 201
 202 use MARC::Record;
 203 use MARC::File::XML (BinaryEncoding => 'UTF-8');
 204 use MARC::Charset;
 205 use strict;
 206
 207 MARC::Charset->assume_unicode(1);
 208
 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 =~ /^.$/;
 213
 214 my $xml = $marcxml;
 215 eval {
 216     my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 217
 218     foreach my $field ($marc->field($tag)) {
 219         $field->update("ind$pos" => $value);
 220     }
 221     $xml = $marc->as_xml_record;
 222     $xml =~ s/^<\?.+?\?>$//mo;
 223     $xml =~ s/\n//sgo;
 224     $xml =~ s/>\s+</></sgo;
 225 };
 226 return $xml;
 227
 228 $func$ LANGUAGE PLPERLU;
 229
 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.$$;
 237
 238 CREATE OR REPLACE FUNCTION migration_tools.create_staff_user(
 239     username TEXT,
 240     password TEXT,
 241     org TEXT,
 242     perm_group TEXT,
 243     first_name TEXT DEFAULT '',
 244     last_name TEXT DEFAULT ''
 245 ) RETURNS VOID AS $func$
 246 BEGIN
 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;
 253 END
 254 $func$
 255 LANGUAGE PLPGSQL;
 256
 257 CREATE OR REPLACE FUNCTION migration_tools.get_marc_leader (TEXT) RETURNS TEXT AS $$
 258     my ($marcxml) = @_;
 259
 260     use MARC::Record;
 261     use MARC::File::XML;
 262     use MARC::Field;
 263
 264     my $field;
 265     eval {
 266         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 267         $field = $marc->leader();
 268     };
 269     return $field;
 270 $$ LANGUAGE PLPERLU STABLE;
 271
 272 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tag (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT AS $$
 273     my ($marcxml, $tag, $subfield, $delimiter) = @_;
 274
 275     use MARC::Record;
 276     use MARC::File::XML;
 277     use MARC::Field;
 278
 279     my $field;
 280     eval {
 281         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 282         $field = $marc->field($tag);
 283     };
 284     return $field->as_string($subfield,$delimiter) if $field;
 285     return;
 286 $$ LANGUAGE PLPERLU STABLE;
 287
 288 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tags (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT[] AS $$
 289     my ($marcxml, $tag, $subfield, $delimiter) = @_;
 290
 291     use MARC::Record;
 292     use MARC::File::XML;
 293     use MARC::Field;
 294
 295     my @fields;
 296     eval {
 297         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 298         @fields = $marc->field($tag);
 299     };
 300     my @texts;
 301     foreach my $field (@fields) {
 302         push @texts, $field->as_string($subfield,$delimiter);
 303     }
 304     return \@texts;
 305 $$ LANGUAGE PLPERLU STABLE;
 306
 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) = @_;
 309
 310     use MARC::Record;
 311     use MARC::File::XML;
 312     use MARC::Field;
 313
 314     my @fields;
 315     eval {
 316         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 317         @fields = $marc->field($tag);
 318     };
 319     my @texts;
 320     foreach my $field (@fields) {
 321         if ($field->as_string() =~ qr/$match/) {
 322             push @texts, $field->as_string($subfield,$delimiter);
 323         }
 324     }
 325     return \@texts;
 326 $$ LANGUAGE PLPERLU STABLE;
 327
 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')
 330     RETURNS BOOLEAN AS
 331 $BODY$
 332 DECLARE
 333     marc_xml    TEXT;
 334     new_marc    TEXT;
 335 BEGIN
 336     SELECT marc FROM biblio.record_entry WHERE id = bib_id INTO marc_xml;
 337
 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;
 340
 341     RETURN true;
 342 END;
 343 $BODY$ LANGUAGE plpgsql;
 344
 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)
 347  RETURNS TEXT
 348  LANGUAGE plperlu
 349 AS $function$
 350 use strict;
 351 use warnings;
 352
 353 use MARC::Record;
 354 use MARC::File::XML (BinaryEncoding => 'utf8');
 355
 356 binmode(STDERR, ':bytes');
 357 binmode(STDOUT, ':utf8');
 358 binmode(STDERR, ':utf8');
 359
 360 my $marc_xml = shift;
 361 my $new_9_to_set = shift;
 362 my $force = shift;
 363
 364 $marc_xml =~ s/(<leader>.........)./${1}a/;
 365
 366 eval {
 367     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 368 };
 369 if ($@) {
 370     #elog("could not parse $bibid: $@\n");
 371     import MARC::File::XML (BinaryEncoding => 'utf8');
 372     return $marc_xml;
 373 }
 374
 375 my @uris = $marc_xml->field('856');
 376 return $marc_xml->as_xml_record() unless @uris;
 377
 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 );
 388 }
 389
 390 return $marc_xml->as_xml_record();
 391
 392 $function$;
 393
 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)
 396  RETURNS TEXT
 397  LANGUAGE plperlu
 398 AS $function$
 399 use strict;
 400 use warnings;
 401
 402 use MARC::Record;
 403 use MARC::File::XML (BinaryEncoding => 'utf8');
 404
 405 binmode(STDERR, ':bytes');
 406 binmode(STDOUT, ':utf8');
 407 binmode(STDERR, ':utf8');
 408
 409 my $marc_xml = shift;
 410 my $qualifying_match = shift;
 411 my $new_9_to_set = shift;
 412 my $force = shift;
 413
 414 $marc_xml =~ s/(<leader>.........)./${1}a/;
 415
 416 eval {
 417     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 418 };
 419 if ($@) {
 420     #elog("could not parse $bibid: $@\n");
 421     import MARC::File::XML (BinaryEncoding => 'utf8');
 422     return $marc_xml;
 423 }
 424
 425 my @uris = $marc_xml->field('856');
 426 return $marc_xml->as_xml_record() unless @uris;
 427
 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 );
 439     }
 440 }
 441
 442 return $marc_xml->as_xml_record();
 443
 444 $function$;
 445
 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)
 448  RETURNS TEXT
 449  LANGUAGE plperlu
 450 AS $function$
 451 use strict;
 452 use warnings;
 453
 454 use MARC::Record;
 455 use MARC::File::XML (BinaryEncoding => 'utf8');
 456
 457 binmode(STDERR, ':bytes');
 458 binmode(STDOUT, ':utf8');
 459 binmode(STDERR, ':utf8');
 460
 461 my $marc_xml = shift;
 462 my $substring_old_value = shift;
 463 my $new_value = shift;
 464 my $fix_indicators = shift;
 465
 466 $marc_xml =~ s/(<leader>.........)./${1}a/;
 467
 468 eval {
 469     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 470 };
 471 if ($@) {
 472     #elog("could not parse $bibid: $@\n");
 473     import MARC::File::XML (BinaryEncoding => 'utf8');
 474     return $marc_xml;
 475 }
 476
 477 my @uris = $marc_xml->field('856');
 478 return $marc_xml->as_xml_record() unless @uris;
 479
 480 foreach my $field (@uris) {
 481     my $ind1 = $field->indicator('1');
 482     if (defined $ind1) {
 483         if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
 484             $field->set_indicator(1,'4');
 485         }
 486     }
 487     my $ind2 = $field->indicator('2');
 488     if (defined $ind2) {
 489         if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
 490             $field->set_indicator(2,'0');
 491         }
 492     }
 493     if ($field->as_string('9') =~ qr/$substring_old_value/) {
 494         $field->delete_subfield('9');
 495         $field->add_subfields( '9' => $new_value );
 496     }
 497     $marc_xml->delete_field($field); # -- we're going to dedup and add them back
 498 }
 499
 500 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
 501 $marc_xml->insert_fields_ordered( values( %hash ) );
 502
 503 return $marc_xml->as_xml_record();
 504
 505 $function$;
 506
 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)
 509  RETURNS TEXT
 510  LANGUAGE plperlu
 511 AS $function$
 512 use strict;
 513 use warnings;
 514
 515 use MARC::Record;
 516 use MARC::File::XML (BinaryEncoding => 'utf8');
 517
 518 binmode(STDERR, ':bytes');
 519 binmode(STDOUT, ':utf8');
 520 binmode(STDERR, ':utf8');
 521
 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;
 527
 528 $marc_xml =~ s/(<leader>.........)./${1}a/;
 529
 530 eval {
 531     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 532 };
 533 if ($@) {
 534     #elog("could not parse $bibid: $@\n");
 535     import MARC::File::XML (BinaryEncoding => 'utf8');
 536     return $marc_xml;
 537 }
 538
 539 my @unqualified_uris = $marc_xml->field('856');
 540 my @uris = ();
 541 foreach my $field (@unqualified_uris) {
 542     if ($field->as_string() =~ qr/$qualifying_match/) {
 543         push @uris, $field;
 544     }
 545 }
 546 return $marc_xml->as_xml_record() unless @uris;
 547
 548 foreach my $field (@uris) {
 549     my $ind1 = $field->indicator('1');
 550     if (defined $ind1) {
 551         if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
 552             $field->set_indicator(1,'4');
 553         }
 554     }
 555     my $ind2 = $field->indicator('2');
 556     if (defined $ind2) {
 557         if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
 558             $field->set_indicator(2,'0');
 559         }
 560     }
 561     if ($field->as_string('9') =~ qr/$substring_old_value/) {
 562         $field->delete_subfield('9');
 563         $field->add_subfields( '9' => $new_value );
 564     }
 565     $marc_xml->delete_field($field); # -- we're going to dedup and add them back
 566 }
 567
 568 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
 569 $marc_xml->insert_fields_ordered( values( %hash ) );
 570
 571 return $marc_xml->as_xml_record();
 572
 573 $function$;
 574
 575 -- strip marc tag
 576 DROP FUNCTION IF EXISTS migration_tools.strip_tag(TEXT,TEXT);
 577 CREATE OR REPLACE FUNCTION migration_tools.strip_tag(marc TEXT, tag TEXT)
 578  RETURNS TEXT
 579  LANGUAGE plperlu
 580 AS $function$
 581 use strict;
 582 use warnings;
 583
 584 use MARC::Record;
 585 use MARC::File::XML (BinaryEncoding => 'utf8');
 586
 587 binmode(STDERR, ':bytes');
 588 binmode(STDOUT, ':utf8');
 589 binmode(STDERR, ':utf8');
 590
 591 my $marc_xml = shift;
 592 my $tag = shift;
 593
 594 $marc_xml =~ s/(<leader>.........)./${1}a/;
 595
 596 eval {
 597     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 598 };
 599 if ($@) {
 600     #elog("could not parse $bibid: $@\n");
 601     import MARC::File::XML (BinaryEncoding => 'utf8');
 602     return $marc_xml;
 603 }
 604
 605 my @fields = $marc_xml->field($tag);
 606 return $marc_xml->as_xml_record() unless @fields;
 607
 608 $marc_xml->delete_fields(@fields);
 609
 610 return $marc_xml->as_xml_record();
 611
 612 $function$;
 613
 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)
 618  RETURNS TEXT
 619  LANGUAGE plperlu
 620 AS $function$
 621 use strict;
 622 use warnings;
 623
 624 use MARC::Record;
 625 use MARC::File::XML (BinaryEncoding => 'utf8');
 626
 627 binmode(STDERR, ':bytes');
 628 binmode(STDOUT, ':utf8');
 629 binmode(STDERR, ':utf8');
 630
 631 my $marc_xml = shift;
 632 my $tag = shift;
 633 my $subfield = shift;
 634 my $evidence = shift;
 635
 636 $marc_xml =~ s/(<leader>.........)./${1}a/;
 637
 638 eval {
 639     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 640 };
 641 if ($@) {
 642     #elog("could not parse $bibid: $@\n");
 643     import MARC::File::XML (BinaryEncoding => 'utf8');
 644     return $marc_xml;
 645 }
 646
 647 my @fields = $marc_xml->field($tag);
 648 return $marc_xml->as_xml_record() unless @fields;
 649
 650 my @fields_to_delete;
 651
 652 foreach my $f (@fields) {
 653     my $sf = lc($f->as_string($subfield));
 654     if ($sf =~ m/$evidence/) { push @fields_to_delete, $f; }
 655 }
 656
 657 $marc_xml->delete_fields(@fields_to_delete);
 658
 659 return $marc_xml->as_xml_record();
 660
 661 $function$;
 662
 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)
 666  RETURNS TEXT
 667  LANGUAGE plperlu
 668 AS $function$
 669 use strict;
 670 use warnings;
 671
 672 use MARC::Record;
 673 use MARC::File::XML (BinaryEncoding => 'utf8');
 674
 675 binmode(STDERR, ':bytes');
 676 binmode(STDOUT, ':utf8');
 677 binmode(STDERR, ':utf8');
 678
 679 my $marc_xml = shift;
 680 my $tag = shift;
 681
 682 $marc_xml =~ s/(<leader>.........)./${1}a/;
 683
 684 eval {
 685     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 686 };
 687 if ($@) {
 688     #elog("could not parse $bibid: $@\n");
 689     import MARC::File::XML (BinaryEncoding => 'utf8');
 690     return $marc_xml;
 691 }
 692
 693 my @fields = $marc_xml->field($tag);
 694 return $marc_xml->as_xml_record() unless @fields;
 695
 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;
 701 }
 702
 703 my @sorted_subfield_refs = reverse sort { $a->[0] <=> $b->[0] } @combined_subfield_refs;
 704
 705 while ( my $tuple = pop( @sorted_subfield_refs ) ) {
 706     my ($code,$data) = @$tuple;
 707     unshift( @combined_subfields, $code, $data );
 708 }
 709
 710 $marc_xml->delete_fields(@fields);
 711
 712 my $new_field = new MARC::Field(
 713     $tag,
 714     $fields[0]->indicator(1),
 715     $fields[0]->indicator(2),
 716     @combined_subfields
 717 );
 718
 719 $marc_xml->insert_grouped_field( $new_field );
 720
 721 return $marc_xml->as_xml_record();
 722
 723 $function$;
 724
 725