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.create_staff_user(
 318     username TEXT,
 319     password TEXT,
 320     org TEXT,
 321     perm_group TEXT,
 322     first_name TEXT DEFAULT '',
 323     last_name TEXT DEFAULT ''
 324 ) RETURNS VOID AS $func$
 325 BEGIN
 326     RAISE NOTICE '%', org ;
 327     INSERT INTO actor.usr (usrname, passwd, ident_type, first_given_name, family_name, home_ou, profile)
 328     SELECT username, password, 1, first_name, last_name, aou.id, pgt.id
 329     FROM   actor.org_unit aou, permission.grp_tree pgt
 330     WHERE  aou.shortname = org
 331     AND    pgt.name = perm_group;
 332 END
 333 $func$
 334 LANGUAGE PLPGSQL;
 335
 336 CREATE OR REPLACE FUNCTION migration_tools.get_marc_leader (TEXT) RETURNS TEXT AS $$
 337     my ($marcxml) = @_;
 338
 339     use MARC::Record;
 340     use MARC::File::XML;
 341     use MARC::Field;
 342
 343     my $field;
 344     eval {
 345         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 346         $field = $marc->leader();
 347     };
 348     return $field;
 349 $$ LANGUAGE PLPERLU STABLE;
 350
 351 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tag (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT AS $$
 352     my ($marcxml, $tag, $subfield, $delimiter) = @_;
 353
 354     use MARC::Record;
 355     use MARC::File::XML;
 356     use MARC::Field;
 357
 358     my $field;
 359     eval {
 360         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 361         $field = $marc->field($tag);
 362     };
 363     return $field->as_string($subfield,$delimiter) if $field;
 364     return;
 365 $$ LANGUAGE PLPERLU STABLE;
 366
 367 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tags (TEXT, TEXT, TEXT, TEXT) RETURNS TEXT[] AS $$
 368     my ($marcxml, $tag, $subfield, $delimiter) = @_;
 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         push @texts, $field->as_string($subfield,$delimiter);
 382     }
 383     return \@texts;
 384 $$ LANGUAGE PLPERLU STABLE;
 385
 386 CREATE OR REPLACE FUNCTION migration_tools.get_marc_tags_filtered (TEXT, TEXT, TEXT, TEXT, TEXT) RETURNS TEXT[] AS $$
 387     my ($marcxml, $tag, $subfield, $delimiter, $match) = @_;
 388
 389     use MARC::Record;
 390     use MARC::File::XML;
 391     use MARC::Field;
 392
 393     my @fields;
 394     eval {
 395         my $marc = MARC::Record->new_from_xml($marcxml, 'UTF-8');
 396         @fields = $marc->field($tag);
 397     };
 398     my @texts;
 399     foreach my $field (@fields) {
 400         if ($field->as_string() =~ qr/$match/) {
 401             push @texts, $field->as_string($subfield,$delimiter);
 402         }
 403     }
 404     return \@texts;
 405 $$ LANGUAGE PLPERLU STABLE;
 406
 407 DROP FUNCTION IF EXISTS migration_tools.munge_sf9(INTEGER,TEXT,TEXT);
 408 CREATE OR REPLACE FUNCTION migration_tools.merge_sf9(bib_id INTEGER,new_sf9 TEXT,force TEXT DEFAULT 'false')
 409     RETURNS BOOLEAN AS
 410 $BODY$
 411 DECLARE
 412     marc_xml    TEXT;
 413     new_marc    TEXT;
 414 BEGIN
 415     SELECT marc FROM biblio.record_entry WHERE id = bib_id INTO marc_xml;
 416
 417     SELECT munge_sf9(marc_xml,new_sf9,force) INTO new_marc;
 418     UPDATE biblio.record_entry SET marc = new_marc WHERE id = bib_id;
 419
 420     RETURN true;
 421 END;
 422 $BODY$ LANGUAGE plpgsql;
 423
 424 DROP FUNCTION IF EXISTS migration_tools.munge_sf9(TEXT,TEXT,TEXT);
 425 CREATE OR REPLACE FUNCTION migration_tools.munge_sf9(marc_xml TEXT, new_9_to_set TEXT, force TEXT)
 426  RETURNS TEXT
 427  LANGUAGE plperlu
 428 AS $function$
 429 use strict;
 430 use warnings;
 431
 432 use MARC::Record;
 433 use MARC::File::XML (BinaryEncoding => 'utf8');
 434
 435 binmode(STDERR, ':bytes');
 436 binmode(STDOUT, ':utf8');
 437 binmode(STDERR, ':utf8');
 438
 439 my $marc_xml = shift;
 440 my $new_9_to_set = shift;
 441 my $force = shift;
 442
 443 $marc_xml =~ s/(<leader>.........)./${1}a/;
 444
 445 eval {
 446     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 447 };
 448 if ($@) {
 449     #elog("could not parse $bibid: $@\n");
 450     import MARC::File::XML (BinaryEncoding => 'utf8');
 451     return $marc_xml;
 452 }
 453
 454 my @uris = $marc_xml->field('856');
 455 return $marc_xml->as_xml_record() unless @uris;
 456
 457 foreach my $field (@uris) {
 458     my $ind1 = $field->indicator('1');
 459     if (!defined $ind1) { next; }
 460     if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'false') { next; }
 461     if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'true') { $field->set_indicator(1,'4'); }
 462     my $ind2 = $field->indicator('2');
 463     if (!defined $ind2) { next; }
 464     if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'false') { next; }
 465     if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'true') { $field->set_indicator(2,'0'); }
 466     $field->add_subfields( '9' => $new_9_to_set );
 467 }
 468
 469 return $marc_xml->as_xml_record();
 470
 471 $function$;
 472
 473 DROP FUNCTION IF EXISTS migration_tools.munge_sf9_qualifying_match(TEXT,TEXT,TEXT);
 474 CREATE OR REPLACE FUNCTION migration_tools.munge_sf9_qualifying_match(marc_xml TEXT, qualifying_match TEXT, new_9_to_set TEXT, force TEXT)
 475  RETURNS TEXT
 476  LANGUAGE plperlu
 477 AS $function$
 478 use strict;
 479 use warnings;
 480
 481 use MARC::Record;
 482 use MARC::File::XML (BinaryEncoding => 'utf8');
 483
 484 binmode(STDERR, ':bytes');
 485 binmode(STDOUT, ':utf8');
 486 binmode(STDERR, ':utf8');
 487
 488 my $marc_xml = shift;
 489 my $qualifying_match = shift;
 490 my $new_9_to_set = shift;
 491 my $force = shift;
 492
 493 $marc_xml =~ s/(<leader>.........)./${1}a/;
 494
 495 eval {
 496     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 497 };
 498 if ($@) {
 499     #elog("could not parse $bibid: $@\n");
 500     import MARC::File::XML (BinaryEncoding => 'utf8');
 501     return $marc_xml;
 502 }
 503
 504 my @uris = $marc_xml->field('856');
 505 return $marc_xml->as_xml_record() unless @uris;
 506
 507 foreach my $field (@uris) {
 508     if ($field->as_string() =~ qr/$qualifying_match/) {
 509         my $ind1 = $field->indicator('1');
 510         if (!defined $ind1) { next; }
 511         if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'false') { next; }
 512         if ($ind1 ne '1' && $ind1 ne '4' && $force eq 'true') { $field->set_indicator(1,'4'); }
 513         my $ind2 = $field->indicator('2');
 514         if (!defined $ind2) { next; }
 515         if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'false') { next; }
 516         if ($ind2 ne '0' && $ind2 ne '1' && $force eq 'true') { $field->set_indicator(2,'0'); }
 517         $field->add_subfields( '9' => $new_9_to_set );
 518     }
 519 }
 520
 521 return $marc_xml->as_xml_record();
 522
 523 $function$;
 524
 525 DROP FUNCTION IF EXISTS migration_tools.owner_change_sf9_substring_match(TEXT,TEXT,TEXT,TEXT);
 526 CREATE OR REPLACE FUNCTION migration_tools.owner_change_sf9_substring_match (marc_xml TEXT, substring_old_value TEXT, new_value TEXT, fix_indicators TEXT)
 527  RETURNS TEXT
 528  LANGUAGE plperlu
 529 AS $function$
 530 use strict;
 531 use warnings;
 532
 533 use MARC::Record;
 534 use MARC::File::XML (BinaryEncoding => 'utf8');
 535
 536 binmode(STDERR, ':bytes');
 537 binmode(STDOUT, ':utf8');
 538 binmode(STDERR, ':utf8');
 539
 540 my $marc_xml = shift;
 541 my $substring_old_value = shift;
 542 my $new_value = shift;
 543 my $fix_indicators = shift;
 544
 545 $marc_xml =~ s/(<leader>.........)./${1}a/;
 546
 547 eval {
 548     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 549 };
 550 if ($@) {
 551     #elog("could not parse $bibid: $@\n");
 552     import MARC::File::XML (BinaryEncoding => 'utf8');
 553     return $marc_xml;
 554 }
 555
 556 my @uris = $marc_xml->field('856');
 557 return $marc_xml->as_xml_record() unless @uris;
 558
 559 foreach my $field (@uris) {
 560     my $ind1 = $field->indicator('1');
 561     if (defined $ind1) {
 562         if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
 563             $field->set_indicator(1,'4');
 564         }
 565     }
 566     my $ind2 = $field->indicator('2');
 567     if (defined $ind2) {
 568         if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
 569             $field->set_indicator(2,'0');
 570         }
 571     }
 572     if ($field->as_string('9') =~ qr/$substring_old_value/) {
 573         $field->delete_subfield('9');
 574         $field->add_subfields( '9' => $new_value );
 575     }
 576     $marc_xml->delete_field($field); # -- we're going to dedup and add them back
 577 }
 578
 579 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
 580 $marc_xml->insert_fields_ordered( values( %hash ) );
 581
 582 return $marc_xml->as_xml_record();
 583
 584 $function$;
 585
 586 DROP FUNCTION IF EXISTS migration_tools.owner_change_sf9_substring_match2(TEXT,TEXT,TEXT,TEXT,TEXT);
 587 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)
 588  RETURNS TEXT
 589  LANGUAGE plperlu
 590 AS $function$
 591 use strict;
 592 use warnings;
 593
 594 use MARC::Record;
 595 use MARC::File::XML (BinaryEncoding => 'utf8');
 596
 597 binmode(STDERR, ':bytes');
 598 binmode(STDOUT, ':utf8');
 599 binmode(STDERR, ':utf8');
 600
 601 my $marc_xml = shift;
 602 my $qualifying_match = shift;
 603 my $substring_old_value = shift;
 604 my $new_value = shift;
 605 my $fix_indicators = shift;
 606
 607 $marc_xml =~ s/(<leader>.........)./${1}a/;
 608
 609 eval {
 610     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 611 };
 612 if ($@) {
 613     #elog("could not parse $bibid: $@\n");
 614     import MARC::File::XML (BinaryEncoding => 'utf8');
 615     return $marc_xml;
 616 }
 617
 618 my @unqualified_uris = $marc_xml->field('856');
 619 my @uris = ();
 620 foreach my $field (@unqualified_uris) {
 621     if ($field->as_string() =~ qr/$qualifying_match/) {
 622         push @uris, $field;
 623     }
 624 }
 625 return $marc_xml->as_xml_record() unless @uris;
 626
 627 foreach my $field (@uris) {
 628     my $ind1 = $field->indicator('1');
 629     if (defined $ind1) {
 630         if ($ind1 ne '1' && $ind1 ne '4' && $fix_indicators eq 'true') {
 631             $field->set_indicator(1,'4');
 632         }
 633     }
 634     my $ind2 = $field->indicator('2');
 635     if (defined $ind2) {
 636         if ($ind2 ne '0' && $ind2 ne '1' && $fix_indicators eq 'true') {
 637             $field->set_indicator(2,'0');
 638         }
 639     }
 640     if ($field->as_string('9') =~ qr/$substring_old_value/) {
 641         $field->delete_subfield('9');
 642         $field->add_subfields( '9' => $new_value );
 643     }
 644     $marc_xml->delete_field($field); # -- we're going to dedup and add them back
 645 }
 646
 647 my %hash = (map { ($_->as_usmarc => $_) } @uris); # -- courtesy of an old Mike Rylander post :-)
 648 $marc_xml->insert_fields_ordered( values( %hash ) );
 649
 650 return $marc_xml->as_xml_record();
 651
 652 $function$;
 653
 654 -- strip marc tag
 655 DROP FUNCTION IF EXISTS migration_tools.strip_tag(TEXT,TEXT);
 656 CREATE OR REPLACE FUNCTION migration_tools.strip_tag(marc TEXT, tag TEXT)
 657  RETURNS TEXT
 658  LANGUAGE plperlu
 659 AS $function$
 660 use strict;
 661 use warnings;
 662
 663 use MARC::Record;
 664 use MARC::File::XML (BinaryEncoding => 'utf8');
 665
 666 binmode(STDERR, ':bytes');
 667 binmode(STDOUT, ':utf8');
 668 binmode(STDERR, ':utf8');
 669
 670 my $marc_xml = shift;
 671 my $tag = shift;
 672
 673 $marc_xml =~ s/(<leader>.........)./${1}a/;
 674
 675 eval {
 676     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 677 };
 678 if ($@) {
 679     #elog("could not parse $bibid: $@\n");
 680     import MARC::File::XML (BinaryEncoding => 'utf8');
 681     return $marc_xml;
 682 }
 683
 684 my @fields = $marc_xml->field($tag);
 685 return $marc_xml->as_xml_record() unless @fields;
 686
 687 $marc_xml->delete_fields(@fields);
 688
 689 return $marc_xml->as_xml_record();
 690
 691 $function$;
 692
 693 -- removes tags from record based on tag, subfield and evidence
 694 -- example: strip_tag(marc, '500', 'a', 'gift') will remove 500s with 'gift' as a part of the $a
 695 DROP FUNCTION IF EXISTS migration_tools.strip_tag(TEXT,TEXT,TEXT,TEXT);
 696 CREATE OR REPLACE FUNCTION migration_tools.strip_tag(marc TEXT, tag TEXT, subfield TEXT, evidence TEXT)
 697  RETURNS TEXT
 698  LANGUAGE plperlu
 699 AS $function$
 700 use strict;
 701 use warnings;
 702
 703 use MARC::Record;
 704 use MARC::File::XML (BinaryEncoding => 'utf8');
 705
 706 binmode(STDERR, ':bytes');
 707 binmode(STDOUT, ':utf8');
 708 binmode(STDERR, ':utf8');
 709
 710 my $marc_xml = shift;
 711 my $tag = shift;
 712 my $subfield = shift;
 713 my $evidence = shift;
 714
 715 $marc_xml =~ s/(<leader>.........)./${1}a/;
 716
 717 eval {
 718     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 719 };
 720 if ($@) {
 721     #elog("could not parse $bibid: $@\n");
 722     import MARC::File::XML (BinaryEncoding => 'utf8');
 723     return $marc_xml;
 724 }
 725
 726 my @fields = $marc_xml->field($tag);
 727 return $marc_xml->as_xml_record() unless @fields;
 728
 729 my @fields_to_delete;
 730
 731 foreach my $f (@fields) {
 732     my $sf = lc($f->as_string($subfield));
 733     if ($sf =~ m/$evidence/) { push @fields_to_delete, $f; }
 734 }
 735
 736 $marc_xml->delete_fields(@fields_to_delete);
 737
 738 return $marc_xml->as_xml_record();
 739
 740 $function$;
 741
 742 -- consolidate marc tag
 743 DROP FUNCTION IF EXISTS migration_tools.consolidate_tag(TEXT,TEXT);
 744 CREATE OR REPLACE FUNCTION migration_tools.consolidate_tag(marc TEXT, tag TEXT)
 745  RETURNS TEXT
 746  LANGUAGE plperlu
 747 AS $function$
 748 use strict;
 749 use warnings;
 750
 751 use MARC::Record;
 752 use MARC::File::XML (BinaryEncoding => 'utf8');
 753
 754 binmode(STDERR, ':bytes');
 755 binmode(STDOUT, ':utf8');
 756 binmode(STDERR, ':utf8');
 757
 758 my $marc_xml = shift;
 759 my $tag = shift;
 760
 761 $marc_xml =~ s/(<leader>.........)./${1}a/;
 762
 763 eval {
 764     $marc_xml = MARC::Record->new_from_xml($marc_xml);
 765 };
 766 if ($@) {
 767     #elog("could not parse $bibid: $@\n");
 768     import MARC::File::XML (BinaryEncoding => 'utf8');
 769     return $marc_xml;
 770 }
 771
 772 my @fields = $marc_xml->field($tag);
 773 return $marc_xml->as_xml_record() unless @fields;
 774
 775 my @combined_subfield_refs = ();
 776 my @combined_subfields = ();
 777 foreach my $field (@fields) {
 778     my @subfield_refs = $field->subfields();
 779     push @combined_subfield_refs, @subfield_refs;
 780 }
 781
 782 my @sorted_subfield_refs = reverse sort { $a->[0] <=> $b->[0] } @combined_subfield_refs;
 783
 784 while ( my $tuple = pop( @sorted_subfield_refs ) ) {
 785     my ($code,$data) = @$tuple;
 786     unshift( @combined_subfields, $code, $data );
 787 }
 788
 789 $marc_xml->delete_fields(@fields);
 790
 791 my $new_field = new MARC::Field(
 792     $tag,
 793     $fields[0]->indicator(1),
 794     $fields[0]->indicator(2),
 795     @combined_subfields
 796 );
 797
 798 $marc_xml->insert_grouped_field( $new_field );
 799
 800 return $marc_xml->as_xml_record();
 801
 802 $function$;
 803
 804