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