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