fixed old2new map issues
[migration-tools.git] / marc_cleanup
index 8438a06..9afae88 100755 (executable)
@@ -1,4 +1,5 @@
 #!/usr/bin/perl
+require 5.10.0;
 
 use strict;
 use warnings;
@@ -24,7 +25,7 @@ open my $NUMARC, '>:utf8', $conf->{output}
 open my $OLD2NEW, '>', 'old2new.map'
   if ($conf->{'renumber-from'} and $conf->{'original-subfield'});
 my $EXMARC = 'EX';
-
+print $NUMARC "<collection>\n";
 
 my @record  = (); # current record storage
 my %recmeta = (); # metadata about current record
@@ -61,7 +62,8 @@ while ( buildrecord() ) {
         $sidx = ($sidx == $#spinner) ? 0 : $sidx + 1;
     }
 
-    do_automated_cleanups();
+    my $rc = do_automated_cleanups();
+    next if $rc;
 
     $ptr = 0;
     until ($ptr == $#record) {
@@ -87,18 +89,22 @@ while ( buildrecord() ) {
 
         # subfields can't be non-alphanumeric
         if ($record[$ptr] =~ /<subfield code="(.*?)"/) {
-            my $match = $1;
-            if ($match =~ /\P{IsAlnum}/ or $match eq '') {
+            if ($1 =~ /\P{IsAlnum}/ or $1 eq '') {
                 edit("Junk in subfield code/Null subfield code");
                 next;
             }
         }
+        # subfields can't be non-alphanumeric
+        if ($record[$ptr] =~ /<subfield code="(\w{2,})"/) {
+            edit("Subfield code larger than 1 char");
+            next;
+        }
 
         $ptr++;
     }
     write_record($NUMARC);
 }
-#print $NUMARC "</collection>\n";
+print $NUMARC "</collection>\n";
 print $OUT "\nDone.               \n";
 
 
@@ -110,7 +116,8 @@ sub do_automated_cleanups {
     $ptr = 0;
     until ($ptr == $#record) {
         # get datafield/tag data if we have it
-        stow_record_data();
+        my $rc = stow_record_data();
+        return $rc if $rc;
 
         # catch empty datafield elements
         if ($record[$ptr] =~ m/<datafield tag="..."/) {
@@ -174,40 +181,46 @@ sub do_automated_cleanups {
 
         # automatable subfield maladies
         $record[$ptr] =~ s/code=" ">c/code="c">/;
-        $record[$ptr] =~ s/code=" ">\$/code="c"$>/;
+        $record[$ptr] =~ s/code=" ">\$/code="c">\$/;
     }
+    return 0;
 }
 
 sub stow_record_data {
     # get tag data if we're looking at it
-    
     if ($record[$ptr] =~ m/<datafield tag="(?<TAG>.{3})"/) {
         $recmeta{tag} = $+{TAG};
         $record[$ptr] =~ m/ind1="(?<IND1>.)"/;
         $recmeta{ind1} = $+{IND1} || '';
         $record[$ptr] =~ m/ind2="(?<IND2>.)"/;
         $recmeta{ind2} = $+{IND2} || '';
-        
+
         unless (defined $recmeta{tag}) {
             message("Autokill record: no detectable tag");
             dump_record("No detectable tag") ;
+            return 1;
         }
 
         # and since we are looking at a tag, see if it's the original id
-        if ($conf->{'original-subfield'} and
-            $recmeta{tag} == $conf->{'original-tag'}) {
+        if ($conf->{'original-subfield'} and $recmeta{tag} == $conf->{'original-tag'}) {
             my $line = $record[$ptr]; my $lptr = $ptr;
             my $osub = $conf->{'original-subfield'};
             $recmeta{oid} = 'NONE';
 
             until ($line =~ m|</record>|) {
+                if ($line =~ /<subfield code="$osub">(.+?)</)
+                  { $recmeta{oid} = $1 }
                 $lptr++;
                 $line = $record[$lptr];
-                $recmeta{oid} = $+{TAG}
-                  if ($line =~ /<subfield code="$osub">(.+?)</);
+            }
+            unless (defined $recmeta{oid}) {
+                message("Autokill record: no oldid when old2new mapping requested");
+                dump_record("No old id found");
+                return 1;
             }
         }
     }
+    return 0;
 }
 
 #-----------------------------------------------------------------------------------
@@ -333,12 +346,7 @@ sub write_record {
 
     # write to old->new map file if needed
     if ($conf->{'renumber-from'} and $conf->{'original-subfield'}) {
-        unless (defined $recmeta{oid}) {
-            my $msg = join(' ', "No old id num found");
-            dump_record($msg);
-        } else {
-            print $OLD2NEW $recmeta{oid}, "\t", $recmeta{nid}, "\n"
-        }
+        print $OLD2NEW $recmeta{oid}, "\t", $recmeta{nid}, "\n"
     }
 
     # actually write the record
@@ -669,10 +677,9 @@ sub initialize {
     show_trashhelp() if ($c->{trashhelp});
 
     # defaults
-    if ($c->{prefix}) {
-        $c->{output} = join('.',$c->{prefix},'clean','marc','xml');
-        $c->{exception} = join('.',$c->{prefix},'marc','ex');
-    }
+    my $pfx = $c->{prefix} // "bibs";
+    $c->{output} = join('.',$c->{prefix},'clean','marc','xml');
+    $c->{exception} = join('.',$c->{prefix},'exception','marc','xml');
     $c->{'renumber-tag'} = 903 unless defined $c->{'renumber-tag'};
     $c->{'renumber-subfield'} = 'a' unless defined $c->{'renumber-subfield'};
     $c->{window} = 5;
@@ -694,10 +701,8 @@ Options
   --output     -o  Cleaned MARCXML output filename
   --exception  -x  Exception (dumped records) MARCXML filename
        or
-  --prefix=<PREFIX>>   -p  Shared prefix for output/exception files. Will
-                           produce PREFIX.marc.xml and PREFIX.ex.xml
-
-  --trashfile  -t  File containing trash tag data (see --trashhelp)
+  --prefix=<PREFIX>>   -p  Shared prefix for output/exception files. Will produce
+                           PREFIX.clean.marc.xml and PREFIX.exception.marc.xml
 
   --renumber-from     -rf  Begin renumbering id sequence with this number
   --renumber-tag      -rt  Tag to use in renumbering (default: 903)
@@ -708,9 +713,11 @@ Options
                            and renumbering is in effect, an old-to-new mapping
                            file (old2new.map) will be generated.
 
-  --nocollapse -n  Don't compress records to one line on output
   --autoscrub  -a  Automatically remove non-numeric tags in data
+  --nocollapse -n  Don't compress records to one line on output
   --strip-nines    Automatically remove any existing 901/903 tags in data
+  --trashfile  -t  File containing trash tag data (see --trashhelp)
+
 
   --script         Store human-initiated ops in scriptfile (.mcscript)
                    Not yet implemented