sql/base/01-marc.sql

   1 CREATE OR REPLACE FUNCTION migration_tools.set_leader (TEXT, INT, TEXT) RETURNS TEXT AS $$
   2   my ($marcxml, $pos, $value) = @_;
   3
   4   use MARC::Record;
   5   use MARC::File::XML;
   6
   7   my $xml = $marcxml;
   8   eval {
   9     my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
  10     my $leader = $marc->leader();
  11     substr($leader, $pos, 1) = $value;
  12     $marc->leader($leader);
  13     $xml = $marc->as_xml_record;
  14     $xml =~ s/^<\?.+?\?>$//mo;
  15     $xml =~ s/\n//sgo;
  16     $xml =~ s/>\s+</></sgo;
  17   };
  18   return $xml;
  19 $$ LANGUAGE PLPERLU STABLE;
  20
  21 CREATE OR REPLACE FUNCTION migration_tools.set_008 (TEXT, INT, TEXT) RETURNS TEXT AS $$
  22   my ($marcxml, $pos, $value) = @_;
  23
  24   use MARC::Record;
  25   use MARC::File::XML;
  26
  27   my $xml = $marcxml;
  28   eval {
  29     my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
  30     my $f008 = $marc->field('008');
  31
  32     if ($f008) {
  33        my $field = $f008->data();
  34        substr($field, $pos, 1) = $value;
  35        $f008->update($field);
  36        $xml = $marc->as_xml_record;
  37        $xml =~ s/^<\?.+?\?>$//mo;
  38        $xml =~ s/\n//sgo;
  39        $xml =~ s/>\s+</></sgo;
  40     }
  41   };
  42   return $xml;
  43 $$ LANGUAGE PLPERLU STABLE;
  44
  45 CREATE OR REPLACE FUNCTION migration_tools.insert_tags (TEXT, TEXT) RETURNS TEXT AS $$
  46
  47   my ($marcxml, $tags) = @_;
  48
  49   use MARC::Record;
  50   use MARC::File::XML;
  51
  52   my $xml = $marcxml;
  53
  54   eval {
  55     my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
  56     my $to_insert = MARC::Record->new_from_xml("<record>$tags</record>", 'UTF-8');
  57
  58     my @incumbents = ();
  59
  60     foreach my $field ( $marc->fields() ) {
  61       push @incumbents, $field->as_formatted();
  62     }
  63
  64     foreach $field ( $to_insert->fields() ) {
  65       if (!grep {$_ eq $field->as_formatted()} @incumbents) {
  66         $marc->insert_fields_ordered( ($field) );
  67       }
  68     }
  69
  70     $xml = $marc->as_xml_record;
  71     $xml =~ s/^<\?.+?\?>$//mo;
  72     $xml =~ s/\n//sgo;
  73     $xml =~ s/>\s+</></sgo;
  74   };
  75
  76   return $xml;
  77
  78 $$ LANGUAGE PLPERLU STABLE;
  79
  80 CREATE OR REPLACE FUNCTION migration_tools.marc_parses( TEXT ) RETURNS BOOLEAN AS $func$
  81
  82 use MARC::Record;
  83 use MARC::File::XML (BinaryEncoding => 'UTF-8');
  84 use MARC::Charset;
  85
  86 MARC::Charset->assume_unicode(1);
  87
  88 my $xml = shift;
  89
  90 eval {
  91     my $r = MARC::Record->new_from_xml( $xml );
  92     my $output_xml = $r->as_xml_record();
  93 };
  94 if ($@) {
  95     return 0;
  96 } else {
  97     return 1;
  98 }
  99
 100 $func$ LANGUAGE PLPERLU;
 101 COMMENT ON FUNCTION migration_tools.marc_parses(TEXT) IS 'Return boolean indicating if MARCXML string is parseable by MARC::File::XML';
 102
 103 CREATE OR REPLACE FUNCTION migration_tools.merge_marc_fields( TEXT, TEXT, TEXT[] ) RETURNS TEXT AS $func$
 104
 105 use strict;
 106 use warnings;
 107
 108 use MARC::Record;
 109 use MARC::File::XML (BinaryEncoding => 'UTF-8');
 110 use MARC::Charset;
 111
 112 MARC::Charset->assume_unicode(1);
 113
 114 my $target_xml = shift;
 115 my $source_xml = shift;
 116 my $tags = shift;
 117
 118 my $target;
 119 my $source;
 120
 121 eval { $target = MARC::Record->new_from_xml( $target_xml ); };
 122 if ($@) {
 123     return;
 124 }
 125 eval { $source = MARC::Record->new_from_xml( $source_xml ); };
 126 if ($@) {
 127     return;
 128 }
 129
 130 my $source_id = $source->subfield('901', 'c');
 131 $source_id = $source->subfield('903', 'a') unless $source_id;
 132 my $target_id = $target->subfield('901', 'c');
 133 $target_id = $target->subfield('903', 'a') unless $target_id;
 134
 135 my %existing_fields;
 136 foreach my $tag (@$tags) {
 137     my %existing_fields = map { $_->as_formatted() => 1 } $target->field($tag);
 138     my @to_add = grep { not exists $existing_fields{$_->as_formatted()} } $source->field($tag);
 139     $target->insert_fields_ordered(map { $_->clone() } @to_add);
 140     if (@to_add) {
 141         elog(NOTICE, "Merged $tag tag(s) from $source_id to $target_id");
 142     }
 143 }
 144
 145 my $xml = $target->as_xml_record;
 146 $xml =~ s/^<\?.+?\?>$//mo;
 147 $xml =~ s/\n//sgo;
 148 $xml =~ s/>\s+</></sgo;
 149
 150 return $xml;
 151
 152 $func$ LANGUAGE PLPERLU;
 153 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.';
 154
 155 CREATE OR REPLACE FUNCTION migration_tools.make_stub_bib (text[], text[]) RETURNS TEXT AS $func$
 156
 157 use strict;
 158 use warnings;
 159
 160 use MARC::Record;
 161 use MARC::File::XML (BinaryEncoding => 'UTF-8');
 162 use Text::CSV;
 163
 164 my $in_tags = shift;
 165 my $in_values = shift;
 166
 167 # hack-and-slash parsing of array-passed-as-string;
 168 # this can go away once everybody is running Postgres 9.1+
 169 my $csv = Text::CSV->new({binary => 1});
 170 $in_tags =~ s/^{//;
 171 $in_tags =~ s/}$//;
 172 my $status = $csv->parse($in_tags);
 173 my $tags = [ $csv->fields() ];
 174 $in_values =~ s/^{//;
 175 $in_values =~ s/}$//;
 176 $status = $csv->parse($in_values);
 177 my $values = [ $csv->fields() ];
 178
 179 my $marc = MARC::Record->new();
 180
 181 $marc->leader('00000nam a22000007  4500');
 182 $marc->append_fields(MARC::Field->new('008', '000000s                       000   eng d'));
 183
 184 foreach my $i (0..$#$tags) {
 185     my ($tag, $sf);
 186     if ($tags->[$i] =~ /^(\d{3})([0-9a-z])$/) {
 187         $tag = $1;
 188         $sf = $2;
 189         $marc->append_fields(MARC::Field->new($tag, ' ', ' ', $sf => $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
 190     } elsif ($tags->[$i] =~ /^(\d{3})$/) {
 191         $tag = $1;
 192         $marc->append_fields(MARC::Field->new($tag, $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
 193     }
 194 }
 195
 196 my $xml = $marc->as_xml_record;
 197 $xml =~ s/^<\?.+?\?>$//mo;
 198 $xml =~ s/\n//sgo;
 199 $xml =~ s/>\s+</></sgo;
 200
 201 return $xml;
 202
 203 $func$ LANGUAGE PLPERLU;
 204 COMMENT ON FUNCTION migration_tools.make_stub_bib (text[], text[]) IS $$Simple function to create a stub MARCXML bib from a set of columns.
 205 The first argument is an array of tag/subfield specifiers, e.g., ARRAY['001', '245a', '500a'].
 206 The second argument is an array of text containing the values to plug into each field.
 207 If the value for a given field is NULL or the empty string, it is not inserted.
 208 $$;
 209
 210 CREATE OR REPLACE FUNCTION migration_tools.make_stub_bib (text[], text[], text[], text[]) RETURNS TEXT AS $func$
 211
 212 use strict;
 213 use warnings;
 214
 215 use MARC::Record;
 216 use MARC::File::XML (BinaryEncoding => 'UTF-8');
 217 use Text::CSV;
 218
 219 my $in_tags = shift;
 220 my $in_ind1 = shift;
 221 my $in_ind2 = shift;
 222 my $in_values = shift;
 223
 224 # hack-and-slash parsing of array-passed-as-string;
 225 # this can go away once everybody is running Postgres 9.1+
 226 my $csv = Text::CSV->new({binary => 1});
 227 $in_tags =~ s/^{//;
 228 $in_tags =~ s/}$//;
 229 my $status = $csv->parse($in_tags);
 230 my $tags = [ $csv->fields() ];
 231 $in_ind1 =~ s/^{//;
 232 $in_ind1 =~ s/}$//;
 233 $status = $csv->parse($in_ind1);
 234 my $ind1s = [ $csv->fields() ];
 235 $in_ind2 =~ s/^{//;
 236 $in_ind2 =~ s/}$//;
 237 $status = $csv->parse($in_ind2);
 238 my $ind2s = [ $csv->fields() ];
 239 $in_values =~ s/^{//;
 240 $in_values =~ s/}$//;
 241 $status = $csv->parse($in_values);
 242 my $values = [ $csv->fields() ];
 243
 244 my $marc = MARC::Record->new();
 245
 246 $marc->leader('00000nam a22000007  4500');
 247 $marc->append_fields(MARC::Field->new('008', '000000s                       000   eng d'));
 248
 249 foreach my $i (0..$#$tags) {
 250     my ($tag, $sf);
 251     if ($tags->[$i] =~ /^(\d{3})([0-9a-z])$/) {
 252         $tag = $1;
 253         $sf = $2;
 254         $marc->append_fields(MARC::Field->new($tag, $ind1s->[$i], $ind2s->[$i], $sf => $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
 255     } elsif ($tags->[$i] =~ /^(\d{3})$/) {
 256         $tag = $1;
 257         $marc->append_fields(MARC::Field->new($tag, $values->[$i])) if $values->[$i] !~ /^\s*$/ and $values->[$i] ne 'NULL';
 258     }
 259 }
 260
 261 my $xml = $marc->as_xml_record;
 262 $xml =~ s/^<\?.+?\?>$//mo;
 263 $xml =~ s/\n//sgo;
 264 $xml =~ s/>\s+</></sgo;
 265
 266 return $xml;
 267
 268 $func$ LANGUAGE PLPERLU;
 269 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.
 270 The first argument is an array of tag/subfield specifiers, e.g., ARRAY['001', '245a', '500a'].
 271 The second argument is an array of text containing the values to plug into indicator 1 for each field.
 272 The third argument is an array of text containing the values to plug into indicator 2 for each field.
 273 The fourth argument is an array of text containing the values to plug into each field.
 274 If the value for a given field is NULL or the empty string, it is not inserted.
 275 $$;
 276
 277 CREATE OR REPLACE FUNCTION migration_tools.set_indicator (TEXT, TEXT, INTEGER, CHAR(1)) RETURNS TEXT AS $func$
 278
 279 my ($marcxml, $tag, $pos, $value) = @_;
 280
 281 use MARC::Record;
 282 use MARC::File::XML (BinaryEncoding => 'UTF-8');
 283 use MARC::Charset;
 284 use strict;
 285
 286 MARC::Charset->assume_unicode(1);
 287
 288 elog(ERROR, 'indicator position must be either 1 or 2') unless $pos =~ /^[12]$/;
 289 elog(ERROR, 'MARC tag must be numeric') unless $tag =~ /^\d{3}$/;
 290 elog(ERROR, 'MARC tag must not be control field') if $tag =~ /^00/;
 291 elog(ERROR, 'Value must be exactly one character') unless $value =~ /^.$/;
 292
 293 my $xml = $marcxml;
 294 eval {
 295     my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 296
 297     foreach my $field ($marc->field($tag)) {
 298         $field->update("ind$pos" => $value);
 299     }
 300     $xml = $marc->as_xml_record;
 301     $xml =~ s/^<\?.+?\?>$//mo;
 302     $xml =~ s/\n//sgo;
 303     $xml =~ s/>\s+</></sgo;
 304 };
 305 return $xml;
 306
 307 $func$ LANGUAGE PLPERLU;
 308
 309 COMMENT ON FUNCTION migration_tools.set_indicator(TEXT, TEXT, INTEGER, CHAR(1)) IS $$Set indicator value of a specified MARC field.
 310 The first argument is a MARCXML string.
 311 The second argument is a MARC tag.
 312 The third argument is the indicator position, either 1 or 2.
 313 The fourth argument is the character to set the indicator value to.
 314 All occurences of the specified field will be changed.
 315 The function returns the revised MARCXML string.$$;
 316
 317 CREATE OR REPLACE FUNCTION migration_tools.get_marc_leader (TEXT) RETURNS TEXT AS $$
 318     my ($marcxml) = @_;
 319
 320     use MARC::Record;
 321     use MARC::File::XML;
 322     use MARC::Field;
 323
 324     my $field;
 325     eval {
 326         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 327         $field = $marc->leader();
 328     };
 329     return $field;
 330 $$ LANGUAGE PLPERLU STABLE;
 331
 332 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tag (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT AS $$
 333     my ($marcxml, $tag, $subfield, $delimiter) = @_;
 334
 335     use MARC::Record;
 336     use MARC::File::XML;
 337     use MARC::Field;
 338
 339     my $field;
 340     eval {
 341         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 342         $field = $marc->field($tag);
 343     };
 344     return $field->as_string($subfield,$delimiter) if $field;
 345     return;
 346 $$ LANGUAGE PLPERLU STABLE;
 347
 348 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tags (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT[] AS $$
 349     my ($marcxml, $tag, $subfield, $delimiter) = @_;
 350
 351     use MARC::Record;
 352     use MARC::File::XML;
 353     use MARC::Field;
 354
 355     my @fields;
 356     eval {
 357         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 358         @fields = $marc->field($tag);
 359     };
 360     my @texts;
 361     foreach my $field (@fields) {
 362         push @texts, $field->as_string($subfield,$delimiter);
 363     }
 364     return \@texts;
 365 $$ LANGUAGE PLPERLU STABLE;
 366
 367 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tags_filtered (TEXT, TEXT, TEXT, TEXT, TEXT) RETURNS TEXT[] AS $$
 368     my ($marcxml, $tag, $subfield, $delimiter, $match) = @_;
 369
 370     use MARC::Record;
 371     use MARC::File::XML;
 372     use MARC::Field;
 373
 374     my @fields;
 375     eval {
 376         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 377         @fields = $marc->field($tag);
 378     };
 379     my @texts;
 380     foreach my $field (@fields) {
 381         if ($field->as_string() =~ qr/$match/) {
 382             push @texts, $field->as_string($subfield,$delimiter);
 383         }
 384     }
 385     return \@texts;
 386 $$ LANGUAGE PLPERLU STABLE;
 387
 388 DROP FUNCTION IF EXISTS migration_tools.munge_sf9(INTEGER,TEXT,TEXT);
 389 CREATE OR REPLACE FUNCTION migration_tools.merge_sf9(bib_id INTEGER,new_sf9 TEXT,force TEXT DEFAULT 'false')
 390     RETURNS BOOLEAN AS
 391 $BODY$
 392 DECLARE
 393     marc_xml    TEXT;
 394     new_marc    TEXT;
 395 BEGIN
 396     SELECT marc FROM biblio.record_entry WHERE id = bib_id INTO marc_xml;
 397
 398     SELECT munge_sf9(marc_xml,new_sf9,force) INTO new_marc;
 399     UPDATE biblio.record_entry SET marc = new_marc WHERE id = bib_id;
 400
 401     RETURN true;
 402 END;
 403 $BODY$ LANGUAGE plpgsql;
 404
 405 DROP FUNCTION IF EXISTS migration_tools.munge_sf9(TEXT,TEXT,TEXT);
 406 CREATE OR REPLACE FUNCTION migration_tools.munge_sf9(marc_xml TEXT, new_9_to_set TEXT, force TEXT)
 407  RETURNS TEXT
 408  LANGUAGE plperlu
 409 AS $function$
 410 use strict;
 411 use warnings;
 412
 413 use MARC::Record;
 414 use MARC::File::XML (BinaryEncoding => 'utf8');
 415
 416 binmode(STDERR, ':bytes');
 417 binmode(STDOUT, ':utf8');
 418 binmode(STDERR, ':utf8');
 419
 420 my $marc_xml = shift;
 421 my $new_9_to_set = shift;
 422 my $force = shift;
 423
 424 $marc_xml =~ s/(<leader>.........)./${1}a/;
 425
 426 eval {
 427     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 428 };
 429 if ($@) {
 430     #elog("could not parse $bibid: $@\n");
 431     import MARC::File::XML (BinaryEncoding => 'utf8');
 432     return $marc_xml;
 433 }
 434
 435 my @uris = $marc_xml->field('856');
 436 return $marc_xml->as_xml_record() unless @uris;
 437
 438 foreach my $field (@uris) {
 439     my $ind1 = $field->indicator('1');
 440     if (!defined $ind1) { next; }
 441     if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'false') { next; }
 442     if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'true') { $field->set_indicator(1,'4'); }
 443     my $ind2 = $field->indicator('2');
 444     if (!defined $ind2) { next; }
 445     if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'false') { next; }
 446     if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'true') { $field->set_indicator(2,'0'); }
 447     $field->add_subfields( '9' => $new_9_to_set );
 448 }
 449
 450 return $marc_xml->as_xml_record();
 451
 452 $function$;
 453
 454 DROP FUNCTION IF EXISTS migration_tools.munge_sf9_qualifying_match(TEXT,TEXT,TEXT);
 455 CREATE OR REPLACE FUNCTION migration_tools.munge_sf9_qualifying_match(marc_xml TEXT, qualifying_match TEXT, new_9_to_set TEXT, force TEXT)
 456  RETURNS TEXT
 457  LANGUAGE plperlu
 458 AS $function$
 459 use strict;
 460 use warnings;
 461
 462 use MARC::Record;
 463 use MARC::File::XML (BinaryEncoding => 'utf8');
 464
 465 binmode(STDERR, ':bytes');
 466 binmode(STDOUT, ':utf8');
 467 binmode(STDERR, ':utf8');
 468
 469 my $marc_xml = shift;
 470 my $qualifying_match = shift;
 471 my $new_9_to_set = shift;
 472 my $force = shift;
 473
 474 $marc_xml =~ s/(<leader>.........)./${1}a/;
 475
 476 eval {
 477     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 478 };
 479 if ($@) {
 480     #elog("could not parse $bibid: $@\n");
 481     import MARC::File::XML (BinaryEncoding => 'utf8');
 482     return $marc_xml;
 483 }
 484
 485 my @uris = $marc_xml->field('856');
 486 return $marc_xml->as_xml_record() unless @uris;
 487
 488 foreach my $field (@uris) {
 489     if ($field->as_string() =~ qr/$qualifying_match/) {
 490         my $ind1 = $field->indicator('1');
 491         if (!defined $ind1) { next; }
 492         if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'false') { next; }
 493         if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'true') { $field->set_indicator(1,'4'); }
 494         my $ind2 = $field->indicator('2');
 495         if (!defined $ind2) { next; }
 496         if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'false') { next; }
 497         if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'true') { $field->set_indicator(2,'0'); }
 498         $field->add_subfields( '9' => $new_9_to_set );
 499     }
 500 }
 501
 502 return $marc_xml->as_xml_record();
 503
 504 $function$;
 505
 506 DROP FUNCTION IF EXISTS migration_tools.owner_change_sf9_substring_match(TEXT,TEXT,TEXT,TEXT);
 507 CREATE OR REPLACE FUNCTION migration_tools.owner_change_sf9_substring_match (marc_xml TEXT, substring_old_value TEXT, new_value TEXT, fix_indicators TEXT)
 508  RETURNS TEXT
 509  LANGUAGE plperlu
 510 AS $function$
 511 use strict;
 512 use warnings;
 513
 514 use MARC::Record;
 515 use MARC::File::XML (BinaryEncoding => 'utf8');
 516
 517 binmode(STDERR, ':bytes');
 518 binmode(STDOUT, ':utf8');
 519 binmode(STDERR, ':utf8');
 520
 521 my $marc_xml = shift;
 522 my $substring_old_value = shift;
 523 my $new_value = shift;
 524 my $fix_indicators = shift;
 525
 526 $marc_xml =~ s/(<leader>.........)./${1}a/;
 527
 528 eval {
 529     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 530 };
 531 if ($@) {
 532     #elog("could not parse $bibid: $@\n");
 533     import MARC::File::XML (BinaryEncoding => 'utf8');
 534     return $marc_xml;
 535 }
 536
 537 my @uris = $marc_xml->field('856');
 538 return $marc_xml->as_xml_record() unless @uris;
 539
 540 foreach my $field (@uris) {
 541     my $ind1 = $field->indicator('1');
 542     if (defined $ind1) {
 543         if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
 544             $field->set_indicator(1,'4');
 545         }
 546     }
 547     my $ind2 = $field->indicator('2');
 548     if (defined $ind2) {
 549         if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
 550             $field->set_indicator(2,'0');
 551         }
 552     }
 553     if ($field->as_string('9') =~ qr/$substring_old_value/) {
 554         $field->delete_subfield('9');
 555         $field->add_subfields( '9' => $new_value );
 556     }
 557     $marc_xml->delete_field($field); # -- we're going to dedup and add them back
 558 }
 559
 560 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
 561 $marc_xml->insert_fields_ordered( values( %hash ) );
 562
 563 return $marc_xml->as_xml_record();
 564
 565 $function$;
 566
 567 DROP FUNCTION IF EXISTS migration_tools.owner_change_sf9_substring_match2(TEXT,TEXT,TEXT,TEXT,TEXT);
 568 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)
 569  RETURNS TEXT
 570  LANGUAGE plperlu
 571 AS $function$
 572 use strict;
 573 use warnings;
 574
 575 use MARC::Record;
 576 use MARC::File::XML (BinaryEncoding => 'utf8');
 577
 578 binmode(STDERR, ':bytes');
 579 binmode(STDOUT, ':utf8');
 580 binmode(STDERR, ':utf8');
 581
 582 my $marc_xml = shift;
 583 my $qualifying_match = shift;
 584 my $substring_old_value = shift;
 585 my $new_value = shift;
 586 my $fix_indicators = shift;
 587
 588 $marc_xml =~ s/(<leader>.........)./${1}a/;
 589
 590 eval {
 591     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 592 };
 593 if ($@) {
 594     #elog("could not parse $bibid: $@\n");
 595     import MARC::File::XML (BinaryEncoding => 'utf8');
 596     return $marc_xml;
 597 }
 598
 599 my @unqualified_uris = $marc_xml->field('856');
 600 my @uris = ();
 601 foreach my $field (@unqualified_uris) {
 602     if ($field->as_string() =~ qr/$qualifying_match/) {
 603         push @uris, $field;
 604     }
 605 }
 606 return $marc_xml->as_xml_record() unless @uris;
 607
 608 foreach my $field (@uris) {
 609     my $ind1 = $field->indicator('1');
 610     if (defined $ind1) {
 611         if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
 612             $field->set_indicator(1,'4');
 613         }
 614     }
 615     my $ind2 = $field->indicator('2');
 616     if (defined $ind2) {
 617         if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
 618             $field->set_indicator(2,'0');
 619         }
 620     }
 621     if ($field->as_string('9') =~ qr/$substring_old_value/) {
 622         $field->delete_subfield('9');
 623         $field->add_subfields( '9' => $new_value );
 624     }
 625     $marc_xml->delete_field($field); # -- we're going to dedup and add them back
 626 }
 627
 628 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
 629 $marc_xml->insert_fields_ordered( values( %hash ) );
 630
 631 return $marc_xml->as_xml_record();
 632
 633 $function$;
 634
 635 -- strip marc tag
 636 DROP FUNCTION IF EXISTS migration_tools.strip_tag(TEXT,TEXT);
 637 CREATE OR REPLACE FUNCTION migration_tools.strip_tag(marc TEXT, tag TEXT)
 638  RETURNS TEXT
 639  LANGUAGE plperlu
 640 AS $function$
 641 use strict;
 642 use warnings;
 643
 644 use MARC::Record;
 645 use MARC::File::XML (BinaryEncoding => 'utf8');
 646
 647 binmode(STDERR, ':bytes');
 648 binmode(STDOUT, ':utf8');
 649 binmode(STDERR, ':utf8');
 650
 651 my $marc_xml = shift;
 652 my $tag = shift;
 653
 654 $marc_xml =~ s/(<leader>.........)./${1}a/;
 655
 656 eval {
 657     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 658 };
 659 if ($@) {
 660     #elog("could not parse $bibid: $@\n");
 661     import MARC::File::XML (BinaryEncoding => 'utf8');
 662     return $marc_xml;
 663 }
 664
 665 my @fields = $marc_xml->field($tag);
 666 return $marc_xml->as_xml_record() unless @fields;
 667
 668 $marc_xml->delete_fields(@fields);
 669
 670 return $marc_xml->as_xml_record();
 671
 672 $function$;
 673
 674 -- removes tags from record based on tag, subfield and evidence
 675 -- example: strip_tag(marc, '500', 'a', 'gift') will remove 500s with 'gift' as a part of the $a
 676 DROP FUNCTION IF EXISTS migration_tools.strip_tag(TEXT,TEXT,TEXT,TEXT);
 677 CREATE OR REPLACE FUNCTION migration_tools.strip_tag(marc TEXT, tag TEXT, subfield TEXT, evidence TEXT)
 678  RETURNS TEXT
 679  LANGUAGE plperlu
 680 AS $function$
 681 use strict;
 682 use warnings;
 683
 684 use MARC::Record;
 685 use MARC::File::XML (BinaryEncoding => 'utf8');
 686
 687 binmode(STDERR, ':bytes');
 688 binmode(STDOUT, ':utf8');
 689 binmode(STDERR, ':utf8');
 690
 691 my $marc_xml = shift;
 692 my $tag = shift;
 693 my $subfield = shift;
 694 my $evidence = shift;
 695
 696 $marc_xml =~ s/(<leader>.........)./${1}a/;
 697
 698 eval {
 699     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 700 };
 701 if ($@) {
 702     #elog("could not parse $bibid: $@\n");
 703     import MARC::File::XML (BinaryEncoding => 'utf8');
 704     return $marc_xml;
 705 }
 706
 707 my @fields = $marc_xml->field($tag);
 708 return $marc_xml->as_xml_record() unless @fields;
 709
 710 my @fields_to_delete;
 711
 712 foreach my $f (@fields) {
 713     my $sf = lc($f->as_string($subfield));
 714     if ($sf =~ m/$evidence/) { push @fields_to_delete, $f; }
 715 }
 716
 717 $marc_xml->delete_fields(@fields_to_delete);
 718
 719 return $marc_xml->as_xml_record();
 720
 721 $function$;
 722
 723 -- consolidate marc tag
 724 DROP FUNCTION IF EXISTS migration_tools.consolidate_tag(TEXT,TEXT);
 725 CREATE OR REPLACE FUNCTION migration_tools.consolidate_tag(marc TEXT, tag TEXT)
 726  RETURNS TEXT
 727  LANGUAGE plperlu
 728 AS $function$
 729 use strict;
 730 use warnings;
 731
 732 use MARC::Record;
 733 use MARC::File::XML (BinaryEncoding => 'utf8');
 734
 735 binmode(STDERR, ':bytes');
 736 binmode(STDOUT, ':utf8');
 737 binmode(STDERR, ':utf8');
 738
 739 my $marc_xml = shift;
 740 my $tag = shift;
 741
 742 $marc_xml =~ s/(<leader>.........)./${1}a/;
 743
 744 eval {
 745     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 746 };
 747 if ($@) {
 748     #elog("could not parse $bibid: $@\n");
 749     import MARC::File::XML (BinaryEncoding => 'utf8');
 750     return $marc_xml;
 751 }
 752
 753 my @fields = $marc_xml->field($tag);
 754 return $marc_xml->as_xml_record() unless @fields;
 755
 756 my @combined_subfield_refs = ();
 757 my @combined_subfields = ();
 758 foreach my $field (@fields) {
 759     my @subfield_refs = $field->subfields();
 760     push @combined_subfield_refs, @subfield_refs;
 761 }
 762
 763 my @sorted_subfield_refs = reverse sort { $a->[0] <=> $b->[0] } @combined_subfield_refs;
 764
 765 while ( my $tuple = pop( @sorted_subfield_refs ) ) {
 766     my ($code,$data) = @$tuple;
 767     unshift( @combined_subfields, $code, $data );
 768 }
 769
 770 $marc_xml->delete_fields(@fields);
 771
 772 my $new_field = new MARC::Field(
 773     $tag,
 774     $fields[0]->indicator(1),
 775     $fields[0]->indicator(2),
 776     @combined_subfields
 777 );
 778
 779 $marc_xml->insert_grouped_field( $new_field );
 780
 781 return $marc_xml->as_xml_record();
 782
 783 $function$;
 784
 785 CREATE OR REPLACE FUNCTION migration_tools.set_leader (TEXT, INT, TEXT) RETURNS TEXT AS $$
 786   my ($marcxml, $pos, $value) = @_;
 787
 788   use MARC::Record;
 789   use MARC::File::XML;
 790
 791   my $xml = $marcxml;
 792   eval {
 793     my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 794     my $leader = $marc->leader();
 795     substr($leader, $pos, 1) = $value;
 796     $marc->leader($leader);
 797     $xml = $marc->as_xml_record;
 798     $xml =~ s/^<\?.+?\?>$//mo;
 799     $xml =~ s/\n//sgo;
 800     $xml =~ s/>\s+</></sgo;
 801   };
 802   return $xml;
 803 $$ LANGUAGE PLPERLU STABLE;
 804
 805 CREATE OR REPLACE FUNCTION migration_tools.set_008 (TEXT, INT, TEXT) RETURNS TEXT AS $$
 806   my ($marcxml, $pos, $value) = @_;
 807
 808   use MARC::Record;
 809   use MARC::File::XML;
 810
 811   my $xml = $marcxml;
 812   eval {
 813     my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 814     my $f008 = $marc->field('008');
 815
 816     if ($f008) {
 817        my $field = $f008->data();
 818        substr($field, $pos, 1) = $value;
 819        $f008->update($field);
 820        $xml = $marc->as_xml_record;
 821        $xml =~ s/^<\?.+?\?>$//mo;
 822        $xml =~ s/\n//sgo;
 823        $xml =~ s/>\s+</></sgo;
 824     }
 825   };
 826   return $xml;
 827 $$ LANGUAGE PLPERLU STABLE;
 828
 829 CREATE OR REPLACE FUNCTION migration_tools.insert_tags (TEXT, TEXT) RETURNS TEXT AS $$
 830
 831   my ($marcxml, $tags) = @_;
 832
 833   use MARC::Record;
 834   use MARC::File::XML;
 835
 836   my $xml = $marcxml;
 837
 838   eval {
 839     my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 840     my $to_insert = MARC::Record->new_from_xml("<record>$tags</record>", 'UTF-8');
 841
 842     my @incumbents = ();
 843
 844     foreach my $field ( $marc->fields() ) {
 845       push @incumbents, $field->as_formatted();
 846     }
 847
 848     foreach $field ( $to_insert->fields() ) {
 849       if (!grep {$_ eq $field->as_formatted()} @incumbents) {
 850         $marc->insert_fields_ordered( ($field) );
 851       }
 852     }
 853
 854     $xml = $marc->as_xml_record;
 855     $xml =~ s/^<\?.+?\?>$//mo;
 856     $xml =~ s/\n//sgo;
 857     $xml =~ s/>\s+</></sgo;
 858   };
 859
 860   return $xml;
 861
 862 $$ LANGUAGE PLPERLU STABLE;
 863
 864
 865