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         open $EXMARC, '>:utf8', $conf->{exception};
 277         $FH = $EXMARC;
 278     }
 279
 280     $conf->{rocount}++ if ($FH eq $NUMARC);
 281     print $FH '<!-- ', $recmeta{explanation}, " -->\n"
 282       if(defined $recmeta{explanation});
 283
 284     # excise unwanted tags
 285     if (keys %{$trash} or $conf->{autoscrub}) {
 286         my @trimmed = ();
 287         my $istrash = 0;
 288         for my $line (@record) {
 289             if ($istrash) {
 290                 $istrash = 0 if $line =~ m|</datafield|;
 291                 next;
 292             }
 293             if ($line =~ m/<datafield tag="(.{3})"/) {
 294                 my $tag = $1;
 295                 if ($trash->{$tag} or ($conf->{autoscrub} and $tag =~ /\D/)) {
 296                     $istrash = 1;
 297                     next
 298                 }
 299             }
 300             push @trimmed, $line;
 301         }
 302         @record = @trimmed;
 303     }
 304
 305     # add 903(?) with new record id
 306     my $renumber = '';
 307     if ($conf->{'renumber-from'}) {
 308         $recmeta{nid} = $conf->{'renumber-from'};
 309         $renumber = join('', ' <datafield tag="', $conf->{'renumber-tag'},
 310                          '" ind1=" " ind2=" "> <subfield code="',
 311                          $conf->{'renumber-subfield'},
 312                          '">', $recmeta{nid}, "</subfield></datafield>\n");
 313         my @tmp = @record[0 .. $#record - 1];
 314         my $last = $record[$#record];
 315         @record = (@tmp, $renumber, $last);
 316         $conf->{'renumber-from'}++;
 317     }
 318
 319     # scrub newlines
 320     unless ($conf->{nocollapse})
 321       { s/\n// for (@record) }
 322
 323     # write to old->new map file if needed
 324     print $OLD2NEW $recmeta{oid}, "\t", $recmeta{nid}, "\n"
 325       if ($conf->{'renumber-from'} and $conf->{'original-subfield'});
 326
 327     # and finally, actually write the record
 328     print $FH @record,"\n";
 329 }
 330
 331 sub print_fullcontext {
 332     print $OUT "\r", ' ' x 72, "\n";
 333     print $OUT $conf->{editmsg},"\n";
 334     print $OUT "\r    Tag:",$recmeta{tag}, " Ind1:'",
 335       $recmeta{ind1},"' Ind2:'", $recmeta{ind2}, "'";
 336     print_context();
 337     return 0;
 338 }
 339
 340 sub print_context {
 341     my $upper = int($conf->{window} / 2) + 1;
 342     my $lower = int($conf->{window} / 2) - 1;
 343     my $start = ($ptr - $upper < 0) ? 0 : $ptr - $upper;
 344     my $stop  = ($ptr + $lower > $#record) ? $#record : $ptr + $lower;
 345     print $OUT "\n";
 346     print $OUT '    |', $record[$_] for ($start .. $ptr - 1);
 347     print $OUT '==> |', $record[$ptr];
 348     print $OUT '    |', $record[$_] for ($ptr + 1 .. $stop);
 349     print $OUT "\n";
 350     return 0;
 351 }
 352
 353 sub message {
 354     my ($msg) = @_;
 355     print $OUT "\r$msg at ",$conf->{ricount},"/",$conf->{rocount} + 1,"\n";
 356 }
 357
 358 #-----------------------------------------------------------------------------------
 359 # command routines
 360 #-----------------------------------------------------------------------------------
 361
 362 sub substitute {
 363     my (@chunks) = @_;
 364
 365     my $ofrom = shift @chunks;
 366     if ($ofrom =~ /^'/) {
 367         until ($ofrom =~ /'$/ or !@chunks)
 368           { $ofrom .= join(' ','',shift @chunks) }
 369         $ofrom =~ s/^'//; $ofrom =~ s/'$//;
 370     }
 371     my $to = shift @chunks;
 372     if ($to =~ /^'/) {
 373         until ($to =~ /'$/ or !@chunks)
 374           { $to .= join(' ','',shift @chunks) }
 375         $to =~ s/^'//; $to =~ s/'$//;
 376     }
 377
 378     my $from = '';
 379     for my $char (split(//,$ofrom)) {
 380         $char = "\\" . $char if ($char =~ /\W/);
 381         $from = join('', $from, $char);
 382     }
 383
 384     $recmeta{prevline} = $record[$ptr];
 385     $record[$ptr] =~ s/$from/$to/;
 386     print_context();
 387     return 0;
 388 }
 389
 390 sub merge_lines {
 391     $recmeta{prevline} = $record[$ptr];
 392     # remove <subfield stuff; extract (probably wrong) subfield code
 393     $record[$ptr] =~ s/^\s*<subfield code="(.*?)">//;
 394     # and move to front of line
 395     $record[$ptr] = join(' ', $1 , $record[$ptr]);
 396     # tear off trailing subfield tag from preceeding line
 397     $record[$ptr - 1] =~ s|</subfield>\n||;
 398     # join current line onto preceeding line
 399     $record[$ptr - 1] = join('', $record[$ptr - 1], $record[$ptr]);
 400     # erase current line
 401     my @a = @record[0 .. $ptr - 1];
 402     my @b = @record[$ptr + 1 .. $#record];
 403     @record = (@a, @b);
 404     # move record pointer to previous line
 405     prev_line();
 406     print_context();
 407     return 0;
 408 }
 409
 410 sub flip_line {
 411     unless ($recmeta{prevline})
 412       { print $OUT "No previously edited line to flip\n"; return }
 413     my $temp = $record[$ptr];
 414     $record[$ptr] = $recmeta{prevline};
 415     $recmeta{prevline} = $temp;
 416     print_context();
 417     return 0;
 418 }
 419
 420 sub kill_line {
 421     $recmeta{killline} = $record[$ptr];
 422     my @a = @record[0 .. $ptr - 1];
 423     my @b = @record[$ptr + 1 .. $#record];
 424     @record = (@a, @b);
 425     print_context();
 426     return 0;
 427 }
 428
 429 sub yank_line {
 430     unless ($recmeta{killline})
 431       { print $OUT "No killed line to yank\n"; return }
 432     my @a = @record[0 .. $ptr - 1];
 433     my @b = @record[$ptr .. $#record];
 434     @record = (@a, $conf->{killline}, @b);
 435     print_context();
 436     return 0;
 437 }
 438
 439 sub display_lines {
 440     print $OUT "\nOrig. edit line  :", $recmeta{origline};
 441     print $OUT "Current flip line:", $recmeta{prevline} if $recmeta{prevline};
 442     print $OUT "Last killed line :", $recmeta{killline} if $recmeta{killline};
 443     print $OUT "\n";
 444     return 0;
 445 }
 446
 447 sub dump_record {
 448     my (@explanation) = @_;
 449     $recmeta{explanation} = join(' ', 'Tag', $recmeta{tag}, @explanation);
 450     write_record($EXMARC);
 451     return 1;
 452 }
 453
 454 sub next_line {
 455     $ptr++ unless ($ptr == $#record);;
 456     print_context();
 457     return 0;
 458 }
 459
 460 sub prev_line {
 461     $ptr-- unless ($ptr == 0);
 462     print_context();
 463     return 0;
 464 }
 465
 466 sub commit_edit { return 1 }
 467
 468 sub widen_window {
 469     if ($conf->{window} == 15)
 470       { print $OUT "Window can't be bigger than 15 lines\n"; return }
 471     $conf->{window} += 2;
 472     print_context;
 473 }
 474
 475 sub narrow_window {
 476     if ($conf->{window} == 5)
 477       { print $OUT "Window can't be smaller than 5 lines\n"; return }
 478     $conf->{window} -= 2;
 479     print_context;
 480 }
 481
 482 sub help {
 483 print $OUT <<HELP;
 484 Type a replacement for the indicated line, or enter a command.
 485
 486 DISPLAY COMMANDS             | LINE AUTO-EDIT COMMANDS
 487 <  Expand context window     | k  Kill current line
 488 >  Contract context window   | y  Yank last killed line
 489 p  Move pointer to prev line | m  Merge current line into preceding line
 490 n  Move pointer to next line | o  Insert original line
 491 c  Print line context        | f  Flip current line and last edited line
 492 d  Print current saved lines |
 493 -----------------------------+-------------------------------------------
 494 s  Subtitute; replace ARG1 in current line with ARG2. If either ARG
 495    contains spaces, it must be single-quoted
 496 t  Commit changes and resume automated operations
 497 x  Dump record to exception file
 498 q  Quit
 499
 500 HELP
 501 return 0;
 502 }
 503
 504 sub quit { exit }
 505
 506 #-----------------------------------------------------------------------------------
 507 # populate_trash
 508 #-----------------------------------------------------------------------------------
 509 # defined a domain-specific language for specifying MARC tags to be dropped from
 510 # records during processing. it is line oriented, and is specified as follows:
 511 #
 512 # each line may specify any number of tags to be included, either singly (\d{1,3})
 513 # or as a range (\d{1,3}\.\.\d{1,3}
 514 #
 515 # if a single number is given, it must be between '000' and '999', inclusive.
 516 #
 517 # ranges obey the previous rule, and also the first number of the range must be less
 518 # than the second number
 519 #
 520 # finally, any single range in a line may be followed by the keyword 'except'. every
 521 # number or range after 'except' is excluded from the range specified. all these
 522 # numbers must actually be within the range.
 523 #
 524 # specifying a tag twice is an error, to help prevent typos
 525
 526 sub populate_trash {
 527     print $OUT ">>> TRASHTAGS FILE FOUND. LOADING TAGS TO BE STRIPPED FROM OUTPUT\n";
 528     open TRASH, '<', $conf->{trashfile}
 529       or die "Can't open trash tags file!\n";
 530     while (<TRASH>) {
 531         my $lastwasrange = 0;
 532         my %lastrange = ( high => 0, low => 0);
 533         my $except = 0;
 534
 535         my @chunks = split /\s+/;
 536         while (my $chunk = shift @chunks) {
 537
 538             # single values
 539             if ($chunk =~ /^\d{1,3}$/) {
 540                 trash_add($chunk, $except);
 541                 $lastwasrange = 0;
 542                 next;
 543             }
 544
 545             # ranges
 546             if ($chunk =~ /^\d{1,3}\.\.\d{1,3}$/) {
 547                 my ($low, $high) = trash_add_range($chunk, $except, \%lastrange);
 548                 $lastwasrange = 1;
 549                 %lastrange = (low => $low, high => $high)
 550                   unless $except;
 551                 next;
 552             }
 553
 554             # 'except'
 555             if ($chunk eq 'except') {
 556                 die "Keyword 'except' can only follow a range (line $.)\n"
 557                   unless $lastwasrange;
 558                 die "Keyword 'except' may only occur once per line (line $.)\n"
 559                   if $except;
 560                 $except = 1;
 561                 next;
 562             }
 563
 564             die "Unknown chunk $chunk in .trashtags file (line $.)\n";
 565         }
 566     }
 567
 568     # remove original id sequence tag from trash hash if we know it
 569     trash_add($conf->{'original-tag'}, 1)
 570       if ($conf->{'original-tag'} and $conf->{trash}{ $conf->{'original-tag'} });
 571 }
 572
 573 sub trash_add_range {
 574     my ($chunk, $except, $range) = @_;
 575     my ($low,$high) = split /\.\./, $chunk;
 576     die "Ranges must be 'low..high' ($low is greater than $high on line $.)\n"
 577       if ($low > $high);
 578     if ($except) {
 579         die "Exception ranges must be within last addition range (line $.)\n"
 580           if ($low < $range->{low} or $high > $range->{high});
 581     }
 582     for my $tag ($low..$high) {
 583         trash_add($tag, $except)
 584     }
 585     return $low, $high;
 586 }
 587
 588 sub trash_add {
 589     my ($tag, $except) = @_;
 590     my $trash = $conf->{trash};
 591
 592     die "Trash values must be valid tags (000-999)\n"
 593       unless ($tag >= 0 and $tag <= 999);
 594
 595     if ($except) {
 596         delete $trash->{$tag};
 597     } else {
 598         die "Trash tag '$tag' specified twice (line $.)\n"
 599           if $trash->{$tag};
 600         $trash->{$tag} = 1;
 601     }
 602 }
 603
 604 #-----------------------------------------------------------------------
 605
 606 =head2 initialize
 607
 608 Performs boring script initialization. Handles argument parsing,
 609 mostly.
 610
 611 =cut
 612
 613 sub initialize {
 614     my ($c) = @_;
 615     my @missing = ();
 616
 617     # set mode on existing filehandles
 618     binmode(STDIN, ':utf8');
 619
 620     my $rc = GetOptions( $c,
 621                          'autoscrub|a',
 622                          'exception|x=s',
 623                          'output|o=s',
 624                          'nocollapse|n',
 625                          'renumber-from|rf=i',
 626                          'renumber-tag|rt=i',
 627                          'renumber-subfield|rs=s',
 628                          'original-tag|ot=i',
 629                          'original-subfield|os=s',
 630                          'script',
 631                          'strip-nines',
 632                          'trashfile|t=s',
 633                          'trashhelp',
 634                          'help|h',
 635                        );
 636     show_help() unless $rc;
 637     show_help() if ($c->{help});
 638     show_trashhelp() if ($c->{trashhelp});
 639
 640     # defaults
 641     $c->{output} = 'cleaned.marc.xml' unless defined $c->{output};
 642     $c->{exception} = 'exceptions.marc.xml' unless defined $c->{exception};
 643     $c->{'renumber-tag'} = 903 unless defined $c->{'renumber-tag'};
 644     $c->{'renumber-subfield'} = 'a' unless defined $c->{'renumber-subfield'};
 645     $c->{window} = 5;
 646
 647     # autotrash 901, 903 if strip-nines
 648     if ($c->{'strip-nines'}) {
 649         $c->{trash}{901} = 1;
 650         $c->{trash}{903} = 1;
 651     }
 652
 653     my @keys = keys %{$c};
 654     show_help() unless (@ARGV and @keys);
 655 }
 656
 657 sub show_help {
 658     print <<HELP;
 659 Usage is: marc-cleanup [OPTIONS] <filelist>
 660 Options
 661   --output     -o  Cleaned MARCXML output filename
 662                    (default: cleaned.marc.xml)
 663   --exception  -x  Exception (dumped records) MARCXML filename
 664                    (exceptions.marc.xml)
 665   --trashfile  -t  File containing trash tag data (see --trashhelp)
 666
 667   --renumber-from     -rf  Begin renumbering id sequence with this number
 668   --renumber-tag      -rt  Tag to use in renumbering (default: 903)
 669   --renumber-subfield -rs  Subfield code to use in renumbering (default: a)
 670   --original-tag      -ot  Original id tag; will be kept in output even if
 671                            it appears in the trash file
 672   --original-subfield -os  Original id subfield code. If this is specified
 673                            and renumbering is in effect, an old-to-new mapping
 674                            file (old2new.map) will be generated.
 675
 676   --nocollapse -n  Don't compress records to one line on output
 677   --autoscrub  -a  Automatically remove non-numeric tags in data
 678   --strip-nines    Automatically remove any existing 901/903 tags in data
 679
 680   --script         Store human-initiated ops in scriptfile (.mcscript)
 681                    Not yet implemented
 682 HELP
 683 exit;
 684 }
 685
 686 sub show_trashhelp {
 687     print <<HELP;
 688 The marc-cleanup trash tags file is a simple plaintext file. It is a
 689 line oriented format. There are three basic tokens:
 690
 691   * The tag
 692   * The tag range
 693   * The "except" clause
 694
 695 Any number of tags and/or tag ranges can appear on a single line. A
 696 tag cannot appear twice in the file, either alone or as part of a
 697 range. This is to prevent errors in the trash tag listing. Items do
 698 not have to be sorted within a line. These following lines are valid:
 699
 700   850 852 870..879 886 890 896..899
 701   214 696..699 012
 702
 703 Ranges must be ordered internally. That is, "870..879" is valid while
 704 "879..870" is not.
 705
 706 Finally, there can be only one "except" clause on a line. It is
 707 composed of the word "except" followed by one or more tags or
 708 ranges. Except clauses must follow a range, and all tags within the
 709 clause must be within the range which the clause follows.
 710
 711   900..997 except 935 950..959 987 994
 712
 713 is a valid example.
 714 HELP
 715 exit;
 716 }