removing miker-filter series; superceded by filter_record_ids, which has far less...

[migration-tools.git] / marc-cleanup

diff --git a/marc-cleanup b/marc-cleanup
index 6cfd6f4..58b59a8 100755 (executable)
--- a/marc-cleanup
+++ b/marc-cleanup
@@ -33,9 +33,12 @@ open my $EXMARC, '>:utf8', $conf->{exception};
 # edit(), below
 my %commands = ( c => \&print_context,
                  C => \&print_linecontext,
-                 k => \&kill_line,
                  o => \&show_original,
+                 f => \&flip_lines,
+                 k => \&kill_line,
                  m => \&merge_lines,
+                 n => \&next_line,
+                 p => \&prev_line,
                  s => \&substitute,
                  t => \&commit_edit,
                  x => \&dump_record,
@@ -49,8 +52,10 @@ my @spinner = qw(- / | \\);
 my $sidx = 0;
 
 while ( buildrecord() ) {
-    print "\rWorking... ", $spinner[$sidx];
-    $sidx = ($sidx == $#spinner) ? 0 : $sidx + 1;
+    unless ($conf->{ricount} % 100) {
+        print "\rWorking... ", $spinner[$sidx];
+        $sidx = ($sidx == $#spinner) ? 0 : $sidx + 1;
+    }
 
     do_automated_cleanups();
 
@@ -81,7 +86,6 @@ while ( buildrecord() ) {
         }
         $recptr++;
     }
-
     write_record($NUMARC);
 }
 print $NUMARC "</collection>\n";
@@ -96,10 +100,10 @@ sub do_automated_cleanups {
     $recptr = 0;
     until ($recptr == $#record) {
         # catch empty datafield elements
-        if ($record[$recptr] =~ m|</datafield>|) {
-            if ($record[$recptr + 1] =~ m/<datafield tag="..." ind1="." ind2=".">/) {
-                my @a = @record[0, $recptr - 1];
-                my @b = @record[$recptr + 1, $#record];
+        if ($record[$recptr] =~ m/<datafield tag="..." ind1="." ind2=".">/) {
+            if ($record[$recptr + 1] =~ m|</datafield>|) {
+                my @a = @record[0 .. $recptr - 1];
+                my @b = @record[$recptr + 2 .. $#record];
                 @record = (@a, @b);
                 message("Empty datafield scrubbed");
                 $recptr = 0;
@@ -107,11 +111,16 @@ sub do_automated_cleanups {
             }
         }
         # and quasi-empty subfields
-        if ($record[$recptr] =~ m|<subfield code="\s*">\s*</sub|) {
-            delete $record[$recptr];
-            message("Empty subfield scrubbed");
-            $recptr = 0;
-            next;
+        if ($record[$recptr] =~ m|<subfield code="(.*?)">(.*?)</sub|) {
+            my $code = $1; my $content = $2;
+            if ($code =~ /\W/ and ($content =~ /\s+/ or $content eq '')) {
+                my @a = @record[0 .. $recptr - 1];
+                my @b = @record[$recptr + 1 .. $#record];
+                @record = (@a, @b);
+                message("Empty subfield scrubbed");
+                $recptr = 0;
+                next;
+            }
         }
         $recptr++;
     }
@@ -128,6 +137,15 @@ sub do_automated_cleanups {
                 message("Short leader padded");
             }
         }
+        if ($record[$recptr] =~ m|<controlfield tag="008">(.+?)</control|) {
+            #pad short 008
+            my $content = $1;
+            if (length $content < 40) {
+                $content .= ' ' x (40 - length($content));
+                $record[$recptr] = "<controlfield tag=\"008\">$content</controlfield>\n";
+                message("Short 008 padded");
+            }
+        }
 
         # clean misplaced dollarsigns
         if ($record[$recptr] =~ m|<subfield code="\$">c?\d+\.\d{2}|) {
@@ -167,12 +185,14 @@ Handles the Term::ReadLine loop
 
 sub edit {
     my ($msg) = @_;
-    my $trash = $conf->{trash};
 
-    return if $trash->{ $recmeta{tag} };
-    message($msg);
+    return if $conf->{trash}{ $recmeta{tag} };
+    message($msg, 1);
     print_context();
 
+    # stow original problem line
+    $conf->{origline} = $record[$recptr];
+
     while (1) {
         my $line = $term->readline('marc-cleanup>');
         my @chunks = split /\s+/, $line;
@@ -198,10 +218,9 @@ to the driver loop.
 =cut
 
 sub buildrecord {
-    my $l = <MARC>;
+    my $l = '';
+    $l = <MARC> while (defined $l and $l !~ /<record>/);
     return $l unless defined $l;
-
-    $l = <MARC> until ($l =~ /<record>/);
     @record = ($l);
     %recmeta = ();
     $conf->{ricount}++;
@@ -262,8 +281,24 @@ sub write_record {
     print $FH "</record>\n";
 }
 
+sub print_context {
+    print "    Tag:",$recmeta{tag}, " Ind1:'",
+      $recmeta{ind1},"' Ind2:'", $recmeta{ind2}, "'\n";
+    print_linecontext();
+    return 0;
+}
+
+sub print_linecontext {
+    my $low = ($recptr - 3 < 0) ? 0 : $recptr - 3;
+    print $OUT '    |', $record[$_] for ($low .. $recptr - 1);
+    print $OUT '==> |', $record[$recptr];
+    print $OUT '    |', $record[$recptr + 1], "\n";
+    return 0;
+}
+
 sub message {
-    my ($msg) = @_;
+    my ($msg, $new) = @_;
+    print $OUT "\r", ' ' x 72, "\n" if $new;
     print $OUT "\r$msg at ",$conf->{ricount},"/",$conf->{rocount} + 1,"\n";
 
 }
@@ -298,15 +333,28 @@ sub substitute {
 }
 
 sub merge_lines {
-    $record[$recptr] =~ s/^\s*<subfield code=".*">//;
-    $record[$recptr - 1] =~ s|<subfield>\n||;
+    # remove <subfield stuff; extract (probably wrong) subfield code
+    $record[$recptr] =~ s/^\s*<subfield code="(.*?)">//;
+    # and move to front of line
+    $record[$recptr] = join(' ', $1 , $record[$recptr]);
+    # tear off trailing subfield tag from preceeding line
+    $record[$recptr - 1] =~ s|</subfield>\n||;
+    # join current line onto preceeding line
     $record[$recptr - 1] = join('', $record[$recptr - 1], $record[$recptr]);
+    # erase current line
+    my @a = @record[0 .. $recptr - 1];
+    my @b = @record[$recptr + 1 .. $#record];
+    @record = (@a, @b);
+    # move record pointer to previous line
+    prev_line();
     print_linecontext();
     return 0;
 }
 
 sub kill_line {
-    delete $record[$recptr];
+    my @a = @record[0 .. $recptr - 1];
+    my @b = @record[$recptr + 1 .. $#record];
+    @record = (@a, @b);
     print_linecontext();
     return 0;
 }
@@ -318,34 +366,32 @@ sub dump_record {
     return 1;
 }
 
-sub commit_edit { return 1 }
-
-sub print_context {
-    print "\n Tag:",$recmeta{tag}, " Ind1:'",
-      $recmeta{ind1},"' Ind2:'", $recmeta{ind2}, "'";
+sub next_line {
+    $recptr++;
     print_linecontext();
     return 0;
 }
 
-sub print_linecontext {
-    print $OUT "\n", join('    |','',@context[0..2]);
-    print $OUT '==> |', $context[3];
-    print $OUT '    |', $context[4],"\n";
+sub prev_line {
+    $recptr--;
+    print_linecontext();
     return 0;
 }
 
 sub show_original {
     my ($line_in) = @_;
-    print $OUT "\n$line_in\n";
+    print $OUT "\n", $conf->{origline}, "\n";
     return 0;
 }
 
+sub commit_edit { return 1 }
+
 sub help {
 print $OUT <<HELP;
 
 Type a replacement for the indicated line, or enter a command.
 
-Commands: c  Show record context ('C' for brief context)
+Commands: c  Show record context again ('C' for brief context)
           k  Kill indicated line (remove from record)
           m  Merge indicated line with previous line
           o  Show original line
@@ -424,7 +470,7 @@ sub populate_trash {
 
     # remove original id sequence tag from trash hash if we know it
     trash_add($conf->{'original-tag'}, 1)
-      if ($conf->{'original-tag'} and $trash{$conf->{'original-tag'}});
+      if ($conf->{'original-tag'} and $conf->{trash}{ $conf->{'original-tag'} });
 }
 
 sub trash_add_range {
@@ -444,7 +490,7 @@ sub trash_add_range {
 
 sub trash_add {
     my ($tag, $except) = @_;
-    my $trash = $conf->{trash}
+    my $trash = $conf->{trash};
 
     die "Trash values must be valid tags (000-999)\n"
       unless ($tag >= 0 and $tag <= 999);