sql/base/01-marc.sql

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