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