marc_cleanup

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