stow_record_data uses named captures now instead of oldstyle automagic capture vars...

[migration-tools.git] / marc-cleanup

diff --git a/marc-cleanup b/marc-cleanup
index cb4fda1..f40babb 100755 (executable)
--- a/marc-cleanup
+++ b/marc-cleanup
@@ -17,13 +17,14 @@ initialize($conf);
 populate_trash() if ($conf->{trashfile});
 
 # set up files, since everything appears to be in order
-my $EXMARC = '';
-open MARC, '<:utf8', (shift || 'incoming.marc.xml');
-open my $NUMARC, '>:utf8', $conf->{output};
+open MARC, '<:utf8', (shift || 'incoming.marc.xml')
+  or die "Can't open input file $!\n";
+open my $NUMARC, '>:utf8', $conf->{output}
+  or die "Can't open output file $!\n";
 open my $OLD2NEW, '>', 'old2new.map'
   if ($conf->{'renumber-from'} and $conf->{'original-subfield'});
-#print $NUMARC '<?xml version="1.0" encoding="UTF-8"?>',"\n";
-#print $NUMARC '<collection xmlns="http://www.loc.gov/MARC21/slim">',"\n";
+my $EXMARC = 'EX';
+
 
 my @record  = (); # current record storage
 my %recmeta = (); # metadata about current record
@@ -112,7 +113,7 @@ sub do_automated_cleanups {
         stow_record_data();
 
         # catch empty datafield elements
-        if ($record[$ptr] =~ m/<datafield tag="..." ind1="." ind2=".">/) {
+        if ($record[$ptr] =~ m/<datafield tag="..."/) {
             if ($record[$ptr + 1] =~ m|</datafield>|) {
                 my @a = @record[0 .. $ptr - 1];
                 my @b = @record[$ptr + 2 .. $#record];
@@ -179,13 +180,22 @@ sub do_automated_cleanups {
 
 sub stow_record_data {
     # get tag data if we're looking at it
-    if ($record[$ptr] =~ m/<datafield tag="(.{3})" ind1="(.)" ind2="(.)">/) {
-        $recmeta{tag}  = $1;
-        $recmeta{ind1} = $2;
-        $recmeta{ind2} = $3;
+    
+    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") ;
+        }
 
         # and since we are looking at a tag, see if it's the original id
-        if ($conf->{'original-subfield'} and $1 == $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';
@@ -193,7 +203,7 @@ sub stow_record_data {
             until ($line =~ m|</record>|) {
                 $lptr++;
                 $line = $record[$lptr];
-                $recmeta{oid} = $1
+                $recmeta{oid} = $+{TAG}
                   if ($line =~ /<subfield code="$osub">(.+?)</);
             }
         }
@@ -257,7 +267,7 @@ sub buildrecord {
     my $l = '';
     $l = <MARC> while (defined $l and $l !~ /<record>/);
     return $l unless defined $l;
-    @record = ($l);
+    @record = ();
     %recmeta = ();
     $conf->{ricount}++;
 
@@ -271,10 +281,10 @@ sub write_record {
     my ($FH) = @_;
     my $trash = $conf->{trash};
 
-    # uninitialized $EXMARC
-    if ($FH eq '') {
+    if ($FH eq 'EX') {
         $EXMARC = undef;
-        open $EXMARC, '>:utf8', $conf->{exception};
+        open $EXMARC, '>:utf8', $conf->{exception}
+          or die "Can't open exception file $!\n";
         $FH = $EXMARC;
     }
 
@@ -317,8 +327,8 @@ sub write_record {
         $conf->{'renumber-from'}++;
     }
 
-    # scrub newlines
-    unless ($conf->{nocollapse})
+    # scrub newlines (unless told not to or writing exception record)
+    unless ($conf->{nocollapse} or $FH eq $EXMARC)
       { s/\n// for (@record) }
 
     # write to old->new map file if needed
@@ -331,8 +341,13 @@ sub write_record {
         }
     }
 
-    # and finally, actually write the record
+    # actually write the record
     print $FH @record,"\n";
+
+    # if we were dumping to exception file, nuke the record and set ptr
+    # to terminate processing loop
+    @record = ('a');
+    $ptr = 0;
 }
 
 sub print_fullcontext {
@@ -340,7 +355,7 @@ sub print_fullcontext {
     print $OUT $conf->{editmsg},"\n";
     print $OUT "\r    Tag:",$recmeta{tag}, " Ind1:'",
       $recmeta{ind1},"' Ind2:'", $recmeta{ind2}, "'";
-    print $OUT " @ ", $conf->{ricount}, "/", $conf->{rocount} + 1,"\n";
+    print $OUT " @ ", $conf->{ricount}, "/", $conf->{rocount} + 1;
     print_context();
     return 0;
 }
@@ -460,6 +475,7 @@ sub display_lines {
 
 sub dump_record {
     my (@explanation) = @_;
+    print $OUT @explanation;
     $recmeta{explanation} = join(' ', 'Tag', $recmeta{tag}, @explanation);
     write_record($EXMARC);
     return 1;
@@ -655,7 +671,7 @@ sub initialize {
     # defaults
     if ($c->{prefix}) {
         $c->{output} = join('.',$c->{prefix},'marc','xml');
-        $c->{exception} = join('.',$c->{prefix},'ex','xml');
+        $c->{exception} = join('.',$c->{prefix},'marc','ex');
     }
     $c->{'renumber-tag'} = 903 unless defined $c->{'renumber-tag'};
     $c->{'renumber-subfield'} = 'a' unless defined $c->{'renumber-subfield'};