license and environment
[migration-tools.git] / marc-cleanup
index 94bb7c6..0f7d638 100755 (executable)
@@ -11,7 +11,7 @@ $| = 1;
 my $term = new Term::ReadLine 'yaz-cleanup';
 my $OUT = $term->OUT || \*STDOUT;
 
-my $conf = {}
+my $conf = {};
 
 my $count = 0;
 my $reccount = 0;
@@ -23,7 +23,7 @@ my %trash = ();   # hash for tags to be dumped
 initialize($conf);
 
 # read in trash tags file if it exists
-populate_trash() if (-e '.trashtags');
+populate_trash() if ($conf->{trash});
 
 my @record = ();  # current record storage
 my %recmeta = (); # metadata about current record
@@ -31,12 +31,12 @@ my @context= ();  # last 5 lines of file
 
 my $input = shift || 'incoming.marc.xml';
 
-open MARC, '<', $input;
-open my $NUMARC, '>', $conf->{output};
+open MARC, '<:utf8', $input;
+open my $NUMARC, '>:utf8', $conf->{output};
 print $NUMARC '<?xml version="1.0" encoding="UTF-8"?>',"\n";
 print $NUMARC '<collection xmlns="http://www.loc.gov/MARC21/slim">',"\n";
 
-open my $EXMARC, '>', $conf->{exception};
+open my $EXMARC, '>:utf8', $conf->{exception};
 print $EXMARC '<?xml version="1.0" encoding="UTF-8"?>',"\n";
 print $EXMARC '<collection xmlns="http://www.loc.gov/MARC21/slim">',"\n";
 open MARC2, '<', $input;
@@ -109,6 +109,10 @@ while (my $line = getline()) {
         $recmeta{ind2} = $3;
     }
 
+    # automatable subfield maladies
+    $line =~ s/code=" ">c/code="c">/;
+    $line =~ s/code=" ">\$/code="c"$>/;
+
     # and stow line back in record
     $record[-1] = $line;
 
@@ -126,10 +130,10 @@ while (my $line = getline()) {
     }
 
     # subfields can't be non-alphanumeric
-    if ($line =~ /<subfield code="(.+?)"/) {
+    if ($line =~ /<subfield code="(.*?)"/) {
         my $match = $1;
-        if ($match =~ /\P{IsAlnum}/) {
-            edit("Junk in subfield code", $line);
+        if ($match =~ /\P{IsAlnum}/ or $match eq '') {
+            edit("Junk in subfield code/Null subfield code", $line);
             next;
         }
     }
@@ -203,8 +207,8 @@ sub write_record {
     print $FH '<!-- ', $recmeta{explanation}, " -->\n"
       if(defined $recmeta{explanation});
 
-    # LOOP OVER %trash TO EXCISE UNWANTED TAGS1
-    if (keys %trash) {
+    # excise unwanted tags
+    if (keys %trash or $conf->{autoscrub}) {
         my @trimmed = ();
         my $istrash = 0;
         for my $line (@record) {
@@ -214,7 +218,7 @@ sub write_record {
             }
             if ($line =~ m/<datafield tag="(.{3})"/) {
                 my $tag = $1;
-                if ($trash{$tag} or ($conf->{autoscrub} and $tag =~ /\D/) {
+                if ($trash{$tag} or ($conf->{autoscrub} and $tag =~ /\D/)) {
                     $istrash = 1;
                     next
                 }
@@ -224,16 +228,25 @@ sub write_record {
         @record = @trimmed;
     }
 
-    # add 903 with new record id
+    # scrub newlines
+    unless ($conf->{nocollapse}) {
+        s/\n// for (@record);
+    }
+
+    # add 903(?) with new record id
+    my $renumber = '';
     if ($conf->{'renumber-from'}) {
-        print $FH '<datafield tag="903"><subfield code="a">', $conf->{'renumber-from'},
-          '</subfield></datafield>';
-        print $FH "\n" unless $conf->{oneperline};
+        $renumber = join('', '<datafield tag="', $conf->{'renumber-tag'},
+                         '" ind1=" " ind2=" ">',
+                         '<subfield code="', $conf->{'renumber-subfield'}, '">',
+                         $conf->{'renumber-from'}, '</subfield></datafield>');
+        $renumber .= "\n" if $conf->{nocollapse};
+        push @record, $renumber;
         $conf->{'renumber-from'}++;
     }
 
     print $FH @record;
-    print $FH '</record>\n';
+    print $FH "</record>\n";
 }
 
 sub update_linecontext {
@@ -377,8 +390,9 @@ sub quit { exit }
 # specifying a tag twice is an error, to help prevent typos
 
 sub populate_trash {
-    print $OUT ">>> TRASHTAGS FILE FOUND. LOADING TAGS TO BE STRIPPED FROM OUTPUT...\n";
-    open TRASH, '<', '.trashtags';
+    print $OUT ">>> TRASHTAGS FILE FOUND. LOADING TAGS TO BE STRIPPED FROM OUTPUT\n";
+    open TRASH, '<', $conf->{trash}
+      or die "Can't open trash tags file!\n";
     while (<TRASH>) {
         my $lastwasrange = 0;
         my %lastrange = ( high => 0, low => 0);
@@ -416,6 +430,10 @@ sub populate_trash {
             die "Unknown chunk $chunk in .trashtags file (line $.)\n";
         }
     }
+
+    # 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'}});
 }
 
 sub trash_add_range {
@@ -464,12 +482,14 @@ sub initialize {
 
     my $rc = GetOptions( $c,
                          'autoscrub|a',
-                         'exception|e=s',
+                         'exception|x=s',
                          'output|o=s',
                          'nocollapse|n',
                          'renumber-from|rf=i',
                          'original-tag|ot=i',
                          'renumber-tag|rt=i',
+                         'renumber-subfield|rt=i',
+                         'trash|t=s',
                          'help|h',
                        );
     show_help() unless $rc;
@@ -478,7 +498,8 @@ sub initialize {
     # defaults
     $c->{output} = 'incoming.cleaned.marc.xml' unless defined $c->{output};
     $c->{exception} = 'incoming.exception.marc.xml' unless defined $c->{exception};
-    $c->{'renumber-tag'} = 903 unless defined $c->{exception};
+    $c->{'renumber-tag'} = 903 unless defined $c->{'renumber-tag'};
+    $c->{'renumber-subfield'} = 'a' unless defined $c->{'renumber-subfield'};
 
     my @keys = keys %{$c};
     show_help() unless (@ARGV and @keys);
@@ -492,5 +513,10 @@ sub initialize {
 
 sub show_help {
     print <<HELP;
+Usage is: $0 [OPTIONS] <filelist>
+Options
+  --output     -o  Cleaned MARCXML output filename (default: incoming.cleaned.marc.xml)
+  --exception  -x  Exception (dumped records) MARCXML filename (incoming.exception.marc.xml)
 HELP
+exit;
 }