sql/base/01-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.get_marc_leader (TEXT) RETURNS TEXT AS $$
 239     my ($marcxml) = @_;
 240
 241     use MARC::Record;
 242     use MARC::File::XML;
 243     use MARC::Field;
 244
 245     my $field;
 246     eval {
 247         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 248         $field = $marc->leader();
 249     };
 250     return $field;
 251 $$ LANGUAGE PLPERLU STABLE;
 252
 253 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tag (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT AS $$
 254     my ($marcxml, $tag, $subfield, $delimiter) = @_;
 255
 256     use MARC::Record;
 257     use MARC::File::XML;
 258     use MARC::Field;
 259
 260     my $field;
 261     eval {
 262         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 263         $field = $marc->field($tag);
 264     };
 265     return $field->as_string($subfield,$delimiter) if $field;
 266     return;
 267 $$ LANGUAGE PLPERLU STABLE;
 268
 269 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tags (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT[] AS $$
 270     my ($marcxml, $tag, $subfield, $delimiter) = @_;
 271
 272     use MARC::Record;
 273     use MARC::File::XML;
 274     use MARC::Field;
 275
 276     my @fields;
 277     eval {
 278         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 279         @fields = $marc->field($tag);
 280     };
 281     my @texts;
 282     foreach my $field (@fields) {
 283         push @texts, $field->as_string($subfield,$delimiter);
 284     }
 285     return \@texts;
 286 $$ LANGUAGE PLPERLU STABLE;
 287
 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) = @_;
 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         if ($field->as_string() =~ qr/$match/) {
 303             push @texts, $field->as_string($subfield,$delimiter);
 304         }
 305     }
 306     return \@texts;
 307 $$ LANGUAGE PLPERLU STABLE;
 308
 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')
 311     RETURNS BOOLEAN AS
 312 $BODY$
 313 DECLARE
 314     marc_xml    TEXT;
 315     new_marc    TEXT;
 316 BEGIN
 317     SELECT marc FROM biblio.record_entry WHERE id = bib_id INTO marc_xml;
 318
 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;
 321
 322     RETURN true;
 323 END;
 324 $BODY$ LANGUAGE plpgsql;
 325
 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)
 328  RETURNS TEXT
 329  LANGUAGE plperlu
 330 AS $function$
 331 use strict;
 332 use warnings;
 333
 334 use MARC::Record;
 335 use MARC::File::XML (BinaryEncoding => 'utf8');
 336
 337 binmode(STDERR, ':bytes');
 338 binmode(STDOUT, ':utf8');
 339 binmode(STDERR, ':utf8');
 340
 341 my $marc_xml = shift;
 342 my $new_9_to_set = shift;
 343 my $force = shift;
 344
 345 $marc_xml =~ s/(<leader>.........)./${1}a/;
 346
 347 eval {
 348     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 349 };
 350 if ($@) {
 351     #elog("could not parse $bibid: $@\n");
 352     import MARC::File::XML (BinaryEncoding => 'utf8');
 353     return $marc_xml;
 354 }
 355
 356 my @uris = $marc_xml->field('856');
 357 return $marc_xml->as_xml_record() unless @uris;
 358
 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 );
 369 }
 370
 371 return $marc_xml->as_xml_record();
 372
 373 $function$;
 374
 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)
 377  RETURNS TEXT
 378  LANGUAGE plperlu
 379 AS $function$
 380 use strict;
 381 use warnings;
 382
 383 use MARC::Record;
 384 use MARC::File::XML (BinaryEncoding => 'utf8');
 385
 386 binmode(STDERR, ':bytes');
 387 binmode(STDOUT, ':utf8');
 388 binmode(STDERR, ':utf8');
 389
 390 my $marc_xml = shift;
 391 my $qualifying_match = shift;
 392 my $new_9_to_set = shift;
 393 my $force = shift;
 394
 395 $marc_xml =~ s/(<leader>.........)./${1}a/;
 396
 397 eval {
 398     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 399 };
 400 if ($@) {
 401     #elog("could not parse $bibid: $@\n");
 402     import MARC::File::XML (BinaryEncoding => 'utf8');
 403     return $marc_xml;
 404 }
 405
 406 my @uris = $marc_xml->field('856');
 407 return $marc_xml->as_xml_record() unless @uris;
 408
 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 );
 420     }
 421 }
 422
 423 return $marc_xml->as_xml_record();
 424
 425 $function$;
 426
 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)
 429  RETURNS TEXT
 430  LANGUAGE plperlu
 431 AS $function$
 432 use strict;
 433 use warnings;
 434
 435 use MARC::Record;
 436 use MARC::File::XML (BinaryEncoding => 'utf8');
 437
 438 binmode(STDERR, ':bytes');
 439 binmode(STDOUT, ':utf8');
 440 binmode(STDERR, ':utf8');
 441
 442 my $marc_xml = shift;
 443 my $substring_old_value = shift;
 444 my $new_value = shift;
 445 my $fix_indicators = shift;
 446
 447 $marc_xml =~ s/(<leader>.........)./${1}a/;
 448
 449 eval {
 450     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 451 };
 452 if ($@) {
 453     #elog("could not parse $bibid: $@\n");
 454     import MARC::File::XML (BinaryEncoding => 'utf8');
 455     return $marc_xml;
 456 }
 457
 458 my @uris = $marc_xml->field('856');
 459 return $marc_xml->as_xml_record() unless @uris;
 460
 461 foreach my $field (@uris) {
 462     my $ind1 = $field->indicator('1');
 463     if (defined $ind1) {
 464         if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
 465             $field->set_indicator(1,'4');
 466         }
 467     }
 468     my $ind2 = $field->indicator('2');
 469     if (defined $ind2) {
 470         if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
 471             $field->set_indicator(2,'0');
 472         }
 473     }
 474     if ($field->as_string('9') =~ qr/$substring_old_value/) {
 475         $field->delete_subfield('9');
 476         $field->add_subfields( '9' => $new_value );
 477     }
 478     $marc_xml->delete_field($field); # -- we're going to dedup and add them back
 479 }
 480
 481 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
 482 $marc_xml->insert_fields_ordered( values( %hash ) );
 483
 484 return $marc_xml->as_xml_record();
 485
 486 $function$;
 487
 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)
 490  RETURNS TEXT
 491  LANGUAGE plperlu
 492 AS $function$
 493 use strict;
 494 use warnings;
 495
 496 use MARC::Record;
 497 use MARC::File::XML (BinaryEncoding => 'utf8');
 498
 499 binmode(STDERR, ':bytes');
 500 binmode(STDOUT, ':utf8');
 501 binmode(STDERR, ':utf8');
 502
 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;
 508
 509 $marc_xml =~ s/(<leader>.........)./${1}a/;
 510
 511 eval {
 512     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 513 };
 514 if ($@) {
 515     #elog("could not parse $bibid: $@\n");
 516     import MARC::File::XML (BinaryEncoding => 'utf8');
 517     return $marc_xml;
 518 }
 519
 520 my @unqualified_uris = $marc_xml->field('856');
 521 my @uris = ();
 522 foreach my $field (@unqualified_uris) {
 523     if ($field->as_string() =~ qr/$qualifying_match/) {
 524         push @uris, $field;
 525     }
 526 }
 527 return $marc_xml->as_xml_record() unless @uris;
 528
 529 foreach my $field (@uris) {
 530     my $ind1 = $field->indicator('1');
 531     if (defined $ind1) {
 532         if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
 533             $field->set_indicator(1,'4');
 534         }
 535     }
 536     my $ind2 = $field->indicator('2');
 537     if (defined $ind2) {
 538         if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
 539             $field->set_indicator(2,'0');
 540         }
 541     }
 542     if ($field->as_string('9') =~ qr/$substring_old_value/) {
 543         $field->delete_subfield('9');
 544         $field->add_subfields( '9' => $new_value );
 545     }
 546     $marc_xml->delete_field($field); # -- we're going to dedup and add them back
 547 }
 548
 549 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
 550 $marc_xml->insert_fields_ordered( values( %hash ) );
 551
 552 return $marc_xml->as_xml_record();
 553
 554 $function$;
 555
 556 -- strip marc tag
 557 DROP FUNCTION IF EXISTS migration_tools.strip_tag(TEXT,TEXT);
 558 CREATE OR REPLACE FUNCTION migration_tools.strip_tag(marc TEXT, tag TEXT)
 559  RETURNS TEXT
 560  LANGUAGE plperlu
 561 AS $function$
 562 use strict;
 563 use warnings;
 564
 565 use MARC::Record;
 566 use MARC::File::XML (BinaryEncoding => 'utf8');
 567
 568 binmode(STDERR, ':bytes');
 569 binmode(STDOUT, ':utf8');
 570 binmode(STDERR, ':utf8');
 571
 572 my $marc_xml = shift;
 573 my $tag = shift;
 574
 575 $marc_xml =~ s/(<leader>.........)./${1}a/;
 576
 577 eval {
 578     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 579 };
 580 if ($@) {
 581     #elog("could not parse $bibid: $@\n");
 582     import MARC::File::XML (BinaryEncoding => 'utf8');
 583     return $marc_xml;
 584 }
 585
 586 my @fields = $marc_xml->field($tag);
 587 return $marc_xml->as_xml_record() unless @fields;
 588
 589 $marc_xml->delete_fields(@fields);
 590
 591 return $marc_xml->as_xml_record();
 592
 593 $function$;
 594
 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)
 599  RETURNS TEXT
 600  LANGUAGE plperlu
 601 AS $function$
 602 use strict;
 603 use warnings;
 604
 605 use MARC::Record;
 606 use MARC::File::XML (BinaryEncoding => 'utf8');
 607
 608 binmode(STDERR, ':bytes');
 609 binmode(STDOUT, ':utf8');
 610 binmode(STDERR, ':utf8');
 611
 612 my $marc_xml = shift;
 613 my $tag = shift;
 614 my $subfield = shift;
 615 my $evidence = shift;
 616
 617 $marc_xml =~ s/(<leader>.........)./${1}a/;
 618
 619 eval {
 620     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 621 };
 622 if ($@) {
 623     #elog("could not parse $bibid: $@\n");
 624     import MARC::File::XML (BinaryEncoding => 'utf8');
 625     return $marc_xml;
 626 }
 627
 628 my @fields = $marc_xml->field($tag);
 629 return $marc_xml->as_xml_record() unless @fields;
 630
 631 my @fields_to_delete;
 632
 633 foreach my $f (@fields) {
 634     my $sf = lc($f->as_string($subfield));
 635     if ($sf =~ m/$evidence/) { push @fields_to_delete, $f; }
 636 }
 637
 638 $marc_xml->delete_fields(@fields_to_delete);
 639
 640 return $marc_xml->as_xml_record();
 641
 642 $function$;
 643
 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)
 647  RETURNS TEXT
 648  LANGUAGE plperlu
 649 AS $function$
 650 use strict;
 651 use warnings;
 652
 653 use MARC::Record;
 654 use MARC::File::XML (BinaryEncoding => 'utf8');
 655
 656 binmode(STDERR, ':bytes');
 657 binmode(STDOUT, ':utf8');
 658 binmode(STDERR, ':utf8');
 659
 660 my $marc_xml = shift;
 661 my $tag = shift;
 662
 663 $marc_xml =~ s/(<leader>.........)./${1}a/;
 664
 665 eval {
 666     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 667 };
 668 if ($@) {
 669     #elog("could not parse $bibid: $@\n");
 670     import MARC::File::XML (BinaryEncoding => 'utf8');
 671     return $marc_xml;
 672 }
 673
 674 my @fields = $marc_xml->field($tag);
 675 return $marc_xml->as_xml_record() unless @fields;
 676
 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;
 682 }
 683
 684 my @sorted_subfield_refs = reverse sort { $a->[0] <=> $b->[0] } @combined_subfield_refs;
 685
 686 while ( my $tuple = pop( @sorted_subfield_refs ) ) {
 687     my ($code,$data) = @$tuple;
 688     unshift( @combined_subfields, $code, $data );
 689 }
 690
 691 $marc_xml->delete_fields(@fields);
 692
 693 my $new_field = new MARC::Field(
 694     $tag,
 695     $fields[0]->indicator(1),
 696     $fields[0]->indicator(2),
 697     @combined_subfields
 698 );
 699
 700 $marc_xml->insert_grouped_field( $new_field );
 701
 702 return $marc_xml->as_xml_record();
 703
 704 $function$;
 705
 706 CREATE OR REPLACE FUNCTION migration_tools.set_leader (TEXT, INT, TEXT) RETURNS TEXT AS $$
 707   my ($marcxml, $pos, $value) = @_;
 708
 709   use MARC::Record;
 710   use MARC::File::XML;
 711
 712   my $xml = $marcxml;
 713   eval {
 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;
 720     $xml =~ s/\n//sgo;
 721     $xml =~ s/>\s+</></sgo;
 722   };
 723   return $xml;
 724 $$ LANGUAGE PLPERLU STABLE;
 725
 726 CREATE OR REPLACE FUNCTION migration_tools.set_008 (TEXT, INT, TEXT) RETURNS TEXT AS $$
 727   my ($marcxml, $pos, $value) = @_;
 728
 729   use MARC::Record;
 730   use MARC::File::XML;
 731
 732   my $xml = $marcxml;
 733   eval {
 734     my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 735     my $f008 = $marc->field('008');
 736
 737     if ($f008) {
 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;
 743        $xml =~ s/\n//sgo;
 744        $xml =~ s/>\s+</></sgo;
 745     }
 746   };
 747   return $xml;
 748 $$ LANGUAGE PLPERLU STABLE;
 749
 750 CREATE OR REPLACE FUNCTION migration_tools.insert_tags (TEXT, TEXT) RETURNS TEXT AS $$
 751
 752   my ($marcxml, $tags) = @_;
 753
 754   use MARC::Record;
 755   use MARC::File::XML;
 756
 757   my $xml = $marcxml;
 758
 759   eval {
 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');
 762
 763     my @incumbents = ();
 764
 765     foreach my $field ( $marc->fields() ) {
 766       push @incumbents, $field->as_formatted();
 767     }
 768
 769     foreach $field ( $to_insert->fields() ) {
 770       if (!grep {$_ eq $field->as_formatted()} @incumbents) {
 771         $marc->insert_fields_ordered( ($field) );
 772       }
 773     }
 774
 775     $xml = $marc->as_xml_record;
 776     $xml =~ s/^<\?.+?\?>$//mo;
 777     $xml =~ s/\n//sgo;
 778     $xml =~ s/>\s+</></sgo;
 779   };
 780
 781   return $xml;
 782
 783 $$ LANGUAGE PLPERLU STABLE;
 784
 785
 786