yaz-cleanup

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 my $skip = shift || 0;
   7 my $count = 0;
   8 $| = 1;
   9
  10 open MARC, '<', 'incoming.marc.xml';
  11 open NUMARC, '>', 'incoming.clean.marc.xml';
  12
  13 if ($skip) {
  14     until ($count == ($skip - 1)) {
  15         my $t = <MARC>;
  16         print NUMARC $t;
  17         $count++;
  18         printf("\rSpinning on to record %s (%2.2f%%)", $skip, ($count / $skip *100))
  19           unless ($count % 1000);
  20     }
  21     print "\nScrubbing resumes...\n" if $skip;
  22 }
  23
  24 my $line1 = <MARC>;
  25
  26 while (my $line2 = <MARC>) {
  27     $count++;
  28     # catch empty datafield elements
  29     if ($line1 =~ m/<datafield tag="..." ind1="." ind2=".">/) {
  30         if ($line2 =~ m|</datafield>|) {
  31             print "Empty datafield scrubbed at line $count\n";
  32             $line1 = <MARC>;
  33             $count++;
  34             next;
  35         }
  36     }
  37
  38     # clean misplaced dollarsigns
  39     if ($line1 =~ m|<subfield code="\$">c?\d+\.\d{2}|) {
  40         $line1 =~ s|"\$">c?(\d+\.\d{2})|"c">\$$1|;
  41         print "Dollar sign in subfield code corrected at line $count\n";
  42     }
  43
  44     # clean up tags with spaces in them
  45     $line1 =~ s/tag="  /tag="00/g;
  46     $line1 =~ s/tag=" /tag="0/g;
  47     $line1 =~ s/tag="-/tag="0/g;
  48     $line1 =~ s/tag="(\d\d) /tag="0$1/g;
  49
  50     # naked ampersands
  51     die "Looks like naked ampersand at line $count: $line1"
  52       if ($line1 =~ /&/ && $line1 !~ /&\w{1,7};/);
  53
  54     # subfields can't be non-alphanumeric
  55     die "Junk in subfield at line $count: $line1"
  56       if $line1 =~ /<subfield code="[^[:alnum:]]"/;
  57
  58     # everything looks ok
  59     print NUMARC $line1;
  60     $line1 = $line2;
  61 }
  62 print NUMARC $line1;