trying to fix memory problems, but barkingup wrong tree
[migration-tools.git] / marc_cleanup
index 9bc7b96..fe25aac 100755 (executable)
@@ -8,9 +8,10 @@ use Getopt::Long;
 use Term::ReadLine;
 use Equinox::Migration::SimpleTagList;
 
-binmode STDOUT, ":utf8";
 my $term = new Term::ReadLine 'yaz-cleanup';
 my $OUT = $term->OUT || \*STDOUT;
+binmode STDOUT, ":utf8";
+binmode $OUT, ":utf8";
 
 $| = 1;
 
@@ -27,15 +28,15 @@ 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";
+print $NUMARC "<collection xmlns=\"http://www.loc.gov/MARC21/slim\">\n";
 
 $conf->{totalrecs} = `grep -c '<record' $marcfile`;
 chomp $conf->{totalrecs};
 $conf->{percent}   = 0;
 
-my @record  = (); # current record storage
-my %recmeta = (); # metadata about current record
-my $ptr  = 0;  # record index pointer
+my @record;  # current record storage
+my %recmeta; # metadata about current record
+my $ptr = 0; # record index pointer
 
 # this is the dispatch table which drives command selection in
 # edit(), below
@@ -89,13 +90,6 @@ while ( buildrecord() ) {
                 edit("Non-numerics in tag") unless $conf->{autoscrub};
                 next;
             }
-            # test for existing 901/903 unless we're autocleaning them
-            unless ($conf->{'strip9'} or $conf->{'no-strip9'}) {
-                if ($match == 901 or $match == 903) {
-                    edit("Incoming 901/903 found in data");
-                    next;
-                }
-            }
         }
 
         # subfields can't be non-alphanumeric
@@ -116,7 +110,7 @@ while ( buildrecord() ) {
     write_record($NUMARC);
 }
 print $NUMARC "</collection>\n";
-print $OUT "\nDone.               \n";
+print $OUT "\nDone. ",$conf->{ricount}," in / ",$conf->{rocount}," out          \n";
 
 
 #-----------------------------------------------------------------------------------
