better non-alnum detection in subfield codes

[migration-tools.git] / yaz-cleanup

diff --git a/yaz-cleanup b/yaz-cleanup
index ddfb1ae..998bfa5 100755 (executable)
--- a/yaz-cleanup
+++ b/yaz-cleanup
@@ -19,12 +19,14 @@ my @record = (); # current record storage
 my %reccontext = ();
 my @linecontext= (); # last 5 lines of file
 
-open MARC, '<', 'incoming.marc.xml';
+my $input = shift || 'incoming.marc.xml';
+
+open MARC, '<', $input;
 open my $NUMARC, '>', 'incoming.clean.marc.xml';
 print $NUMARC '<?xml version="1.0" encoding="UTF-8"?>',"\n";
 open my $EXMARC, '>', 'incoming.exceptions.marc.xml';
 print $EXMARC '<?xml version="1.0" encoding="UTF-8"?>',"\n";
-open MARC2, '<', 'incoming.marc.xml';
+open MARC2, '<', $input;
 <MARC2>;
 
 # this is the dispatch table which drives command selection in
@@ -33,6 +35,7 @@ my %commands = ( c => \&print_context,
                  C => \&print_linecontext,
                  k => \&kill_line,
                  o => \&show_original,
+                 m => \&merge_lines,
                  t => \&commit_edit,
                  x => \&dump_record,
                  q => \&quit,
@@ -80,12 +83,18 @@ while (my $line = getline()) {
     }
 
     # naked ampersands
-    if ($line =~ /&/ && $line !~ /&\w{1,7};/)
+    if ($line =~ /&/ && $line !~ /&\w+?;/)
       { edit("Looks like naked ampersand", $line); next }
 
     # subfields can't be non-alphanumeric
-      if ($line =~ /<subfield code="[^[:alnum:]]"/)
-        { edit("Junk in subfield", $line); next }
+    if ($line =~ /<subfield code="(.+?)"/) {
+        my $match = $1;
+        if ($match =~ /\P{IsAlnum}/) {
+            print $OUT "\n$match\n";
+            edit("Junk in subfield", $line);
+            next;
+        }
+    }
 
 }
 print $NUMARC "</xml>\n";
@@ -103,7 +112,7 @@ sub edit {
     print_context();
     while (1) {
         my $line = $term->readline('yaz-cleanup>');
-        if (length $line == 1)
+        if (length $line < 2)
           { next unless (defined $commands{$line}) }
         if (defined $commands{$line}) {
             my $term = $commands{$line}->($line_in);
@@ -136,6 +145,7 @@ sub getline {
             %reccontext = ();
             $reccount++;
         } elsif ($l =~ m|</record>|) {
+            push @record, $l;
             write_record($NUMARC) if $reccount;
         } else {
             push @record, $l;
@@ -162,7 +172,7 @@ sub update_linecontext {
 #-----------------------------------------------------------------------------------
 
 sub print_context {
-    print "\n    Tag: ",$reccontext{tag}, " Ind1:'",
+    print "\n Tag:",$reccontext{tag}, " Ind1:'",
       $reccontext{ind1},"' Ind2:'", $reccontext{ind2}, "'";
     print_linecontext();
     return 0;
@@ -181,6 +191,20 @@ sub show_original {
     return 0;
 }
 
+sub merge_lines {
+    my $last = pop @record;
+    $last =~ s/^\s+//;
+    $record[-1] =~ s/\n//;
+    $record[-1] = join('', $record[-1], $last);
+    my @temp = ("\n");
+    push @temp, @linecontext[0..1];
+    $temp[3] = $record[-1];
+    $temp[4] = $linecontext[4];
+    @linecontext = @temp;
+    print_linecontext();
+    return 0;
+}
+
 sub kill_line {
     pop @record;
     $linecontext[3] = " [LINE KILLED]\n";
@@ -210,7 +234,7 @@ Type a replacement for the indicated line, or enter a command.
 
 Commands: c  Show record context ('C' for brief context)
           k  Kill this line (remove from record)
-          m  Merge indicated line with previous line [NOT IMPLEMENTED]
+          m  Merge indicated line with previous line
           o  Show original line
           t  Commit changes and resume stream edit
           x  Write this record to the exception file instead of output