marc-cleanup

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Getopt::Long;
   7 use Term::ReadLine;
   8
   9 my $term = new Term::ReadLine 'yaz-cleanup';
  10 my $OUT = $term->OUT || \*STDOUT;
  11
  12 $| = 1;
  13
  14 # initialization and setup
  15 my $conf = {};
  16 initialize($conf);
  17 populate_trash() if ($conf->{trashfile});
  18
  19 # set up files, since everything appears to be in order
  20 open MARC, '<:utf8', (shift || 'incoming.marc.xml')
  21   or die "Can't open input file $!\n";
  22 open my $NUMARC, '>:utf8', $conf->{output}
  23   or die "Can't open output file $!\n";
  24 open my $OLD2NEW, '>', 'old2new.map'
  25   if ($conf->{'renumber-from'} and $conf->{'original-subfield'});
  26 my $EXMARC = 'EX';
  27
  28
  29 my @record  = (); # current record storage
  30 my %recmeta = (); # metadata about current record
  31 my $ptr  = 0;  # record index pointer
  32
  33 # this is the dispatch table which drives command selection in
  34 # edit(), below
  35 my %commands = ( c => \&print_fullcontext,
  36                  n => \&next_line,
  37                  p => \&prev_line,
  38                  '<' => \&widen_window,
  39                  '>' => \&narrow_window,
  40                  d => \&display_lines,
  41                  o => \&insert_original,
  42                  k => \&kill_line,
  43                  y => \&yank_line,
  44                  f => \&flip_line,
  45                  m => \&merge_lines,
  46                  s => \&substitute,
  47                  t => \&commit_edit,
  48                  x => \&dump_record,
  49                  q => \&quit,
  50                  '?' => \&help,
  51                  h   => \&help,
  52                  help => \&help,
  53                );
  54
  55 my @spinner = qw(- / | \\);
  56 my $sidx = 0;
  57
  58 while ( buildrecord() ) {
  59     unless ($conf->{ricount} % 100) {
  60         print "\rWorking... ", $spinner[$sidx];
  61         $sidx = ($sidx == $#spinner) ? 0 : $sidx + 1;
  62     }
  63
  64     do_automated_cleanups();
  65
  66     $ptr = 0;
  67     until ($ptr == $#record) {
  68         # naked ampersands
  69         if ($record[$ptr] =~ /&/ && $record[$ptr] !~ /&\w+?;/)
  70           { edit("Naked ampersand"); $ptr= 0; next }
  71
  72         if ($record[$ptr] =~ /<datafield tag="(.+?)"/) {
  73             my $match = $1;
  74             # tags must be numeric
  75             if ($match =~ /\D/) {
  76                 edit("Non-numerics in tag") unless $conf->{autoscrub};
  77                 next;
  78             }
  79             # test for existing 901/903 unless we're autocleaning them
  80             unless ($conf->{'strip-nines'}) {
  81                 if ($match == 901 or $match == 903) {
  82                     edit("Incoming 901/903 found in data");
  83                     next;
  84                 }
  85             }
  86         }
  87
  88         # subfields can't be non-alphanumeric
  89         if ($record[$ptr] =~ /<subfield code="(.*?)"/) {
  90             my $match = $1;
  91             if ($match =~ /\P{IsAlnum}/ or $match eq '') {
  92                 edit("Junk in subfield code/Null subfield code");
  93                 next;
  94             }
  95         }
  96
  97         $ptr++;
  98     }
  99     write_record($NUMARC);
 100 }
 101 #print $NUMARC "</collection>\n";
 102 print $OUT "\nDone.               \n";
 103
 104
 105 #-----------------------------------------------------------------------------------
 106 # cleanup routines
 107 #-----------------------------------------------------------------------------------
 108
 109 sub do_automated_cleanups {
 110     $ptr = 0;
 111     until ($ptr == $#record) {
 112         # get datafield/tag data if we have it
 113         stow_record_data();
 114
 115         # catch empty datafield elements
 116         if ($record[$ptr] =~ m/<datafield tag="..."/) {
 117             if ($record[$ptr + 1] =~ m|</datafield>|) {
 118                 my @a = @record[0 .. $ptr - 1];
 119                 my @b = @record[$ptr + 2 .. $#record];
 120                 @record = (@a, @b);
 121                 message("Empty datafield scrubbed");
 122                 $ptr = 0;
 123                 next;
 124             }
 125         }
 126         # and quasi-empty subfields
 127         if ($record[$ptr] =~ m|<subfield code="(.*?)">(.*?)</sub|) {
 128             my $code = $1; my $content = $2;
 129             if ($code =~ /\W/ and ($content =~ /\s+/ or $content eq '')) {
 130                 my @a = @record[0 .. $ptr - 1];
 131                 my @b = @record[$ptr + 1 .. $#record];
 132                 @record = (@a, @b);
 133                 message("Empty subfield scrubbed");
 134                 $ptr = 0;
 135                 next;
 136             }
 137         }
 138         $ptr++;
 139     }
 140
 141     # single-line fixes
 142     for $ptr (0 .. $#record) {
 143         # pad short leaders
 144         if ($record[$ptr] =~ m|<leader>(.+?)</leader>|) {
 145             my $leader = $1;
 146             if (length $leader < 24) {
 147                 $leader .= ' ' x (20 - length($leader));
 148                 $leader .= "4500";
 149                 $record[$ptr] = "<leader>$leader</leader>\n";
 150                 message("Short leader padded");
 151             }
 152         }
 153         if ($record[$ptr] =~ m|<controlfield tag="008">(.+?)</control|) {
 154             #pad short 008
 155             my $content = $1;
 156             if (length $content < 40) {
 157                 $content .= ' ' x (40 - length($content));
 158                 $record[$ptr] = "<controlfield tag=\"008\">$content</controlfield>\n";
 159                 message("Short 008 padded");
 160             }
 161         }
 162
 163         # clean misplaced dollarsigns
 164         if ($record[$ptr] =~ m|<subfield code="\$">c?\d+\.\d{2}|) {
 165             $record[$ptr] =~ s|"\$">c?(\d+\.\d{2})|"c">\$$1|;
 166             message("Dollar sign corrected");
 167         }
 168
 169         # clean up tags with spaces in them
 170         $record[$ptr] =~ s/tag="  /tag="00/g;
 171         $record[$ptr] =~ s/tag=" /tag="0/g;
 172         $record[$ptr] =~ s/tag="-/tag="0/g;
 173         $record[$ptr] =~ s/tag="(\d\d) /tag="0$1/g;
 174
 175         # automatable subfield maladies
 176         $record[$ptr] =~ s/code=" ">c/code="c">/;
 177         $record[$ptr] =~ s/code=" ">\$/code="c"$>/;
 178     }
 179 }
 180
 181 sub stow_record_data {
 182     # get tag data if we're looking at it
 183     if ($record[$ptr] =~ m/<datafield tag="(.{3})" ind1="(.)" ind2="(.)"/) {
 184         $recmeta{tag}  = $1;
 185         $recmeta{ind1} = $2 || '';
 186         $recmeta{ind2} = $3 || '';
 187
 188         unless (defined $recmeta{tag}) {
 189             message("Autokill record: no detectable tag");
 190             dump_record("No detectable tag") ;
 191         }
 192
 193         # and since we are looking at a tag, see if it's the original id
 194         if ($conf->{'original-subfield'} and $1 == $conf->{'original-tag'}) {
 195             my $line = $record[$ptr]; my $lptr = $ptr;
 196             my $osub = $conf->{'original-subfield'};
 197             $recmeta{oid} = 'NONE';
 198
 199             until ($line =~ m|</record>|) {
 200                 $lptr++;
 201                 $line = $record[$lptr];
 202                 $recmeta{oid} = $1
 203                   if ($line =~ /<subfield code="$osub">(.+?)</);
 204             }
 205         }
 206     }
 207 }
 208
 209 #-----------------------------------------------------------------------------------
 210 # driver routines
 211 #-----------------------------------------------------------------------------------
 212
 213 =head2 edit
 214
 215 Handles the Term::ReadLine loop
 216
 217 =cut
 218
 219 sub edit {
 220     my ($msg) = @_;
 221
 222     return if $conf->{trash}{ $recmeta{tag} };
 223     $conf->{editmsg} = $msg;
 224     print_fullcontext();
 225
 226     # stow original problem line
 227     $recmeta{origline} = $record[$ptr];
 228
 229     while (1) {
 230         my $line = $term->readline('marc-cleanup>');
 231         my @chunks = split /\s+/, $line;
 232
 233         # lines with single-character first chunks are commands.
 234         # make sure they exist.
 235         if (length $chunks[0] == 1) {
 236             unless (defined $commands{$chunks[0]}) {
 237                 print $OUT "No such command '", $chunks[0], "'\n";
 238                 next;
 239             }
 240         }
 241
 242         if (defined $commands{$chunks[0]}) {
 243             my $term = $commands{$chunks[0]}->(@chunks[1..$#chunks]);
 244             last if $term;
 245         } else {
 246             $recmeta{prevline} = $record[$ptr];
 247             $record[$ptr] = "$line\n";
 248             print_context();
 249         }
 250     }
 251     # set pointer to top on the way out
 252     $ptr = 0;
 253 }
 254
 255 =head2 buildrecord
 256
 257 Constructs record arrays from the incoming MARC file and returns them
 258 to the driver loop.
 259
 260 =cut
 261
 262 sub buildrecord {
 263     my $l = '';
 264     $l = <MARC> while (defined $l and $l !~ /<record>/);
 265     return $l unless defined $l;
 266     @record = ();
 267     %recmeta = ();
 268     $conf->{ricount}++;
 269
 270     until ($l =~ m|</record>|)
 271       { push @record, $l; $l = <MARC>; }
 272     push @record, $l;
 273     return 1;
 274 }
 275
 276 sub write_record {
 277     my ($FH) = @_;
 278     my $trash = $conf->{trash};
 279
 280     if ($FH eq 'EX') {
 281         $EXMARC = undef;
 282         open $EXMARC, '>:utf8', $conf->{exception}
 283           or die "Can't open exception file $!\n";
 284         $FH = $EXMARC;
 285     }
 286
 287     $conf->{rocount}++ if ($FH eq $NUMARC);
 288     print $FH '<!-- ', $recmeta{explanation}, " -->\n"
 289       if(defined $recmeta{explanation});
 290
 291     # excise unwanted tags
 292     if (keys %{$trash} or $conf->{autoscrub}) {
 293         my @trimmed = ();
 294         my $istrash = 0;
 295         for my $line (@record) {
 296             if ($istrash) {
 297                 $istrash = 0 if $line =~ m|</datafield|;
 298                 next;
 299             }
 300             if ($line =~ m/<datafield tag="(.{3})"/) {
 301                 my $tag = $1;
 302                 if ($trash->{$tag} or ($conf->{autoscrub} and $tag =~ /\D/)) {
 303                     $istrash = 1;
 304                     next
 305                 }
 306             }
 307             push @trimmed, $line;
 308         }
 309         @record = @trimmed;
 310     }
 311
 312     # add 903(?) with new record id
 313     my $renumber = '';
 314     if ($conf->{'renumber-from'}) {
 315         $recmeta{nid} = $conf->{'renumber-from'};
 316         $renumber = join('', ' <datafield tag="', $conf->{'renumber-tag'},
 317                          '" ind1=" " ind2=" "> <subfield code="',
 318                          $conf->{'renumber-subfield'},
 319                          '">', $recmeta{nid}, "</subfield></datafield>\n");
 320         my @tmp = @record[0 .. $#record - 1];
 321         my $last = $record[$#record];
 322         @record = (@tmp, $renumber, $last);
 323         $conf->{'renumber-from'}++;
 324     }
 325
 326     # scrub newlines (unless told not to or writing exception record)
 327     unless ($conf->{nocollapse} or $FH eq $EXMARC)
 328       { s/\n// for (@record) }
 329
 330     # write to old->new map file if needed
 331     if ($conf->{'renumber-from'} and $conf->{'original-subfield'}) {
 332         unless (defined $recmeta{oid}) {
 333             my $msg = join(' ', "No old id num found");
 334             dump_record($msg);
 335         } else {
 336             print $OLD2NEW $recmeta{oid}, "\t", $recmeta{nid}, "\n"
 337         }
 338     }
 339
 340     # actually write the record
 341     print $FH @record,"\n";
 342
 343     # if we were dumping to exception file, nuke the record and set ptr
 344     # to terminate processing loop
 345     @record = ('a');
 346     $ptr = 0;
 347 }
 348
 349 sub print_fullcontext {
 350     print $OUT "\r", ' ' x 72, "\n";
 351     print $OUT $conf->{editmsg},"\n";
 352     print $OUT "\r    Tag:",$recmeta{tag}, " Ind1:'",
 353       $recmeta{ind1},"' Ind2:'", $recmeta{ind2}, "'";
 354     print $OUT " @ ", $conf->{ricount}, "/", $conf->{rocount} + 1,"\n";
 355     print_context();
 356     return 0;
 357 }
 358
 359 sub print_context {
 360     my $upper = int($conf->{window} / 2) + 1;
 361     my $lower = int($conf->{window} / 2) - 1;
 362     my $start = ($ptr - $upper < 0) ? 0 : $ptr - $upper;
 363     my $stop  = ($ptr + $lower > $#record) ? $#record : $ptr + $lower;
 364     print $OUT "\n";
 365     print $OUT '    |', $record[$_] for ($start .. $ptr - 1);
 366     print $OUT '==> |', $record[$ptr];
 367     print $OUT '    |', $record[$_] for ($ptr + 1 .. $stop);
 368     print $OUT "\n";
 369     return 0;
 370 }
 371
 372 sub message {
 373     my ($msg) = @_;
 374     print $OUT "\r$msg at ",$conf->{ricount},"/",$conf->{rocount} + 1,"\n";
 375 }
 376
 377 #-----------------------------------------------------------------------------------
 378 # command routines
 379 #-----------------------------------------------------------------------------------
 380
 381 sub substitute {
 382     my (@chunks) = @_;
 383
 384     my $ofrom = shift @chunks;
 385     if ($ofrom =~ /^'/) {
 386         until ($ofrom =~ /'$/ or !@chunks)
 387           { $ofrom .= join(' ','',shift @chunks) }
 388         $ofrom =~ s/^'//; $ofrom =~ s/'$//;
 389     }
 390     my $to = shift @chunks;
 391     if ($to =~ /^'/) {
 392         until ($to =~ /'$/ or !@chunks)
 393           { $to .= join(' ','',shift @chunks) }
 394         $to =~ s/^'//; $to =~ s/'$//;
 395     }
 396
 397     my $from = '';
 398     for my $char (split(//,$ofrom)) {
 399         $char = "\\" . $char if ($char =~ /\W/);
 400         $from = join('', $from, $char);
 401     }
 402
 403     $recmeta{prevline} = $record[$ptr];
 404     $record[$ptr] =~ s/$from/$to/;
 405     print_context();
 406     return 0;
 407 }
 408
 409 sub merge_lines {
 410     $recmeta{prevline} = $record[$ptr];
 411     # remove <subfield stuff; extract (probably wrong) subfield code
 412     $record[$ptr] =~ s/^\s*<subfield code="(.*?)">//;
 413     # and move to front of line
 414     $record[$ptr] = join(' ', $1 , $record[$ptr]);
 415     # tear off trailing subfield tag from preceeding line
 416     $record[$ptr - 1] =~ s|</subfield>\n||;
 417     # join current line onto preceeding line
 418     $record[$ptr - 1] = join('', $record[$ptr - 1], $record[$ptr]);
 419     # erase current line
 420     my @a = @record[0 .. $ptr - 1];
 421     my @b = @record[$ptr + 1 .. $#record];
 422     @record = (@a, @b);
 423     # move record pointer to previous line
 424     prev_line();
 425     print_context();
 426     return 0;
 427 }
 428
 429 sub flip_line {
 430     unless ($recmeta{prevline})
 431       { print $OUT "No previously edited line to flip\n"; return }
 432     my $temp = $record[$ptr];
 433     $record[$ptr] = $recmeta{prevline};
 434     $recmeta{prevline} = $temp;
 435     print_context();
 436     return 0;
 437 }
 438
 439 sub kill_line {
 440     $recmeta{killline} = $record[$ptr];
 441     my @a = @record[0 .. $ptr - 1];
 442     my @b = @record[$ptr + 1 .. $#record];
 443     @record = (@a, @b);
 444     print_context();
 445     return 0;
 446 }
 447
 448 sub yank_line {
 449     unless ($recmeta{killline})
 450       { print $OUT "No killed line to yank\n"; return }
 451     my @a = @record[0 .. $ptr - 1];
 452     my @b = @record[$ptr .. $#record];
 453     @record = (@a, $conf->{killline}, @b);
 454     print_context();
 455     return 0;
 456 }
 457
 458 sub insert_original {
 459     $record[$ptr] = $recmeta{origline};
 460     print_context();
 461     return 0;
 462 }
 463
 464 sub display_lines {
 465     print $OUT "\nOrig. edit line  :", $recmeta{origline};
 466     print $OUT "Current flip line:", $recmeta{prevline} if $recmeta{prevline};
 467     print $OUT "Last killed line :", $recmeta{killline} if $recmeta{killline};
 468     print $OUT "\n";
 469     return 0;
 470 }
 471
 472 sub dump_record {
 473     my (@explanation) = @_;
 474     print $OUT @explanation;
 475     $recmeta{explanation} = join(' ', 'Tag', $recmeta{tag}, @explanation);
 476     write_record($EXMARC);
 477     return 1;
 478 }
 479
 480 sub next_line {
 481     $ptr++ unless ($ptr == $#record);;
 482     print_context();
 483     return 0;
 484 }
 485
 486 sub prev_line {
 487     $ptr-- unless ($ptr == 0);
 488     print_context();
 489     return 0;
 490 }
 491
 492 sub commit_edit { return 1 }
 493
 494 sub widen_window {
 495     if ($conf->{window} == 15)
 496       { print $OUT "Window can't be bigger than 15 lines\n"; return }
 497     $conf->{window} += 2;
 498     print_context;
 499 }
 500
 501 sub narrow_window {
 502     if ($conf->{window} == 5)
 503       { print $OUT "Window can't be smaller than 5 lines\n"; return }
 504     $conf->{window} -= 2;
 505     print_context;
 506 }
 507
 508 sub help {
 509 print $OUT <<HELP;
 510 Type a replacement for the indicated line, or enter a command.
 511
 512 DISPLAY COMMANDS             | LINE AUTO-EDIT COMMANDS
 513 <  Expand context window     | k  Kill current line
 514 >  Contract context window   | y  Yank last killed line
 515 p  Move pointer to prev line | m  Merge current line into preceding line
 516 n  Move pointer to next line | o  Insert original line
 517 c  Print line context        | f  Flip current line and last edited line
 518 d  Print current saved lines |
 519 -----------------------------+-------------------------------------------
 520 s  Subtitute; replace ARG1 in current line with ARG2. If either ARG
 521    contains spaces, it must be single-quoted
 522 t  Commit changes and resume automated operations
 523 x  Dump record to exception file
 524 q  Quit
 525
 526 HELP
 527 return 0;
 528 }
 529
 530 sub quit { exit }
 531
 532 #-----------------------------------------------------------------------------------
 533 # populate_trash
 534 #-----------------------------------------------------------------------------------
 535 # defined a domain-specific language for specifying MARC tags to be dropped from
 536 # records during processing. it is line oriented, and is specified as follows:
 537 #
 538 # each line may specify any number of tags to be included, either singly (\d{1,3})
 539 # or as a range (\d{1,3}\.\.\d{1,3}
 540 #
 541 # if a single number is given, it must be between '000' and '999', inclusive.
 542 #
 543 # ranges obey the previous rule, and also the first number of the range must be less
 544 # than the second number
 545 #
 546 # finally, any single range in a line may be followed by the keyword 'except'. every
 547 # number or range after 'except' is excluded from the range specified. all these
 548 # numbers must actually be within the range.
 549 #
 550 # specifying a tag twice is an error, to help prevent typos
 551
 552 sub populate_trash {
 553     print $OUT ">>> TRASHTAGS FILE FOUND. LOADING TAGS TO BE STRIPPED FROM OUTPUT\n";
 554     open TRASH, '<', $conf->{trashfile}
 555       or die "Can't open trash tags file!\n";
 556     while (<TRASH>) {
 557         my $lastwasrange = 0;
 558         my %lastrange = ( high => 0, low => 0);
 559         my $except = 0;
 560
 561         my @chunks = split /\s+/;
 562         while (my $chunk = shift @chunks) {
 563
 564             # single values
 565             if ($chunk =~ /^\d{1,3}$/) {
 566                 trash_add($chunk, $except);
 567                 $lastwasrange = 0;
 568                 next;
 569             }
 570
 571             # ranges
 572             if ($chunk =~ /^\d{1,3}\.\.\d{1,3}$/) {
 573                 my ($low, $high) = trash_add_range($chunk, $except, \%lastrange);
 574                 $lastwasrange = 1;
 575                 %lastrange = (low => $low, high => $high)
 576                   unless $except;
 577                 next;
 578             }
 579
 580             # 'except'
 581             if ($chunk eq 'except') {
 582                 die "Keyword 'except' can only follow a range (line $.)\n"
 583                   unless $lastwasrange;
 584                 die "Keyword 'except' may only occur once per line (line $.)\n"
 585                   if $except;
 586                 $except = 1;
 587                 next;
 588             }
 589
 590             die "Unknown chunk $chunk in .trashtags file (line $.)\n";
 591         }
 592     }
 593
 594     # remove original id sequence tag from trash hash if we know it
 595     trash_add($conf->{'original-tag'}, 1)
 596       if ($conf->{'original-tag'} and $conf->{trash}{ $conf->{'original-tag'} });
 597 }
 598
 599 sub trash_add_range {
 600     my ($chunk, $except, $range) = @_;
 601     my ($low,$high) = split /\.\./, $chunk;
 602     die "Ranges must be 'low..high' ($low is greater than $high on line $.)\n"
 603       if ($low > $high);
 604     if ($except) {
 605         die "Exception ranges must be within last addition range (line $.)\n"
 606           if ($low < $range->{low} or $high > $range->{high});
 607     }
 608     for my $tag ($low..$high) {
 609         trash_add($tag, $except)
 610     }
 611     return $low, $high;
 612 }
 613
 614 sub trash_add {
 615     my ($tag, $except) = @_;
 616     my $trash = $conf->{trash};
 617
 618     die "Trash values must be valid tags (000-999)\n"
 619       unless ($tag >= 0 and $tag <= 999);
 620
 621     if ($except) {
 622         delete $trash->{$tag};
 623     } else {
 624         die "Trash tag '$tag' specified twice (line $.)\n"
 625           if $trash->{$tag};
 626         $trash->{$tag} = 1;
 627     }
 628 }
 629
 630 #-----------------------------------------------------------------------
 631
 632 =head2 initialize
 633
 634 Performs boring script initialization. Handles argument parsing,
 635 mostly.
 636
 637 =cut
 638
 639 sub initialize {
 640     my ($c) = @_;
 641     my @missing = ();
 642
 643     # set mode on existing filehandles
 644     binmode(STDIN, ':utf8');
 645
 646     my $rc = GetOptions( $c,
 647                          'autoscrub|a',
 648                          'exception|x=s',
 649                          'output|o=s',
 650                          'prefix|p=s',
 651                          'nocollapse|n',
 652                          'renumber-from|rf=i',
 653                          'renumber-tag|rt=i',
 654                          'renumber-subfield|rs=s',
 655                          'original-tag|ot=i',
 656                          'original-subfield|os=s',
 657                          'script',
 658                          'strip-nines',
 659                          'trashfile|t=s',
 660                          'trashhelp',
 661                          'help|h',
 662                        );
 663     show_help() unless $rc;
 664     show_help() if ($c->{help});
 665     show_trashhelp() if ($c->{trashhelp});
 666
 667     # defaults
 668     if ($c->{prefix}) {
 669         $c->{output} = join('.',$c->{prefix},'marc','xml');
 670         $c->{exception} = join('.',$c->{prefix},'ex','xml');
 671     }
 672     $c->{'renumber-tag'} = 903 unless defined $c->{'renumber-tag'};
 673     $c->{'renumber-subfield'} = 'a' unless defined $c->{'renumber-subfield'};
 674     $c->{window} = 5;
 675
 676     # autotrash 901, 903 if strip-nines
 677     if ($c->{'strip-nines'}) {
 678         $c->{trash}{901} = 1;
 679         $c->{trash}{903} = 1;
 680     }
 681
 682     my @keys = keys %{$c};
 683     show_help() unless (@ARGV and @keys);
 684 }
 685
 686 sub show_help {
 687     print <<HELP;
 688 Usage is: marc-cleanup [OPTIONS] <filelist>
 689 Options
 690   --output     -o  Cleaned MARCXML output filename
 691   --exception  -x  Exception (dumped records) MARCXML filename
 692        or
 693   --prefix=<PREFIX>>   -p  Shared prefix for output/exception files. Will
 694                            produce PREFIX.marc.xml and PREFIX.ex.xml
 695
 696   --trashfile  -t  File containing trash tag data (see --trashhelp)
 697
 698   --renumber-from     -rf  Begin renumbering id sequence with this number
 699   --renumber-tag      -rt  Tag to use in renumbering (default: 903)
 700   --renumber-subfield -rs  Subfield code to use in renumbering (default: a)
 701   --original-tag      -ot  Original id tag; will be kept in output even if
 702                            it appears in the trash file
 703   --original-subfield -os  Original id subfield code. If this is specified
 704                            and renumbering is in effect, an old-to-new mapping
 705                            file (old2new.map) will be generated.
 706
 707   --nocollapse -n  Don't compress records to one line on output
 708   --autoscrub  -a  Automatically remove non-numeric tags in data
 709   --strip-nines    Automatically remove any existing 901/903 tags in data
 710
 711   --script         Store human-initiated ops in scriptfile (.mcscript)
 712                    Not yet implemented
 713 HELP
 714 exit;
 715 }
 716
 717 sub show_trashhelp {
 718     print <<HELP;
 719 The marc-cleanup trash tags file is a simple plaintext file. It is a
 720 line oriented format. There are three basic tokens:
 721
 722   * The tag
 723   * The tag range
 724   * The "except" clause
 725
 726 Any number of tags and/or tag ranges can appear on a single line. A
 727 tag cannot appear twice in the file, either alone or as part of a
 728 range. This is to prevent errors in the trash tag listing. Items do
 729 not have to be sorted within a line. These following lines are valid:
 730
 731   850 852 870..879 886 890 896..899
 732   214 696..699 012
 733
 734 Ranges must be ordered internally. That is, "870..879" is valid while
 735 "879..870" is not.
 736
 737 Finally, there can be only one "except" clause on a line. It is
 738 composed of the word "except" followed by one or more tags or
 739 ranges. Except clauses must follow a range, and all tags within the
 740 clause must be within the range which the clause follows.
 741
 742   900..997 except 935 950..959 987 994
 743
 744 is a valid example.
 745 HELP
 746 exit;
 747 }