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