@@ -126,12 +120,14 @@ print $OUT "\nDone.               \n";
 sub do_automated_cleanups {
     $ptr = 0;
     until ($ptr == $#record) {
+
         # catch empty datafield elements
         if ($record[$ptr] =~ m/<datafield tag="..."/) {
             if ($record[$ptr + 1] =~ m|</datafield>|) {
                 my @a = @record[0 .. $ptr - 1];
                 my @b = @record[$ptr + 2 .. $#record];
                 @record = (@a, @b);
+                @a = undef; @b = undef;
                 message("Empty datafield scrubbed");
                 $ptr = 0;
                 next;
@@ -144,6 +140,7 @@ sub do_automated_cleanups {
                 my @a = @record[0 .. $ptr - 1];
                 my @b = @record[$ptr + 1 .. $#record];
                 @record = (@a, @b);
+                @a = undef; @b = undef;
                 message("Empty subfield scrubbed");
                 $ptr = 0;
                 next;
@@ -180,12 +177,6 @@ sub do_automated_cleanups {
             message("Dollar sign corrected");
         }
 
-        # clean up tags with spaces in them
-        $record[$ptr] =~ s/tag="  /tag="00/g;
-        $record[$ptr] =~ s/tag=" /tag="0/g;
-        $record[$ptr] =~ s/tag="-/tag="0/g;
-        $record[$ptr] =~ s/tag="(\d\d) /tag="0$1/g;
-
         # automatable subfield maladies
         $record[$ptr] =~ s/code=" ">c/code="c">/;
         $record[$ptr] =~ s/code=" ">\$/code="c">\$/;
@@ -214,7 +205,8 @@ sub stow_record_data {
             my $osub = $conf->{'original-subfield'};
             $recmeta{oid} = 'NONE';
 
-            until ($line =~ m|</record>|) {
+            # skim to end of this tag
+            until ($line =~ m|</datafield>|) {
                 if ($line =~ /<subfield code="$osub">(.+?)</)
                   { $recmeta{oid} = $1 }
                 $lptr++;
@@ -285,21 +277,45 @@ to the driver loop.
 
 sub buildrecord {
     my $l = '';
+    my $istrash = 0;
+    my $trash = $conf->{trash};
+
     $l = <MARC> while (defined $l and $l !~ /<record>/);
     return $l unless defined $l;
-    @record = ();
-    %recmeta = ();
     $conf->{ricount}++;
 
-    until ($l =~ m|</record>|)
-      { push @record, $l; $l = <MARC>; }
-    push @record, $l;
+    for (keys %recmeta) { $recmeta{$_} = undef }
+    for (0 .. @record)  { delete $record[$_] }
+
+    my $i = 0;
+    until ($l =~ m|</record>|) {
+        # clean up tags with spaces in them
+        $l =~ s/tag="  /tag="00/g;
+        $l =~ s/tag=" /tag="0/g;
+        $l =~ s/tag="-/tag="0/g;
+        $l =~ s/tag="(\d\d) /tag="0$1/g;
+
+        # excise unwanted tags
+        if ($istrash) {
+            $istrash = 0 if ($l =~ m|</datafield|);
+            $l = <MARC>;
+            next;
+        }
+        if ($l =~ m/<datafield tag="(.{3})"/) {
+            if ($trash->has($1) or ($conf->{autoscrub} and $1 =~ /\D/))
+              { $istrash = 1; next }
+        }
+
+        $record[$i] = $l;
+        $l = <MARC>;
+        $i++;
+    }
+    $record[$i] = $l;
     return 1;
 }
 
 sub write_record {
     my ($FH) = @_;
-    my $trash = $conf->{trash};
 
     if ($FH eq 'EX') {
         $EXMARC = undef;
@@ -312,27 +328,6 @@ sub write_record {
     print $FH '<!-- ', $recmeta{explanation}, " -->\n"
       if(defined $recmeta{explanation});
 
-    # excise unwanted tags
-    if (defined $trash or $conf->{autoscrub}) {
-        my @trimmed = ();
-        my $istrash = 0;
-        for my $line (@record) {
-            if ($istrash) {
-                $istrash = 0 if $line =~ m|</datafield|;
-                next;
-            }
-            if ($line =~ m/<datafield tag="(.{3})"/) {
-                my $tag = $1;
-                if ($trash->has($tag) or ($conf->{autoscrub} and $tag =~ /\D/)) {
-                    $istrash = 1;
-                    next
-                }
-            }
-            push @trimmed, $line;
-        }
-        @record = @trimmed;
-    }
-
     # add 903(?) with new record id
     my $renumber = '';
     if ($conf->{'renumber-from'}) {
@@ -341,9 +336,11 @@ sub write_record {
                          '" ind1=" " ind2=" "> <subfield code="',
                          $conf->{'renumber-subfield'},
                          '">', $recmeta{nid}, "</subfield></datafield>\n");
-        my @tmp = @record[0 .. $#record - 1];
-        my $last = $record[$#record];
+        my @tmp = @record[0 .. @record - 2];
+        my $last = $record[-1];
+        @record = undef;
         @record = (@tmp, $renumber, $last);
+        @tmp = undef; $last = undef;
         $conf->{'renumber-from'}++;
     }
 
@@ -421,6 +418,7 @@ sub substitute {
 
     $recmeta{prevline} = $record[$ptr];
     $record[$ptr] =~ s/$from/$to/;
+    $ofrom = undef; $to = undef; $from = undef;
     print_context();
     return 0;
 }
@@ -451,6 +449,7 @@ sub flip_line {
     my $temp = $record[$ptr];
     $record[$ptr] = $recmeta{prevline};
     $recmeta{prevline} = $temp;
+    $temp = undef;
     print_context();
     return 0;
 }
@@ -460,6 +459,7 @@ sub kill_line {
     my @a = @record[0 .. $ptr - 1];
     my @b = @record[$ptr + 1 .. $#record];
     @record = (@a, @b);
+    @a = undef; @b = undef;
     print_context();
     return 0;
 }
@@ -470,6 +470,7 @@ sub yank_line {
     my @a = @record[0 .. $ptr - 1];
     my @b = @record[$ptr .. $#record];
     @record = (@a, $conf->{killline}, @b);
+    @a = undef; @b = undef;
     print_context();
     return 0;
 }
@@ -492,6 +493,7 @@ sub dump_record {
     my (@explanation) = @_;
     print $OUT @explanation;
     $recmeta{explanation} = join(' ', 'Tag', $recmeta{tag}, @explanation);
+    @explanation = undef;
     write_record($EXMARC);
     return 1;
 }
@@ -576,13 +578,12 @@ sub initialize {
                          'original-tag|ot=i',
                          'original-subfield|os=s',
                          'script',
-                         'strip9',
                          'no-strip9',
                          'trashfile|t=s',
                          'trashhelp',
                          'help|h',
                        );
-    show_help() unless $rc;
+    show_help() unless $rc and @ARGV;
     show_help() if ($c->{help});
     show_trashhelp() if ($c->{trashhelp});
 
@@ -595,19 +596,18 @@ sub initialize {
     $c->{window} = 5;
 
     if ($c->{trashfile}) {
-        $c->{trash} = Equinox::Migration::SimpleTagList->new($conf->{trashfile})
+        $c->{trash} = Equinox::Migration::SimpleTagList->new(file => $conf->{trashfile})
     } else {
         $c->{trash} = Equinox::Migration::SimpleTagList->new;
     }
-    # remove original id sequence tag from trash hash if we know it
-    $c->{trash}->remove_tag($c->{'original-tag'})
-      if ( $c->{'original-tag'} and $c->{trash}->has($c->{'original-tag'}) );
-
-    # autotrash 901, 903 if strip-nines
-    if ($c->{'strip9'}) {
+    # autotrash 901, 903 unless no strip-nines
+    unless ($c->{'no-strip9'}) {
         $c->{trash}->add_tag(901);
         $c->{trash}->add_tag(903);
     }
+    # remove original id sequence tag from trash hash if we know it
+    $c->{trash}->remove_tag($c->{'original-tag'})
+      if ( $c->{'original-tag'} and $c->{trash}->has($c->{'original-tag'}) );
 
     my @keys = keys %{$c};
     show_help() unless (@ARGV and @keys);
@@ -634,8 +634,7 @@ Options
 
   --autoscrub  -a  Automatically remove non-numeric tags in data
   --nocollapse -n  Don't compress records to one line on output
-  --strip9         Automatically remove any existing 901/903 tags in data
-  --no-strip9      Don't complain about 901/903 tags in data
+  --no-strip9      Don't autoremove 901/903 tags in data
   --trashfile  -t  File containing trash tag data (see --trashhelp)