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