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